diff --git a/Compiler/CompilationModel/Compile.lean b/Compiler/CompilationModel/Compile.lean index 86f2f1da8..8a5e86585 100644 --- a/Compiler/CompilationModel/Compile.lean +++ b/Compiler/CompilationModel/Compile.lean @@ -169,19 +169,20 @@ def compileStmt (fields : List Field) (events : List EventDef := []) | Stmt.setStorageWord field wordOffset value => match findFieldWithResolvedSlot fields field with | some (f, slot) => do + let storeBuiltin := if f.isTransient then "tstore" else "sstore" let valueExpr ← compileExprWithInternals fields dynamicSource internalFunctions value let slotExpr (baseSlot : Nat) := if wordOffset == 0 then YulExpr.lit baseSlot else YulExpr.call "add" [YulExpr.lit baseSlot, YulExpr.lit wordOffset] match f.aliasSlots with | [] => - pure [YulStmt.expr (YulExpr.call "sstore" [slotExpr slot, valueExpr])] + pure [YulStmt.expr (YulExpr.call storeBuiltin [slotExpr slot, valueExpr])] | _ => pure [ YulStmt.block ( [YulStmt.let_ "__compat_value" valueExpr] ++ (slot :: f.aliasSlots).map (fun writeSlot => - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ slotExpr writeSlot, YulExpr.ident "__compat_value" ])) @@ -200,12 +201,15 @@ def compileStmt (fields : List Field) (events : List EventDef := []) (← compileExprWithInternals fields dynamicSource internalFunctions key) (← compileExprWithInternals fields dynamicSource internalFunctions value) "setMapping" + 0 + true | Stmt.setMappingWord field key wordOffset value => do compileMappingSlotWrite fields field (← compileExprWithInternals fields dynamicSource internalFunctions key) (← compileExprWithInternals fields dynamicSource internalFunctions value) "setMappingWord" wordOffset + true | Stmt.setMappingPackedWord field key wordOffset packed value => do compileMappingPackedSlotWrite fields field (← compileExprWithInternals fields dynamicSource internalFunctions key) @@ -213,6 +217,7 @@ def compileStmt (fields : List Field) (events : List EventDef := []) wordOffset packed "setMappingPackedWord" + true | Stmt.setMapping2 field key1 key2 value => compileSetMapping2 fields dynamicSource field key1 key2 value internalFunctions | Stmt.setMapping2Word field key1 key2 wordOffset value => @@ -222,6 +227,8 @@ def compileStmt (fields : List Field) (events : List EventDef := []) (← compileExprWithInternals fields dynamicSource internalFunctions key) (← compileExprWithInternals fields dynamicSource internalFunctions value) "setMappingUint" + 0 + true | Stmt.setMappingChain field keys value => compileSetMappingChain fields dynamicSource field keys value internalFunctions | Stmt.setStructMember field key memberName value => diff --git a/Compiler/CompilationModel/ExpressionCompile.lean b/Compiler/CompilationModel/ExpressionCompile.lean index 623be0673..c02ec7db2 100644 --- a/Compiler/CompilationModel/ExpressionCompile.lean +++ b/Compiler/CompilationModel/ExpressionCompile.lean @@ -28,11 +28,12 @@ def compileMappingSlotRead (fields : List Field) (field : String) (keyExpr : Yul if !isMapping fields field then throw s!"Compilation error: field '{field}' is not a mapping" else - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (f, slot) => let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyExpr] let finalSlot := if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset] - pure (YulExpr.call "sload" [finalSlot]) + let loadBuiltin := if f.isTransient then "tload" else "sload" + pure (YulExpr.call loadBuiltin [finalSlot]) | none => throw s!"Compilation error: unknown mapping field '{field}' in {label}" -- Exposed so proof modules can name the exact nested mapping-chain lowering shape. @@ -191,12 +192,13 @@ def compileExprWithInternals (fields : List Field) else match findFieldWithResolvedSlot fields field with | some (f, slot) => + let loadBuiltin := if f.isTransient then "tload" else "sload" match f.packedBits with | none => - pure (YulExpr.call "sload" [YulExpr.lit slot]) + pure (YulExpr.call loadBuiltin [YulExpr.lit slot]) | some packed => pure (YulExpr.call "and" [ - YulExpr.call "shr" [YulExpr.lit packed.offset, YulExpr.call "sload" [YulExpr.lit slot]], + YulExpr.call "shr" [YulExpr.lit packed.offset, YulExpr.call loadBuiltin [YulExpr.lit slot]], YulExpr.lit (packedMaskNat packed) ]) | none => throw s!"Compilation error: unknown storage field '{field}'" @@ -206,14 +208,15 @@ def compileExprWithInternals (fields : List Field) else match findFieldWithResolvedSlot fields field with | some (f, slot) => + let loadBuiltin := if f.isTransient then "tload" else "sload" match f.ty with | .address => match f.packedBits with | none => - pure (YulExpr.call "sload" [YulExpr.lit slot]) + pure (YulExpr.call loadBuiltin [YulExpr.lit slot]) | some packed => pure (YulExpr.call "and" [ - YulExpr.call "shr" [YulExpr.lit packed.offset, YulExpr.call "sload" [YulExpr.lit slot]], + YulExpr.call "shr" [YulExpr.lit packed.offset, YulExpr.call loadBuiltin [YulExpr.lit slot]], YulExpr.lit (packedMaskNat packed) ]) | _ => @@ -236,25 +239,27 @@ def compileExprWithInternals (fields : List Field) if !isMapping2 fields field then throw s!"Compilation error: field '{field}' is not a double mapping" else - match findFieldSlot fields field with - | some slot => do + match findFieldWithResolvedSlot fields field with + | some (f, slot) => do + let loadBuiltin := if f.isTransient then "tload" else "sload" let key1Expr ← compileExprWithInternals fields dynamicSource internalFunctions key1 let key2Expr ← compileExprWithInternals fields dynamicSource internalFunctions key2 let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1Expr] - pure (YulExpr.call "sload" [YulExpr.call "mappingSlot" [innerSlot, key2Expr]]) + pure (YulExpr.call loadBuiltin [YulExpr.call "mappingSlot" [innerSlot, key2Expr]]) | none => throw s!"Compilation error: unknown mapping field '{field}'" | Expr.mapping2Word field key1 key2 wordOffset => if !isMapping2 fields field then throw s!"Compilation error: field '{field}' is not a double mapping" else - match findFieldSlot fields field with - | some slot => do + match findFieldWithResolvedSlot fields field with + | some (f, slot) => do + let loadBuiltin := if f.isTransient then "tload" else "sload" let key1Expr ← compileExprWithInternals fields dynamicSource internalFunctions key1 let key2Expr ← compileExprWithInternals fields dynamicSource internalFunctions key2 let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1Expr] let outerSlot := YulExpr.call "mappingSlot" [innerSlot, key2Expr] let finalSlot := if wordOffset == 0 then outerSlot else YulExpr.call "add" [outerSlot, YulExpr.lit wordOffset] - pure (YulExpr.call "sload" [finalSlot]) + pure (YulExpr.call loadBuiltin [finalSlot]) | none => throw s!"Compilation error: unknown mapping field '{field}'" | Expr.mappingUint field key => do compileMappingSlotRead fields field (← compileExprWithInternals fields dynamicSource internalFunctions key) "mappingUint" @@ -262,10 +267,11 @@ def compileExprWithInternals (fields : List Field) if !isMapping fields field then throw s!"Compilation error: field '{field}' is not a mapping" else - match findFieldSlot fields field with - | some slot => do + match findFieldWithResolvedSlot fields field with + | some (f, slot) => do let keyExprs ← compileExprListWithInternals fields dynamicSource internalFunctions keys - pure (YulExpr.call "sload" [compileMappingSlotChain (YulExpr.lit slot) keyExprs]) + let loadBuiltin := if f.isTransient then "tload" else "sload" + pure (YulExpr.call loadBuiltin [compileMappingSlotChain (YulExpr.lit slot) keyExprs]) | none => throw s!"Compilation error: unknown mapping field '{field}'" | Expr.structMember field key memberName => do if isMapping2 fields field then @@ -295,8 +301,9 @@ def compileExprWithInternals (fields : List Field) match findStructMember members memberName with | none => throw s!"Compilation error: struct field '{field}' has no member '{memberName}'" | some member => - match findFieldSlot fields field with - | some slot => do + match findFieldWithResolvedSlot fields field with + | some (f, slot) => do + let loadBuiltin := if f.isTransient then "tload" else "sload" let key1Expr ← compileExprWithInternals fields dynamicSource internalFunctions key1 let key2Expr ← compileExprWithInternals fields dynamicSource internalFunctions key2 let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1Expr] @@ -304,10 +311,10 @@ def compileExprWithInternals (fields : List Field) let finalSlot := if member.wordOffset == 0 then outerSlot else YulExpr.call "add" [outerSlot, YulExpr.lit member.wordOffset] match member.packed with | none => - pure (YulExpr.call "sload" [finalSlot]) + pure (YulExpr.call loadBuiltin [finalSlot]) | some packed => pure (YulExpr.call "and" [ - YulExpr.call "shr" [YulExpr.lit packed.offset, YulExpr.call "sload" [finalSlot]], + YulExpr.call "shr" [YulExpr.lit packed.offset, YulExpr.call loadBuiltin [finalSlot]], YulExpr.lit (packedMaskNat packed) ]) | none => throw s!"Compilation error: unknown mapping field '{field}'" diff --git a/Compiler/CompilationModel/MappingWrites.lean b/Compiler/CompilationModel/MappingWrites.lean index f98171425..0432479ee 100644 --- a/Compiler/CompilationModel/MappingWrites.lean +++ b/Compiler/CompilationModel/MappingWrites.lean @@ -7,48 +7,81 @@ open Compiler open Compiler.Yul def compileMappingSlotWrite (fields : List Field) (field : String) - (keyExpr valueExpr : YulExpr) (label : String) (wordOffset : Nat := 0) : Except String (List YulStmt) := + (keyExpr valueExpr : YulExpr) (label : String) (wordOffset : Nat := 0) + (allowTransient : Bool := false) : Except String (List YulStmt) := if !isMapping fields field then throw s!"Compilation error: field '{field}' is not a mapping" else + let storeBuiltin := + if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tstore" else "sstore" + | none => "sstore" + else + "sstore" match findFieldWriteSlots fields field with | some slots => match slots with - | [] => - throw s!"Compilation error: internal invariant failure: no write slots for mapping field '{field}' in {label}" - | [slot] => - let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyExpr] - let writeSlot := if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset] - pure [ - YulStmt.expr (YulExpr.call "sstore" [ - writeSlot, - valueExpr - ]) - ] - | _ => - let compatSlotExpr := fun (slot : Nat) => - let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, YulExpr.ident "__compat_key"] - if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset] - pure [ - YulStmt.block ( - [YulStmt.let_ "__compat_key" keyExpr, YulStmt.let_ "__compat_value" valueExpr] ++ - slots.map (fun slot => + | [] => + throw s!"Compilation error: internal invariant failure: no write slots for mapping field '{field}' in {label}" + | [slot] => + let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyExpr] + let writeSlot := if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset] + if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (_, _) => + pure [ + YulStmt.expr (YulExpr.call storeBuiltin [ + writeSlot, + valueExpr + ]) + ] + | none => throw s!"Compilation error: unknown mapping field '{field}' in {label}" + else + pure [ YulStmt.expr (YulExpr.call "sstore" [ - compatSlotExpr slot, - YulExpr.ident "__compat_value" - ])) - ) - ] + writeSlot, + valueExpr + ]) + ] + | _ => + let compatSlotExpr := fun (slot : Nat) => + let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, YulExpr.ident "__compat_key"] + if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset] + pure [ + YulStmt.block ( + [YulStmt.let_ "__compat_key" keyExpr, YulStmt.let_ "__compat_value" valueExpr] ++ + slots.map (fun slot => + YulStmt.expr (YulExpr.call storeBuiltin [ + compatSlotExpr slot, + YulExpr.ident "__compat_value" + ])) + ) + ] | none => throw s!"Compilation error: unknown mapping field '{field}' in {label}" def compileMappingPackedSlotWrite (fields : List Field) (field : String) (keyExpr valueExpr : YulExpr) (wordOffset : Nat) (packed : PackedBits) - (label : String) : Except String (List YulStmt) := + (label : String) (allowTransient : Bool := false) : Except String (List YulStmt) := if !isMapping fields field then throw s!"Compilation error: field '{field}' is not a mapping" else if !packedBitsValid packed then throw s!"Compilation error: {label} for field '{field}' has invalid packed range offset={packed.offset} width={packed.width}. Require 0 < width <= 256, offset < 256, and offset + width <= 256." else + let loadBuiltin := + if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tload" else "sload" + | none => "sload" + else + "sload" + let storeBuiltin := + if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tstore" else "sstore" + | none => "sstore" + else + "sstore" match findFieldWriteSlots fields field with | some slots => match slots with @@ -63,12 +96,12 @@ def compileMappingPackedSlotWrite (fields : List Field) (field : String) YulStmt.block [ YulStmt.let_ "__compat_value" valueExpr, YulStmt.let_ "__compat_packed" (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit maskNat]), - YulStmt.let_ "__compat_slot_word" (YulExpr.call "sload" [writeSlot]), + YulStmt.let_ "__compat_slot_word" (YulExpr.call loadBuiltin [writeSlot]), YulStmt.let_ "__compat_slot_cleared" (YulExpr.call "and" [ YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit shiftedMaskNat] ]), - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ writeSlot, YulExpr.call "or" [ YulExpr.ident "__compat_slot_cleared", @@ -90,12 +123,12 @@ def compileMappingPackedSlotWrite (fields : List Field) (field : String) YulStmt.let_ "__compat_packed" (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit maskNat])] ++ slots.map (fun slot => YulStmt.block [ - YulStmt.let_ "__compat_slot_word" (YulExpr.call "sload" [slotExpr slot]), + YulStmt.let_ "__compat_slot_word" (YulExpr.call loadBuiltin [slotExpr slot]), YulStmt.let_ "__compat_slot_cleared" (YulExpr.call "and" [ YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit shiftedMaskNat] ]), - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ slotExpr slot, YulExpr.call "or" [ YulExpr.ident "__compat_slot_cleared", diff --git a/Compiler/CompilationModel/StorageWrites.lean b/Compiler/CompilationModel/StorageWrites.lean index 7a6373b8d..c9645ee4b 100644 --- a/Compiler/CompilationModel/StorageWrites.lean +++ b/Compiler/CompilationModel/StorageWrites.lean @@ -22,7 +22,8 @@ def validateDynamicArrayField (fields : List Field) (field : String) : | none => throw s!"Compilation error: unknown storage field '{field}'" -def compilePackedStorageWrite (writeSlot valueExpr : YulExpr) (packed : PackedBits) : +def compilePackedStorageWrite (writeSlot valueExpr : YulExpr) (packed : PackedBits) + (loadBuiltin : String := "sload") (storeBuiltin : String := "sstore") : List YulStmt := let maskNat := packedMaskNat packed let shiftedMaskNat := packedShiftedMaskNat packed @@ -30,12 +31,12 @@ def compilePackedStorageWrite (writeSlot valueExpr : YulExpr) (packed : PackedBi YulStmt.block [ YulStmt.let_ "__compat_value" valueExpr, YulStmt.let_ "__compat_packed" (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit maskNat]), - YulStmt.let_ "__compat_slot_word" (YulExpr.call "sload" [writeSlot]), + YulStmt.let_ "__compat_slot_word" (YulExpr.call loadBuiltin [writeSlot]), YulStmt.let_ "__compat_slot_cleared" (YulExpr.call "and" [ YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit shiftedMaskNat] ]), - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ writeSlot, YulExpr.call "or" [ YulExpr.ident "__compat_slot_cleared", @@ -46,7 +47,8 @@ def compilePackedStorageWrite (writeSlot valueExpr : YulExpr) (packed : PackedBi ] def compileCompatPackedStorageWrites (writeSlots : List YulExpr) (valueExpr : YulExpr) - (packed : PackedBits) : List YulStmt := + (packed : PackedBits) (loadBuiltin : String := "sload") + (storeBuiltin : String := "sstore") : List YulStmt := let maskNat := packedMaskNat packed let shiftedMaskNat := packedShiftedMaskNat packed [ @@ -55,12 +57,12 @@ def compileCompatPackedStorageWrites (writeSlots : List YulExpr) (valueExpr : Yu YulStmt.let_ "__compat_packed" (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit maskNat])] ++ writeSlots.map (fun writeSlot => YulStmt.block [ - YulStmt.let_ "__compat_slot_word" (YulExpr.call "sload" [writeSlot]), + YulStmt.let_ "__compat_slot_word" (YulExpr.call loadBuiltin [writeSlot]), YulStmt.let_ "__compat_slot_cleared" (YulExpr.call "and" [ YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit shiftedMaskNat] ]), - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ writeSlot, YulExpr.call "or" [ YulExpr.ident "__compat_slot_cleared", @@ -86,6 +88,8 @@ def compileSetStorage (fields : List Field) (dynamicSource : DynamicDataSource) | _ => throw s!"Compilation error: field '{field}' is not address-typed; use Stmt.setStorage instead" let slots := slot :: f.aliasSlots + let loadBuiltin := if f.isTransient then "tload" else "sload" + let storeBuiltin := if f.isTransient then "tstore" else "sstore" let valueExpr ← compileExprWithInternals fields dynamicSource internalFunctions value let storedValueExpr := if requireAddressField then @@ -102,9 +106,9 @@ def compileSetStorage (fields : List Field) (dynamicSource : DynamicDataSource) | [singleSlot] => match f.packedBits with | none => - pure [YulStmt.expr (YulExpr.call "sstore" [YulExpr.lit singleSlot, storedValueExpr])] + pure [YulStmt.expr (YulExpr.call storeBuiltin [YulExpr.lit singleSlot, storedValueExpr])] | some packed => - pure (compilePackedStorageWrite (YulExpr.lit singleSlot) storedValueExpr packed) + pure (compilePackedStorageWrite (YulExpr.lit singleSlot) storedValueExpr packed loadBuiltin storeBuiltin) | _ => let writeSlots := slots.map YulExpr.lit match f.packedBits with @@ -113,11 +117,11 @@ def compileSetStorage (fields : List Field) (dynamicSource : DynamicDataSource) YulStmt.block ( [YulStmt.let_ "__compat_value" storedValueExpr] ++ writeSlots.map (fun writeSlot => - YulStmt.expr (YulExpr.call "sstore" [writeSlot, YulExpr.ident "__compat_value"])) + YulStmt.expr (YulExpr.call storeBuiltin [writeSlot, YulExpr.ident "__compat_value"])) ) ] | some packed => - pure (compileCompatPackedStorageWrites writeSlots storedValueExpr packed) + pure (compileCompatPackedStorageWrites writeSlots storedValueExpr packed loadBuiltin storeBuiltin) | none => throw s!"Compilation error: unknown storage field '{field}' in setStorage" def compileStorageArrayPush (fields : List Field) (dynamicSource : DynamicDataSource) @@ -192,6 +196,10 @@ def compileSetMapping2 (fields : List Field) (dynamicSource : DynamicDataSource) else match findFieldWriteSlots fields field with | some slots => do + let storeBuiltin := + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tstore" else "sstore" + | none => "sstore" let key1Expr ← compileExprWithInternals fields dynamicSource internalFunctions key1 let key2Expr ← compileExprWithInternals fields dynamicSource internalFunctions key2 let valueExpr ← compileExprWithInternals fields dynamicSource internalFunctions value @@ -201,7 +209,7 @@ def compileSetMapping2 (fields : List Field) (dynamicSource : DynamicDataSource) | [slot] => let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1Expr] pure [ - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ YulExpr.call "mappingSlot" [innerSlot, key2Expr], valueExpr ]) @@ -213,7 +221,7 @@ def compileSetMapping2 (fields : List Field) (dynamicSource : DynamicDataSource) YulStmt.let_ "__compat_value" valueExpr] ++ slots.map (fun slot => let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, YulExpr.ident "__compat_key1"] - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ YulExpr.call "mappingSlot" [innerSlot, YulExpr.ident "__compat_key2"], YulExpr.ident "__compat_value" ])) @@ -230,6 +238,10 @@ def compileSetMapping2Word (fields : List Field) (dynamicSource : DynamicDataSou else match findFieldWriteSlots fields field with | some slots => do + let storeBuiltin := + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tstore" else "sstore" + | none => "sstore" let key1Expr ← compileExprWithInternals fields dynamicSource internalFunctions key1 let key2Expr ← compileExprWithInternals fields dynamicSource internalFunctions key2 let valueExpr ← compileExprWithInternals fields dynamicSource internalFunctions value @@ -240,7 +252,7 @@ def compileSetMapping2Word (fields : List Field) (dynamicSource : DynamicDataSou let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1Expr] let outerSlot := YulExpr.call "mappingSlot" [innerSlot, key2Expr] let finalSlot := if wordOffset == 0 then outerSlot else YulExpr.call "add" [outerSlot, YulExpr.lit wordOffset] - pure [YulStmt.expr (YulExpr.call "sstore" [finalSlot, valueExpr])] + pure [YulStmt.expr (YulExpr.call storeBuiltin [finalSlot, valueExpr])] | _ => pure [ YulStmt.block ( @@ -250,7 +262,7 @@ def compileSetMapping2Word (fields : List Field) (dynamicSource : DynamicDataSou let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, YulExpr.ident "__compat_key1"] let outerSlot := YulExpr.call "mappingSlot" [innerSlot, YulExpr.ident "__compat_key2"] let finalSlot := if wordOffset == 0 then outerSlot else YulExpr.call "add" [outerSlot, YulExpr.lit wordOffset] - YulStmt.expr (YulExpr.call "sstore" [finalSlot, YulExpr.ident "__compat_value"]))) + YulStmt.expr (YulExpr.call storeBuiltin [finalSlot, YulExpr.ident "__compat_value"]))) ] | none => throw s!"Compilation error: unknown mapping field '{field}' in setMapping2Word" @@ -262,10 +274,14 @@ def compileSetMappingChain (fields : List Field) (dynamicSource : DynamicDataSou else match findFieldWriteSlots fields field with | some slots => do + let storeBuiltin := + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tstore" else "sstore" + | none => "sstore" let keyExprs ← compileExprListWithInternals fields dynamicSource internalFunctions keys let valueExpr ← compileExprWithInternals fields dynamicSource internalFunctions value let writeAt (slot : Nat) (keysRef : List YulExpr) (valueRef : YulExpr) : YulStmt := - YulStmt.expr (YulExpr.call "sstore" [ + YulStmt.expr (YulExpr.call storeBuiltin [ keysRef.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot), valueRef ]) @@ -305,6 +321,7 @@ def compileSetStructMember (fields : List Field) (dynamicSource : DynamicDataSou (← compileExprWithInternals fields dynamicSource internalFunctions value) s!"setStructMember.{memberName}" member.wordOffset + true | some packed => compileMappingPackedSlotWrite fields field (← compileExprWithInternals fields dynamicSource internalFunctions key) @@ -312,6 +329,7 @@ def compileSetStructMember (fields : List Field) (dynamicSource : DynamicDataSou member.wordOffset packed s!"setStructMember.{memberName}" + true def compileSetStructMember2 (fields : List Field) (dynamicSource : DynamicDataSource) (field : String) (key1 key2 : Expr) (memberName : String) (value : Expr) @@ -328,6 +346,14 @@ def compileSetStructMember2 (fields : List Field) (dynamicSource : DynamicDataSo | some member => match findFieldWriteSlots fields field with | some slots => do + let loadBuiltin := + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tload" else "sload" + | none => "sload" + let storeBuiltin := + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient then "tstore" else "sstore" + | none => "sstore" let key1Expr ← compileExprWithInternals fields dynamicSource internalFunctions key1 let key2Expr ← compileExprWithInternals fields dynamicSource internalFunctions key2 let valueExpr ← compileExprWithInternals fields dynamicSource internalFunctions value @@ -340,9 +366,9 @@ def compileSetStructMember2 (fields : List Field) (dynamicSource : DynamicDataSo let finalSlot := if member.wordOffset == 0 then outerSlot else YulExpr.call "add" [outerSlot, YulExpr.lit member.wordOffset] match member.packed with | none => - pure [YulStmt.expr (YulExpr.call "sstore" [finalSlot, valueExpr])] + pure [YulStmt.expr (YulExpr.call storeBuiltin [finalSlot, valueExpr])] | some packed => - pure (compilePackedStorageWrite finalSlot valueExpr packed) + pure (compilePackedStorageWrite finalSlot valueExpr packed loadBuiltin storeBuiltin) | _ => let finalSlots := slots.map fun slot => let innerSlot := YulExpr.call "mappingSlot" [YulExpr.lit slot, YulExpr.ident "__compat_key1"] @@ -355,14 +381,14 @@ def compileSetStructMember2 (fields : List Field) (dynamicSource : DynamicDataSo [YulStmt.let_ "__compat_key1" key1Expr, YulStmt.let_ "__compat_key2" key2Expr, YulStmt.let_ "__compat_value" valueExpr] ++ finalSlots.map (fun finalSlot => - YulStmt.expr (YulExpr.call "sstore" [finalSlot, YulExpr.ident "__compat_value"])) + YulStmt.expr (YulExpr.call storeBuiltin [finalSlot, YulExpr.ident "__compat_value"])) ) ] | some packed => pure [ YulStmt.block ( [YulStmt.let_ "__compat_key1" key1Expr, YulStmt.let_ "__compat_key2" key2Expr] ++ - compileCompatPackedStorageWrites finalSlots valueExpr packed + compileCompatPackedStorageWrites finalSlots valueExpr packed loadBuiltin storeBuiltin ) ] | none => throw s!"Compilation error: unknown mapping field '{field}' in setStructMember2.{memberName}" diff --git a/Compiler/Proofs/Frames.lean b/Compiler/Proofs/Frames.lean index 9142efe38..d25273ea2 100644 --- a/Compiler/Proofs/Frames.lean +++ b/Compiler/Proofs/Frames.lean @@ -646,6 +646,72 @@ theorem writeAddressSlots_preserves_address_except rw [hcontains] simp +theorem writeUintFieldSlots_preserves_storage_except + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value slot : Nat) + (hslot : slot ∉ slots.map wordNormalize) : + (writeUintFieldSlots fields fieldName world slots value).storage slot = world.storage slot := by + simp only [writeUintFieldSlots] + split + · simp [writeTransientTargets] + · exact writeUintSlots_preserves_storage_except world slots value slot hslot + +theorem writeUintFieldSlots_preserves_address + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value slot : Nat) : + (writeUintFieldSlots fields fieldName world slots value).storageAddr slot = + world.storageAddr slot := by + simp only [writeUintFieldSlots] + split <;> simp [writeTransientTargets, writeUintSlots] + +theorem writeUintFieldSlots_preserves_arrays + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value slot : Nat) : + (writeUintFieldSlots fields fieldName world slots value).storageArray slot = + world.storageArray slot := by + simp only [writeUintFieldSlots] + split <;> simp [writeTransientTargets, writeUintSlots] + +theorem writeUintFieldSlots_preserves_calldata + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value : Nat) : + (writeUintFieldSlots fields fieldName world slots value).calldata = world.calldata := by + simp only [writeUintFieldSlots] + split <;> simp [writeTransientTargets, writeUintSlots] + +theorem writeAddressFieldSlots_preserves_address_except + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value slot : Nat) + (hslot : slot ∉ slots.map wordNormalize) : + (writeAddressFieldSlots fields fieldName world slots value).storageAddr slot = + world.storageAddr slot := by + simp only [writeAddressFieldSlots] + split + · simp [writeTransientTargets] + · exact writeAddressSlots_preserves_address_except world slots value slot hslot + +theorem writeAddressFieldSlots_preserves_storage + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value slot : Nat) : + (writeAddressFieldSlots fields fieldName world slots value).storage slot = world.storage slot := by + simp only [writeAddressFieldSlots] + split <;> simp [writeTransientTargets, writeAddressSlots] + +theorem writeAddressFieldSlots_preserves_arrays + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value slot : Nat) : + (writeAddressFieldSlots fields fieldName world slots value).storageArray slot = + world.storageArray slot := by + simp only [writeAddressFieldSlots] + split <;> simp [writeTransientTargets, writeAddressSlots] + +theorem writeAddressFieldSlots_preserves_calldata + (fields : List Compiler.CompilationModel.Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value : Nat) : + (writeAddressFieldSlots fields fieldName world slots value).calldata = world.calldata := by + simp only [writeAddressFieldSlots] + split <;> simp [writeTransientTargets, writeAddressSlots] + theorem writeStorageArray_preserves_arrays_except (world : Verity.ContractState) (arraySlot slot : Nat) (values : List Verity.Core.Uint256) (hslot : slot ∉ [arraySlot]) : @@ -662,7 +728,7 @@ theorem execStmt_setStorage_execution_summary rw [show execStmt fields st (.setStorage fieldName value) = (match Compiler.CompilationModel.findFieldWriteSlots fields fieldName, evalExpr fields st value with | some slots, some resolved => - .continue { st with world := writeUintSlots st.world slots resolved } + .continue { st with world := writeUintFieldSlots fields fieldName st.world slots resolved } | _, _ => .revert) from rfl] at h rw [hslots] at h cases hval : evalExpr fields st value with @@ -673,10 +739,13 @@ theorem execStmt_setStorage_execution_summary constructor · intro _ _; rfl · intro slot hslot - exact writeUintSlots_preserves_storage_except st.world slots resolved slot hslot - · intro _ _; rfl - · intro _ _; rfl - · exact And.intro rfl rfl + exact writeUintFieldSlots_preserves_storage_except fields fieldName st.world slots resolved slot hslot + · intro slot _ + exact writeUintFieldSlots_preserves_address fields fieldName st.world slots resolved slot + · intro slot _ + exact writeUintFieldSlots_preserves_arrays fields fieldName st.world slots resolved slot + · exact And.intro rfl + (writeUintFieldSlots_preserves_calldata fields fieldName st.world slots resolved) theorem execStmt_setStorageAddr_execution_summary (fields : List Compiler.CompilationModel.Field) @@ -687,7 +756,7 @@ theorem execStmt_setStorageAddr_execution_summary rw [show execStmt fields st (.setStorageAddr fieldName value) = (match Compiler.CompilationModel.findFieldWriteSlots fields fieldName, evalExpr fields st value with | some slots, some resolved => - .continue { st with world := writeAddressSlots st.world slots resolved } + .continue { st with world := writeAddressFieldSlots fields fieldName st.world slots resolved } | _, _ => .revert) from rfl] at h rw [hslots] at h cases hval : evalExpr fields st value with @@ -697,11 +766,14 @@ theorem execStmt_setStorageAddr_execution_summary injection h with hh; subst hh constructor · intro _ _; rfl - · intro _ _; rfl + · intro slot _ + exact writeAddressFieldSlots_preserves_storage fields fieldName st.world slots resolved slot · intro slot hslot - exact writeAddressSlots_preserves_address_except st.world slots resolved slot hslot - · intro _ _; rfl - · exact And.intro rfl rfl + exact writeAddressFieldSlots_preserves_address_except fields fieldName st.world slots resolved slot hslot + · intro slot _ + exact writeAddressFieldSlots_preserves_arrays fields fieldName st.world slots resolved slot + · exact And.intro rfl + (writeAddressFieldSlots_preserves_calldata fields fieldName st.world slots resolved) theorem execStmtList_execution_summary_cons (fields : List Compiler.CompilationModel.Field) diff --git a/Compiler/Proofs/IRGeneration/DenoteAgreement.lean b/Compiler/Proofs/IRGeneration/DenoteAgreement.lean index 1bb06481d..b1fa1be53 100644 --- a/Compiler/Proofs/IRGeneration/DenoteAgreement.lean +++ b/Compiler/Proofs/IRGeneration/DenoteAgreement.lean @@ -253,6 +253,51 @@ theorem writeAddressKeyedMapping2Slots_eq congr 1 exact storage_field_eq_of_rel h +@[simp] theorem fieldIsTransient_eq (fields : List Field) (fieldName : String) : + Denote.fieldIsTransient fields fieldName = + SourceSemantics.fieldIsTransient fields fieldName := rfl + +@[simp] theorem writeTransientTargets_eq + (w : Verity.ContractState) (targets : List Nat) (v : Nat) : + Denote.writeTransientTargets w targets v = + SourceSemantics.writeTransientTargets w targets v := rfl + +theorem writeAddressKeyedMappingFieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k v : Nat) : + Denote.writeAddressKeyedMappingFieldSlots sourceOracle fields fieldName w slots k v = + SourceSemantics.writeAddressKeyedMappingFieldSlots fields fieldName w slots k v := by + simp only [Denote.writeAddressKeyedMappingFieldSlots, + SourceSemantics.writeAddressKeyedMappingFieldSlots] + by_cases h : SourceSemantics.fieldIsTransient fields fieldName = true + · simp [fieldIsTransient_eq, h, sourceOracle, writeTransientTargets_eq, + Denote.wordNormalize, SourceSemantics.wordNormalize] + · simp [fieldIsTransient_eq, h, writeAddressKeyedMappingSlots_eq] + +theorem writeUintKeyedMappingFieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k v : Nat) : + Denote.writeUintKeyedMappingFieldSlots sourceOracle fields fieldName w slots k v = + SourceSemantics.writeUintKeyedMappingFieldSlots fields fieldName w slots k v := by + simp only [Denote.writeUintKeyedMappingFieldSlots, + SourceSemantics.writeUintKeyedMappingFieldSlots] + by_cases h : SourceSemantics.fieldIsTransient fields fieldName = true + · simp [fieldIsTransient_eq, h, sourceOracle, writeTransientTargets_eq, + Denote.wordNormalize, SourceSemantics.wordNormalize] + · simp [fieldIsTransient_eq, h, writeUintKeyedMappingSlots_eq] + +theorem writeAddressKeyedMapping2FieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k1 k2 v : Nat) : + Denote.writeAddressKeyedMapping2FieldSlots sourceOracle fields fieldName w slots k1 k2 v = + SourceSemantics.writeAddressKeyedMapping2FieldSlots fields fieldName w slots k1 k2 v := by + simp only [Denote.writeAddressKeyedMapping2FieldSlots, + SourceSemantics.writeAddressKeyedMapping2FieldSlots] + by_cases h : SourceSemantics.fieldIsTransient fields fieldName = true + · simp [fieldIsTransient_eq, h, sourceOracle, writeTransientTargets_eq, + Denote.wordNormalize, SourceSemantics.wordNormalize] + · simp [fieldIsTransient_eq, h, writeAddressKeyedMapping2Slots_eq] + /-! ## Definitional write/helper bridges (the mirrors are byte-for-byte) -/ @[simp] theorem wordNormalize_eq (n : Nat) : @@ -289,6 +334,15 @@ theorem writeAddressKeyedMapping2Slots_eq Denote.writeAddressKeyedMappingPackedWordSlots sourceOracle w slots k off p v = SourceSemantics.writeAddressKeyedMappingPackedWordSlots w slots k off p v := rfl +@[simp] theorem writeAddressKeyedMappingPackedWordFieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k off : Nat) + (p : PackedBits) (v : Nat) : + Denote.writeAddressKeyedMappingPackedWordFieldSlots + sourceOracle fields fieldName w slots k off p v = + SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName w slots k off p v := rfl + @[simp] theorem writeAddressKeyedMapping2WordSlots_eq (w : Verity.ContractState) (slots : List Nat) (k1 k2 off v : Nat) : Denote.writeAddressKeyedMapping2WordSlots sourceOracle w slots k1 k2 off v = @@ -300,11 +354,32 @@ theorem writeAddressKeyedMapping2Slots_eq Denote.writeAddressKeyedMapping2PackedWordSlots sourceOracle w slots k1 k2 off p v = SourceSemantics.writeAddressKeyedMapping2PackedWordSlots w slots k1 k2 off p v := rfl +@[simp] theorem writeAddressKeyedMapping2PackedWordFieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k1 k2 off : Nat) + (p : PackedBits) (v : Nat) : + Denote.writeAddressKeyedMapping2PackedWordFieldSlots + sourceOracle fields fieldName w slots k1 k2 off p v = + SourceSemantics.writeAddressKeyedMapping2PackedWordFieldSlots + fields fieldName w slots k1 k2 off p v := rfl + @[simp] theorem writeAddressKeyedMappingChainSlots_eq (w : Verity.ContractState) (slots keys : List Nat) (v : Nat) : Denote.writeAddressKeyedMappingChainSlots sourceOracle w slots keys v = SourceSemantics.writeAddressKeyedMappingChainSlots w slots keys v := rfl +@[simp] theorem writeAddressKeyedMappingWordFieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k off v : Nat) : + Denote.writeAddressKeyedMappingWordFieldSlots sourceOracle fields fieldName w slots k off v = + SourceSemantics.writeAddressKeyedMappingWordFieldSlots fields fieldName w slots k off v := rfl + +@[simp] theorem writeAddressKeyedMapping2WordFieldSlots_eq + (fields : List Field) (fieldName : String) + (w : Verity.ContractState) (slots : List Nat) (k1 k2 off v : Nat) : + Denote.writeAddressKeyedMapping2WordFieldSlots sourceOracle fields fieldName w slots k1 k2 off v = + SourceSemantics.writeAddressKeyedMapping2WordFieldSlots fields fieldName w slots k1 k2 off v := rfl + @[simp] theorem writeStorageArray_eq (w : Verity.ContractState) (slot : Nat) (vs : List Verity.Core.Uint256) : Denote.writeStorageArray w slot vs = SourceSemantics.writeStorageArray w slot vs := rfl @@ -355,9 +430,11 @@ macro "denote_stmt_arm" : tactic => (simp only [Denote.execStmt, SourceSemantics.execStmt, ← denote_evalExpr_eq, ← denote_evalExprList_eq] repeat' (split <;> - try simp_all [toStmtResult, toRuntimeState, + try simp_all [toStmtResult, toRuntimeState, writeAddressKeyedMappingSlots_eq, writeUintKeyedMappingSlots_eq, - writeAddressKeyedMapping2Slots_eq, storageArraySetAt_eq, + writeAddressKeyedMapping2Slots_eq, writeAddressKeyedMappingFieldSlots_eq, + writeUintKeyedMappingFieldSlots_eq, writeAddressKeyedMapping2FieldSlots_eq, + storageArraySetAt_eq, storageArrayDropLast?_eq, SourceSemantics.eventFromResolvedArgs?, SourceSemantics.eventScratchMemoryAfterEmit?]) @@ -367,7 +444,9 @@ macro "denote_stmt_arm" : tactic => | rfl | simp_all [toStmtResult, toRuntimeState, writeAddressKeyedMappingSlots_eq, writeUintKeyedMappingSlots_eq, - writeAddressKeyedMapping2Slots_eq, storageArraySetAt_eq, + writeAddressKeyedMapping2Slots_eq, writeAddressKeyedMappingFieldSlots_eq, + writeUintKeyedMappingFieldSlots_eq, writeAddressKeyedMapping2FieldSlots_eq, + storageArraySetAt_eq, storageArrayDropLast?_eq, SourceSemantics.eventFromResolvedArgs?, SourceSemantics.eventScratchMemoryAfterEmit?])) diff --git a/Compiler/Proofs/IRGeneration/FunctionBody/Stmt.lean b/Compiler/Proofs/IRGeneration/FunctionBody/Stmt.lean index 1eb25597d..653cffcd8 100644 --- a/Compiler/Proofs/IRGeneration/FunctionBody/Stmt.lean +++ b/Compiler/Proofs/IRGeneration/FunctionBody/Stmt.lean @@ -3185,18 +3185,21 @@ theorem exec_compileStmtList_core hevalOffset.symm have hValueSrc : SourceSemantics.evalExpr fields runtime value = some valueNat := hevalValue.symm + let offsetKey := offsetNat % Compiler.Constants.evmModulus let runtime' := { runtime with world := { runtime.world with - transientStorage := fun o => if o = offsetNat then valueNat else runtime.world.transientStorage o + transientStorage := fun o => + if o = offsetKey then valueNat else runtime.world.transientStorage o } } - let state' := { state with transientStorage := fun o => if o = offsetNat then valueNat else state.transientStorage o } + let state' := { state with + transientStorage := fun o => if o = offsetKey then valueNat else state.transientStorage o } have hvalueLt := evalExpr_lt_evmModulus_core_onExpr hvalue (bindingsExactlyMatchIRVars_implies_onExpr hexact) hbounded hpresentValue hruntime rw [hValueSrc] at hvalueLt have hruntime' : runtimeStateMatchesIR fields runtime' state' := - runtimeStateMatchesIR_setTransientStorage hruntime offsetNat valueNat hvalueLt + runtimeStateMatchesIR_setTransientStorage hruntime offsetKey valueNat hvalueLt have hexact' : bindingsExactlyMatchIRVars runtime'.bindings state' := by intro name; simpa [IRState.getVar, state'] using hexact name have hbounded' : bindingsBounded runtime'.bindings := by @@ -3216,7 +3219,7 @@ theorem exec_compileStmtList_core · have hstmt : execIRStmt (tailIR.length + 1) state (YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR])) = .continue state' := by - simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state'] + simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state', offsetKey] have hirExec : execIRStmts (tailIR.length + 2) state (YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR]) :: tailIR) = @@ -3668,18 +3671,21 @@ theorem exec_compileStmtList_core_extraFuel hevalOffset.symm have hValueSrc : SourceSemantics.evalExpr fields runtime value = some valueNat := hevalValue.symm + let offsetKey := offsetNat % Compiler.Constants.evmModulus let runtime' := { runtime with world := { runtime.world with - transientStorage := fun o => if o = offsetNat then valueNat else runtime.world.transientStorage o + transientStorage := fun o => + if o = offsetKey then valueNat else runtime.world.transientStorage o } } - let state' := { state with transientStorage := fun o => if o = offsetNat then valueNat else state.transientStorage o } + let state' := { state with + transientStorage := fun o => if o = offsetKey then valueNat else state.transientStorage o } have hvalueLt := evalExpr_lt_evmModulus_core_onExpr hvalue (bindingsExactlyMatchIRVars_implies_onExpr hexact) hbounded hpresentValue hruntime rw [hValueSrc] at hvalueLt have hruntime' : runtimeStateMatchesIR fields runtime' state' := - runtimeStateMatchesIR_setTransientStorage hruntime offsetNat valueNat hvalueLt + runtimeStateMatchesIR_setTransientStorage hruntime offsetKey valueNat hvalueLt have hexact' : bindingsExactlyMatchIRVars runtime'.bindings state' := by intro name; simpa [IRState.getVar, state'] using hexact name have hbounded' : bindingsBounded runtime'.bindings := by @@ -3699,7 +3705,7 @@ theorem exec_compileStmtList_core_extraFuel · have hstmt : execIRStmt (tailIR.length + extraFuel + 1) state (YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR])) = .continue state' := by - simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state'] + simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state', offsetKey] have hirExec : execIRStmts (tailIR.length + extraFuel + 2) state (YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR]) :: tailIR) = @@ -7480,7 +7486,8 @@ theorem exec_compileStmtList_terminal_core_sizeOf_extraFuel sizeOf_singleton_append_extraFuel_ne_zero _ _ _ cases hfuel : sizeOf ([YulStmt.expr (YulExpr.call "mstore" [offsetIR, valueIR])] ++ tailIR) + extraFuel with | zero => exact absurd hfuel hfuelNe - | succ n => simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state'] + | succ n => + simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state'] have hirExec := execIRStmts_singleton_append_of_execIRStmt_continue_wholeFuel extraFuel state state' (YulStmt.expr (YulExpr.call "mstore" [offsetIR, valueIR])) tailIR hstmt @@ -7511,17 +7518,20 @@ theorem exec_compileStmtList_terminal_core_sizeOf_extraFuel hevalOffset.symm have hValueSrc : SourceSemantics.evalExpr fields runtime value = some valueNat := hevalValue.symm + let offsetKey := offsetNat % Compiler.Constants.evmModulus let runtime' := { runtime with world := { runtime.world with - transientStorage := fun o => if o = offsetNat then valueNat else runtime.world.transientStorage o + transientStorage := fun o => + if o = offsetKey then valueNat else runtime.world.transientStorage o } } - let state' := { state with transientStorage := fun o => if o = offsetNat then valueNat else state.transientStorage o } + let state' := { state with + transientStorage := fun o => if o = offsetKey then valueNat else state.transientStorage o } have hvalueLt := evalExpr_lt_evmModulus_core_of_scope hvalue hexact hinScopeValue hbounded hpresentValue hruntime rw [hValueSrc] at hvalueLt; simp at hvalueLt have hruntime' : runtimeStateMatchesIR fields runtime' state' := - runtimeStateMatchesIR_setTransientStorage hruntime offsetNat valueNat hvalueLt + runtimeStateMatchesIR_setTransientStorage hruntime offsetKey valueNat hvalueLt have hexact' : bindingsExactlyMatchIRVarsOnScope scope runtime'.bindings state' := by intro name hname; simpa [IRState.getVar, state'] using hexact name hname have hbounded' : bindingsBounded runtime'.bindings := by @@ -7551,7 +7561,7 @@ theorem exec_compileStmtList_terminal_core_sizeOf_extraFuel sizeOf_singleton_append_extraFuel_ne_zero _ _ _ cases hfuel : sizeOf ([YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR])] ++ tailIR) + extraFuel with | zero => exact absurd hfuel hfuelNe - | succ n => simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state'] + | succ n => simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state', offsetKey] have hirExec := execIRStmts_singleton_append_of_execIRStmt_continue_wholeFuel extraFuel state state' (YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR])) tailIR hstmt diff --git a/Compiler/Proofs/IRGeneration/GenericInduction/Storage.lean b/Compiler/Proofs/IRGeneration/GenericInduction/Storage.lean index cb37d4053..cb333ef08 100644 --- a/Compiler/Proofs/IRGeneration/GenericInduction/Storage.lean +++ b/Compiler/Proofs/IRGeneration/GenericInduction/Storage.lean @@ -475,7 +475,7 @@ private theorem fieldWriteEntriesAt_base_mem (idx : Nat) (field : Field) : SourceSemantics.wordNormalize (field.slot.getD idx) ∈ (fieldWriteEntriesAt idx field).map (fun entry => entry.1) := by - obtain ⟨name, ty, slotOpt, packedBits, aliasSlots⟩ := field + obtain ⟨name, ty, isTransient, slotOpt, packedBits, aliasSlots⟩ := field cases ty with | adt _ maxFields => simp [fieldWriteEntriesAt, firstFieldWriteSlotConflict.fieldOccupiedSlots, @@ -503,7 +503,7 @@ private theorem fieldWriteEntriesAt_alias_mem (hmem : slot ∈ field.aliasSlots) : SourceSemantics.wordNormalize slot ∈ (fieldWriteEntriesAt idx field).map (fun entry => entry.1) := by - obtain ⟨name, ty, slotOpt, packedBits, aliasSlots⟩ := field + obtain ⟨name, ty, isTransient, slotOpt, packedBits, aliasSlots⟩ := field obtain ⟨aliasIdx, halias⟩ : ∃ i, (slot, i) ∈ aliasSlots.zipIdx := exists_mem_zipIdx_of_mem hmem cases ty with @@ -1515,9 +1515,43 @@ private theorem runtimeStateMatchesIR_writeUintKeyedMappingSlot rw [hstorage] exact congrArg Compiler.Proofs.IRGeneration.IRStorageWord.ofNat (encodeStorageAt_writeUintKeyedMappingSlots_singleton_other (fields := fields) (world := runtime.world) (slot := slot) (key := key) (query := query.toNat) (value := value) - (by simpa [Compiler.Constants.evmModulus, EvmYul.UInt256.size] using IRStorageSlot.toNat_lt_size query) + (by simpa [Compiler.Constants.evmModulus, EvmYul.UInt256.size] using IRStorageSlot.toNat_lt_size query) (IRStorageSlot.ne_toNat_wordNormalize_of_ne_ofNat hEq)).symm +private theorem runtimeStateMatchesIR_writeTransientTarget + {fields : List Field} + {runtime : SourceSemantics.RuntimeState} + {state : IRState} + {target value : Nat} + (hruntime : FunctionBody.runtimeStateMatchesIR fields runtime state) + (hvalue : value < Verity.Core.Uint256.modulus) : + FunctionBody.runtimeStateMatchesIR fields + { runtime with + world := SourceSemantics.writeTransientTargets runtime.world [target] value } + { state with + transientStorage := fun slot => + if slot = SourceSemantics.wordNormalize target then value else state.transientStorage slot } := by + rcases hruntime with + ⟨hstorage, htransient, hsender, hmsgValue, hthis, htimestamp, hblock, hchain, hret, hevents⟩ + refine ⟨?_, ?_, hsender, hmsgValue, hthis, htimestamp, hblock, hchain, hret, hevents⟩ + · funext query + rw [hstorage] + exact congrArg Compiler.Proofs.IRGeneration.IRStorageWord.ofNat + (SourceSemantics.encodeStorageAt_congr (by simp [SourceSemantics.writeTransientTargets]) + (by simp [SourceSemantics.writeTransientTargets]) + (by simp [SourceSemantics.writeTransientTargets])) + · funext slot + by_cases hslot : slot = SourceSemantics.wordNormalize target + · subst hslot + simp [SourceSemantics.writeTransientTargets] + exact (Nat.mod_eq_of_lt (by + simpa [Compiler.Constants.evmModulus, Verity.Core.UINT256_MODULUS, + Verity.Core.Uint256.modulus] using hvalue)).symm + · simp [SourceSemantics.writeTransientTargets, hslot] + have hslot' : slot ≠ target % Compiler.Constants.evmModulus := by + simpa [SourceSemantics.wordNormalize] using hslot + simp [hslot', congrFun htransient slot] + private theorem runtimeStateMatchesIR_writeAddressKeyedMappingChainSlot {fields : List Field} {runtime : SourceSemantics.RuntimeState} @@ -2374,6 +2408,37 @@ private theorem findFieldWriteSlots_of_findFieldWithResolvedSlot · rw [if_neg hname] at h ⊢ exact ih (idx + 1) h +private theorem findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton + {fields : List Field} {name : String} {slot : Nat} + (h : findFieldWriteSlots fields name = some [slot]) : + ∃ f, findFieldWithResolvedSlot fields name = some (f, slot) ∧ f.aliasSlots = [] := by + rw [findFieldWriteSlots_eq_CopyFrom, findFieldWithResolvedSlot_eq_CopyFrom] at * + revert h + suffices ∀ idx, + findFieldWriteSlotsCopyFrom fields idx name = some [slot] → + ∃ f, findFieldWithResolvedSlotCopyFrom fields idx name = some (f, slot) ∧ + f.aliasSlots = [] by + exact this 0 + intro idx h + induction fields generalizing idx with + | nil => simp [findFieldWriteSlotsCopyFrom] at h + | cons hd tl ih => + unfold findFieldWriteSlotsCopyFrom at h + unfold findFieldWithResolvedSlotCopyFrom + by_cases hname : hd.name == name + · rw [if_pos hname] at h ⊢ + simp at h + rcases h with ⟨hslot, halias⟩ + exact ⟨hd, by simpa [hslot, halias]⟩ + · rw [if_neg hname] at h ⊢ + exact ih (idx + 1) h + +private def fieldStoreBuiltin (fields : List Field) (fieldName : String) : String := + if SourceSemantics.fieldIsTransient fields fieldName then "tstore" else "sstore" + +private def fieldLoadBuiltin (fields : List Field) (fieldName : String) : String := + if SourceSemantics.fieldIsTransient fields fieldName then "tload" else "sload" + theorem compiledStmtStep_setStorage_singleSlot {fields : List Field} {scope : List String} @@ -2391,6 +2456,7 @@ theorem compiledStmtStep_setStorage_singleSlot (hnoConflict : firstFieldWriteSlotConflict fields = none) (hnotAddr : SourceSemantics.fieldUsesAddressStorage f = false) (hnotDyn : SourceSemantics.fieldUsesDynamicArrayStorage f = false) + (hnotTransient : f.isTransient = false) (hNotMapping : isMapping fields fieldName = false) (hNotAdt : ∀ name maxFields, f.ty ≠ FieldType.adt name maxFields) (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : @@ -2398,7 +2464,7 @@ theorem compiledStmtStep_setStorage_singleSlot [YulStmt.expr (YulExpr.call "sstore" [YulExpr.lit slot, valueIR])] where compileOk := by simp [CompilationModel.compileStmt, CompilationModel.compileSetStorage, - hNotMapping, hfind, halias, hunpacked, hvalueIR] + hNotMapping, hfind, halias, hunpacked, hnotTransient, hvalueIR] preserves runtime state extraFuel hexact hscope hbounded hruntime hslack := by let compiledIR := [YulStmt.expr (YulExpr.call "sstore" [YulExpr.lit slot, valueIR])] have hresolvedSlot : @@ -2428,9 +2494,13 @@ theorem compiledStmtStep_setStorage_singleSlot Compiler.Proofs.abstractStoreStorageOrMapping state.storage slot valueNat } set runtime' := { runtime with world := SourceSemantics.writeUintSlots runtime.world [slot] valueNat } + have hfieldTransient : + SourceSemantics.fieldIsTransient fields fieldName = false := by + simp [SourceSemantics.fieldIsTransient, hfind, hnotTransient] have hSrcExec : SourceSemantics.execStmt fields runtime (.setStorage fieldName value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hValueSrc, runtime'] + simp [SourceSemantics.execStmt, SourceSemantics.writeUintFieldSlots, + SourceSemantics.writeMappingTargets, hwriteSlots, hValueSrc, hfieldTransient, runtime'] have hExecStmt : execIRStmt (extraFuel + 1) state (YulStmt.expr (YulExpr.call "sstore" [YulExpr.lit slot, valueIR])) = @@ -2555,9 +2625,13 @@ private theorem compiledStmtStep_setStorageAddr_singleSlot_preserves (valueNat &&& Compiler.Constants.addressMask) } set runtime' := { runtime with world := SourceSemantics.writeAddressSlots runtime.world [slot] valueNat } + have hfieldTransient : + SourceSemantics.fieldIsTransient fields fieldName = false := by + simp [SourceSemantics.fieldIsTransient, hfind] have hSrcExec : SourceSemantics.execStmt fields runtime (.setStorageAddr fieldName value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hValueSrc, runtime'] + simp [SourceSemantics.execStmt, SourceSemantics.writeAddressFieldSlots, + hwriteSlots, hValueSrc, hfieldTransient, runtime'] have hExecStmt : execIRStmt (extraFuel + 1) state (YulStmt.expr @@ -2818,25 +2892,26 @@ private theorem compiledStmtStep_tstore_single_preserves rw [hValueSrc] at hValueLt simp at hValueLt -- Source execution: tstore updates transientStorage + let offsetKey := offsetNat % Compiler.Constants.evmModulus set runtime' := { runtime with world := { runtime.world with transientStorage := fun o => - if o = offsetNat then valueNat else runtime.world.transientStorage o + if o = offsetKey then valueNat else runtime.world.transientStorage o } } have hSrcExec : SourceSemantics.execStmt fields runtime (.tstore offset value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hOffsetSrc, hValueSrc, runtime'] + simp [SourceSemantics.execStmt, hOffsetSrc, hValueSrc, runtime', offsetKey] -- IR execution: tstore updates transientStorage set state' := { state with - transientStorage := fun o => if o = offsetNat then valueNat else state.transientStorage o } + transientStorage := fun o => if o = offsetKey then valueNat else state.transientStorage o } have hExecStmt : execIRStmt (extraFuel + 1) state (YulStmt.expr (YulExpr.call "tstore" [offsetIR, valueIR])) = .continue state' := by - simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state'] + simp [execIRStmt, evalIRExprs, hIROffset, hIRValue, state', offsetKey] have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = .continue state' := by @@ -2864,7 +2939,7 @@ private theorem compiledStmtStep_tstore_single_preserves have hbounded' : FunctionBody.bindingsBounded runtime'.bindings := by simpa [runtime'] using hbounded have hruntime' : FunctionBody.runtimeStateMatchesIR fields runtime' state' := - FunctionBody.runtimeStateMatchesIR_setTransientStorage hruntime offsetNat valueNat hValueLt + FunctionBody.runtimeStateMatchesIR_setTransientStorage hruntime offsetKey valueNat hValueLt exact ⟨_, _, hSrcExec, hIRExec, hruntime', hexact', hbounded', hscope'⟩ @@ -2918,21 +2993,21 @@ private theorem compiledStmtStep_setMappingUint_singleSlot_of_slotSafety_preserv FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → sizeOf [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] - [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])].length ≤ extraFuel → ∃ sourceResult irExec, SourceSemantics.execStmt fields runtime (.setMappingUint fieldName key value) = sourceResult ∧ execIRStmts ([YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])].length + extraFuel + 1) state [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] = irExec ∧ stmtStepMatchesIRExec fields (stmtNextScope scope (.setMappingUint fieldName key value)) @@ -2940,7 +3015,7 @@ private theorem compiledStmtStep_setMappingUint_singleSlot_of_slotSafety_preserv irExec := by intro runtime state extraFuel hexact hscope hbounded hruntime hslack let compiledIR := [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] have hkeySourceEval := FunctionBody.eval_compileExpr_core_of_scope @@ -2974,31 +3049,6 @@ private theorem compiledStmtStep_setMappingUint_singleSlot_of_slotSafety_preserv hruntime rw [hValueSrc] at hvalueLt simp at hvalueLt - -- Define post-states - set state' := { state with - storage := - Compiler.Proofs.abstractStoreMappingEntry - state.storage slot keyNat valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeUintKeyedMappingSlots - runtime.world [slot] keyNat valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setMappingUint fieldName key value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime'] - -- IR execution - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, hIRKey, hIRValue, - Compiler.Proofs.abstractStoreMappingEntry_eq, state'] - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = - .continue state' := by - simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] -- Scope inclusion: stmtNextScope only adds expr names already in scope have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMappingUint fieldName key value)) scope := by @@ -3008,22 +3058,102 @@ private theorem compiledStmtStep_setMappingUint_singleSlot_of_slotSafety_preserv · exact hinScopeKey n (collectExprNames_mem_exprBoundNames_of_core hcoreKey n hk) · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setMappingUint fieldName key value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeMappingSlot hexact) - hincl have hscope' : FunctionBody.scopeNamesPresent (stmtNextScope scope (.setMappingUint fieldName key value)) - runtime'.bindings := + runtime.bindings := FunctionBody.scopeNamesPresent_of_included hscope hincl - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeUintKeyedMappingSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · let target := SourceSemantics.wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyNat) + set state' := { state with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize target then valueNat else state.transientStorage o } + set runtime' := { runtime with + world := SourceSemantics.writeUintKeyedMappingFieldSlots + fields fieldName runtime.world [slot] keyNat valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMappingUint fieldName key value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime', + SourceSemantics.writeUintKeyedMappingFieldSlots, htrans, target] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = + .continue state' := by + have htargetMod : + Compiler.Proofs.solidityMappingSlot slot keyNat % + Compiler.Constants.evmModulus = + Compiler.Proofs.solidityMappingSlot slot keyNat := by + exact Nat.mod_eq_of_lt (by + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using + (Compiler.Proofs.abstractMappingSlot_lt_evmModulus slot keyNat)) + simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey, hIRValue, + fieldStoreBuiltin, htrans, target, state', htargetMod, + Compiler.Proofs.abstractMappingSlot_eq_solidity, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMappingUint fieldName key value)) + runtime'.bindings state' := by + exact FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (by intro name hname; simpa [IRState.getVar, state', runtime'] using hexact name hname) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMappingUint fieldName key value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ + simp [stmtStepMatchesIRExec] + exact ⟨by + simpa [runtime', state', SourceSemantics.writeUintKeyedMappingFieldSlots, + htrans, target] using + (runtimeStateMatchesIR_writeTransientTarget + (target := target) hruntime hvalueLt), + hexact', hbounded, hscopeRuntime'⟩ + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + set state' := { state with + storage := + Compiler.Proofs.abstractStoreMappingEntry + state.storage slot keyNat valueNat } + set runtime' := { runtime with + world := SourceSemantics.writeUintKeyedMappingSlots + runtime.world [slot] keyNat valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMappingUint fieldName key value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime', + SourceSemantics.writeUintKeyedMappingFieldSlots, htransFalse] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = + .continue state' := by + simp [execIRStmt, evalIRExpr, hIRKey, hIRValue, fieldStoreBuiltin, + htransFalse, Compiler.Proofs.abstractStoreMappingEntry_eq, state'] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMappingUint fieldName key value)) + runtime'.bindings state' := + FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (bindingsExactlyMatchIRVarsOnScope_writeMappingSlot hexact) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMappingUint fieldName key value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ + simp [stmtStepMatchesIRExec] + exact ⟨runtimeStateMatchesIR_writeUintKeyedMappingSlot + hruntime hresolvedNone hdynNone hvalueLt, + hexact', hbounded, hscopeRuntime'⟩ theorem compiledStmtStep_setMappingUint_singleSlot_of_slotSafety {fields : List Field} @@ -3049,14 +3179,17 @@ theorem compiledStmtStep_setMappingUint_singleSlot_of_slotSafety (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setMappingUint fieldName key value) [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkeyIRInternal := compileExprWithInternals_nil_ok hkeyIR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileMappingSlotWrite, hmapping, hwriteSlots, hkeyIRInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setMappingUint_singleSlot_of_slotSafety_preserves hcoreKey hinScopeKey hcoreValue hinScopeValue hwriteSlots hslotSafety hkeyIR hvalueIR @@ -3339,6 +3472,160 @@ private theorem execIRStmt_sstore_of_eval · simp [execIRStmt, hslot, hvalue, hfunc] | cons arg3 rest => simp [execIRStmt, hslot, hvalue] +private theorem execIRStmt_tstore_of_eval + {state : IRState} + {slotExpr valueExpr : Compiler.Yul.YulExpr} + {slotVal valueVal : Nat} + {fuel : Nat} + (hslot : evalIRExpr state slotExpr = some slotVal) + (hvalue : evalIRExpr state valueExpr = some valueVal) : + execIRStmt (Nat.succ fuel) state + (Compiler.Yul.YulStmt.expr (Compiler.Yul.YulExpr.call "tstore" + [slotExpr, valueExpr])) = + .continue { state with + transientStorage := fun slot => + if slot = slotVal % Compiler.Constants.evmModulus then valueVal + else state.transientStorage slot } := by + simp [execIRStmt, hslot, hvalue] + +private theorem evalIRExpr_mappingWordTarget_of_eval + {state : IRState} {slot keyNat wordOffset : Nat} {keyIR : YulExpr} + (hkey : evalIRExpr state keyIR = some keyNat) : + evalIRExpr state + (let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] + if wordOffset == 0 then mappingBase + else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset]) = + some (mappingWordTargetSlot slot keyNat wordOffset) := by + have hMappingBaseEval : + evalIRExpr state (YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR]) = + some (Compiler.Proofs.abstractMappingSlot slot keyNat) := by + simpa using + (evalIRExpr_mappingSlotChain + (state := state) + (baseSlot := slot) + (keyIRs := [keyIR]) + (keyVals := [keyNat]) + (by simp [hkey] : List.Forall₂ + (fun exprIR value => evalIRExpr state exprIR = some value) + [keyIR] [keyNat])) + by_cases hzero : wordOffset = 0 + · subst hzero + have hlt : + Compiler.Proofs.solidityMappingSlot slot keyNat < Compiler.Constants.evmModulus := by + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using + (Compiler.Proofs.abstractMappingSlot_lt_evmModulus slot keyNat) + simpa [Verity.Core.Uint256.val_ofNat, mappingWordTargetSlot, + SourceSemantics.wordNormalize, Compiler.Proofs.abstractMappingSlot_eq_solidity, + Nat.mod_eq_of_lt hlt] using hMappingBaseEval + · have hAddEval := + FunctionBody.evalIRExpr_add_of_eval + (state := state) + (lhs := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR]) + (rhs := YulExpr.lit wordOffset) + (a := Compiler.Proofs.abstractMappingSlot slot keyNat) + (b := wordOffset) + hMappingBaseEval + (by simp [evalIRExpr]) + have hAddEval' : + evalIRExpr state + (YulExpr.call "add" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], YulExpr.lit wordOffset]) = + some ((Verity.Core.Uint256.ofNat wordOffset + + Verity.Core.Uint256.ofNat (Compiler.Proofs.solidityMappingSlot slot keyNat)).val) := by + rw [uint256_add_val_eq_mod] + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity, Nat.add_assoc, + Nat.add_comm, Nat.add_left_comm] using hAddEval + simpa [hzero, mappingWordTargetSlot_eq_uint256_add] using hAddEval' + +private theorem evalIRExpr_mappingSlot2_of_eval + {state : IRState} {slot key1Nat key2Nat : Nat} + {key1IR key2IR : YulExpr} + (hkey1 : evalIRExpr state key1IR = some key1Nat) + (hkey2 : evalIRExpr state key2IR = some key2Nat) : + evalIRExpr state + (YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR]) = + some (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) := by + simpa using + (evalIRExpr_mappingSlotChain + (state := state) + (baseSlot := slot) + (keyIRs := [key1IR, key2IR]) + (keyVals := [key1Nat, key2Nat]) + (by simp [hkey1, hkey2] : List.Forall₂ + (fun exprIR value => evalIRExpr state exprIR = some value) + [key1IR, key2IR] [key1Nat, key2Nat])) + +private theorem evalIRExpr_mappingSlot2_add_of_eval + {state : IRState} {slot key1Nat key2Nat wordOffset : Nat} + {key1IR key2IR : YulExpr} + (hMappingSlot2Eval : + evalIRExpr state + (YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR]) = + some (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat)) : + evalIRExpr state + (YulExpr.call "add" + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], + YulExpr.lit wordOffset]) = + some ((Verity.Core.Uint256.ofNat wordOffset + + Verity.Core.Uint256.ofNat + (Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).val) := by + have hAddEval := + FunctionBody.evalIRExpr_add_of_eval + (state := state) + (lhs := YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR]) + (rhs := YulExpr.lit wordOffset) + (a := Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) + (b := wordOffset) + hMappingSlot2Eval + (by simp [evalIRExpr]) + rw [uint256_add_val_eq_mod] + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity, Nat.add_assoc, + Nat.add_comm, Nat.add_left_comm] using hAddEval + +private theorem evalIRExpr_mapping2WordTarget_of_eval + {state : IRState} {slot key1Nat key2Nat wordOffset : Nat} + {key1IR key2IR : YulExpr} + (hkey1 : evalIRExpr state key1IR = some key1Nat) + (hkey2 : evalIRExpr state key2IR = some key2Nat) : + evalIRExpr state + (let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] + let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] + if wordOffset == 0 then mappingSlot2 + else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset]) = + some (mapping2WordTargetSlot slot key1Nat key2Nat wordOffset) := by + have hMappingSlot2Eval : + evalIRExpr state + (YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR]) = + some (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) := + evalIRExpr_mappingSlot2_of_eval hkey1 hkey2 + by_cases hzero : wordOffset = 0 + · subst hzero + have hlt : + Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat < + Compiler.Constants.evmModulus := by + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using + (Compiler.Proofs.abstractMappingSlot_lt_evmModulus + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) + simpa [mapping2WordTargetSlot, SourceSemantics.wordNormalize, + Compiler.Proofs.abstractMappingSlot_eq_solidity, Nat.mod_eq_of_lt hlt] using + hMappingSlot2Eval + · have hAddEval' := + evalIRExpr_mappingSlot2_add_of_eval + (wordOffset := wordOffset) + hMappingSlot2Eval + simpa [hzero, mapping2WordTargetSlot_eq_uint256_add] using hAddEval' + private theorem execIRStmt_sstore_foldl_mappingSlot {state : IRState} {baseSlot : Nat} @@ -3418,12 +3705,12 @@ private theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preser FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → sizeOf [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [keyIRs.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot), valueIR])] - [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [keyIRs.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot), valueIR])].length ≤ extraFuel → @@ -3431,13 +3718,13 @@ private theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preser SourceSemantics.execStmt fields runtime (.setMappingChain fieldName keys value) = sourceResult ∧ execIRStmts ([YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [keyIRs.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot), valueIR])].length + extraFuel + 1) state [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [keyIRs.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot), valueIR])] = irExec ∧ @@ -3450,7 +3737,8 @@ private theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preser keyIRs.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot) - let compiledIR := [YulStmt.expr (YulExpr.call "sstore" [writeSlotExpr, valueIR])] + let compiledIR := [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [writeSlotExpr, valueIR])] -- Evaluate value expression have hvalueSourceEval := FunctionBody.eval_compileExpr_core_of_scope @@ -3483,30 +3771,6 @@ private theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preser hruntime rw [hValueSrc] at hvalueLt simp at hvalueLt - -- Define post-states - set state' := { state with - storage := - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage - (SourceSemantics.mappingSlotChain slot resolvedKeys) - valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMappingChainSlots - runtime.world [slot] resolvedKeys valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setMappingChain fieldName keys value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hkeysEval, hValueSrc, runtime'] - -- IR execution - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr (YulExpr.call "sstore" [writeSlotExpr, valueIR])) = - .continue state' := by - exact execIRStmt_sstore_foldl_mappingSlot hkeyIRVals hIRValue - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = - .continue state' := by - simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] -- Scope inclusion have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMappingChain fieldName keys value)) scope := by @@ -3531,24 +3795,103 @@ private theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preser (fun e he => hscope' e (by simp [he])) htl · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setMappingChain fieldName keys value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) - hincl have hscope' : FunctionBody.scopeNamesPresent (stmtNextScope scope (.setMappingChain fieldName keys value)) - runtime'.bindings := + runtime.bindings := FunctionBody.scopeNamesPresent_of_included hscope hincl - have hbounded' : FunctionBody.bindingsBounded runtime'.bindings := by - simpa [runtime'] using hbounded - have hruntime' : FunctionBody.runtimeStateMatchesIR fields runtime' state' := - runtimeStateMatchesIR_writeAddressKeyedMappingChainSlot - hruntime hresolvedNone hdynNone hvalueLt - exact ⟨_, _, hSrcExec, hIRExec, - hruntime', hexact', hbounded', hscope'⟩ + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · let target := SourceSemantics.wordNormalize + (SourceSemantics.mappingSlotChain slot resolvedKeys) + set state' := { state with + transientStorage := fun o => + if o = target then valueNat else state.transientStorage o } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMappingChainFieldSlots + fields fieldName runtime.world [slot] resolvedKeys valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMappingChain fieldName keys value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hkeysEval, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMappingChainFieldSlots, htrans, target, + SourceSemantics.mappingSlotChain] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [writeSlotExpr, valueIR])) = + .continue state' := by + have h := execIRStmt_tstore_of_eval + (state := state) (slotExpr := writeSlotExpr) (valueExpr := valueIR) + (fuel := extraFuel) hWriteSlotEval hIRValue + simpa [fieldStoreBuiltin, htrans, state', target, SourceSemantics.wordNormalize, + SourceSemantics.mappingSlotChain] using h + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMappingChain fieldName keys value)) + runtime'.bindings state' := by + exact FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (by intro name hname; simpa [IRState.getVar, state', runtime'] using hexact name hname) + hincl + have hbounded' : FunctionBody.bindingsBounded runtime'.bindings := by + simpa [runtime'] using hbounded + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMappingChain fieldName keys value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨_, _, hSrcExec, hIRExec, ?_⟩ + exact ⟨by + simpa [runtime', state', SourceSemantics.writeAddressKeyedMappingChainFieldSlots, + htrans, target, SourceSemantics.mappingSlotChain] using + (runtimeStateMatchesIR_writeTransientTarget + (target := target) hruntime hvalueLt), + hexact', hbounded', hscopeRuntime'⟩ + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + set state' := { state with + storage := + Compiler.Proofs.abstractStoreStorageOrMapping + state.storage + (SourceSemantics.mappingSlotChain slot resolvedKeys) + valueNat } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMappingChainSlots + runtime.world [slot] resolvedKeys valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMappingChain fieldName keys value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hkeysEval, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMappingChainFieldSlots, htransFalse] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [writeSlotExpr, valueIR])) = + .continue state' := by + simpa [fieldStoreBuiltin, htransFalse, state'] using + (execIRStmt_sstore_foldl_mappingSlot + (state := state) (baseSlot := slot) (keyIRs := keyIRs) + (keyVals := resolvedKeys) (valueExpr := valueIR) + (valueVal := valueNat) (fuel := extraFuel) hkeyIRVals hIRValue) + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMappingChain fieldName keys value)) + runtime'.bindings state' := + FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) + hincl + have hbounded' : FunctionBody.bindingsBounded runtime'.bindings := by + simpa [runtime'] using hbounded + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMappingChain fieldName keys value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + have hruntime' : FunctionBody.runtimeStateMatchesIR fields runtime' state' := + runtimeStateMatchesIR_writeAddressKeyedMappingChainSlot + hruntime hresolvedNone hdynNone hvalueLt + exact ⟨_, _, hSrcExec, hIRExec, + hruntime', hexact', hbounded', hscopeRuntime'⟩ theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety {fields : List Field} @@ -3576,16 +3919,19 @@ theorem compiledStmtStep_setMappingChain_singleSlot_of_slotSafety (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setMappingChain fieldName keys value) [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [keyIRs.foldl (fun slotExpr keyExpr => YulExpr.call "mappingSlot" [slotExpr, keyExpr]) (YulExpr.lit slot), valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkeyIRsInternal := compileExprListWithInternals_nil_ok hkeyIRs have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileSetMappingChain, hmapping, hwriteSlots, hkeyIRsInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preserves hcoreKeys hinScopeKeys hcoreValue hinScopeValue hwriteSlots hslotSafety hkeyIRs hvalueIR @@ -3618,21 +3964,21 @@ private theorem compiledStmtStep_setMapping_singleSlot_of_slotSafety_preserves FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → sizeOf [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] - [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])].length ≤ extraFuel → ∃ sourceResult irExec, SourceSemantics.execStmt fields runtime (.setMapping fieldName key value) = sourceResult ∧ execIRStmts ([YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])].length + extraFuel + 1) state [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] = irExec ∧ stmtStepMatchesIRExec fields (stmtNextScope scope (.setMapping fieldName key value)) @@ -3640,7 +3986,7 @@ private theorem compiledStmtStep_setMapping_singleSlot_of_slotSafety_preserves irExec := by intro runtime state extraFuel hexact hscope hbounded hruntime hslack let compiledIR := [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] have hkeySourceEval := FunctionBody.eval_compileExpr_core_of_scope @@ -3674,31 +4020,6 @@ private theorem compiledStmtStep_setMapping_singleSlot_of_slotSafety_preserves hruntime rw [hValueSrc] at hvalueLt simp at hvalueLt - -- Define post-states - set state' := { state with - storage := - Compiler.Proofs.abstractStoreMappingEntry - state.storage slot keyNat valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMappingSlots - runtime.world [slot] keyNat valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setMapping fieldName key value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime'] - -- IR execution - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, hIRKey, hIRValue, - Compiler.Proofs.abstractStoreMappingEntry_eq, state'] - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = - .continue state' := by - simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] -- Scope inclusion: stmtNextScope only adds expr names already in scope have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMapping fieldName key value)) scope := by @@ -3708,61 +4029,144 @@ private theorem compiledStmtStep_setMapping_singleSlot_of_slotSafety_preserves · exact hinScopeKey n (collectExprNames_mem_exprBoundNames_of_core hcoreKey n hk) · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setMapping fieldName key value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeMappingSlot hexact) - hincl have hscope' : FunctionBody.scopeNamesPresent (stmtNextScope scope (.setMapping fieldName key value)) - runtime'.bindings := + runtime.bindings := FunctionBody.scopeNamesPresent_of_included hscope hincl - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMappingSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ - -theorem compiledStmtStep_setMapping_singleSlot_of_slotSafety - {fields : List Field} - {scope : List String} - {fieldName : String} - {key value : Expr} - {keyIR valueIR : YulExpr} - {slot : Nat} - (hmapping : isMapping fields fieldName = true) - (hcoreKey : FunctionBody.ExprCompileCore key) - (hinScopeKey : FunctionBody.exprBoundNamesInScope key scope) - (hcoreValue : FunctionBody.ExprCompileCore value) - (hinScopeValue : FunctionBody.exprBoundNamesInScope value scope) - (hwriteSlots : findFieldWriteSlots fields fieldName = some [slot]) - (hslotSafety : - ∀ runtime keyNat, - SourceSemantics.evalExpr fields runtime key = some keyNat → - findResolvedFieldAtSlotCopy fields - (Compiler.Proofs.abstractMappingSlot slot keyNat) = none ∧ - findDynamicArrayElementAtSlotCopy fields runtime.world - (Compiler.Proofs.abstractMappingSlot slot keyNat) = none) - (hkeyIR : CompilationModel.compileExpr fields .calldata key = Except.ok keyIR) - (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : - CompiledStmtStep fields scope (.setMapping fieldName key value) - [YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] where - compileOk := by - have hkeyIRInternal := compileExprWithInternals_nil_ok hkeyIR - have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR - simp only [CompilationModel.compileStmt, CompilationModel.compileMappingSlotWrite, - hmapping, hwriteSlots, hkeyIRInternal, hvalueIRInternal] - rfl - preserves := compiledStmtStep_setMapping_singleSlot_of_slotSafety_preserves - hcoreKey hinScopeKey hcoreValue hinScopeValue hwriteSlots hslotSafety hkeyIR hvalueIR - -private theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserves - {fields : List Field} - {scope : List String} + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · let target := SourceSemantics.wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyNat) + set state' := { state with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize target then valueNat else state.transientStorage o } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMappingFieldSlots + fields fieldName runtime.world [slot] keyNat valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMapping fieldName key value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMappingFieldSlots, htrans, target] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = + .continue state' := by + have htargetMod : + Compiler.Proofs.solidityMappingSlot slot keyNat % + Compiler.Constants.evmModulus = + Compiler.Proofs.solidityMappingSlot slot keyNat := by + exact Nat.mod_eq_of_lt (by + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using + (Compiler.Proofs.abstractMappingSlot_lt_evmModulus slot keyNat)) + simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey, hIRValue, + fieldStoreBuiltin, htrans, target, state', htargetMod, + Compiler.Proofs.abstractMappingSlot_eq_solidity, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMapping fieldName key value)) + runtime'.bindings state' := by + exact FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (by intro name hname; simpa [IRState.getVar, state', runtime'] using hexact name hname) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMapping fieldName key value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ + simp [stmtStepMatchesIRExec] + exact ⟨by + simpa [runtime', state', SourceSemantics.writeAddressKeyedMappingFieldSlots, + htrans, target] using + (runtimeStateMatchesIR_writeTransientTarget + (target := target) hruntime hvalueLt), + hexact', hbounded, hscopeRuntime'⟩ + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + set state' := { state with + storage := + Compiler.Proofs.abstractStoreMappingEntry + state.storage slot keyNat valueNat } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMappingSlots + runtime.world [slot] keyNat valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMapping fieldName key value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMappingFieldSlots, htransFalse] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = + .continue state' := by + simp [execIRStmt, evalIRExpr, hIRKey, hIRValue, fieldStoreBuiltin, + htransFalse, Compiler.Proofs.abstractStoreMappingEntry_eq, state'] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMapping fieldName key value)) + runtime'.bindings state' := + FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (bindingsExactlyMatchIRVarsOnScope_writeMappingSlot hexact) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMapping fieldName key value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ + simp [stmtStepMatchesIRExec] + exact ⟨runtimeStateMatchesIR_writeAddressKeyedMappingSlot + hruntime hresolvedNone hdynNone hvalueLt, + hexact', hbounded, hscopeRuntime'⟩ + +theorem compiledStmtStep_setMapping_singleSlot_of_slotSafety + {fields : List Field} + {scope : List String} + {fieldName : String} + {key value : Expr} + {keyIR valueIR : YulExpr} + {slot : Nat} + (hmapping : isMapping fields fieldName = true) + (hcoreKey : FunctionBody.ExprCompileCore key) + (hinScopeKey : FunctionBody.exprBoundNamesInScope key scope) + (hcoreValue : FunctionBody.ExprCompileCore value) + (hinScopeValue : FunctionBody.exprBoundNamesInScope value scope) + (hwriteSlots : findFieldWriteSlots fields fieldName = some [slot]) + (hslotSafety : + ∀ runtime keyNat, + SourceSemantics.evalExpr fields runtime key = some keyNat → + findResolvedFieldAtSlotCopy fields + (Compiler.Proofs.abstractMappingSlot slot keyNat) = none ∧ + findDynamicArrayElementAtSlotCopy fields runtime.world + (Compiler.Proofs.abstractMappingSlot slot keyNat) = none) + (hkeyIR : CompilationModel.compileExpr fields .calldata key = Except.ok keyIR) + (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : + CompiledStmtStep fields scope (.setMapping fieldName key value) + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] where + compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ + have hkeyIRInternal := compileExprWithInternals_nil_ok hkeyIR + have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR + simp only [CompilationModel.compileStmt, CompilationModel.compileMappingSlotWrite, + hmapping, hwriteSlots, hkeyIRInternal, hvalueIRInternal] + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] + preserves := compiledStmtStep_setMapping_singleSlot_of_slotSafety_preserves + hcoreKey hinScopeKey hcoreValue hinScopeValue hwriteSlots hslotSafety hkeyIR hvalueIR + +private theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserves + {fields : List Field} + {scope : List String} {fieldName : String} {key value : Expr} {wordOffset : Nat} @@ -3789,31 +4193,31 @@ private theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserv FunctionBody.scopeNamesPresent scope runtime.bindings → FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → - sizeOf [YulStmt.expr - (YulExpr.call "sstore" - [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] - if wordOffset == 0 then mappingBase - else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] - - [YulStmt.expr - (YulExpr.call "sstore" + sizeOf [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase - else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])].length ≤ extraFuel → + else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] - + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] + if wordOffset == 0 then mappingBase + else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])].length ≤ extraFuel → ∃ sourceResult irExec, SourceSemantics.execStmt fields runtime (.setMappingWord fieldName key wordOffset value) = sourceResult ∧ execIRStmts - ([YulStmt.expr - (YulExpr.call "sstore" - [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] - if wordOffset == 0 then mappingBase - else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])].length + + ([YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] + if wordOffset == 0 then mappingBase + else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])].length + extraFuel + 1) state - [YulStmt.expr - (YulExpr.call "sstore" - [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] - if wordOffset == 0 then mappingBase - else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] = irExec ∧ + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] + if wordOffset == 0 then mappingBase + else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] = irExec ∧ stmtStepMatchesIRExec fields (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) sourceResult @@ -3850,20 +4254,27 @@ private theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserv hruntime rw [hValueSrc] at hvalueLt simp at hvalueLt - -- Define post-states set targetSlot := mappingWordTargetSlot slot keyNat wordOffset - set state' := { state with - storage := - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage targetSlot valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMappingWordSlots - runtime.world [slot] keyNat wordOffset valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setMappingWord fieldName key wordOffset value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime'] + let writeSlotExpr := + let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] + if wordOffset == 0 then mappingBase + else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset] + have hWriteSlotEval : evalIRExpr state writeSlotExpr = some targetSlot := by + simpa [writeSlotExpr, targetSlot] using + (evalIRExpr_mappingWordTarget_of_eval + (state := state) (slot := slot) (wordOffset := wordOffset) hIRKey) -- Scope inclusion: stmtNextScope only adds expr names already in scope + have hTargetMod : + (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % + Compiler.Constants.evmModulus = targetSlot := by + rw [show targetSlot = + (Verity.Core.Uint256.ofNat wordOffset + + Verity.Core.Uint256.ofNat + (Compiler.Proofs.solidityMappingSlot slot keyNat)).val by + simpa [targetSlot] using mappingWordTargetSlot_eq_uint256_add slot keyNat wordOffset] + simpa [Nat.add_comm] using + (uint256_add_val_eq_mod wordOffset + (Compiler.Proofs.solidityMappingSlot slot keyNat)).symm have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) scope := by intro n hn @@ -3872,119 +4283,109 @@ private theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserv · exact hinScopeKey n (collectExprNames_mem_exprBoundNames_of_core hcoreKey n hk) · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) - hincl have hscope' : FunctionBody.scopeNamesPresent (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) - runtime'.bindings := + runtime.bindings := FunctionBody.scopeNamesPresent_of_included hscope hincl - -- IR execution: case split on wordOffset have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - by_cases hzero : wordOffset = 0 - · -- wordOffset = 0: slot expr is just mappingSlot, uses abstractStoreMappingEntry - subst hzero - have hTargetZero : - mappingWordTargetSlot slot keyNat 0 = Compiler.Proofs.abstractMappingSlot slot keyNat := by - have hlt : - Compiler.Proofs.solidityMappingSlot slot keyNat < Compiler.Constants.evmModulus := by - simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Compiler.Proofs.abstractMappingSlot_lt_evmModulus slot keyNat) - simpa [mappingWordTargetSlot, SourceSemantics.wordNormalize, - Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Nat.mod_eq_of_lt hlt) - have hStoreEq : Compiler.Proofs.abstractStoreMappingEntry state.storage slot keyNat valueNat = - Compiler.Proofs.abstractStoreStorageOrMapping state.storage - (mappingWordTargetSlot slot keyNat 0) valueNat := by - simp [Compiler.Proofs.abstractStoreStorageOrMapping, - Compiler.Proofs.abstractStoreMappingEntry, hTargetZero] + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · let target := + (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % + Compiler.Constants.evmModulus + set state' := { state with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize target then valueNat else state.transientStorage o } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMappingWordFieldSlots + fields fieldName runtime.world [slot] keyNat wordOffset valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMappingWord fieldName key wordOffset value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMappingWordFieldSlots, + SourceSemantics.writeMappingTargets, htrans, target, targetSlot, hTargetMod] have hExecStmt : execIRStmt (extraFuel + 1) state - (YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = - .continue state' := by - have hTargetZero' : targetSlot = Compiler.Proofs.solidityMappingSlot slot keyNat := by - simpa [targetSlot, Compiler.Proofs.abstractMappingSlot_eq_solidity] using hTargetZero - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey, hIRValue, - state', hTargetZero', Compiler.Proofs.abstractStoreMappingEntry_eq, - Compiler.Proofs.abstractStoreStorageOrMapping_eq] + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, valueIR])) = .continue state' := by + simpa [fieldStoreBuiltin, htrans, state', target, hTargetMod] using + (execIRStmt_tstore_of_eval + (state := state) (slotExpr := writeSlotExpr) (valueExpr := valueIR) + (slotVal := targetSlot) (valueVal := valueNat) (fuel := extraFuel) + hWriteSlotEval hIRValue) have hIRExec : execIRStmts (1 + extraFuel + 1) state - [YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] = + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [writeSlotExpr, valueIR])] = .continue state' := by simp [execIRStmts, hfuelEq, hExecStmt] - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMappingWordSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ - · -- wordOffset ≠ 0: slot expr is add [mappingSlot [...], lit wordOffset] - -- Use keccak axiom: mappingSlot + wordOffset < evmModulus - -- Reduce the if-then-else: wordOffset ≠ 0 means we take the else branch - have hbeq : (wordOffset == 0) = false := by - simp [beq_iff_eq, hzero] - have hTargetMod : - (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % - Compiler.Constants.evmModulus = targetSlot := by - rw [show targetSlot = - (Verity.Core.Uint256.ofNat wordOffset + - Verity.Core.Uint256.ofNat - (Compiler.Proofs.solidityMappingSlot slot keyNat)).val by - simpa [targetSlot] using mappingWordTargetSlot_eq_uint256_add slot keyNat wordOffset] - simpa [Nat.add_comm] using - (uint256_add_val_eq_mod wordOffset - (Compiler.Proofs.solidityMappingSlot slot keyNat)).symm - have hTargetAdd : - targetSlot = - (Verity.Core.Uint256.ofNat wordOffset + - Verity.Core.Uint256.ofNat (Compiler.Proofs.solidityMappingSlot slot keyNat)).val := by - simpa [targetSlot] using mappingWordTargetSlot_eq_uint256_add slot keyNat wordOffset - have hStoreEq : - Compiler.Proofs.abstractStoreStorageOrMapping state.storage targetSlot valueNat = - fun s => - if s = - IRStorageSlot.ofNat - ((Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % - Compiler.Constants.evmModulus) then - Compiler.Proofs.IRGeneration.IRStorageWord.ofNat valueNat - else - state.storage s := by - funext s - rw [Compiler.Proofs.abstractStoreStorageOrMapping_eq, ← hTargetMod] - -- The compiled IR with the if-else reduced + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) + runtime'.bindings state' := by + exact FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (by intro name hname; simpa [IRState.getVar, state', runtime'] using hexact name hname) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, ?_, ?_⟩ + · simpa [writeSlotExpr] using hIRExec + · simp [stmtStepMatchesIRExec] + exact ⟨by + simpa [runtime', state', SourceSemantics.writeAddressKeyedMappingWordFieldSlots, + SourceSemantics.writeMappingTargets, htrans, target, targetSlot, hTargetMod] using + (runtimeStateMatchesIR_writeTransientTarget + (target := target) hruntime hvalueLt), + hexact', hbounded, hscopeRuntime'⟩ + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + have htargetSlotNorm : + targetSlot % Compiler.Constants.evmModulus = targetSlot := by + exact Nat.mod_eq_of_lt (SourceSemantics.wordNormalize_lt_evmModulus _) + set state' := { state with + storage := + Compiler.Proofs.abstractStoreStorageOrMapping + state.storage targetSlot valueNat } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMappingWordSlots + runtime.world [slot] keyNat wordOffset valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMappingWord fieldName key wordOffset value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMappingWordFieldSlots, + SourceSemantics.writeMappingTargets, SourceSemantics.writeAddressKeyedMappingWordSlots, + htransFalse, hTargetMod, htargetSlotNorm] have hExecStmt : execIRStmt (extraFuel + 1) state - (YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "add" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], - YulExpr.lit wordOffset], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, - hIRKey, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractMappingSlot_eq_solidity, - state', hTargetMod, hStoreEq] + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, valueIR])) = .continue state' := by + simpa [fieldStoreBuiltin, htransFalse, state'] using + (execIRStmt_sstore_of_eval + (state := state) (slotExpr := writeSlotExpr) (valueExpr := valueIR) + (slotVal := targetSlot) (valueVal := valueNat) (fuel := extraFuel) + hWriteSlotEval hIRValue) have hIRExec : execIRStmts (1 + extraFuel + 1) state - [YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "add" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], - YulExpr.lit wordOffset], valueIR])] = + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [writeSlotExpr, valueIR])] = .continue state' := by simp [execIRStmts, hfuelEq, hExecStmt] - -- Now show the goal with the if-else reduced matches + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) + runtime'.bindings state' := + FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMappingWord fieldName key wordOffset value)) + runtime'.bindings := by + simpa [runtime'] using hscope' refine ⟨.continue runtime', .continue state', hSrcExec, ?_, ?_⟩ - · -- IR execution: reduce the if-then-else, then use hIRExec - simp only [List.length_singleton, hbeq, ite_false] - exact hIRExec + · simpa [writeSlotExpr] using hIRExec · simp [stmtStepMatchesIRExec] exact ⟨runtimeStateMatchesIR_writeAddressKeyedMappingWordSlot hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ + hexact', hbounded, hscopeRuntime'⟩ theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety {fields : List Field} @@ -4011,16 +4412,19 @@ theorem compiledStmtStep_setMappingWord_singleSlot_of_slotSafety (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setMappingWord fieldName key wordOffset value) [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkeyIRInternal := compileExprWithInternals_nil_ok hkeyIR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileMappingSlotWrite, hmapping, hwriteSlots, hkeyIRInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserves hcoreKey hinScopeKey hcoreValue hinScopeValue hwriteSlots hslotSafety hkeyIR hvalueIR @@ -4138,7 +4542,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit (packedMaskNat packed)]) , YulStmt.let_ "__compat_slot_word" - (YulExpr.call "sload" + (YulExpr.call (fieldLoadBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset]]) @@ -4147,7 +4551,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p [YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit (packedShiftedMaskNat packed)]]) , YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], @@ -4161,7 +4565,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit (packedMaskNat packed)]) , YulStmt.let_ "__compat_slot_word" - (YulExpr.call "sload" + (YulExpr.call (fieldLoadBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset]]) @@ -4170,7 +4574,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p [YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit (packedShiftedMaskNat packed)]]) , YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], @@ -4189,7 +4593,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit (packedMaskNat packed)]) , YulStmt.let_ "__compat_slot_word" - (YulExpr.call "sload" + (YulExpr.call (fieldLoadBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset]]) @@ -4198,7 +4602,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p [YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit (packedShiftedMaskNat packed)]]) , YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], @@ -4214,7 +4618,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit (packedMaskNat packed)]) , YulStmt.let_ "__compat_slot_word" - (YulExpr.call "sload" + (YulExpr.call (fieldLoadBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset]]) @@ -4223,7 +4627,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p [YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit (packedShiftedMaskNat packed)]]) , YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], @@ -4243,13 +4647,13 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p [ YulStmt.let_ "__compat_value" valueIR , YulStmt.let_ "__compat_packed" (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit (packedMaskNat packed)]) - , YulStmt.let_ "__compat_slot_word" (YulExpr.call "sload" [writeSlotExpr]) + , YulStmt.let_ "__compat_slot_word" (YulExpr.call (fieldLoadBuiltin fields fieldName) [writeSlotExpr]) , YulStmt.let_ "__compat_slot_cleared" (YulExpr.call "and" [YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit (packedShiftedMaskNat packed)]]) , YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [writeSlotExpr, YulExpr.call "or" [YulExpr.ident "__compat_slot_cleared", @@ -4281,8 +4685,12 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p hvalueSourceEval.symm rcases hslotSafety runtime keyNat hKeySrc with ⟨hresolvedNone, hdynNone⟩ set targetSlot := mappingWordTargetSlot slot keyNat wordOffset - set oldWordNat := Compiler.Proofs.IRGeneration.IRStorageWord.toNat - (state.storage (IRStorageSlot.ofNat targetSlot)) + set oldWordNat := + if SourceSemantics.fieldIsTransient fields fieldName then + state.transientStorage (SourceSemantics.wordNormalize targetSlot) + else + Compiler.Proofs.IRGeneration.IRStorageWord.toNat + (state.storage (IRStorageSlot.ofNat targetSlot)) set storedWordNat := SourceSemantics.packedWordWrite oldWordNat valueNat packed have hMappingBaseEval : evalIRExpr state (YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR]) = @@ -4431,10 +4839,28 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity, Nat.add_comm] using hAddEval simpa [hzero, targetSlot, mappingWordTargetSlot_eq_uint256_add] using hAddEval' have hSlotWordEval : - evalIRExpr state2 (YulExpr.call "sload" [writeSlotExpr]) = some oldWordNat := by - simp [evalIRExpr, evalIRCall, evalIRExprs, hWriteSlotEval2, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, oldWordNat, state2, state1] + evalIRExpr state2 (YulExpr.call (fieldLoadBuiltin fields fieldName) [writeSlotExpr]) = some oldWordNat := by + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · simpa [evalIRExpr, evalIRCall, evalIRExprs, + fieldLoadBuiltin, htrans, oldWordNat, state2, state1, + SourceSemantics.wordNormalize, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean] using + congrArg + (fun r => r.bind (fun a => + some (state.transientStorage (a % Compiler.Constants.evmModulus)))) + hWriteSlotEval2 + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + simpa [evalIRExpr, evalIRCall, evalIRExprs, + fieldLoadBuiltin, htransFalse, oldWordNat, state2, state1, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean] using + congrArg + (fun r => r.bind (fun a => + some (Compiler.Proofs.IRGeneration.IRStorageWord.toNat + (state.storage (IRStorageSlot.ofNat a))))) + hWriteSlotEval2 set state3 := state2.setVar "__compat_slot_word" oldWordNat have hexact_state3 : FunctionBody.bindingsExactlyMatchIRVarsOnScope scope runtime.bindings state3 := FunctionBody.bindingsExactlyMatchIRVarsOnScope_setVar_irrelevant hexact_state2 hcompatSlotWord @@ -4442,7 +4868,7 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p FunctionBody.runtimeStateMatchesIR_setVar_irrelevant hruntimeCompat2 have hCompatSlotWord : ∀ fuel, execIRStmt (fuel + 1) state2 - (YulStmt.let_ "__compat_slot_word" (YulExpr.call "sload" [writeSlotExpr])) = + (YulStmt.let_ "__compat_slot_word" (YulExpr.call (fieldLoadBuiltin fields fieldName) [writeSlotExpr])) = .continue state3 := by intro fuel simp [state3, execIRStmt, hSlotWordEval] @@ -4616,8 +5042,17 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p rw [hShiftedOfNat] at hOrEval simpa [storedWordNat, SourceSemantics.packedWordWrite, hClearedOfNat, hPackedOfNat] using hOrEval - set state' := { state4 with - storage := Compiler.Proofs.abstractStoreStorageOrMapping state.storage targetSlot storedWordNat } + set state' := + if SourceSemantics.fieldIsTransient fields fieldName then + { state4 with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize targetSlot then + storedWordNat + else + state4.transientStorage o } + else + { state4 with + storage := Compiler.Proofs.abstractStoreStorageOrMapping state.storage targetSlot storedWordNat } have hIRKeyState4 : evalIRExpr state4 keyIR = some keyNat := by have h := FunctionBody.eval_compileExpr_core_of_scope @@ -4676,25 +5111,41 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p have hSstore : ∀ fuel, execIRStmt (fuel + 1) state4 (YulStmt.expr - (YulExpr.call "sstore" - [writeSlotExpr, - YulExpr.call "or" - [YulExpr.ident "__compat_slot_cleared", - YulExpr.call "shl" [YulExpr.lit packed.offset, YulExpr.ident "__compat_packed"]]])) = + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, + YulExpr.call "or" + [YulExpr.ident "__compat_slot_cleared", + YulExpr.call "shl" [YulExpr.lit packed.offset, YulExpr.ident "__compat_packed"]]])) = .continue state' := by intro fuel - simpa [state', state4, state3, state2, state1] using - (execIRStmt_sstore_of_eval - (state := state4) - (slotExpr := writeSlotExpr) - (valueExpr := YulExpr.call "or" - [YulExpr.ident "__compat_slot_cleared", - YulExpr.call "shl" [YulExpr.lit packed.offset, YulExpr.ident "__compat_packed"]]) - (slotVal := targetSlot) - (valueVal := storedWordNat) - (fuel := fuel) - hWriteSlotEval4 - hStoredEval) + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · simpa [fieldStoreBuiltin, htrans, state', state4, state3, state2, state1, + SourceSemantics.wordNormalize] using + (execIRStmt_tstore_of_eval + (state := state4) + (slotExpr := writeSlotExpr) + (valueExpr := YulExpr.call "or" + [YulExpr.ident "__compat_slot_cleared", + YulExpr.call "shl" [YulExpr.lit packed.offset, YulExpr.ident "__compat_packed"]]) + (slotVal := targetSlot) + (valueVal := storedWordNat) + (fuel := fuel) + hWriteSlotEval4 + hStoredEval) + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + simpa [fieldStoreBuiltin, htransFalse, state', state4, state3, state2, state1] using + (execIRStmt_sstore_of_eval + (state := state4) + (slotExpr := writeSlotExpr) + (valueExpr := YulExpr.call "or" + [YulExpr.ident "__compat_slot_cleared", + YulExpr.call "shl" [YulExpr.lit packed.offset, YulExpr.ident "__compat_packed"]]) + (slotVal := targetSlot) + (valueVal := storedWordNat) + (fuel := fuel) + hWriteSlotEval4 + hStoredEval) have hSizeOfListBound : ∀ (l : List YulStmt), l.length + 1 ≤ sizeOf l := by intro l induction l with @@ -4732,10 +5183,10 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p (.setMappingPackedWord fieldName key wordOffset packed value) = .continue { runtime with - world := SourceSemantics.writeAddressKeyedMappingPackedWordSlots - runtime.world [slot] keyNat wordOffset packed valueNat } := by + world := SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName runtime.world [slot] keyNat wordOffset packed valueNat } := by simp [SourceSemantics.execStmt, hwriteSlots, hKeySrc, hValueSrc, hpacked, - SourceSemantics.writeAddressKeyedMappingPackedWordSlots] + SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots] have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMappingPackedWord fieldName key wordOffset packed value)) scope := by intro n hn @@ -4765,15 +5216,122 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p have hruntime' : FunctionBody.runtimeStateMatchesIR fields { runtime with - world := SourceSemantics.writeAddressKeyedMappingPackedWordSlots - runtime.world [slot] keyNat wordOffset packed valueNat } + world := SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName runtime.world [slot] keyNat wordOffset packed valueNat } state' := by - simpa [state', targetSlot, oldWordNat, storedWordNat] using - runtimeStateMatchesIR_writeAddressKeyedMappingPackedWordSlot - (runtime := runtime) - (state := state4) - (slot := slot) (key := keyNat) (wordOffset := wordOffset) (packed := packed) - (value := valueNat) hruntime4 hresolvedNone hdynNone + have hstoredLt : storedWordNat < Compiler.Constants.evmModulus := by + dsimp [storedWordNat, SourceSemantics.packedWordWrite] + exact ((Verity.Core.Uint256.and oldWordNat + (Verity.Core.Uint256.not (packedShiftedMaskNat packed))).or + (Verity.Core.Uint256.shl packed.offset + (Verity.Core.Uint256.and valueNat (packedMaskNat packed)))).isLt + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · have hmatch : + FunctionBody.runtimeStateMatchesIR fields + { runtime with + world := SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName runtime.world [slot] keyNat wordOffset packed valueNat } + { state4 with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize targetSlot then storedWordNat + else state4.transientStorage o } := by + rcases hruntime4 with + ⟨hstorage, htransient, hsender, hmsgValue, hthis, htimestamp, hblock, hchain, + hret, hevents⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · funext query + rw [hstorage] + exact congrArg Compiler.Proofs.IRGeneration.IRStorageWord.ofNat + (SourceSemantics.encodeStorageAt_congr + (by simp [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans]) + (by simp [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans]) + (by simp [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans])) + · funext query + have htargetNorm : SourceSemantics.wordNormalize targetSlot = targetSlot := by + simpa [targetSlot, mappingWordTargetSlot] using + SourceSemantics.wordNormalize_idem + (Compiler.Proofs.abstractMappingSlot slot keyNat + wordOffset) + by_cases hquery : query = targetSlot + · subst hquery + have hTargetMod : + (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % + Compiler.Constants.evmModulus = targetSlot := by + rw [show targetSlot = + (Verity.Core.Uint256.ofNat wordOffset + + Verity.Core.Uint256.ofNat + (Compiler.Proofs.solidityMappingSlot slot keyNat)).val by + simpa [targetSlot] using mappingWordTargetSlot_eq_uint256_add slot keyNat wordOffset] + simpa [Nat.add_comm] using + (uint256_add_val_eq_mod wordOffset + (Compiler.Proofs.solidityMappingSlot slot keyNat)).symm + have htargetModSelf : targetSlot % Compiler.Constants.evmModulus = targetSlot := by + exact Nat.mod_eq_of_lt (SourceSemantics.wordNormalize_lt_evmModulus _) + simp [oldWordNat, storedWordNat, + SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans, + htargetNorm, htargetModSelf, hTargetMod, htransient, Nat.mod_eq_of_lt hstoredLt] + have hstateTransient : + state.transientStorage targetSlot = + (runtime.world.transientStorage targetSlot).val := by + have hstate4Transient : + state4.transientStorage targetSlot = + state.transientStorage targetSlot := by + simp [state4, state3, state2, state1, IRState.setVar] + rw [← hstate4Transient] + exact congrFun htransient targetSlot + rw [hstateTransient] + exact (Nat.mod_eq_of_lt (by + dsimp [SourceSemantics.packedWordWrite] + exact ((Verity.Core.Uint256.and (runtime.world.transientStorage targetSlot).val + (Verity.Core.Uint256.not (packedShiftedMaskNat packed))).or + (Verity.Core.Uint256.shl packed.offset + (Verity.Core.Uint256.and valueNat (packedMaskNat packed)))).isLt)).symm + · have hbeq : (targetSlot == query) = false := by + have hqueryRev : ¬ targetSlot = query := by + intro h + exact hquery h.symm + simp [BEq.beq, hqueryRev] + have hTargetMod : + (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % + Compiler.Constants.evmModulus = targetSlot := by + rw [show targetSlot = + (Verity.Core.Uint256.ofNat wordOffset + + Verity.Core.Uint256.ofNat + (Compiler.Proofs.solidityMappingSlot slot keyNat)).val by + simpa [targetSlot] using mappingWordTargetSlot_eq_uint256_add slot keyNat wordOffset] + simpa [Nat.add_comm] using + (uint256_add_val_eq_mod wordOffset + (Compiler.Proofs.solidityMappingSlot slot keyNat)).symm + have htargetModSelf : targetSlot % Compiler.Constants.evmModulus = targetSlot := by + exact Nat.mod_eq_of_lt (SourceSemantics.wordNormalize_lt_evmModulus _) + have hqueryTarget : + ¬ (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % + Compiler.Constants.evmModulus = query := by + have hqueryRev : ¬ targetSlot = query := by + intro h + exact hquery h.symm + simpa [hTargetMod] using hqueryRev + simp [oldWordNat, storedWordNat, + SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans, + htargetNorm, htargetModSelf, hquery, hbeq, hqueryTarget, htransient] + exact congrFun htransient query + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hsender + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hmsgValue + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hthis + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using htimestamp + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hblock + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hchain + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hret + · simpa [SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htrans] using hevents + simpa [state', htrans] using hmatch + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + simpa [state', targetSlot, oldWordNat, storedWordNat, + SourceSemantics.writeAddressKeyedMappingPackedWordFieldSlots, htransFalse] using + runtimeStateMatchesIR_writeAddressKeyedMappingPackedWordSlot + (runtime := runtime) + (state := state4) + (slot := slot) (key := keyNat) (wordOffset := wordOffset) (packed := packed) + (value := valueNat) hruntime4 hresolvedNone hdynNone have hexact1 := FunctionBody.bindingsExactlyMatchIRVarsOnScope_setVar_irrelevant (tempName := "__compat_value") (value := valueNat) hexact hcompatValue @@ -4796,7 +5354,14 @@ private theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_p (stmtNextScope scope (.setMappingPackedWord fieldName key wordOffset packed value)) runtime.bindings state' := FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact4) hincl + (by + intro name hname + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · simpa [IRState.getVar, state', htrans] using hexact4 name hname + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + simpa [IRState.getVar, state', htransFalse] using hexact4 name hname) + hincl refine ⟨_, _, hSrcExec, hWhole, ?_⟩ simp [stmtStepMatchesIRExec] exact ⟨hruntime', hexact', hbounded, hscope'⟩ @@ -4837,7 +5402,7 @@ theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety (YulExpr.call "and" [YulExpr.ident "__compat_value", YulExpr.lit (packedMaskNat packed)]) , YulStmt.let_ "__compat_slot_word" - (YulExpr.call "sload" + (YulExpr.call (fieldLoadBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset]]) @@ -4846,7 +5411,7 @@ theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety [YulExpr.ident "__compat_slot_word", YulExpr.call "not" [YulExpr.lit (packedShiftedMaskNat packed)]]) , YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], @@ -4855,12 +5420,15 @@ theorem compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety YulExpr.call "shl" [YulExpr.lit packed.offset, YulExpr.ident "__compat_packed"]]])]] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkeyIRInternal := compileExprWithInternals_nil_ok hkeyIR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileMappingPackedSlotWrite, hmapping, hpacked, hwriteSlots, hkeyIRInternal, hvalueIRInternal, Bool.not_true, bne_self_eq_false, ite_false, ite_true, pure, Except.pure, bind, Except.bind] - rfl + simp [hfind, fieldLoadBuiltin, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setMappingPackedWord_singleSlot_of_slotSafety_preserves hcoreKey hinScopeKey hcoreValue hinScopeValue hcompatValue hcompatPacked hcompatSlotWord hcompatSlotCleared @@ -4900,12 +5468,12 @@ private theorem compiledStmtStep_setStructMember_singleSlot_of_slotSafety_preser FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → sizeOf [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] - [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])].length ≤ extraFuel → @@ -4914,14 +5482,14 @@ private theorem compiledStmtStep_setStructMember_singleSlot_of_slotSafety_preser sourceResult ∧ execIRStmts ([YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])].length + extraFuel + 1) state [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] = irExec ∧ @@ -4930,158 +5498,18 @@ private theorem compiledStmtStep_setStructMember_singleSlot_of_slotSafety_preser sourceResult irExec := by intro runtime state extraFuel hexact hscope hbounded hruntime hslack - have hkeySourceEval := - FunctionBody.eval_compileExpr_core_of_scope - hcoreKey hexact hinScopeKey hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeKey) - hruntime - have hvalueSourceEval := - FunctionBody.eval_compileExpr_core_of_scope - hcoreValue hexact hinScopeValue hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeValue) - hruntime - rw [hkeyIR] at hkeySourceEval - rw [hvalueIR] at hvalueSourceEval - simp [Except.toOption] at hkeySourceEval hvalueSourceEval - rcases hIRKey : evalIRExpr state keyIR with _ | keyNat - · simp [hIRKey, Option.bind] at hkeySourceEval - · simp [hIRKey, Option.bind] at hkeySourceEval - rcases hIRValue : evalIRExpr state valueIR with _ | valueNat - · simp [hIRValue, Option.bind] at hvalueSourceEval - · simp [hIRValue, Option.bind] at hvalueSourceEval - have hKeySrc : SourceSemantics.evalExpr fields runtime key = some keyNat := - hkeySourceEval.symm - have hValueSrc : SourceSemantics.evalExpr fields runtime value = some valueNat := - hvalueSourceEval.symm - rcases hslotSafety runtime keyNat hKeySrc with ⟨hresolvedNone, hdynNone⟩ - have hvalueLt := FunctionBody.evalExpr_lt_evmModulus_core_of_scope - hcoreValue hexact hinScopeValue hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeValue) - hruntime - rw [hValueSrc] at hvalueLt - simp at hvalueLt - set targetSlot := mappingWordTargetSlot slot keyNat wordOffset - set state' := { state with - storage := - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage targetSlot valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMappingWordSlots - runtime.world [slot] keyNat wordOffset valueNat } - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setStructMember fieldName key memberName value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hmembers, hmember, hKeySrc, hValueSrc, runtime'] - have hincl : FunctionBody.scopeNamesIncluded - (stmtNextScope scope (.setStructMember fieldName key memberName value)) scope := by - intro n hn - simp [stmtNextScope, collectStmtNames] at hn - rcases hn with hk | hv | hs - · exact hinScopeKey n (collectExprNames_mem_exprBoundNames_of_core hcoreKey n hk) - · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) - · exact hs - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setStructMember fieldName key memberName value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) - hincl - have hscope' : FunctionBody.scopeNamesPresent - (stmtNextScope scope (.setStructMember fieldName key memberName value)) - runtime'.bindings := - FunctionBody.scopeNamesPresent_of_included hscope hincl - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - by_cases hzero : wordOffset = 0 - · subst hzero - have hTargetZero : - mappingWordTargetSlot slot keyNat 0 = Compiler.Proofs.abstractMappingSlot slot keyNat := by - have hlt : - Compiler.Proofs.solidityMappingSlot slot keyNat < Compiler.Constants.evmModulus := by - simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Compiler.Proofs.abstractMappingSlot_lt_evmModulus slot keyNat) - simpa [mappingWordTargetSlot, SourceSemantics.wordNormalize, - Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Nat.mod_eq_of_lt hlt) - have hStoreEq : Compiler.Proofs.abstractStoreMappingEntry state.storage slot keyNat valueNat = - Compiler.Proofs.abstractStoreStorageOrMapping state.storage - (mappingWordTargetSlot slot keyNat 0) valueNat := by - simp [Compiler.Proofs.abstractStoreStorageOrMapping, - Compiler.Proofs.abstractStoreMappingEntry, hTargetZero] - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])) = - .continue state' := by - have hTargetZero' : targetSlot = Compiler.Proofs.solidityMappingSlot slot keyNat := by - simpa [targetSlot, Compiler.Proofs.abstractMappingSlot_eq_solidity] using hTargetZero - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey, hIRValue, - state', hTargetZero', Compiler.Proofs.abstractStoreMappingEntry_eq, - Compiler.Proofs.abstractStoreStorageOrMapping_eq] - have hIRExec : execIRStmts (1 + extraFuel + 1) state - [YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], valueIR])] = - .continue state' := by - simp [execIRStmts, hfuelEq, hExecStmt] - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMappingWordSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ - · -- wordOffset ≠ 0: slot expr is add [mappingSlot [...], lit wordOffset] - -- Use keccak axiom: mappingSlot + wordOffset < evmModulus - have hbeq : (wordOffset == 0) = false := by - simp [beq_iff_eq, hzero] - have hTargetAdd : - targetSlot = - (Verity.Core.Uint256.ofNat wordOffset + - Verity.Core.Uint256.ofNat - (Compiler.Proofs.solidityMappingSlot slot keyNat)).val := by - simpa [targetSlot] using mappingWordTargetSlot_eq_uint256_add slot keyNat wordOffset - have hTargetMod : - (Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % - Compiler.Constants.evmModulus = targetSlot := by - rw [hTargetAdd] - simpa [Nat.add_comm] using - (uint256_add_val_eq_mod wordOffset - (Compiler.Proofs.solidityMappingSlot slot keyNat)).symm - have hStoreEq : - Compiler.Proofs.abstractStoreStorageOrMapping state.storage targetSlot valueNat = - fun s => - if s = - IRStorageSlot.ofNat - ((Compiler.Proofs.solidityMappingSlot slot keyNat + wordOffset) % - Compiler.Constants.evmModulus) then - Compiler.Proofs.IRGeneration.IRStorageWord.ofNat valueNat - else - state.storage s := by - funext s - rw [Compiler.Proofs.abstractStoreStorageOrMapping_eq, ← hTargetMod] - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "add" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], - YulExpr.lit wordOffset], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, - hIRKey, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractMappingSlot_eq_solidity, - state', hTargetMod, hStoreEq] - have hIRExec : execIRStmts (1 + extraFuel + 1) state - [YulStmt.expr (YulExpr.call "sstore" - [YulExpr.call "add" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR], - YulExpr.lit wordOffset], valueIR])] = - .continue state' := by - simp [execIRStmts, hfuelEq, hExecStmt] - refine ⟨.continue runtime', .continue state', hSrcExec, ?_, ?_⟩ - · simp only [List.length_singleton, hbeq, ite_false] - exact hIRExec - · simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMappingWordSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ + obtain ⟨sourceResult, irExec, hSrcMappingWord, hIRExec, hmatch⟩ := + compiledStmtStep_setMappingWord_singleSlot_of_slotSafety_preserves + hcoreKey hinScopeKey hcoreValue hinScopeValue hwriteSlots hslotSafety + hkeyIR hvalueIR runtime state extraFuel hexact hscope hbounded hruntime hslack + refine ⟨sourceResult, irExec, ?_, hIRExec, ?_⟩ + · rw [← hSrcMappingWord] + simp only [SourceSemantics.execStmt, hwriteSlots, hmembers] + cases SourceSemantics.evalExpr fields runtime key <;> + cases SourceSemantics.evalExpr fields runtime value <;> + simp [hmember] + · simpa [stmtStepMatchesIRExec, stmtNextScope, collectStmtNames] + using hmatch theorem compiledStmtStep_setStructMember_singleSlot_of_slotSafety {fields : List Field} @@ -5114,17 +5542,20 @@ theorem compiledStmtStep_setStructMember_singleSlot_of_slotSafety (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setStructMember fieldName key memberName value) [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, keyIR] if wordOffset == 0 then mappingBase else YulExpr.call "add" [mappingBase, YulExpr.lit wordOffset], valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkeyIRInternal := compileExprWithInternals_nil_ok hkeyIR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileSetStructMember, CompilationModel.compileMappingSlotWrite, hmapping, hnotMapping2, hmembers, hmember, hwriteSlots, hkeyIRInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setStructMember_singleSlot_of_slotSafety_preserves hcoreKey hinScopeKey hcoreValue hinScopeValue hmembers hmember hwriteSlots hslotSafety hkeyIR hvalueIR @@ -5163,34 +5594,34 @@ private theorem compiledStmtStep_setMapping2_singleSlot_of_slotSafety_preserves FunctionBody.scopeNamesPresent scope runtime.bindings → FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → - sizeOf [YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] - - [YulStmt.expr - (YulExpr.call "sstore" + sizeOf [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])].length ≤ extraFuel → + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] - + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])].length ≤ extraFuel → ∃ sourceResult irExec, SourceSemantics.execStmt fields runtime (.setMapping2 fieldName key1 key2 value) = sourceResult ∧ execIRStmts - ([YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])].length + + ([YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])].length + extraFuel + 1) state - [YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] = irExec ∧ + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] = irExec ∧ stmtStepMatchesIRExec fields (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) sourceResult irExec := by intro runtime state extraFuel hexact hscope hbounded hruntime hslack let compiledIR := [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [YulExpr.call "mappingSlot" [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] -- Evaluate key1 expression @@ -5240,37 +5671,6 @@ private theorem compiledStmtStep_setMapping2_singleSlot_of_slotSafety_preserves hruntime rw [hValueSrc] at hvalueLt simp at hvalueLt - -- Define post-states - set state' := { state with - storage := - Compiler.Proofs.abstractStoreMappingEntry - state.storage - (Compiler.Proofs.abstractMappingSlot slot key1Nat) - key2Nat - valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMapping2Slots - runtime.world [slot] key1Nat key2Nat valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setMapping2 fieldName key1 key2 value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hKey1Src, hKey2Src, hValueSrc, runtime'] - -- IR execution - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey1, hIRKey2, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractStoreMappingEntry_eq, state'] - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = - .continue state' := by - simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] -- Scope inclusion have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) scope := by @@ -5281,22 +5681,115 @@ private theorem compiledStmtStep_setMapping2_singleSlot_of_slotSafety_preserves · exact hinScopeKey2 n (collectExprNames_mem_exprBoundNames_of_core hcoreKey2 n hk2) · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeMappingSlot hexact) - hincl have hscope' : FunctionBody.scopeNamesPresent (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) - runtime'.bindings := + runtime.bindings := FunctionBody.scopeNamesPresent_of_included hscope hincl - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMapping2Slot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · let target := SourceSemantics.wordNormalize + (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) + set state' := { state with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize target then valueNat else state.transientStorage o } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMapping2FieldSlots + fields fieldName runtime.world [slot] key1Nat key2Nat valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMapping2 fieldName key1 key2 value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKey1Src, hKey2Src, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMapping2FieldSlots, htrans, target] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = + .continue state' := by + have htargetMod : + Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat % + Compiler.Constants.evmModulus = + Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat := by + exact Nat.mod_eq_of_lt (by + simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using + (Compiler.Proofs.abstractMappingSlot_lt_evmModulus + (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat)) + simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey1, hIRKey2, hIRValue, + fieldStoreBuiltin, htrans, target, state', htargetMod, + Compiler.Proofs.abstractMappingSlot_eq_solidity, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) + runtime'.bindings state' := by + exact FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (by intro name hname; simpa [IRState.getVar, state', runtime'] using hexact name hname) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ + simp [stmtStepMatchesIRExec] + exact ⟨by + simpa [runtime', state', SourceSemantics.writeAddressKeyedMapping2FieldSlots, + htrans, target] using + (runtimeStateMatchesIR_writeTransientTarget + (target := target) hruntime hvalueLt), + hexact', hbounded, hscopeRuntime'⟩ + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + set state' := { state with + storage := + Compiler.Proofs.abstractStoreMappingEntry + state.storage + (Compiler.Proofs.abstractMappingSlot slot key1Nat) + key2Nat + valueNat } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMapping2Slots + runtime.world [slot] key1Nat key2Nat valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMapping2 fieldName key1 key2 value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKey1Src, hKey2Src, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMapping2FieldSlots, htransFalse] + have hExecStmt : + execIRStmt (extraFuel + 1) state + (YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = + .continue state' := by + simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey1, hIRKey2, hIRValue, + fieldStoreBuiltin, htransFalse, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, + Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, + Compiler.Proofs.abstractStoreMappingEntry_eq, state'] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = + .continue state' := by + simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) + runtime'.bindings state' := + FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (bindingsExactlyMatchIRVarsOnScope_writeMappingSlot hexact) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMapping2 fieldName key1 key2 value)) + runtime'.bindings := by + simpa [runtime'] using hscope' + refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ + simp [stmtStepMatchesIRExec] + exact ⟨runtimeStateMatchesIR_writeAddressKeyedMapping2Slot + hruntime hresolvedNone hdynNone hvalueLt, + hexact', hbounded, hscopeRuntime'⟩ theorem compiledStmtStep_setMapping2_singleSlot_of_slotSafety {fields : List Field} @@ -5327,17 +5820,20 @@ theorem compiledStmtStep_setMapping2_singleSlot_of_slotSafety (hkey2IR : CompilationModel.compileExpr fields .calldata key2 = Except.ok key2IR) (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setMapping2 fieldName key1 key2 value) - [YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] where + [YulStmt.expr + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkey1IRInternal := compileExprWithInternals_nil_ok hkey1IR have hkey2IRInternal := compileExprWithInternals_nil_ok hkey2IR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileSetMapping2, hmapping2, hwriteSlots, hkey1IRInternal, hkey2IRInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setMapping2_singleSlot_of_slotSafety_preserves hcoreKey1 hinScopeKey1 hcoreKey2 hinScopeKey2 hcoreValue hinScopeValue hwriteSlots hslotSafety hkey1IR hkey2IR hvalueIR @@ -5376,13 +5872,13 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → sizeOf [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset], valueIR])] - [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5393,7 +5889,7 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser sourceResult ∧ execIRStmts ([YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5401,7 +5897,7 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser extraFuel + 1) state [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5412,7 +5908,7 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser irExec := by intro runtime state extraFuel hexact hscope hbounded hruntime hslack let compiledIR := [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5464,19 +5960,33 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser hruntime rw [hValueSrc] at hvalueLt simp at hvalueLt - -- Define post-states set targetSlot := mapping2WordTargetSlot slot key1Nat key2Nat wordOffset - set state' := { state with - storage := - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage targetSlot valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMapping2WordSlots - runtime.world [slot] key1Nat key2Nat wordOffset valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setMapping2Word fieldName key1 key2 wordOffset value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hKey1Src, hKey2Src, hValueSrc, runtime'] + let writeSlotExpr := + let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] + let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] + if wordOffset == 0 then mappingSlot2 + else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset] + have hWriteSlotEval : evalIRExpr state writeSlotExpr = some targetSlot := by + simpa [writeSlotExpr, targetSlot] using + (evalIRExpr_mapping2WordTarget_of_eval + (state := state) (slot := slot) (wordOffset := wordOffset) hIRKey1 hIRKey2) + have hTargetAdd : + targetSlot = + (Verity.Core.Uint256.ofNat wordOffset + + Verity.Core.Uint256.ofNat + (Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).val := by + simpa [targetSlot] using + mapping2WordTargetSlot_eq_uint256_add slot key1Nat key2Nat wordOffset + have hTargetMod : + (Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat + wordOffset) % + Compiler.Constants.evmModulus = targetSlot := by + rw [hTargetAdd] + simpa [Nat.add_comm] using + (uint256_add_val_eq_mod wordOffset + (Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).symm -- Scope inclusion have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) scope := by @@ -5487,104 +5997,79 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser · exact hinScopeKey2 n (collectExprNames_mem_exprBoundNames_of_core hcoreKey2 n hk2) · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) - hincl have hscope' : FunctionBody.scopeNamesPresent (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) - runtime'.bindings := + runtime.bindings := FunctionBody.scopeNamesPresent_of_included hscope hincl - by_cases hzero : wordOffset = 0 - · -- wordOffset = 0: slot expr is mappingSlot [mappingSlot [lit slot, key1IR], key2IR] - subst hzero - have hTargetZero : - mapping2WordTargetSlot slot key1Nat key2Nat 0 = - Compiler.Proofs.abstractMappingSlot - (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat := by - have hlt : - Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat < - Compiler.Constants.evmModulus := by - simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Compiler.Proofs.abstractMappingSlot_lt_evmModulus - (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) - simpa [mapping2WordTargetSlot, SourceSemantics.wordNormalize, - Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Nat.mod_eq_of_lt hlt) - have hStoreEq : - Compiler.Proofs.abstractStoreMappingEntry - state.storage - (Compiler.Proofs.abstractMappingSlot slot key1Nat) - key2Nat - valueNat = - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage - (Compiler.Proofs.abstractMappingSlot - (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) - valueNat := by - funext s - simp [Compiler.Proofs.abstractStoreMappingEntry_eq, - Compiler.Proofs.abstractStoreStorageOrMapping_eq, - Compiler.Proofs.abstractMappingSlot] + have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + by_cases htrans : SourceSemantics.fieldIsTransient fields fieldName = true + · let target := + (Compiler.Proofs.solidityMappingSlot + (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat + wordOffset) % + Compiler.Constants.evmModulus + set state' := { state with + transientStorage := fun o => + if o = SourceSemantics.wordNormalize target then valueNat else state.transientStorage o } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMapping2WordFieldSlots + fields fieldName runtime.world [slot] key1Nat key2Nat wordOffset valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMapping2Word fieldName key1 key2 wordOffset value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKey1Src, hKey2Src, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMapping2WordFieldSlots, + SourceSemantics.writeMappingTargets, htrans, target, targetSlot, hTargetMod] have hExecStmt : execIRStmt (extraFuel + 1) state (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = - .continue state' := by - simpa [state', targetSlot, hTargetZero, hStoreEq] using - (show - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = - .continue - { state with - storage := Compiler.Proofs.abstractStoreMappingEntry - state.storage - (Compiler.Proofs.abstractMappingSlot slot key1Nat) - key2Nat - valueNat } by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey1, hIRKey2, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractStoreMappingEntry_eq]) - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, valueIR])) = .continue state' := by + simpa [fieldStoreBuiltin, htrans, state', target, hTargetMod] using + (execIRStmt_tstore_of_eval + (state := state) (slotExpr := writeSlotExpr) (valueExpr := valueIR) + (slotVal := targetSlot) (valueVal := valueNat) (fuel := extraFuel) + hWriteSlotEval hIRValue) have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = .continue state' := by - simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] + change execIRStmts (1 + extraFuel + 1) state + [YulStmt.expr (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, valueIR])] = .continue state' + simp [execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) + runtime'.bindings state' := by + exact FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (by intro name hname; simpa [IRState.getVar, state', runtime'] using hexact name hname) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) + runtime'.bindings := by + simpa [runtime'] using hscope' refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMapping2WordSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ - · -- wordOffset ≠ 0: slot expr is add [mappingSlot [mappingSlot [...], ...], lit wordOffset] - -- Use keccak axiom: nested mappingSlot + wordOffset < evmModulus - have hbeq : (wordOffset == 0) = false := by - simp [beq_iff_eq, hzero] - have hTargetAdd : - targetSlot = - (Verity.Core.Uint256.ofNat wordOffset + - Verity.Core.Uint256.ofNat - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).val := by - simpa [targetSlot] using - mapping2WordTargetSlot_eq_uint256_add slot key1Nat key2Nat wordOffset - have hTargetMod : - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat + wordOffset) % - Compiler.Constants.evmModulus = targetSlot := by - rw [hTargetAdd] - simpa [Nat.add_comm] using - (uint256_add_val_eq_mod wordOffset - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).symm + exact ⟨by + simpa [runtime', state', SourceSemantics.writeAddressKeyedMapping2WordFieldSlots, + SourceSemantics.writeMappingTargets, htrans, target, targetSlot, hTargetMod] using + (runtimeStateMatchesIR_writeTransientTarget + (target := target) hruntime hvalueLt), + hexact', hbounded, hscopeRuntime'⟩ + · have htransFalse : SourceSemantics.fieldIsTransient fields fieldName = false := by + cases h : SourceSemantics.fieldIsTransient fields fieldName <;> simp [h] at htrans ⊢ + have htargetSlotNorm : + targetSlot % Compiler.Constants.evmModulus = targetSlot := by + exact Nat.mod_eq_of_lt (SourceSemantics.wordNormalize_lt_evmModulus _) + set state' := { state with + storage := + Compiler.Proofs.abstractStoreStorageOrMapping + state.storage targetSlot valueNat } + set runtime' := { runtime with + world := SourceSemantics.writeAddressKeyedMapping2WordSlots + runtime.world [slot] key1Nat key2Nat wordOffset valueNat } + have hSrcExec : SourceSemantics.execStmt fields runtime + (.setMapping2Word fieldName key1 key2 wordOffset value) = .continue runtime' := by + simp [SourceSemantics.execStmt, hwriteSlots, hKey1Src, hKey2Src, hValueSrc, runtime', + SourceSemantics.writeAddressKeyedMapping2WordFieldSlots, + SourceSemantics.writeMappingTargets, SourceSemantics.writeAddressKeyedMapping2WordSlots, + htransFalse, hTargetMod, htargetSlotNorm] have hStoreEq : Compiler.Proofs.abstractStoreStorageOrMapping state.storage targetSlot valueNat = fun s => @@ -5602,28 +6087,34 @@ private theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preser have hExecStmt : execIRStmt (extraFuel + 1) state (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "add" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], - YulExpr.lit wordOffset], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, - hIRKey1, hIRKey2, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractMappingSlot_eq_solidity, - state', hTargetMod, hStoreEq] - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega + (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, valueIR])) = .continue state' := by + simpa [fieldStoreBuiltin, htransFalse, state'] using + (execIRStmt_sstore_of_eval + (state := state) (slotExpr := writeSlotExpr) (valueExpr := valueIR) + (slotVal := targetSlot) (valueVal := valueNat) (fuel := extraFuel) + hWriteSlotEval hIRValue) have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = .continue state' := by - simp only [compiledIR, hbeq, ite_false] + change execIRStmts (1 + extraFuel + 1) state + [YulStmt.expr (YulExpr.call (fieldStoreBuiltin fields fieldName) + [writeSlotExpr, valueIR])] = .continue state' simp [execIRStmts, hfuelEq, hExecStmt] + have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope + (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) + runtime'.bindings state' := + FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included + (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) + hincl + have hscopeRuntime' : FunctionBody.scopeNamesPresent + (stmtNextScope scope (.setMapping2Word fieldName key1 key2 wordOffset value)) + runtime'.bindings := by + simpa [runtime'] using hscope' refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ simp [stmtStepMatchesIRExec] exact ⟨runtimeStateMatchesIR_writeAddressKeyedMapping2WordSlot hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ + hexact', hbounded, hscopeRuntime'⟩ theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety {fields : List Field} @@ -5654,18 +6145,21 @@ theorem compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setMapping2Word fieldName key1 key2 wordOffset value) [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset], valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkey1IRInternal := compileExprWithInternals_nil_ok hkey1IR have hkey2IRInternal := compileExprWithInternals_nil_ok hkey2IR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileSetMapping2Word, hmapping2, hwriteSlots, hkey1IRInternal, hkey2IRInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preserves hcoreKey1 hinScopeKey1 hcoreKey2 hinScopeKey2 hcoreValue hinScopeValue hwriteSlots hslotSafety hkey1IR hkey2IR hvalueIR @@ -5704,13 +6198,13 @@ private theorem compiledStmtStep_setStructMember2_singleSlot_of_slotSafety_prese FunctionBody.bindingsBounded runtime.bindings → FunctionBody.runtimeStateMatchesIR fields runtime state → sizeOf [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset], valueIR])] - [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5721,7 +6215,7 @@ private theorem compiledStmtStep_setStructMember2_singleSlot_of_slotSafety_prese (.setStructMember2 fieldName key1 key2 memberName value) = sourceResult ∧ execIRStmts ([YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5729,7 +6223,7 @@ private theorem compiledStmtStep_setStructMember2_singleSlot_of_slotSafety_prese extraFuel + 1) state [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 @@ -5739,220 +6233,20 @@ private theorem compiledStmtStep_setStructMember2_singleSlot_of_slotSafety_prese sourceResult irExec := by intro runtime state extraFuel hexact hscope hbounded hruntime hslack - let compiledIR := [YulStmt.expr - (YulExpr.call "sstore" - [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] - let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] - if wordOffset == 0 then mappingSlot2 - else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset], valueIR])] - -- Evaluate key1 expression - have hkey1SourceEval := - FunctionBody.eval_compileExpr_core_of_scope - hcoreKey1 hexact hinScopeKey1 hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeKey1) - hruntime - rw [hkey1IR] at hkey1SourceEval - simp [Except.toOption] at hkey1SourceEval - rcases hIRKey1 : evalIRExpr state key1IR with _ | key1Nat - · simp [hIRKey1, Option.bind] at hkey1SourceEval - · simp [hIRKey1, Option.bind] at hkey1SourceEval - -- Evaluate key2 expression - have hkey2SourceEval := - FunctionBody.eval_compileExpr_core_of_scope - hcoreKey2 hexact hinScopeKey2 hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeKey2) - hruntime - rw [hkey2IR] at hkey2SourceEval - simp [Except.toOption] at hkey2SourceEval - rcases hIRKey2 : evalIRExpr state key2IR with _ | key2Nat - · simp [hIRKey2, Option.bind] at hkey2SourceEval - · simp [hIRKey2, Option.bind] at hkey2SourceEval - -- Evaluate value expression - have hvalueSourceEval := - FunctionBody.eval_compileExpr_core_of_scope - hcoreValue hexact hinScopeValue hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeValue) - hruntime - rw [hvalueIR] at hvalueSourceEval - simp [Except.toOption] at hvalueSourceEval - rcases hIRValue : evalIRExpr state valueIR with _ | valueNat - · simp [hIRValue, Option.bind] at hvalueSourceEval - · simp [hIRValue, Option.bind] at hvalueSourceEval - have hKey1Src : SourceSemantics.evalExpr fields runtime key1 = some key1Nat := - hkey1SourceEval.symm - have hKey2Src : SourceSemantics.evalExpr fields runtime key2 = some key2Nat := - hkey2SourceEval.symm - have hValueSrc : SourceSemantics.evalExpr fields runtime value = some valueNat := - hvalueSourceEval.symm - rcases hslotSafety runtime key1Nat key2Nat hKey1Src hKey2Src with ⟨hresolvedNone, hdynNone⟩ - -- Get boundedness of valueNat - have hvalueLt := FunctionBody.evalExpr_lt_evmModulus_core_of_scope - hcoreValue hexact hinScopeValue hbounded - (FunctionBody.exprBoundNamesPresent_of_scope hscope hinScopeValue) - hruntime - rw [hValueSrc] at hvalueLt - simp at hvalueLt - -- Define post-states - set targetSlot := mapping2WordTargetSlot slot key1Nat key2Nat wordOffset - set state' := { state with - storage := - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage targetSlot valueNat } - set runtime' := { runtime with - world := SourceSemantics.writeAddressKeyedMapping2WordSlots - runtime.world [slot] key1Nat key2Nat wordOffset valueNat } - -- Source execution - have hSrcExec : SourceSemantics.execStmt fields runtime - (.setStructMember2 fieldName key1 key2 memberName value) = .continue runtime' := by - simp [SourceSemantics.execStmt, hwriteSlots, hmembers, hmember, - hKey1Src, hKey2Src, hValueSrc, runtime'] - -- Scope inclusion - have hincl : FunctionBody.scopeNamesIncluded - (stmtNextScope scope (.setStructMember2 fieldName key1 key2 memberName value)) scope := by - intro n hn - simp [stmtNextScope, collectStmtNames] at hn - rcases hn with hk1 | hk2 | hv | hs - · exact hinScopeKey1 n (collectExprNames_mem_exprBoundNames_of_core hcoreKey1 n hk1) - · exact hinScopeKey2 n (collectExprNames_mem_exprBoundNames_of_core hcoreKey2 n hk2) - · exact hinScopeValue n (collectExprNames_mem_exprBoundNames_of_core hcoreValue n hv) - · exact hs - -- Post-state invariants - have hexact' : FunctionBody.bindingsExactlyMatchIRVarsOnScope - (stmtNextScope scope (.setStructMember2 fieldName key1 key2 memberName value)) - runtime'.bindings state' := - FunctionBody.bindingsExactlyMatchIRVarsOnScope_of_included - (bindingsExactlyMatchIRVarsOnScope_writeUintSlot hexact) - hincl - have hscope' : FunctionBody.scopeNamesPresent - (stmtNextScope scope (.setStructMember2 fieldName key1 key2 memberName value)) - runtime'.bindings := - FunctionBody.scopeNamesPresent_of_included hscope hincl - by_cases hzero : wordOffset = 0 - · -- wordOffset = 0: slot expr is mappingSlot [mappingSlot [lit slot, key1IR], key2IR] - subst hzero - have hTargetZero : - mapping2WordTargetSlot slot key1Nat key2Nat 0 = - Compiler.Proofs.abstractMappingSlot - (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat := by - have hlt : - Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat < - Compiler.Constants.evmModulus := by - simpa [Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Compiler.Proofs.abstractMappingSlot_lt_evmModulus - (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) - simpa [mapping2WordTargetSlot, SourceSemantics.wordNormalize, - Compiler.Proofs.abstractMappingSlot_eq_solidity] using - (Nat.mod_eq_of_lt hlt) - have hStoreEq : - Compiler.Proofs.abstractStoreMappingEntry - state.storage - (Compiler.Proofs.abstractMappingSlot slot key1Nat) - key2Nat - valueNat = - Compiler.Proofs.abstractStoreStorageOrMapping - state.storage - (Compiler.Proofs.abstractMappingSlot - (Compiler.Proofs.abstractMappingSlot slot key1Nat) key2Nat) - valueNat := by - funext s - simp [Compiler.Proofs.abstractStoreMappingEntry_eq, - Compiler.Proofs.abstractStoreStorageOrMapping_eq, - Compiler.Proofs.abstractMappingSlot] - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = - .continue state' := by - simpa [state', targetSlot, hTargetZero, hStoreEq] using - (show - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], valueIR])) = - .continue - { state with - storage := Compiler.Proofs.abstractStoreMappingEntry - state.storage - (Compiler.Proofs.abstractMappingSlot slot key1Nat) - key2Nat - valueNat } by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, hIRKey1, hIRKey2, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractStoreMappingEntry_eq]) - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = - .continue state' := by - simp [compiledIR, execIRStmts, hfuelEq, hExecStmt] - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMapping2WordSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ - · -- wordOffset ≠ 0: slot expr is add [mappingSlot [mappingSlot [...], ...], lit wordOffset] - -- Use keccak axiom: nested mappingSlot + wordOffset < evmModulus - have hbeq : (wordOffset == 0) = false := by - simp [beq_iff_eq, hzero] - have hTargetAdd : - targetSlot = - (Verity.Core.Uint256.ofNat wordOffset + - Verity.Core.Uint256.ofNat - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).val := by - simpa [targetSlot] using - mapping2WordTargetSlot_eq_uint256_add slot key1Nat key2Nat wordOffset - have hTargetMod : - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat + wordOffset) % - Compiler.Constants.evmModulus = targetSlot := by - rw [hTargetAdd] - simpa [Nat.add_comm] using - (uint256_add_val_eq_mod wordOffset - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).symm - have hStoreEq : - Compiler.Proofs.abstractStoreStorageOrMapping state.storage targetSlot valueNat = - fun s => - if s = - IRStorageSlot.ofNat - ((Verity.Core.Uint256.ofNat wordOffset + - Verity.Core.Uint256.ofNat - (Compiler.Proofs.solidityMappingSlot - (Compiler.Proofs.solidityMappingSlot slot key1Nat) key2Nat)).val) then - Compiler.Proofs.IRGeneration.IRStorageWord.ofNat valueNat - else - state.storage s := by - funext s - rw [Compiler.Proofs.abstractStoreStorageOrMapping_eq, hTargetAdd] - have hExecStmt : - execIRStmt (extraFuel + 1) state - (YulStmt.expr - (YulExpr.call "sstore" - [YulExpr.call "add" - [YulExpr.call "mappingSlot" - [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR], key2IR], - YulExpr.lit wordOffset], valueIR])) = - .continue state' := by - simp [execIRStmt, evalIRExpr, evalIRCall, evalIRExprs, - hIRKey1, hIRKey2, hIRValue, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallWithEvmYulLeanContext, - Compiler.Proofs.YulGeneration.Backends.evalBuiltinCallViaEvmYulLean, - Compiler.Proofs.abstractMappingSlot_eq_solidity, - state', hTargetMod, hStoreEq] - have hfuelEq : 1 + extraFuel = extraFuel + 1 := by omega - have hIRExec : execIRStmts (compiledIR.length + extraFuel + 1) state compiledIR = - .continue state' := by - simp only [compiledIR, hbeq, ite_false] - simp [execIRStmts, hfuelEq, hExecStmt] - refine ⟨.continue runtime', .continue state', hSrcExec, hIRExec, ?_⟩ - simp [stmtStepMatchesIRExec] - exact ⟨runtimeStateMatchesIR_writeAddressKeyedMapping2WordSlot - hruntime hresolvedNone hdynNone hvalueLt, - hexact', hbounded, hscope'⟩ + obtain ⟨sourceResult, irExec, hSrcMappingWord, hIRExec, hmatch⟩ := + compiledStmtStep_setMapping2Word_singleSlot_of_slotSafety_preserves + hcoreKey1 hinScopeKey1 hcoreKey2 hinScopeKey2 hcoreValue hinScopeValue + hwriteSlots hslotSafety hkey1IR hkey2IR hvalueIR + runtime state extraFuel hexact hscope hbounded hruntime hslack + refine ⟨sourceResult, irExec, ?_, hIRExec, ?_⟩ + · rw [← hSrcMappingWord] + simp only [SourceSemantics.execStmt, hwriteSlots, hmembers] + cases SourceSemantics.evalExpr fields runtime key1 <;> + cases SourceSemantics.evalExpr fields runtime key2 <;> + cases SourceSemantics.evalExpr fields runtime value <;> + simp [hmember] + · simpa [stmtStepMatchesIRExec, stmtNextScope, collectStmtNames] + using hmatch theorem compiledStmtStep_setStructMember2_singleSlot_of_slotSafety {fields : List Field} {scope : List String} @@ -5981,19 +6275,22 @@ theorem compiledStmtStep_setStructMember2_singleSlot_of_slotSafety (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : CompiledStmtStep fields scope (.setStructMember2 fieldName key1 key2 memberName value) [YulStmt.expr - (YulExpr.call "sstore" + (YulExpr.call (fieldStoreBuiltin fields fieldName) [let mappingBase := YulExpr.call "mappingSlot" [YulExpr.lit slot, key1IR] let mappingSlot2 := YulExpr.call "mappingSlot" [mappingBase, key2IR] if wordOffset == 0 then mappingSlot2 else YulExpr.call "add" [mappingSlot2, YulExpr.lit wordOffset], valueIR])] where compileOk := by + rcases findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton hwriteSlots with + ⟨f, hfind, _⟩ have hkey1IRInternal := compileExprWithInternals_nil_ok hkey1IR have hkey2IRInternal := compileExprWithInternals_nil_ok hkey2IR have hvalueIRInternal := compileExprWithInternals_nil_ok hvalueIR simp only [CompilationModel.compileStmt, CompilationModel.compileSetStructMember2, hmapping2, hmembers, hmember, hwriteSlots, hkey1IRInternal, hkey2IRInternal, hvalueIRInternal] - rfl + simp [hfind, fieldStoreBuiltin, SourceSemantics.fieldIsTransient, + Bind.bind, Except.bind, pure, Except.pure] preserves := compiledStmtStep_setStructMember2_singleSlot_of_slotSafety_preserves hcoreKey1 hinScopeKey1 hcoreKey2 hinScopeKey2 hcoreValue hinScopeValue hmembers hmember hwriteSlots hslotSafety hkey1IR hkey2IR hvalueIR @@ -6016,6 +6313,7 @@ theorem compiledStmtStep_setStorage_aliasSlots (hnoConflict : firstFieldWriteSlotConflict fields = none) (hnotAddr : SourceSemantics.fieldUsesAddressStorage f = false) (hnotDyn : SourceSemantics.fieldUsesDynamicArrayStorage f = false) + (hnotTransient : f.isTransient = false) (hNotMapping : isMapping fields fieldName = false) (hNotAdt : ∀ name maxFields, f.ty ≠ FieldType.adt name maxFields) (hvalueIR : CompilationModel.compileExpr fields .calldata value = Except.ok valueIR) : @@ -6031,7 +6329,7 @@ theorem compiledStmtStep_setStorage_aliasSlots exact False.elim (hNotAdt name maxFields hty) | uint256 | address | dynamicArray | mappingTyped | mappingStruct | mappingStruct2 => simp [CompilationModel.compileStmt, CompilationModel.compileSetStorage, - hNotMapping, hfind, hwriteSlots, halias, hunpacked, hvalueIR, hty, + hNotMapping, hfind, hwriteSlots, halias, hunpacked, hnotTransient, hvalueIR, hty, pure, Except.pure, Bind.bind, Except.bind] preserves runtime state extraFuel hexact hscope hbounded hruntime hslack := by let slots := slot :: f.aliasSlots @@ -6129,11 +6427,15 @@ theorem compiledStmtStep_setStorage_aliasSlots rw [hValueSrc] at hvalueLt simp at hvalueLt -- Source execution + have hfieldTransient : + SourceSemantics.fieldIsTransient fields fieldName = false := by + simp [SourceSemantics.fieldIsTransient, hfind, hnotTransient] have hSrcExec : SourceSemantics.execStmt fields runtime (.setStorage fieldName value) = .continue { runtime with world := SourceSemantics.writeUintSlots runtime.world (slot :: f.aliasSlots) valueNat } := by - simp [SourceSemantics.execStmt, hwriteSlots, hValueSrc, slots] + simp [SourceSemantics.execStmt, SourceSemantics.writeUintFieldSlots, + SourceSemantics.writeMappingTargets, hwriteSlots, hValueSrc, hfieldTransient, slots] -- Scope inclusion have hincl : FunctionBody.scopeNamesIncluded (stmtNextScope scope (.setStorage fieldName value)) scope := by @@ -6196,6 +6498,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes (hnoConflict : firstFieldWriteSlotConflict spec.fields = none) (hnotAddr : SourceSemantics.fieldUsesAddressStorage f = false) (hnotDyn : SourceSemantics.fieldUsesDynamicArrayStorage f = false) + (hnotTransient : f.isTransient = false) (hNotMapping : isMapping spec.fields fieldName = false) (hNotAdt : ∀ name maxFields, f.ty ≠ FieldType.adt name maxFields) (hvalueIR : CompilationModel.compileExpr spec.fields .calldata value = Except.ok valueIR) : @@ -6212,6 +6515,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes (hnoConflict := hnoConflict) (hnotAddr := hnotAddr) (hnotDyn := hnotDyn) + (hnotTransient := hnotTransient) (hNotMapping := hNotMapping) (hNotAdt := hNotAdt) (hvalueIR := hvalueIR) @@ -6235,6 +6539,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes (hnoConflict := hnoConflict) (hnotAddr := hnotAddr) (hnotDyn := hnotDyn) + (hnotTransient := hnotTransient) (hNotMapping := hNotMapping) (hNotAdt := hNotAdt) (hvalueIR := hvalueIR) @@ -6267,6 +6572,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes_of_scopeDiscipli (hnoConflict : firstFieldWriteSlotConflict spec.fields = none) (hnotAddr : SourceSemantics.fieldUsesAddressStorage f = false) (hnotDyn : SourceSemantics.fieldUsesDynamicArrayStorage f = false) + (hnotTransient : f.isTransient = false) (hNotMapping : isMapping spec.fields fieldName = false) (hNotAdt : ∀ name maxFields, f.ty ≠ FieldType.adt name maxFields) (hvalueIR : CompilationModel.compileExpr spec.fields .calldata value = Except.ok valueIR) : @@ -6288,6 +6594,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes_of_scopeDiscipli (hnoConflict := hnoConflict) (hnotAddr := hnotAddr) (hnotDyn := hnotDyn) + (hnotTransient := hnotTransient) (hNotMapping := hNotMapping) (hNotAdt := hNotAdt) (hvalueIR := hvalueIR) @@ -6350,6 +6657,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes_of_validateFunct (hnoConflict : firstFieldWriteSlotConflict spec.fields = none) (hnotAddr : SourceSemantics.fieldUsesAddressStorage f = false) (hnotDyn : SourceSemantics.fieldUsesDynamicArrayStorage f = false) + (hnotTransient : f.isTransient = false) (hNotMapping : isMapping spec.fields fieldName = false) (hNotAdt : ∀ name maxFields, f.ty ≠ FieldType.adt name maxFields) (hvalueIR : CompilationModel.compileExpr spec.fields .calldata value = Except.ok valueIR) : @@ -6373,6 +6681,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes_of_validateFunct (hnoConflict := hnoConflict) (hnotAddr := hnotAddr) (hnotDyn := hnotDyn) + (hnotTransient := hnotTransient) (hNotMapping := hNotMapping) (hNotAdt := hNotAdt) (hvalueIR := hvalueIR) @@ -6406,6 +6715,7 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes_of_validateFunct (hnoConflict : firstFieldWriteSlotConflict spec.fields = none) (hnotAddr : SourceSemantics.fieldUsesAddressStorage f = false) (hnotDyn : SourceSemantics.fieldUsesDynamicArrayStorage f = false) + (hnotTransient : f.isTransient = false) (hvalueIR : CompilationModel.compileExpr spec.fields .calldata value = Except.ok valueIR) : ∃ compiledIR, CompiledStmtStep spec.fields @@ -6437,7 +6747,8 @@ theorem compiledStmtStep_setStorage_of_validateIdentifierShapes_of_validateFunct Bind.bind, Except.bind] at hstmt exact compiledStmtStep_setStorage_of_validateIdentifierShapes_of_validateFunctionIdentifierReferences hvalidateShapes hvalidateRefs hfn hparamScope hprefixCore hbody hvalueCore hinScope - hfind hwriteSlots hunpacked hnoConflict hnotAddr hnotDyn hNotMapping hNotAdt hvalueIR + hfind hwriteSlots hunpacked hnoConflict hnotAddr hnotDyn hnotTransient + hNotMapping hNotAdt hvalueIR private theorem terminal_stmtResultMatchesIRExec_implies_stmtStepMatchesIRExec {fields : List Field} @@ -6760,10 +7071,11 @@ private theorem compiledStmtStep_letStorageField preserves runtime state extraFuel hexact hscope hbounded hruntime hslack := by have hEvalSrc : SourceSemantics.evalExpr fields runtime (.storage fieldName) = some (runtime.world.storage (SourceSemantics.wordNormalize slot)).val := by - show (match findFieldWithResolvedSlot fields fieldName with - | some (_, s) => some (runtime.world.storage (SourceSemantics.wordNormalize s)).val + change (match findFieldWithResolvedSlot fields fieldName with + | some (field, s) => some (SourceSemantics.readFieldWord runtime.world field s).val | none => none) = _ rw [hfind] + rfl have hresolved := findResolvedFieldAtSlotCopy_of_findFieldWithResolvedSlot_singleton hnoConflict hfind (by simpa using findFieldWriteSlots_of_findFieldWithResolvedSlot hfind) (by rfl) @@ -6839,10 +7151,15 @@ private theorem compiledStmtStep_letStorageAddrField preserves runtime state extraFuel hexact hscope hbounded hruntime hslack := by have hEvalSrc : SourceSemantics.evalExpr fields runtime (.storageAddr fieldName) = some (runtime.world.storageAddr (SourceSemantics.wordNormalize slot)).val := by - show (match findFieldWithResolvedSlot fields fieldName with - | some (_, s) => some (runtime.world.storageAddr (SourceSemantics.wordNormalize s)).val + change (match findFieldWithResolvedSlot fields fieldName with + | some (field, s) => + if field.isTransient then + some (runtime.world.transientStorage (SourceSemantics.wordNormalize s)).val + else + some (runtime.world.storageAddr (SourceSemantics.wordNormalize s)).val | none => none) = _ rw [hfind] + rfl have hresolved := findResolvedFieldAtSlotCopy_of_findFieldWithResolvedSlot_singleton hnoConflict hfind (by simpa using findFieldWriteSlots_of_findFieldWithResolvedSlot hfind) (by rfl) @@ -6919,10 +7236,11 @@ private theorem compiledStmtStep_assignStorageField preserves runtime state extraFuel hexact hscope hbounded hruntime hslack := by have hEvalSrc : SourceSemantics.evalExpr fields runtime (.storage fieldName) = some (runtime.world.storage (SourceSemantics.wordNormalize slot)).val := by - show (match findFieldWithResolvedSlot fields fieldName with - | some (_, s) => some (runtime.world.storage (SourceSemantics.wordNormalize s)).val + change (match findFieldWithResolvedSlot fields fieldName with + | some (field, s) => some (SourceSemantics.readFieldWord runtime.world field s).val | none => none) = _ rw [hfind] + rfl have hresolved := findResolvedFieldAtSlotCopy_of_findFieldWithResolvedSlot_singleton hnoConflict hfind (by simpa using findFieldWriteSlots_of_findFieldWithResolvedSlot hfind) (by rfl) @@ -6998,10 +7316,15 @@ private theorem compiledStmtStep_assignStorageAddrField preserves runtime state extraFuel hexact hscope hbounded hruntime hslack := by have hEvalSrc : SourceSemantics.evalExpr fields runtime (.storageAddr fieldName) = some (runtime.world.storageAddr (SourceSemantics.wordNormalize slot)).val := by - show (match findFieldWithResolvedSlot fields fieldName with - | some (_, s) => some (runtime.world.storageAddr (SourceSemantics.wordNormalize s)).val + change (match findFieldWithResolvedSlot fields fieldName with + | some (field, s) => + if field.isTransient then + some (runtime.world.transientStorage (SourceSemantics.wordNormalize s)).val + else + some (runtime.world.storageAddr (SourceSemantics.wordNormalize s)).val | none => none) = _ rw [hfind] + rfl have hresolved := findResolvedFieldAtSlotCopy_of_findFieldWithResolvedSlot_singleton hnoConflict hfind (by simpa using findFieldWriteSlots_of_findFieldWithResolvedSlot hfind) (by rfl) @@ -7098,6 +7421,7 @@ theorem stmtListGenericCore_singleton_setStorage_singleSlot (hnoConflict := hnoConflict) (hnotAddr := by rfl) (hnotDyn := by rfl) + (hnotTransient := by rfl) (hNotMapping := isMapping_false_of_findFieldWithResolvedSlot_uint256 hfind rfl) (hNotAdt := by intro name maxFields hty diff --git a/Compiler/Proofs/IRGeneration/IRInterpreter.lean b/Compiler/Proofs/IRGeneration/IRInterpreter.lean index e5c96b4ca..a503f8ea2 100644 --- a/Compiler/Proofs/IRGeneration/IRInterpreter.lean +++ b/Compiler/Proofs/IRGeneration/IRInterpreter.lean @@ -615,6 +615,7 @@ def execIRStmtWithInternals | .call "tstore" [offsetExpr, valExpr] => match evalIRExprsWithInternals contract fuel state [offsetExpr, valExpr] with | .values [offset, val] state' => + let offset := offset % Compiler.Constants.evmModulus .continue { state' with transientStorage := fun o => @@ -909,6 +910,7 @@ def execIRStmt : Nat → IRState → YulStmt → IRExecResult | .call "tstore" [offsetExpr, valExpr] => match evalIRExpr state offsetExpr, evalIRExpr state valExpr with | some offset, some val => + let offset := offset % Compiler.Constants.evmModulus .continue { state with transientStorage := fun o => @@ -1534,7 +1536,7 @@ theorem IRStmtPreservesObsAt_of_tstore obtain ⟨o, ho⟩ := hOffsetEval obtain ⟨v, hv⟩ := hValEval refine ⟨{ state with transientStorage := fun x => - if x = o then v else state.transientStorage x }, fun _ => ?_⟩ + if x = o % Compiler.Constants.evmModulus then v else state.transientStorage x }, fun _ => ?_⟩ simp only [execIRStmt, ho, hv] /-- Cross-cast for `.expr (.call "mstore" [offset, val])`: at any state where diff --git a/Compiler/Proofs/IRGeneration/SourceSemantics.lean b/Compiler/Proofs/IRGeneration/SourceSemantics.lean index 28a3f10bc..971187a9d 100644 --- a/Compiler/Proofs/IRGeneration/SourceSemantics.lean +++ b/Compiler/Proofs/IRGeneration/SourceSemantics.lean @@ -402,6 +402,61 @@ def writeAddressSlots (world : Verity.ContractState) (slots : List Nat) (value : storageAddr := fun slot => if targets.contains slot then addr else world.storageAddr slot } +def fieldIsTransient (fields : List Field) (name : String) : Bool := + match findFieldWithResolvedSlot fields name with + | some (field, _) => field.isTransient + | none => false + +def readFieldWord (world : Verity.ContractState) (field : Field) (slot : Nat) : + Verity.Core.Uint256 := + if field.isTransient then + world.transientStorage (wordNormalize slot) + else + world.storage (wordNormalize slot) + +def writeTransientTargets (world : Verity.ContractState) (targets : List Nat) (value : Nat) : + Verity.ContractState := + let word : Verity.Core.Uint256 := value + let targets := targets.map wordNormalize + { world with + transientStorage := fun slot => + if targets.contains slot then word else world.transientStorage slot } + +def writeUintFieldSlots (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world slots value + else + writeUintSlots world slots value + +def writeStorageWordFieldSlots (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (wordOffset value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world (slots.map (fun slot => slot + wordOffset)) value + else + writeStorageWordSlots world slots wordOffset value + +def writeAddressFieldSlots (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world slots (Verity.wordToAddress (value : Verity.Core.Uint256)).val + else + writeAddressSlots world slots value + +def writeMappingTargets (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (targets : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world targets value + else + let word : Verity.Core.Uint256 := value + { world with + storage := fun slot => + if targets.map wordNormalize |>.contains slot then word else world.storage slot } + def writeAddressKeyedMappingSlots (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : Verity.ContractState := @@ -472,6 +527,26 @@ def writeAddressKeyedMappingPackedWordSlots else world.storage slot } +def writeAddressKeyedMappingPackedWordFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key wordOffset : Nat) + (packed : PackedBits) (value : Nat) : + Verity.ContractState := + let targets := + slots.map (fun slot => + wordNormalize (Compiler.Proofs.abstractMappingSlot slot key + wordOffset)) + if fieldIsTransient fields fieldName then + let wordAt := fun slot => (world.transientStorage slot).val + let updated := targets.map (fun slot => + (slot, packedWordWrite (wordAt slot) value packed)) + { world with + transientStorage := fun slot => + match updated.find? (fun entry => entry.fst == slot) with + | some (_, word) => word + | none => world.transientStorage slot } + else + writeAddressKeyedMappingPackedWordSlots world slots key wordOffset packed value + def writeAddressKeyedMapping2PackedWordSlots (world : Verity.ContractState) (slots : List Nat) (key1 key2 wordOffset : Nat) (packed : PackedBits) (value : Nat) : @@ -488,6 +563,28 @@ def writeAddressKeyedMapping2PackedWordSlots else world.storage slot } +def writeAddressKeyedMapping2PackedWordFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key1 key2 wordOffset : Nat) + (packed : PackedBits) (value : Nat) : + Verity.ContractState := + let targets := + slots.map (fun slot => + wordNormalize + (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1) key2 + wordOffset)) + if fieldIsTransient fields fieldName then + let wordAt := fun slot => (world.transientStorage slot).val + let updated := targets.map (fun slot => + (slot, packedWordWrite (wordAt slot) value packed)) + { world with + transientStorage := fun slot => + match updated.find? (fun entry => entry.fst == slot) with + | some (_, word) => word + | none => world.transientStorage slot } + else + writeAddressKeyedMapping2PackedWordSlots world slots key1 key2 wordOffset packed value + def writeUintKeyedMappingSlots (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : Verity.ContractState := @@ -558,6 +655,76 @@ def writeAddressKeyedMapping2WordSlots storage := fun slot => if targets.contains slot then word else world.storage slot } +def writeAddressKeyedMappingWordFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key wordOffset value : Nat) : + Verity.ContractState := + let targets := + slots.map (fun slot => + wordNormalize (Compiler.Proofs.abstractMappingSlot slot key + wordOffset)) + writeMappingTargets fields fieldName world targets value + +def writeAddressKeyedMappingFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := + slots.map (fun slot => + wordNormalize (Compiler.Proofs.abstractMappingSlot slot key)) + writeTransientTargets world targets value + else + writeAddressKeyedMappingSlots world slots key value + +def writeAddressKeyedMappingChainFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots keys : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := + slots.map (fun slot => + wordNormalize (keys.foldl Compiler.Proofs.abstractMappingSlot slot)) + writeTransientTargets world targets value + else + writeAddressKeyedMappingChainSlots world slots keys value + +def writeAddressKeyedMapping2WordFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key1 key2 wordOffset value : Nat) : + Verity.ContractState := + let targets := slots.map (fun slot => + wordNormalize + (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1) + key2 + wordOffset)) + writeMappingTargets fields fieldName world targets value + +def writeUintKeyedMappingFieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := + slots.map (fun slot => + wordNormalize (Compiler.Proofs.abstractMappingSlot slot key)) + writeTransientTargets world targets value + else + writeUintKeyedMappingSlots world slots key value + +def writeAddressKeyedMapping2FieldSlots + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key1 key2 value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := slots.map (fun slot => + wordNormalize + (Compiler.Proofs.abstractMappingSlot + (Compiler.Proofs.abstractMappingSlot slot key1) + key2)) + writeTransientTargets world targets value + else + writeAddressKeyedMapping2Slots world slots key1 key2 value + def decodeSupportedParamWord (ty : ParamType) (word : Nat) : Option Nat := let word := wordNormalize word match ty with @@ -818,11 +985,15 @@ def evalExpr (fields : List Field) (state : RuntimeState) : Expr → Option Nat | .immutable name => some (state.immutable name).val | .storage fieldName => match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.storage (wordNormalize slot)).val + | some (field, slot) => some (readFieldWord state.world field slot).val | none => none | .storageAddr fieldName => match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.storageAddr (wordNormalize slot)).val + | some (field, slot) => + if field.isTransient then + some (state.world.transientStorage (wordNormalize slot)).val + else + some (state.world.storageAddr (wordNormalize slot)).val | none => none | .storageArrayLength fieldName => match findFieldWithResolvedSlot fields fieldName with @@ -1004,51 +1175,51 @@ def evalExpr (fields : List Field) (state : RuntimeState) : Expr → Option Nat (Verity.Core.Uint256.ofNat value)).val | .mapping field key => do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage (Compiler.Proofs.abstractMappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot slot keyVal)).val | none => none | .mappingWord field key wordOffset => do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + wordOffset))).val | none => none | .mappingUint field key => do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage (Compiler.Proofs.abstractMappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot slot keyVal)).val | none => none | .mapping2 field key1 key2 => do let key1Val ← evalExpr fields state key1 let key2Val ← evalExpr fields state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val - some (state.world.storage (Compiler.Proofs.abstractMappingSlot innerSlot key2Val)).val + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot innerSlot key2Val)).val | none => none | .mapping2Word field key1 key2 wordOffset => do let key1Val ← evalExpr fields state key1 let key2Val ← evalExpr fields state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val let outerSlot := Compiler.Proofs.abstractMappingSlot innerSlot key2Val - some (state.world.storage (wordNormalize (outerSlot + wordOffset))).val + some (readFieldWord state.world field (wordNormalize (outerSlot + wordOffset))).val | none => none -- mappingChain: deferred — requires List Expr recursion infrastructure -- | .mappingChain field keys => ... | .structMember field key memberName => do let keyVal ← evalExpr fields state key - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let targetSlot := wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + member.wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -1060,14 +1231,14 @@ def evalExpr (fields : List Field) (state : RuntimeState) : Expr → Option Nat | .structMember2 field key1 key2 memberName => do let key1Val ← evalExpr fields state key1 let key2Val ← evalExpr fields state key2 - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val let outerSlot := Compiler.Proofs.abstractMappingSlot innerSlot key2Val let targetSlot := wordNormalize (outerSlot + member.wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -1078,11 +1249,11 @@ def evalExpr (fields : List Field) (state : RuntimeState) : Expr → Option Nat | _, _ => none | .mappingPackedWord field key wordOffset packed => do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (fieldInfo, slot) => let targetSlot := wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val some (Verity.Core.Uint256.and (Verity.Core.Uint256.shr packed.offset rawWord) (packedMaskNat packed)).val @@ -1181,7 +1352,7 @@ private theorem evalExpr_storage (fieldName : String) : evalExpr fields state (.storage fieldName) = match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.storage (wordNormalize slot)).val + | some (field, slot) => some (readFieldWord state.world field slot).val | none => none := rfl private theorem evalExpr_storageAddr @@ -1190,7 +1361,11 @@ private theorem evalExpr_storageAddr (fieldName : String) : evalExpr fields state (.storageAddr fieldName) = match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.storageAddr (wordNormalize slot)).val + | some (field, slot) => + if field.isTransient then + some (state.world.transientStorage (wordNormalize slot)).val + else + some (state.world.storageAddr (wordNormalize slot)).val | none => none := rfl private theorem evalExpr_storageArrayLength @@ -1651,9 +1826,9 @@ private theorem evalExpr_mapping (key : Expr) : evalExpr fields state (.mapping field key) = (do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage (Compiler.Proofs.abstractMappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot slot keyVal)).val | none => none) := rfl private theorem evalExpr_mappingUint @@ -1663,9 +1838,9 @@ private theorem evalExpr_mappingUint (key : Expr) : evalExpr fields state (.mappingUint field key) = (do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage (Compiler.Proofs.abstractMappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot slot keyVal)).val | none => none) := rfl private theorem evalExpr_arrayElement @@ -1739,9 +1914,9 @@ private theorem evalExpr_mappingWord (wordOffset : Nat) : evalExpr fields state (.mappingWord field key wordOffset) = (do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + wordOffset))).val | none => none) := rfl @@ -1754,11 +1929,11 @@ private theorem evalExpr_mappingPackedWord (packed : PackedBits) : evalExpr fields state (.mappingPackedWord field key wordOffset packed) = (do let keyVal ← evalExpr fields state key - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (fieldInfo, slot) => let targetSlot := wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val some (Verity.Core.Uint256.and (Verity.Core.Uint256.shr packed.offset rawWord) (packedMaskNat packed)).val @@ -1772,13 +1947,13 @@ private theorem evalExpr_structMember (memberName : String) : evalExpr fields state (.structMember field key memberName) = (do let keyVal ← evalExpr fields state key - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let targetSlot := wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + member.wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -1810,10 +1985,10 @@ private theorem evalExpr_mapping2 evalExpr fields state (.mapping2 field key1 key2) = (do let key1Val ← evalExpr fields state key1 let key2Val ← evalExpr fields state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val - some (state.world.storage (Compiler.Proofs.abstractMappingSlot innerSlot key2Val)).val + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot innerSlot key2Val)).val | none => none) := rfl private theorem evalExpr_mapping2Word @@ -1825,11 +2000,11 @@ private theorem evalExpr_mapping2Word evalExpr fields state (.mapping2Word field key1 key2 wordOffset) = (do let key1Val ← evalExpr fields state key1 let key2Val ← evalExpr fields state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val let outerSlot := Compiler.Proofs.abstractMappingSlot innerSlot key2Val - some (state.world.storage (wordNormalize (outerSlot + wordOffset))).val + some (readFieldWord state.world field (wordNormalize (outerSlot + wordOffset))).val | none => none) := rfl private theorem evalExpr_structMember2 @@ -1841,14 +2016,14 @@ private theorem evalExpr_structMember2 evalExpr fields state (.structMember2 field key1 key2 memberName) = (do let key1Val ← evalExpr fields state key1 let key2Val ← evalExpr fields state key2 - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val let outerSlot := Compiler.Proofs.abstractMappingSlot innerSlot key2Val let targetSlot := wordNormalize (outerSlot + member.wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -1921,14 +2096,14 @@ mutual | state, .setStorage fieldName value => match findFieldWriteSlots fields fieldName, evalExpr fields state value with | some slots, some resolved => - .continue { state with world := writeUintSlots state.world slots resolved } + .continue { state with world := writeUintFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | state, .setStorageWord fieldName wordOffset value => match findFieldWriteSlots fields fieldName, evalExpr fields state value with | some slots, some resolved => .continue { state with - world := writeStorageWordSlots state.world slots wordOffset resolved } + world := writeStorageWordFieldSlots fields fieldName state.world slots wordOffset resolved } | _, _ => .revert | state, .setMapping fieldName key value => match findFieldWriteSlots fields fieldName, @@ -1937,7 +2112,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingSlots state.world slots resolvedKey resolved } + world := writeAddressKeyedMappingFieldSlots + fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | state, .setMappingWord fieldName key wordOffset value => match findFieldWriteSlots fields fieldName, @@ -1946,8 +2122,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingWordSlots - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset resolved } | _, _, _ => .revert | state, .setMappingPackedWord fieldName key wordOffset packed value => match findFieldWriteSlots fields fieldName, @@ -1957,8 +2133,8 @@ mutual if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _, _, _ => .revert @@ -1972,14 +2148,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMappingWordSlots - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _ => .revert @@ -1993,12 +2169,8 @@ mutual .continue { state with world := - writeAddressKeyedMapping2Slots - state.world - slots - resolvedKey1 - resolvedKey2 - resolved } + writeAddressKeyedMapping2FieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 resolved } | _, _, _, _ => .revert | state, .setMapping2Word fieldName key1 key2 wordOffset value => match findFieldWriteSlots fields fieldName, @@ -2009,7 +2181,9 @@ mutual .continue { state with world := - writeAddressKeyedMapping2WordSlots + writeAddressKeyedMapping2WordFieldSlots + fields + fieldName state.world slots resolvedKey1 @@ -2028,14 +2202,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMapping2WordSlots - state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } + world := writeAddressKeyedMapping2WordFieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMapping2PackedWordSlots - state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } + world := writeAddressKeyedMapping2PackedWordFieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } else .revert | _ => .revert @@ -2047,7 +2221,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeUintKeyedMappingSlots state.world slots resolvedKey resolved } + world := writeUintKeyedMappingFieldSlots + fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | state, .setMappingChain fieldName keys value => match findFieldWriteSlots fields fieldName, @@ -2056,8 +2231,8 @@ mutual | some slots@(_ :: _), some resolvedKeys, some resolved => .continue { state with - world := writeAddressKeyedMappingChainSlots - state.world slots resolvedKeys resolved } + world := writeAddressKeyedMappingChainFieldSlots + fields fieldName state.world slots resolvedKeys resolved } | _, _, _ => .revert | state, .storageArrayPush fieldName value => match findFieldWithResolvedSlot fields fieldName, evalExpr fields state value with @@ -2084,7 +2259,7 @@ mutual | state, .setStorageAddr fieldName value => match findFieldWriteSlots fields fieldName, evalExpr fields state value with | some slots, some resolved => - .continue { state with world := writeAddressSlots state.world slots resolved } + .continue { state with world := writeAddressFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | state, .setImmutable name value => match evalExpr fields state value with @@ -2109,6 +2284,7 @@ mutual | state, .tstore offset value => match evalExpr fields state offset, evalExpr fields state value with | some resolvedOffset, some resolvedValue => + let resolvedOffset := wordNormalize resolvedOffset .continue { state with world := { @@ -2189,14 +2365,14 @@ mutual | state, .setStorage fieldName value => match findFieldWriteSlots fields fieldName, evalExpr fields state value with | some slots, some resolved => - .continue { state with world := writeUintSlots state.world slots resolved } + .continue { state with world := writeUintFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | state, .setStorageWord fieldName wordOffset value => match findFieldWriteSlots fields fieldName, evalExpr fields state value with | some slots, some resolved => .continue { state with - world := writeStorageWordSlots state.world slots wordOffset resolved } + world := writeStorageWordFieldSlots fields fieldName state.world slots wordOffset resolved } | _, _ => .revert | state, .setMapping fieldName key value => match findFieldWriteSlots fields fieldName, @@ -2205,7 +2381,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingSlots state.world slots resolvedKey resolved } + world := writeAddressKeyedMappingFieldSlots + fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | state, .setMappingWord fieldName key wordOffset value => match findFieldWriteSlots fields fieldName, @@ -2214,8 +2391,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingWordSlots - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset resolved } | _, _, _ => .revert | state, .setMappingPackedWord fieldName key wordOffset packed value => match findFieldWriteSlots fields fieldName, @@ -2225,8 +2402,8 @@ mutual if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _, _, _ => .revert @@ -2240,14 +2417,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMappingWordSlots - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _ => .revert @@ -2261,12 +2438,8 @@ mutual .continue { state with world := - writeAddressKeyedMapping2Slots - state.world - slots - resolvedKey1 - resolvedKey2 - resolved } + writeAddressKeyedMapping2FieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 resolved } | _, _, _, _ => .revert | state, .setMapping2Word fieldName key1 key2 wordOffset value => match findFieldWriteSlots fields fieldName, @@ -2277,7 +2450,9 @@ mutual .continue { state with world := - writeAddressKeyedMapping2WordSlots + writeAddressKeyedMapping2WordFieldSlots + fields + fieldName state.world slots resolvedKey1 @@ -2296,14 +2471,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMapping2WordSlots - state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } + world := writeAddressKeyedMapping2WordFieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMapping2PackedWordSlots - state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } + world := writeAddressKeyedMapping2PackedWordFieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } else .revert | _ => .revert @@ -2315,7 +2490,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeUintKeyedMappingSlots state.world slots resolvedKey resolved } + world := writeUintKeyedMappingFieldSlots + fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | state, .setMappingChain fieldName keys value => match findFieldWriteSlots fields fieldName, @@ -2324,8 +2500,8 @@ mutual | some slots@(_ :: _), some resolvedKeys, some resolved => .continue { state with - world := writeAddressKeyedMappingChainSlots - state.world slots resolvedKeys resolved } + world := writeAddressKeyedMappingChainFieldSlots + fields fieldName state.world slots resolvedKeys resolved } | _, _, _ => .revert | state, .storageArrayPush fieldName value => match findFieldWithResolvedSlot fields fieldName, evalExpr fields state value with @@ -2352,7 +2528,7 @@ mutual | state, .setStorageAddr fieldName value => match findFieldWriteSlots fields fieldName, evalExpr fields state value with | some slots, some resolved => - .continue { state with world := writeAddressSlots state.world slots resolved } + .continue { state with world := writeAddressFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | state, .setImmutable name value => match evalExpr fields state value with @@ -2377,6 +2553,7 @@ mutual | state, .tstore offset value => match evalExpr fields state offset, evalExpr fields state value with | some resolvedOffset, some resolvedValue => + let resolvedOffset := wordNormalize resolvedOffset .continue { state with world := { @@ -2905,11 +3082,15 @@ mutual | .immutable name => some (state.immutable name).val | .storage fieldName => match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.storage (wordNormalize slot)).val + | some (field, slot) => some (readFieldWord state.world field slot).val | none => none | .storageAddr fieldName => match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.storageAddr (wordNormalize slot)).val + | some (field, slot) => + if field.isTransient then + some (state.world.transientStorage (wordNormalize slot)).val + else + some (state.world.storageAddr (wordNormalize slot)).val | none => none | .storageArrayLength fieldName => match findFieldWithResolvedSlot fields fieldName with @@ -3092,60 +3273,60 @@ mutual (Verity.Core.Uint256.ofNat value)).val | .mapping field key => do let keyVal ← evalExprWithHelpers spec fields fuel state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage (Compiler.Proofs.abstractMappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot slot keyVal)).val | none => none | .mappingWord field key wordOffset => do let keyVal ← evalExprWithHelpers spec fields fuel state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + wordOffset))).val | none => none | .mappingUint field key => do let keyVal ← evalExprWithHelpers spec fields fuel state key - match findFieldSlot fields field with - | some slot => - some (state.world.storage (Compiler.Proofs.abstractMappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot slot keyVal)).val | none => none | .mapping2 field key1 key2 => do let key1Val ← evalExprWithHelpers spec fields fuel state key1 let key2Val ← evalExprWithHelpers spec fields fuel state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val - some (state.world.storage (Compiler.Proofs.abstractMappingSlot innerSlot key2Val)).val + some (readFieldWord state.world field (Compiler.Proofs.abstractMappingSlot innerSlot key2Val)).val | none => none | .mapping2Word field key1 key2 wordOffset => do let key1Val ← evalExprWithHelpers spec fields fuel state key1 let key2Val ← evalExprWithHelpers spec fields fuel state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val let outerSlot := Compiler.Proofs.abstractMappingSlot innerSlot key2Val - some (state.world.storage (wordNormalize (outerSlot + wordOffset))).val + some (readFieldWord state.world field (wordNormalize (outerSlot + wordOffset))).val | none => none | .mappingPackedWord field key wordOffset packed => do let keyVal ← evalExprWithHelpers spec fields fuel state key - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (fieldInfo, slot) => let targetSlot := wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val some (Verity.Core.Uint256.and (Verity.Core.Uint256.shr packed.offset rawWord) (packedMaskNat packed)).val | none => none | .structMember field key memberName => do let keyVal ← evalExprWithHelpers spec fields fuel state key - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let targetSlot := wordNormalize (Compiler.Proofs.abstractMappingSlot slot keyVal + member.wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -3157,14 +3338,14 @@ mutual | .structMember2 field key1 key2 memberName => do let key1Val ← evalExprWithHelpers spec fields fuel state key1 let key2Val ← evalExprWithHelpers spec fields fuel state key2 - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let innerSlot := Compiler.Proofs.abstractMappingSlot slot key1Val let outerSlot := Compiler.Proofs.abstractMappingSlot innerSlot key2Val let targetSlot := wordNormalize (outerSlot + member.wordOffset) - let rawWord := (state.world.storage targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -3250,7 +3431,7 @@ mutual | .setStorage fieldName value => match findFieldWriteSlots fields fieldName, evalExprWithHelpers spec fields fuel state value with | some slots, some resolved => - .continue { state with world := writeUintSlots state.world slots resolved } + .continue { state with world := writeUintFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | .setStorageWord fieldName wordOffset value => match findFieldWriteSlots fields fieldName, @@ -3258,7 +3439,7 @@ mutual | some slots, some resolved => .continue { state with - world := writeStorageWordSlots state.world slots wordOffset resolved } + world := writeStorageWordFieldSlots fields fieldName state.world slots wordOffset resolved } | _, _ => .revert | .setMapping fieldName key value => match findFieldWriteSlots fields fieldName, @@ -3267,7 +3448,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingSlots state.world slots resolvedKey resolved } + world := writeAddressKeyedMappingFieldSlots + fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | .setMappingWord fieldName key wordOffset value => match findFieldWriteSlots fields fieldName, @@ -3276,8 +3458,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingWordSlots - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset resolved } | _, _, _ => .revert | .setMappingPackedWord fieldName key wordOffset packed value => match findFieldWriteSlots fields fieldName, @@ -3287,8 +3469,8 @@ mutual if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _, _, _ => .revert @@ -3302,14 +3484,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMappingWordSlots - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _ => .revert @@ -3323,12 +3505,8 @@ mutual .continue { state with world := - writeAddressKeyedMapping2Slots - state.world - slots - resolvedKey1 - resolvedKey2 - resolved } + writeAddressKeyedMapping2FieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 resolved } | _, _, _, _ => .revert | .setMapping2Word fieldName key1 key2 wordOffset value => match findFieldWriteSlots fields fieldName, @@ -3339,7 +3517,9 @@ mutual .continue { state with world := - writeAddressKeyedMapping2WordSlots + writeAddressKeyedMapping2WordFieldSlots + fields + fieldName state.world slots resolvedKey1 @@ -3358,14 +3538,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMapping2WordSlots - state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } + world := writeAddressKeyedMapping2WordFieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMapping2PackedWordSlots - state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } + world := writeAddressKeyedMapping2PackedWordFieldSlots + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } else .revert | _ => .revert @@ -3377,7 +3557,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeUintKeyedMappingSlots state.world slots resolvedKey resolved } + world := writeUintKeyedMappingFieldSlots + fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | .setMappingChain fieldName keys value => match findFieldWriteSlots fields fieldName, @@ -3386,8 +3567,8 @@ mutual | some slots@(_ :: _), some resolvedKeys, some resolved => .continue { state with - world := writeAddressKeyedMappingChainSlots - state.world slots resolvedKeys resolved } + world := writeAddressKeyedMappingChainFieldSlots + fields fieldName state.world slots resolvedKeys resolved } | _, _, _ => .revert | .storageArrayPush fieldName value => match findFieldWithResolvedSlot fields fieldName, evalExprWithHelpers spec fields fuel state value with @@ -3416,7 +3597,7 @@ mutual | .setStorageAddr fieldName value => match findFieldWriteSlots fields fieldName, evalExprWithHelpers spec fields fuel state value with | some slots, some resolved => - .continue { state with world := writeAddressSlots state.world slots resolved } + .continue { state with world := writeAddressFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | .setImmutable name value => match evalExprWithHelpers spec fields fuel state value with @@ -3443,6 +3624,7 @@ mutual match evalExprWithHelpers spec fields fuel state offset, evalExprWithHelpers spec fields fuel state value with | some resolvedOffset, some resolvedValue => + let resolvedOffset := wordNormalize resolvedOffset .continue { state with world := { diff --git a/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanBodyClosure/Base.lean b/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanBodyClosure/Base.lean index ac76753d2..b2404d512 100644 --- a/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanBodyClosure/Base.lean +++ b/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanBodyClosure/Base.lean @@ -39,6 +39,212 @@ open Compiler.CompilationModel open Compiler.Proofs.YulGeneration open Verity.Core.Free +private theorem bridgedExpr_mappingSlot_local {base key : YulExpr} + (hBase : BridgedExpr base) (hKey : BridgedExpr key) : + BridgedExpr (YulExpr.call "mappingSlot" [base, key]) := by + refine BridgedExpr.call "mappingSlot" _ (Or.inl (by simp [bridgedBuiltins])) ?_ + intro arg hMem + simp only [List.mem_cons, List.mem_nil_iff, or_false] at hMem + rcases hMem with rfl | rfl + · exact hBase + · exact hKey + +private theorem bridgedExpr_add_local {left right : YulExpr} + (hLeft : BridgedExpr left) (hRight : BridgedExpr right) : + BridgedExpr (YulExpr.call "add" [left, right]) := by + refine BridgedExpr.call "add" _ (Or.inl (by simp [bridgedBuiltins])) ?_ + intro arg hMem + simp only [List.mem_cons, List.mem_nil_iff, or_false] at hMem + rcases hMem with rfl | rfl + · exact hLeft + · exact hRight + +private theorem bridgedStraightStmt_storageStore_lit + (isTransient : Bool) (slot : Nat) (valueExpr : YulExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call (if isTransient then "tstore" else "sstore") + [YulExpr.lit slot, valueExpr])) := by + cases isTransient + · exact BridgedStraightStmt.expr_sstore_lit slot valueExpr hValue + · exact BridgedStraightStmt.expr_tstore (YulExpr.lit slot) valueExpr + (BridgedExpr.lit slot) hValue + +private theorem bridgedStraightStmt_storageStore_mapping + (isTransient : Bool) (baseExpr keyExpr valueExpr : YulExpr) + (hBase : BridgedExpr baseExpr) (hKey : BridgedExpr keyExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call (if isTransient then "tstore" else "sstore") + [YulExpr.call "mappingSlot" [baseExpr, keyExpr], valueExpr])) := by + cases isTransient + · exact BridgedStraightStmt.expr_sstore_mapping + baseExpr keyExpr valueExpr hBase hKey hValue + · exact BridgedStraightStmt.expr_tstore + (YulExpr.call "mappingSlot" [baseExpr, keyExpr]) valueExpr + (bridgedExpr_mappingSlot_local hBase hKey) hValue + +private theorem bridgedStraightStmt_storageStore_add + (isTransient : Bool) (leftExpr rightExpr valueExpr : YulExpr) + (hLeft : BridgedExpr leftExpr) (hRight : BridgedExpr rightExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call (if isTransient then "tstore" else "sstore") + [YulExpr.call "add" [leftExpr, rightExpr], valueExpr])) := by + cases isTransient + · exact BridgedStraightStmt.expr_sstore_add + leftExpr rightExpr valueExpr hLeft hRight hValue + · exact BridgedStraightStmt.expr_tstore + (YulExpr.call "add" [leftExpr, rightExpr]) valueExpr + (bridgedExpr_add_local hLeft hRight) hValue + +private theorem bridgedExpr_storageLoad_local (isTransient : Bool) + (slotExpr : YulExpr) (hSlot : BridgedExpr slotExpr) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") [slotExpr]) := by + cases isTransient + · refine BridgedExpr.call "sload" _ (Or.inl (by simp [bridgedBuiltins])) ?_ + intro arg hMem + simp only [List.mem_cons, List.mem_nil_iff, or_false] at hMem + subst hMem + exact hSlot + · exact bridgedExpr_tload slotExpr hSlot + +private theorem bridgedExpr_fieldStorageLoad + (fields : List Field) (field : String) + (slotExpr : YulExpr) (hSlot : BridgedExpr slotExpr) : + BridgedExpr + (YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tload" else "sload" + | none => "sload") [slotExpr]) := by + cases hField : findFieldWithResolvedSlot fields field with + | none => + simpa [hField] using bridgedExpr_storageLoad_local false slotExpr hSlot + | some found => + cases found with + | mk f resolvedSlot => + cases hTransient : f.isTransient <;> + simpa [hField, hTransient] using + bridgedExpr_storageLoad_local f.isTransient slotExpr hSlot + +private theorem bridgedStraightStmt_fieldStorageStore_mapping + (fields : List Field) (field : String) + (baseExpr keyExpr valueExpr : YulExpr) + (hBase : BridgedExpr baseExpr) (hKey : BridgedExpr keyExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore") + [YulExpr.call "mappingSlot" [baseExpr, keyExpr], valueExpr])) := by + cases hField : findFieldWithResolvedSlot fields field with + | none => + simpa [hField] using + bridgedStraightStmt_storageStore_mapping false baseExpr keyExpr valueExpr hBase hKey hValue + | some found => + cases found with + | mk f resolvedSlot => + cases hTransient : f.isTransient <;> + simpa [hField, hTransient] using + bridgedStraightStmt_storageStore_mapping f.isTransient baseExpr keyExpr valueExpr + hBase hKey hValue + +private theorem bridgedStraightStmt_fieldStorageStore_lit + (fields : List Field) (field : String) + (slot : Nat) (valueExpr : YulExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore") + [YulExpr.lit slot, valueExpr])) := by + cases hField : findFieldWithResolvedSlot fields field with + | none => + simpa [hField] using + bridgedStraightStmt_storageStore_lit false slot valueExpr hValue + | some found => + cases found with + | mk f resolvedSlot => + cases hTransient : f.isTransient <;> + simpa [hField, hTransient] using + bridgedStraightStmt_storageStore_lit f.isTransient slot valueExpr hValue + +private theorem bridgedStraightStmt_fieldStorageStore_add + (fields : List Field) (field : String) + (leftExpr rightExpr valueExpr : YulExpr) + (hLeft : BridgedExpr leftExpr) (hRight : BridgedExpr rightExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore") + [YulExpr.call "add" [leftExpr, rightExpr], valueExpr])) := by + cases hField : findFieldWithResolvedSlot fields field with + | none => + simpa [hField] using + bridgedStraightStmt_storageStore_add false leftExpr rightExpr valueExpr hLeft hRight hValue + | some found => + cases found with + | mk f resolvedSlot => + cases hTransient : f.isTransient <;> + simpa [hField, hTransient] using + bridgedStraightStmt_storageStore_add f.isTransient leftExpr rightExpr valueExpr + hLeft hRight hValue + +private theorem bridgedStraightStmt_maybeFieldStorageStore_add + (allowTransient : Bool) (fields : List Field) (field : String) + (leftExpr rightExpr valueExpr : YulExpr) + (hLeft : BridgedExpr leftExpr) (hRight : BridgedExpr rightExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call + (if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore" + else + "sstore") + [YulExpr.call "add" [leftExpr, rightExpr], valueExpr])) := by + cases allowTransient + · exact bridgedStraightStmt_storageStore_add false leftExpr rightExpr valueExpr + hLeft hRight hValue + · simpa using + bridgedStraightStmt_fieldStorageStore_add fields field leftExpr rightExpr valueExpr + hLeft hRight hValue + +private theorem bridgedStraightStmt_maybeFieldStorageStore_mapping + (allowTransient : Bool) (fields : List Field) (field : String) + (baseExpr keyExpr valueExpr : YulExpr) + (hBase : BridgedExpr baseExpr) (hKey : BridgedExpr keyExpr) + (hValue : BridgedExpr valueExpr) : + BridgedStraightStmt + (YulStmt.expr + (YulExpr.call + (if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore" + else + "sstore") + [YulExpr.call "mappingSlot" [baseExpr, keyExpr], valueExpr])) := by + cases allowTransient + · exact bridgedStraightStmt_storageStore_mapping false baseExpr keyExpr valueExpr + hBase hKey hValue + · simpa using + bridgedStraightStmt_fieldStorageStore_mapping fields field baseExpr keyExpr valueExpr + hBase hKey hValue + /-- Scalar ABI parameter types handled inline by `genScalarLoad`. These are the `ParamType` constructors whose head word is consumed directly from calldata without offset/length bookkeeping. -/ @@ -842,7 +1048,8 @@ theorem compileStmt_setStorage_singleSlot_pure_bridged simp only [List.mem_singleton] at hMem subst yulStmt exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_lit slot valueExpr hBridged) + (bridgedStraightStmt_storageStore_lit + f.isTransient slot valueExpr hBridged) /-- An unpacked single-slot `setStorage` source statement with a pure bridged right-hand side compiles to a Yul list with no nested function declarations. -/ @@ -1352,34 +1559,63 @@ def BridgedSourceMappingWriteStmts (fields : List Field) (stmts : List Stmt) : P private theorem compileMappingSlotWrite_singleSlot_bridged (fields : List Field) (field : String) {slot : Nat} (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) (hKey : BridgedExpr keyExpr) (hValue : BridgedExpr valueExpr) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some [slot]) : ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label 0 = .ok out → + compileMappingSlotWrite fields field keyExpr valueExpr label 0 allowTransient = .ok out → BridgedStmts out := by - intro out hOk - simp [compileMappingSlotWrite, hMapping, hSlots, Pure.pure, Except.pure] at hOk - subst hOk - intro yulStmt hMem - simp only [List.mem_singleton] at hMem - subst yulStmt - exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping (.lit slot) keyExpr valueExpr - (BridgedExpr.lit slot) hKey hValue) + intro out hOk + cases allowTransient + · simp [compileMappingSlotWrite, hMapping, hSlots, Pure.pure, Except.pure] at hOk + subst out + intro yulStmt hMem + simp only [List.mem_singleton] at hMem + subst yulStmt + exact BridgedStmt.straight _ + (bridgedStraightStmt_maybeFieldStorageStore_mapping false fields field + (.lit slot) keyExpr valueExpr (BridgedExpr.lit slot) hKey hValue) + · cases hField : findFieldWithResolvedSlot fields field with + | none => + simp [compileMappingSlotWrite, hMapping, hSlots, hField, Pure.pure, + Except.pure] at hOk + | some found => + simp [compileMappingSlotWrite, hMapping, hSlots, hField, Pure.pure, + Except.pure] at hOk + subst out + intro yulStmt hMem + simp only [List.mem_singleton] at hMem + subst yulStmt + exact BridgedStmt.straight _ + (by + simpa [hField] using + bridgedStraightStmt_fieldStorageStore_mapping fields field + (.lit slot) keyExpr valueExpr (BridgedExpr.lit slot) hKey hValue) private theorem compileMappingSlotWrite_singleSlot_noFuncDefs (fields : List Field) (field : String) {slot : Nat} (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some [slot]) : ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label 0 = .ok out → + compileMappingSlotWrite fields field keyExpr valueExpr label 0 allowTransient = .ok out → Native.yulStmtsContainFuncDef out = false := by - intro out hOk - simp [compileMappingSlotWrite, hMapping, hSlots, Pure.pure, Except.pure] at hOk - subst hOk - simp [Native.yulStmtContainsFuncDef] + intro out hOk + cases allowTransient + · simp [compileMappingSlotWrite, hMapping, hSlots, Pure.pure, Except.pure] at hOk + subst out + simp [Native.yulStmtContainsFuncDef] + · cases hField : findFieldWithResolvedSlot fields field with + | none => + simp [compileMappingSlotWrite, hMapping, hSlots, hField, Pure.pure, + Except.pure] at hOk + | some found => + simp [compileMappingSlotWrite, hMapping, hSlots, hField, Pure.pure, + Except.pure] at hOk + subst out + simp [Native.yulStmtContainsFuncDef] /-- A single-slot `Stmt.setMapping` source write with a pure bridged key and value compiles to `BridgedStmts`. -/ @@ -1403,12 +1639,12 @@ theorem compileStmt_setMapping_singleSlot_bridged cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr] at hOk - exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr - valueExpr "setMapping" - (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) - (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) - hMapping hSlots hOk + simp [hKeyExpr, hValueExpr] at hOk + exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr + valueExpr "setMapping" true + (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) + (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) + hMapping hSlots hOk /-- A single-slot `Stmt.setMappingUint` source write with a pure bridged key and value compiles to `BridgedStmts`. Emission path is identical to @@ -1433,12 +1669,12 @@ theorem compileStmt_setMappingUint_singleSlot_bridged cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr] at hOk - exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr - valueExpr "setMappingUint" - (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) - (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) - hMapping hSlots hOk + simp [hKeyExpr, hValueExpr] at hOk + exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr + valueExpr "setMappingUint" true + (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) + (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) + hMapping hSlots hOk theorem compileStmt_setMapping_singleSlot_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -1460,9 +1696,9 @@ theorem compileStmt_setMapping_singleSlot_noFuncDefs cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr] at hOk - exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field - keyExpr valueExpr "setMapping" hMapping hSlots hOk + simp [hKeyExpr, hValueExpr] at hOk + exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field + keyExpr valueExpr "setMapping" true hMapping hSlots hOk theorem compileStmt_setMappingUint_singleSlot_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -1484,9 +1720,9 @@ theorem compileStmt_setMappingUint_singleSlot_noFuncDefs cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr] at hOk - exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field - keyExpr valueExpr "setMappingUint" hMapping hSlots hOk + simp [hKeyExpr, hValueExpr] at hOk + exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field + keyExpr valueExpr "setMappingUint" true hMapping hSlots hOk /-- Each statement in the mapping-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -4311,7 +4547,7 @@ theorem compileStmt_setMapping2_singleSlot_bridged · subst hArg; exact BridgedExpr.lit slot · subst hArg; exact hBridgedKey1 exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ key2Expr valueExpr + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ key2Expr valueExpr hInnerBridged hBridgedKey2 hBridgedValue) /-- Each statement in the double-mapping-write fragment compiles to Yul @@ -4463,7 +4699,8 @@ theorem compileStmt_setStorageAddr_singleSlot_bridged simp only [List.mem_singleton] at hMem subst yulStmt exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_lit slot _ hMasked) + (bridgedStraightStmt_storageStore_lit + f.isTransient slot _ hMasked) /-- Each statement in the setStorageAddr fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -4563,12 +4800,12 @@ theorem compileStmt_setStructMember_singleSlot_bridged cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk - exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr - valueExpr s!"setStructMember.{memberName}" - (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) - (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) - hMapping hSlots hOk + simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk + exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr + valueExpr s!"setStructMember.{memberName}" true + (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) + (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) + hMapping hSlots hOk /-- Each statement in the struct-member-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -4618,10 +4855,10 @@ theorem compileStmt_setStructMember_singleSlot_noFuncDefs cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk - exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field - keyExpr valueExpr s!"setStructMember.{memberName}" - hMapping hSlots hOk + simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk + exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field + keyExpr valueExpr s!"setStructMember.{memberName}" true + hMapping hSlots hOk theorem compileStmt_structMember_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -4644,52 +4881,80 @@ theorem compileStmt_structMember_noFuncDefs private theorem compileMappingSlotWrite_singleSlot_nonzero_bridged (fields : List Field) (field : String) {slot wordOffset : Nat} (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) (hKey : BridgedExpr keyExpr) (hValue : BridgedExpr valueExpr) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some [slot]) (hNonzero : wordOffset ≠ 0) : ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset = .ok out → + compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset allowTransient = .ok out → BridgedStmts out := by - intro out hOk - have hBeq : (wordOffset == 0) = false := by - cases wordOffset with - | zero => exact absurd rfl hNonzero - | succ n => rfl - simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, Pure.pure, Except.pure] at hOk - subst hOk - intro yulStmt hMem - simp only [List.mem_singleton] at hMem - subst yulStmt - have hMappingExpr : BridgedExpr (.call "mappingSlot" [.lit slot, keyExpr]) := by - refine BridgedExpr.call "mappingSlot" _ (Or.inl (by simp [bridgedBuiltins])) ?_ - intro arg hArg - simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg - rcases hArg with rfl | rfl - · exact BridgedExpr.lit slot - · exact hKey - exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add - (.call "mappingSlot" [.lit slot, keyExpr]) (.lit wordOffset) valueExpr - hMappingExpr (BridgedExpr.lit wordOffset) hValue) + intro out hOk + have hBeq : (wordOffset == 0) = false := by + cases wordOffset with + | zero => exact absurd rfl hNonzero + | succ n => rfl + cases allowTransient + · simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, Pure.pure, Except.pure] at hOk + subst out + intro yulStmt hMem + simp only [List.mem_singleton] at hMem + subst yulStmt + exact BridgedStmt.straight _ + (bridgedStraightStmt_maybeFieldStorageStore_add false fields field + (.call "mappingSlot" [.lit slot, keyExpr]) (.lit wordOffset) + valueExpr + (bridgedExpr_mappingSlot_local (BridgedExpr.lit slot) hKey) + (BridgedExpr.lit wordOffset) hValue) + · cases hField : findFieldWithResolvedSlot fields field with + | none => + simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, hField, + Pure.pure, Except.pure] at hOk + | some found => + simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, hField, + Pure.pure, Except.pure] at hOk + subst out + intro yulStmt hMem + simp only [List.mem_singleton] at hMem + subst yulStmt + exact BridgedStmt.straight _ + (by + simpa [hField] using + bridgedStraightStmt_fieldStorageStore_add fields field + (.call "mappingSlot" [.lit slot, keyExpr]) (.lit wordOffset) + valueExpr + (bridgedExpr_mappingSlot_local (BridgedExpr.lit slot) hKey) + (BridgedExpr.lit wordOffset) hValue) private theorem compileMappingSlotWrite_singleSlot_nonzero_noFuncDefs (fields : List Field) (field : String) {slot wordOffset : Nat} (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some [slot]) (hNonzero : wordOffset ≠ 0) : ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset = .ok out → + compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset allowTransient = .ok out → Native.yulStmtsContainFuncDef out = false := by - intro out hOk - have hBeq : (wordOffset == 0) = false := by - cases wordOffset with - | zero => exact absurd rfl hNonzero - | succ n => rfl - simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, Pure.pure, Except.pure] at hOk - subst hOk - simp [Native.yulStmtContainsFuncDef] + intro out hOk + have hBeq : (wordOffset == 0) = false := by + cases wordOffset with + | zero => exact absurd rfl hNonzero + | succ n => rfl + cases allowTransient + · simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, Pure.pure, + Except.pure] at hOk + subst out + simp [Native.yulStmtContainsFuncDef] + · cases hField : findFieldWithResolvedSlot fields field with + | none => + simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, hField, + Pure.pure, Except.pure] at hOk + | some found => + simp [compileMappingSlotWrite, hMapping, hSlots, hBeq, hField, + Pure.pure, Except.pure] at hOk + subst out + simp [Native.yulStmtContainsFuncDef] /-! ## Source statement body closure: single-slot `setStructMember` (wordOffset ≠ 0) -/ @@ -4745,7 +5010,7 @@ theorem compileStmt_setStructMember_singleSlot_nonzero_bridged | ok valueExpr => simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk exact compileMappingSlotWrite_singleSlot_nonzero_bridged fields field - keyExpr valueExpr s!"setStructMember.{memberName}" + keyExpr valueExpr s!"setStructMember.{memberName}" true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hNonzero hOk @@ -4798,7 +5063,7 @@ theorem compileStmt_setStructMember_singleSlot_nonzero_noFuncDefs | ok valueExpr => simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk exact compileMappingSlotWrite_singleSlot_nonzero_noFuncDefs fields field - keyExpr valueExpr s!"setStructMember.{memberName}" + keyExpr valueExpr s!"setStructMember.{memberName}" true hMapping hSlots hNonzero hOk theorem compileStmt_structMemberNonzero_noFuncDefs @@ -4895,16 +5160,10 @@ theorem compileStmt_setStructMember2_singleSlot_bridged compileExpr_bridgedSource fields dynamicSource hValue hValueExpr have hInnerBridged : BridgedExpr (Compiler.Yul.YulExpr.call "mappingSlot" - [Compiler.Yul.YulExpr.lit slot, key1Expr]) := by - apply BridgedExpr.call - · exact Or.inl (by decide) - · intro arg hArg - simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg - rcases hArg with hArg | hArg - · subst hArg; exact BridgedExpr.lit slot - · subst hArg; exact hBridgedKey1 + [Compiler.Yul.YulExpr.lit slot, key1Expr]) := + bridgedExpr_mappingSlot_local (BridgedExpr.lit slot) hBridgedKey1 exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ key2Expr valueExpr + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ key2Expr valueExpr hInnerBridged hBridgedKey2 hBridgedValue) /-- Each statement in the struct-member2-write fragment compiles to Yul @@ -5072,7 +5331,8 @@ theorem compileStmt_setStructMember2_singleSlot_nonzero_bridged · exact hInnerBridged · exact hBridgedKey2 exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add _ (.lit member.wordOffset) + (bridgedStraightStmt_fieldStorageStore_add fields field _ + (.lit member.wordOffset) valueExpr hOuterBridged (BridgedExpr.lit member.wordOffset) hBridgedValue) @@ -5199,12 +5459,12 @@ theorem compileStmt_setMappingWord_singleSlot_bridged cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr] at hOk - exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr - valueExpr "setMappingWord" - (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) - (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) - hMapping hSlots hOk + simp [hKeyExpr, hValueExpr] at hOk + exact compileMappingSlotWrite_singleSlot_bridged fields field keyExpr + valueExpr "setMappingWord" true + (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) + (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) + hMapping hSlots hOk /-- Each statement in the mappingWord-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -5246,9 +5506,9 @@ theorem compileStmt_setMappingWord_singleSlot_noFuncDefs cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr] at hOk | ok valueExpr => - simp [hKeyExpr, hValueExpr] at hOk - exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field - keyExpr valueExpr "setMappingWord" hMapping hSlots hOk + simp [hKeyExpr, hValueExpr] at hOk + exact compileMappingSlotWrite_singleSlot_noFuncDefs fields field + keyExpr valueExpr "setMappingWord" true hMapping hSlots hOk theorem compileStmt_mappingWord_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -5344,7 +5604,7 @@ theorem compileStmt_setMapping2Word_singleSlot_bridged · subst hArg; exact BridgedExpr.lit slot · subst hArg; exact hBridgedKey1 exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ key2Expr valueExpr + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ key2Expr valueExpr hInnerBridged hBridgedKey2 hBridgedValue) /-- Each statement in the mapping2Word-write fragment compiles to Yul @@ -6543,7 +6803,7 @@ theorem compileStmt_setMappingWord_singleSlot_nonzero_bridged | ok valueExpr => simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_singleSlot_nonzero_bridged fields field - keyExpr valueExpr "setMappingWord" + keyExpr valueExpr "setMappingWord" true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hNonzero hOk @@ -6589,7 +6849,7 @@ theorem compileStmt_setMappingWord_singleSlot_nonzero_noFuncDefs | ok valueExpr => simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_singleSlot_nonzero_noFuncDefs fields field - keyExpr valueExpr "setMappingWord" hMapping hSlots hNonzero hOk + keyExpr valueExpr "setMappingWord" true hMapping hSlots hNonzero hOk theorem compileStmt_mappingWordNonzero_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -6701,7 +6961,8 @@ theorem compileStmt_setMapping2Word_singleSlot_nonzero_bridged · exact hInnerBridged · exact hBridgedKey2 exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add _ (.lit wordOffset) valueExpr + (bridgedStraightStmt_fieldStorageStore_add fields field _ + (.lit wordOffset) valueExpr hOuterBridged (BridgedExpr.lit wordOffset) hBridgedValue) /-- Each statement in the nonzero-offset mapping2Word-write fragment @@ -6873,7 +7134,8 @@ theorem compileStmt_setMappingChain_singleSlot_bridged subst hNil simp only [List.foldl_nil] exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_lit slot valueExpr hBridgedValue) + (bridgedStraightStmt_fieldStorageStore_lit fields field slot valueExpr + hBridgedValue) · -- keyExprs = pre ++ [last] → outermost call is mappingSlot(...) rw [List.concat_eq_append] at hConcat subst hConcat @@ -6888,7 +7150,7 @@ theorem compileStmt_setMappingChain_singleSlot_bridged bridgedExpr_foldl_mappingSlot pre _ (BridgedExpr.lit slot) hAllPre simp only [List.foldl_append, List.foldl_cons, List.foldl_nil] exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ last valueExpr + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ last valueExpr hPreFold hLast hBridgedValue) private theorem compileStmt_setMappingChain_singleSlot_noFuncDefs @@ -7016,15 +7278,16 @@ produces a `BridgedStmts` list (one outer block wrapping two let-bindings and N sstore writes). -/ private theorem compileMappingSlotWrite_multiSlot_bridged (fields : List Field) (field : String) - {slot0 slot1 : Nat} {slotsRest : List Nat} - (keyExpr valueExpr : YulExpr) (label : String) - (hKey : BridgedExpr keyExpr) (hValue : BridgedExpr valueExpr) + {slot0 slot1 : Nat} {slotsRest : List Nat} + (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) + (hKey : BridgedExpr keyExpr) (hValue : BridgedExpr valueExpr) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some (slot0 :: slot1 :: slotsRest)) : - ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label 0 = .ok out → - BridgedStmts out := by + ∀ {out : List YulStmt}, + compileMappingSlotWrite fields field keyExpr valueExpr label 0 allowTransient = .ok out → + BridgedStmts out := by intro out hOk simp [compileMappingSlotWrite, hMapping, hSlots, Pure.pure, Except.pure] at hOk subst hOk @@ -7042,46 +7305,60 @@ private theorem compileMappingSlotWrite_multiSlot_bridged rcases hMem with hEq | hMem · subst hEq exact BridgedStmt.straight _ (BridgedStraightStmt.let_ _ _ hValue) - rcases hMem with hEq | hMem - · subst hEq + have hStoreFor : ∀ slot : Nat, + BridgedStmt + (Compiler.Yul.YulStmt.expr + (Compiler.Yul.YulExpr.call + (if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore" + else + "sstore") + [Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"], + Compiler.Yul.YulExpr.ident "__compat_value"])) := by + intro slot exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping - (Compiler.Yul.YulExpr.lit slot0) + (bridgedStraightStmt_maybeFieldStorageStore_mapping allowTransient fields field + (Compiler.Yul.YulExpr.lit slot) (Compiler.Yul.YulExpr.ident "__compat_key") (Compiler.Yul.YulExpr.ident "__compat_value") - (BridgedExpr.lit slot0) + (BridgedExpr.lit slot) (BridgedExpr.ident "__compat_key") (BridgedExpr.ident "__compat_value")) rcases hMem with hEq | hMem · subst hEq - exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping - (Compiler.Yul.YulExpr.lit slot1) - (Compiler.Yul.YulExpr.ident "__compat_key") - (Compiler.Yul.YulExpr.ident "__compat_value") - (BridgedExpr.lit slot1) - (BridgedExpr.ident "__compat_key") - (BridgedExpr.ident "__compat_value")) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping slotsRest stmt - (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + exact hStoreFor slot0 + rcases hMem with hEq | hMem + · subst hEq + exact hStoreFor slot1 + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst stmt + exact hStoreFor slot private theorem compileMappingSlotWrite_multiSlot_noFuncDefs (fields : List Field) (field : String) - {slot0 slot1 : Nat} {slotsRest : List Nat} - (keyExpr valueExpr : YulExpr) (label : String) + {slot0 slot1 : Nat} {slotsRest : List Nat} + (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some (slot0 :: slot1 :: slotsRest)) : - ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label 0 = .ok out → - Native.yulStmtsContainFuncDef out = false := by + ∀ {out : List YulStmt}, + compileMappingSlotWrite fields field keyExpr valueExpr label 0 allowTransient = .ok out → + Native.yulStmtsContainFuncDef out = false := by intro out hOk simp [compileMappingSlotWrite, hMapping, hSlots, Pure.pure, Except.pure] at hOk subst hOk - simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, - yulStmtsContainFuncDef_multiSlot_sstore_mapping] + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Multi-slot mapping-write source statements: `setMapping` / `setMappingUint` to a declared mapping field whose write slots list has ≥ 2 @@ -7136,6 +7413,7 @@ theorem compileStmt_setMapping_multiSlot_bridged simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_bridged fields field keyExpr valueExpr "setMapping" + true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hOk @@ -7163,7 +7441,7 @@ theorem compileStmt_setMapping_multiSlot_noFuncDefs | ok valueExpr => simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_noFuncDefs fields field - keyExpr valueExpr "setMapping" hMapping hSlots hOk + keyExpr valueExpr "setMapping" true hMapping hSlots hOk /-- A multi-slot `Stmt.setMappingUint` source write with pure bridged key and value compiles to `BridgedStmts`. Emission path is identical to @@ -7193,6 +7471,7 @@ theorem compileStmt_setMappingUint_multiSlot_bridged simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_bridged fields field keyExpr valueExpr "setMappingUint" + true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hOk @@ -7220,7 +7499,7 @@ theorem compileStmt_setMappingUint_multiSlot_noFuncDefs | ok valueExpr => simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_noFuncDefs fields field - keyExpr valueExpr "setMappingUint" hMapping hSlots hOk + keyExpr valueExpr "setMappingUint" true hMapping hSlots hOk /-- Each statement in the multi-slot mapping-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -7434,7 +7713,7 @@ theorem compileStmt_setMapping2_multiSlot_bridged · subst hArg; exact BridgedExpr.lit slot0 · subst hArg; exact BridgedExpr.ident "__compat_key1" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ _ _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ hInner0 (BridgedExpr.ident "__compat_key2") (BridgedExpr.ident "__compat_value")) @@ -7452,14 +7731,29 @@ theorem compileStmt_setMapping2_multiSlot_bridged · subst hArg; exact BridgedExpr.lit slot1 · subst hArg; exact BridgedExpr.ident "__compat_key1" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ _ _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ hInner1 (BridgedExpr.ident "__compat_key2") (BridgedExpr.ident "__compat_value")) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping2 slotsRest stmt - (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst stmt + have hInner : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact BridgedExpr.lit slot + · subst hArg; exact BridgedExpr.ident "__compat_key1" + exact BridgedStmt.straight _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ + hInner + (BridgedExpr.ident "__compat_key2") + (BridgedExpr.ident "__compat_value")) theorem compileStmt_setMapping2_multiSlot_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -7490,8 +7784,13 @@ theorem compileStmt_setMapping2_multiSlot_noFuncDefs | ok valueExpr => simp [hKey1Expr, hKey2Expr, hValueExpr, bind, Except.bind] at hOk subst out - simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, - yulStmtsContainFuncDef_multiSlot_sstore_mapping2] + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + clear hSlots + induction slotsRest with + | nil => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot double-mapping-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -7594,6 +7893,7 @@ theorem compileStmt_setStructMember_multiSlot_bridged simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk exact compileMappingSlotWrite_multiSlot_bridged fields field keyExpr valueExpr s!"setStructMember.{memberName}" + true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hOk @@ -7630,7 +7930,7 @@ theorem compileStmt_setStructMember_multiSlot_noFuncDefs simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk exact compileMappingSlotWrite_multiSlot_noFuncDefs fields field keyExpr valueExpr s!"setStructMember.{memberName}" - hMapping hSlots hOk + true hMapping hSlots hOk /-- Each statement in the multi-slot struct-member-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -7780,7 +8080,7 @@ theorem compileStmt_setStructMember2_multiSlot_bridged · subst hArg; exact BridgedExpr.lit slot0 · subst hArg; exact BridgedExpr.ident "__compat_key1" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ _ _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ hInner0 (BridgedExpr.ident "__compat_key2") (BridgedExpr.ident "__compat_value")) @@ -7798,14 +8098,29 @@ theorem compileStmt_setStructMember2_multiSlot_bridged · subst hArg; exact BridgedExpr.lit slot1 · subst hArg; exact BridgedExpr.ident "__compat_key1" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ _ _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ hInner1 (BridgedExpr.ident "__compat_key2") (BridgedExpr.ident "__compat_value")) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping2 slotsRest stmt - (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst stmt + have hInner : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact BridgedExpr.lit slot + · subst hArg; exact BridgedExpr.ident "__compat_key1" + exact BridgedStmt.straight _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ + hInner + (BridgedExpr.ident "__compat_key2") + (BridgedExpr.ident "__compat_value")) theorem compileStmt_setStructMember2_multiSlot_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -7843,8 +8158,11 @@ theorem compileStmt_setStructMember2_multiSlot_noFuncDefs simp [hKey1Expr, hKey2Expr, hValueExpr, bind, Except.bind] at hOk subst out simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa [Function.comp_def] using - yulStmtsContainFuncDef_multiSlot_sstore_mapping2 slotsRest + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot struct-member2-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -7944,6 +8262,7 @@ theorem compileStmt_setMappingWord_multiSlot_bridged simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_bridged fields field keyExpr valueExpr "setMappingWord" + true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hOk @@ -7973,7 +8292,7 @@ theorem compileStmt_setMappingWord_multiSlot_noFuncDefs | ok valueExpr => simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_noFuncDefs fields field - keyExpr valueExpr "setMappingWord" hMapping hSlots hOk + keyExpr valueExpr "setMappingWord" true hMapping hSlots hOk /-- Each statement in the multi-slot mappingWord-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -8110,7 +8429,7 @@ theorem compileStmt_setMapping2Word_multiSlot_bridged · subst hArg; exact BridgedExpr.lit slot0 · subst hArg; exact BridgedExpr.ident "__compat_key1" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ _ _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ hInner0 (BridgedExpr.ident "__compat_key2") (BridgedExpr.ident "__compat_value")) @@ -8128,14 +8447,29 @@ theorem compileStmt_setMapping2Word_multiSlot_bridged · subst hArg; exact BridgedExpr.lit slot1 · subst hArg; exact BridgedExpr.ident "__compat_key1" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping _ _ _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ hInner1 (BridgedExpr.ident "__compat_key2") (BridgedExpr.ident "__compat_value")) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping2 slotsRest stmt - (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst stmt + have hInner : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact BridgedExpr.lit slot + · subst hArg; exact BridgedExpr.ident "__compat_key1" + exact BridgedStmt.straight _ + (bridgedStraightStmt_fieldStorageStore_mapping fields field _ _ _ + hInner + (BridgedExpr.ident "__compat_key2") + (BridgedExpr.ident "__compat_value")) theorem compileStmt_setMapping2Word_multiSlot_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -8169,8 +8503,11 @@ theorem compileStmt_setMapping2Word_multiSlot_noFuncDefs simp [hKey1Expr, hKey2Expr, hValueExpr, bind, Except.bind] at hOk subst out simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa [Function.comp_def] using - yulStmtsContainFuncDef_multiSlot_sstore_mapping2 slotsRest + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot mapping2Word-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -8290,17 +8627,18 @@ expressions produces a `BridgedStmts` list. Mirrors `compileMappingSlotWrite_multiSlot_bridged` (cd135ff7, line 8827) but with the `add`-wrapped sstore shape. -/ private theorem compileMappingSlotWrite_multiSlot_nonzero_bridged - (fields : List Field) (field : String) - {slot0 slot1 : Nat} {slotsRest : List Nat} {wordOffset : Nat} - (keyExpr valueExpr : YulExpr) (label : String) - (hKey : BridgedExpr keyExpr) (hValue : BridgedExpr valueExpr) + (fields : List Field) (field : String) + {slot0 slot1 : Nat} {slotsRest : List Nat} {wordOffset : Nat} + (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) + (hKey : BridgedExpr keyExpr) (hValue : BridgedExpr valueExpr) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some (slot0 :: slot1 :: slotsRest)) - (hNonzero : wordOffset ≠ 0) : - ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset = .ok out → - BridgedStmts out := by + (hNonzero : wordOffset ≠ 0) : + ∀ {out : List YulStmt}, + compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset allowTransient = .ok out → + BridgedStmts out := by intro out hOk have hBeq : (wordOffset == 0) = false := by cases wordOffset with @@ -8317,22 +8655,66 @@ private theorem compileMappingSlotWrite_multiSlot_nonzero_bridged rcases hMem with hEq | hMem · subst hEq exact BridgedStmt.straight _ (BridgedStraightStmt.let_ _ _ hValue) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping_add - (slot0 :: slot1 :: slotsRest) wordOffset stmt (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + have hStoreFor : ∀ slot : Nat, + BridgedStmt + (Compiler.Yul.YulStmt.expr + (Compiler.Yul.YulExpr.call + (if allowTransient then + match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore" + else + "sstore") + [Compiler.Yul.YulExpr.call "add" [ + Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"], + Compiler.Yul.YulExpr.lit wordOffset], + Compiler.Yul.YulExpr.ident "__compat_value"])) := by + intro slot + have hMappingExpr : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact BridgedExpr.lit slot + · subst hArg; exact BridgedExpr.ident "__compat_key" + exact BridgedStmt.straight _ + (bridgedStraightStmt_maybeFieldStorageStore_add allowTransient fields field + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"]) + (Compiler.Yul.YulExpr.lit wordOffset) + (Compiler.Yul.YulExpr.ident "__compat_value") + hMappingExpr (BridgedExpr.lit wordOffset) + (BridgedExpr.ident "__compat_value")) + rcases hMem with hEq | hMem + · subst hEq + exact hStoreFor slot0 + rcases hMem with hEq | hMem + · subst hEq + exact hStoreFor slot1 + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst stmt + exact hStoreFor slot private theorem compileMappingSlotWrite_multiSlot_nonzero_noFuncDefs - (fields : List Field) (field : String) - {slot0 slot1 : Nat} {slotsRest : List Nat} {wordOffset : Nat} - (keyExpr valueExpr : YulExpr) (label : String) + (fields : List Field) (field : String) + {slot0 slot1 : Nat} {slotsRest : List Nat} {wordOffset : Nat} + (keyExpr valueExpr : YulExpr) (label : String) + (allowTransient : Bool) (hMapping : isMapping fields field = true) (hSlots : findFieldWriteSlots fields field = some (slot0 :: slot1 :: slotsRest)) - (hNonzero : wordOffset ≠ 0) : - ∀ {out : List YulStmt}, - compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset = .ok out → - Native.yulStmtsContainFuncDef out = false := by + (hNonzero : wordOffset ≠ 0) : + ∀ {out : List YulStmt}, + compileMappingSlotWrite fields field keyExpr valueExpr label wordOffset allowTransient = .ok out → + Native.yulStmtsContainFuncDef out = false := by intro out hOk have hBeq : (wordOffset == 0) = false := by cases wordOffset with @@ -8342,8 +8724,11 @@ private theorem compileMappingSlotWrite_multiSlot_nonzero_noFuncDefs Except.pure] at hOk subst hOk simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa using - yulStmtsContainFuncDef_multiSlot_sstore_mapping_add slotsRest wordOffset + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- A multi-slot `Stmt.setMappingWord field key wordOffset value` source write with pure bridged key and value at `wordOffset ≠ 0` on a mapping @@ -8392,6 +8777,7 @@ theorem compileStmt_setMappingWord_multiSlot_nonzero_bridged simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_nonzero_bridged fields field keyExpr valueExpr "setMappingWord" + true (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) hMapping hSlots hNonzero hOk @@ -8420,7 +8806,7 @@ theorem compileStmt_setMappingWord_multiSlot_nonzero_noFuncDefs | ok valueExpr => simp [hKeyExpr, hValueExpr] at hOk exact compileMappingSlotWrite_multiSlot_nonzero_noFuncDefs fields field - keyExpr valueExpr "setMappingWord" hMapping hSlots hNonzero hOk + keyExpr valueExpr "setMappingWord" true hMapping hSlots hNonzero hOk /-- Each statement in the multi-slot nonzero-offset mappingWord-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -8663,7 +9049,7 @@ theorem compileStmt_setMapping2Word_multiSlot_nonzero_bridged · subst hArg; exact hInner0 · subst hArg; exact BridgedExpr.ident "__compat_key2" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add _ _ _ + (bridgedStraightStmt_fieldStorageStore_add fields field _ _ _ hOuter0 (BridgedExpr.lit wordOffset) (BridgedExpr.ident "__compat_value")) @@ -8694,14 +9080,42 @@ theorem compileStmt_setMapping2Word_multiSlot_nonzero_bridged · subst hArg; exact hInner1 · subst hArg; exact BridgedExpr.ident "__compat_key2" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add _ _ _ + (bridgedStraightStmt_fieldStorageStore_add fields field _ _ _ hOuter1 (BridgedExpr.lit wordOffset) (BridgedExpr.ident "__compat_value")) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping2_add slotsRest - wordOffset stmt (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst hEq + have hInner : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact BridgedExpr.lit slot + · subst hArg; exact BridgedExpr.ident "__compat_key1" + have hOuter : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" [ + Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"], + Compiler.Yul.YulExpr.ident "__compat_key2"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact hInner + · subst hArg; exact BridgedExpr.ident "__compat_key2" + exact BridgedStmt.straight _ + (bridgedStraightStmt_fieldStorageStore_add fields field _ _ _ + hOuter + (BridgedExpr.lit wordOffset) + (BridgedExpr.ident "__compat_value")) theorem compileStmt_setMapping2Word_multiSlot_nonzero_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -8738,9 +9152,11 @@ theorem compileStmt_setMapping2Word_multiSlot_nonzero_noFuncDefs simp [hKey1Expr, hKey2Expr, hValueExpr, bind, Except.bind] at hOk subst out simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa [Function.comp_def] using - yulStmtsContainFuncDef_multiSlot_sstore_mapping2_add slotsRest - wordOffset + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot mapping2Word-write wordOffset≠0 fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -8842,13 +9258,14 @@ theorem compileStmt_setStructMember_multiSlot_nonzero_bridged cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk - | ok valueExpr => - simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk - exact compileMappingSlotWrite_multiSlot_nonzero_bridged fields field - keyExpr valueExpr s!"setStructMember.{memberName}" - (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) - (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) - hMapping hSlots hNonzero hOk + | ok valueExpr => + simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk + exact compileMappingSlotWrite_multiSlot_nonzero_bridged fields field + keyExpr valueExpr s!"setStructMember.{memberName}" + true + (compileExpr_bridgedSource fields dynamicSource hKey hKeyExpr) + (compileExpr_bridgedSource fields dynamicSource hValue hValueExpr) + hMapping hSlots hNonzero hOk theorem compileStmt_setStructMember_multiSlot_nonzero_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -8879,11 +9296,11 @@ theorem compileStmt_setStructMember_multiSlot_nonzero_noFuncDefs cases hValueExpr : compileExprWithInternals fields dynamicSource [] value with | error err => simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk - | ok valueExpr => - simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk - exact compileMappingSlotWrite_multiSlot_nonzero_noFuncDefs fields - field keyExpr valueExpr s!"setStructMember.{memberName}" - hMapping hSlots hNonzero hOk + | ok valueExpr => + simp [hKeyExpr, hValueExpr, pure, Pure.pure, Except.pure] at hOk + exact compileMappingSlotWrite_multiSlot_nonzero_noFuncDefs fields + field keyExpr valueExpr s!"setStructMember.{memberName}" + true hMapping hSlots hNonzero hOk /-- Each statement in the multi-slot nonzero-offset struct-member-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -9052,7 +9469,7 @@ theorem compileStmt_setStructMember2_multiSlot_nonzero_bridged · subst hArg; exact hInner0 · subst hArg; exact BridgedExpr.ident "__compat_key2" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add _ _ _ + (bridgedStraightStmt_fieldStorageStore_add fields field _ _ _ hOuter0 (BridgedExpr.lit member.wordOffset) (BridgedExpr.ident "__compat_value")) @@ -9083,14 +9500,42 @@ theorem compileStmt_setStructMember2_multiSlot_nonzero_bridged · subst hArg; exact hInner1 · subst hArg; exact BridgedExpr.ident "__compat_key2" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add _ _ _ + (bridgedStraightStmt_fieldStorageStore_add fields field _ _ _ hOuter1 (BridgedExpr.lit member.wordOffset) (BridgedExpr.ident "__compat_value")) - · have hSstore : BridgedStraightStmt stmt := - bridgedStraightStmts_multiSlot_sstore_mapping2_add slotsRest - member.wordOffset stmt (by simpa using hMem) - exact BridgedStmt.straight _ hSstore + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst hEq + have hInner : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact BridgedExpr.lit slot + · subst hArg; exact BridgedExpr.ident "__compat_key1" + have hOuter : BridgedExpr + (Compiler.Yul.YulExpr.call "mappingSlot" [ + Compiler.Yul.YulExpr.call "mappingSlot" + [Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key1"], + Compiler.Yul.YulExpr.ident "__compat_key2"]) := by + apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + rcases hArg with hArg | hArg + · subst hArg; exact hInner + · subst hArg; exact BridgedExpr.ident "__compat_key2" + exact BridgedStmt.straight _ + (bridgedStraightStmt_fieldStorageStore_add fields field _ _ _ + hOuter + (BridgedExpr.lit member.wordOffset) + (BridgedExpr.ident "__compat_value")) theorem compileStmt_setStructMember2_multiSlot_nonzero_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -9132,9 +9577,11 @@ theorem compileStmt_setStructMember2_multiSlot_nonzero_noFuncDefs simp [hKey1Expr, hKey2Expr, hValueExpr, bind, Except.bind] at hOk subst out simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa [Function.comp_def] using - yulStmtsContainFuncDef_multiSlot_sstore_mapping2_add slotsRest - member.wordOffset + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot nonzero-offset struct-member2-write fragment compiles to Yul satisfying `BridgedStmts`. -/ @@ -9271,12 +9718,8 @@ theorem compileStmt_setMappingPackedWord_singleSlot_bridged · subst hArg; exact BridgedExpr.lit _ · -- let_ "__compat_slot_word" (sload(mappingSlot(lit slot, keyExpr))) refine BridgedStmt.straight _ - (BridgedStraightStmt.let_ _ _ ?_) - apply BridgedExpr.call - · exact Or.inl (by decide) - · intro arg hArg - simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg - subst hArg; exact hMappingBase + (BridgedStraightStmt.let_ _ _ + (bridgedExpr_fieldStorageLoad fields field _ hMappingBase)) · -- let_ "__compat_slot_cleared" -- (and(ident "__compat_slot_word", not(lit shiftedMaskNat))) refine BridgedStmt.straight _ @@ -9319,7 +9762,7 @@ theorem compileStmt_setMappingPackedWord_singleSlot_bridged · subst hArg'; exact BridgedExpr.lit _ · subst hArg'; exact BridgedExpr.ident "__compat_packed" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping + (bridgedStraightStmt_fieldStorageStore_mapping fields field (Compiler.Yul.YulExpr.lit slot) keyExpr _ (BridgedExpr.lit slot) hKeyBridged hVal) @@ -9497,12 +9940,8 @@ theorem compileStmt_setMappingPackedWord_singleSlot_nonzero_bridged · subst hArg; exact BridgedExpr.lit _ · -- let_ "__compat_slot_word" (sload(add(mappingBase, lit wordOffset))) refine BridgedStmt.straight _ - (BridgedStraightStmt.let_ _ _ ?_) - apply BridgedExpr.call - · exact Or.inl (by decide) - · intro arg hArg - simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg - subst hArg; exact hWriteSlot + (BridgedStraightStmt.let_ _ _ + (bridgedExpr_fieldStorageLoad fields field _ hWriteSlot)) · -- let_ "__compat_slot_cleared" -- (and(ident "__compat_slot_word", not(lit shiftedMaskNat))) refine BridgedStmt.straight _ @@ -9545,11 +9984,11 @@ theorem compileStmt_setMappingPackedWord_singleSlot_nonzero_bridged · subst hArg'; exact BridgedExpr.lit _ · subst hArg'; exact BridgedExpr.ident "__compat_packed" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add + (bridgedStraightStmt_fieldStorageStore_add fields field (Compiler.Yul.YulExpr.call "mappingSlot" [Compiler.Yul.YulExpr.lit slot, keyExpr]) (Compiler.Yul.YulExpr.lit wordOffset) _ - hMappingBase (BridgedExpr.lit wordOffset) hVal) + hMappingBase (BridgedExpr.lit wordOffset) hVal) theorem compileStmt_setMappingPackedWord_singleSlot_nonzero_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -9641,10 +10080,10 @@ wrapped in an inner `BridgedStmts_singleton_block`. -/ multi-slot `compileMappingPackedSlotWrite` wordOffset=0 branch is a `BridgedStmt`. -/ private theorem bridgedStmt_packedInnerBlock_wordOffsetZero - (slot : Nat) (packed : PackedBits) : + (isTransient : Bool) (slot : Nat) (packed : PackedBits) : BridgedStmt (Compiler.Yul.YulStmt.block [ Compiler.Yul.YulStmt.let_ "__compat_slot_word" - (Compiler.Yul.YulExpr.call "sload" [ + (Compiler.Yul.YulExpr.call (if isTransient then "tload" else "sload") [ Compiler.Yul.YulExpr.call "mappingSlot" [ Compiler.Yul.YulExpr.lit slot, Compiler.Yul.YulExpr.ident "__compat_key"]]), @@ -9654,7 +10093,7 @@ private theorem bridgedStmt_packedInnerBlock_wordOffsetZero Compiler.Yul.YulExpr.call "not" [ Compiler.Yul.YulExpr.lit (packedShiftedMaskNat packed)]]), Compiler.Yul.YulStmt.expr ( - Compiler.Yul.YulExpr.call "sstore" [ + Compiler.Yul.YulExpr.call (if isTransient then "tstore" else "sstore") [ Compiler.Yul.YulExpr.call "mappingSlot" [ Compiler.Yul.YulExpr.lit slot, Compiler.Yul.YulExpr.ident "__compat_key"], @@ -9680,11 +10119,13 @@ private theorem bridgedStmt_packedInnerBlock_wordOffsetZero rcases hMem with rfl | rfl | rfl · -- let_ __compat_slot_word (sload(mappingSlot(lit slot, ident "__compat_key"))) refine BridgedStmt.straight _ (BridgedStraightStmt.let_ _ _ ?_) - apply BridgedExpr.call - · exact Or.inl (by decide) - · intro arg hArg - simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg - subst hArg; exact hMappingBase + cases isTransient + · apply BridgedExpr.call + · exact Or.inl (by decide) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + subst hArg; exact hMappingBase + · exact bridgedExpr_tload _ hMappingBase · -- let_ __compat_slot_cleared (and(ident, not(lit shiftedMaskNat))) refine BridgedStmt.straight _ (BridgedStraightStmt.let_ _ _ ?_) apply BridgedExpr.call @@ -9722,12 +10163,52 @@ private theorem bridgedStmt_packedInnerBlock_wordOffsetZero · subst hArg'; exact BridgedExpr.lit _ · subst hArg'; exact BridgedExpr.ident "__compat_packed" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_mapping + (bridgedStraightStmt_storageStore_mapping isTransient (Compiler.Yul.YulExpr.lit slot) (Compiler.Yul.YulExpr.ident "__compat_key") _ (BridgedExpr.lit slot) (BridgedExpr.ident "__compat_key") hVal) +private theorem bridgedStmt_packedInnerBlock_wordOffsetZero_field + (fields : List Field) (field : String) (slot : Nat) (packed : PackedBits) : + BridgedStmt (Compiler.Yul.YulStmt.block [ + Compiler.Yul.YulStmt.let_ "__compat_slot_word" + (Compiler.Yul.YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tload" else "sload" + | none => "sload") [ + Compiler.Yul.YulExpr.call "mappingSlot" [ + Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"]]), + Compiler.Yul.YulStmt.let_ "__compat_slot_cleared" + (Compiler.Yul.YulExpr.call "and" [ + Compiler.Yul.YulExpr.ident "__compat_slot_word", + Compiler.Yul.YulExpr.call "not" [ + Compiler.Yul.YulExpr.lit (packedShiftedMaskNat packed)]]), + Compiler.Yul.YulStmt.expr ( + Compiler.Yul.YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore") [ + Compiler.Yul.YulExpr.call "mappingSlot" [ + Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"], + Compiler.Yul.YulExpr.call "or" [ + Compiler.Yul.YulExpr.ident "__compat_slot_cleared", + Compiler.Yul.YulExpr.call "shl" [ + Compiler.Yul.YulExpr.lit packed.offset, + Compiler.Yul.YulExpr.ident "__compat_packed"]]])]) := by + cases hField : findFieldWithResolvedSlot fields field with + | none => + simpa [hField] using + bridgedStmt_packedInnerBlock_wordOffsetZero false slot packed + | some found => + cases found with + | mk f resolvedSlot => + cases hTransient : f.isTransient <;> + simpa [hField, hTransient] using + bridgedStmt_packedInnerBlock_wordOffsetZero f.isTransient slot packed + /-- Helper: every element of `slots.map innerBlockFn` satisfies `BridgedStmt` via the single-slot inner-block helper. -/ private theorem bridgedStmts_slotsMap_packedInnerBlock_wordOffsetZero @@ -9759,7 +10240,7 @@ private theorem bridgedStmts_slotsMap_packedInnerBlock_wordOffsetZero rw [List.mem_map] at hMem obtain ⟨slot, _, hEq⟩ := hMem subst hEq - exact bridgedStmt_packedInnerBlock_wordOffsetZero slot packed + exact bridgedStmt_packedInnerBlock_wordOffsetZero false slot packed private theorem yulStmtsContainFuncDef_slotsMap_packedInnerBlock_wordOffsetZero (slots : List Nat) (packed : PackedBits) : @@ -9873,11 +10354,16 @@ theorem compileStmt_setMappingPackedWord_multiSlot_bridged -- After simp unfolds the head of List.map, hMem ranges over -- inner_block(slot0) :: inner_block(slot1) :: slotsRest.map inner_block_fn rcases hMem with rfl | hMem - · exact bridgedStmt_packedInnerBlock_wordOffsetZero slot0 packed + · exact bridgedStmt_packedInnerBlock_wordOffsetZero_field + fields field slot0 packed rcases hMem with rfl | hMem - · exact bridgedStmt_packedInnerBlock_wordOffsetZero slot1 packed - · exact bridgedStmts_slotsMap_packedInnerBlock_wordOffsetZero - slotsRest packed stmt hMem + · exact bridgedStmt_packedInnerBlock_wordOffsetZero_field + fields field slot1 packed + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst hEq + exact bridgedStmt_packedInnerBlock_wordOffsetZero_field + fields field slot packed theorem compileStmt_setMappingPackedWord_multiSlot_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -9908,9 +10394,11 @@ theorem compileStmt_setMappingPackedWord_multiSlot_noFuncDefs hMapping, hPacked, hSlots, Pure.pure, Except.pure] at hOk subst out simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa using - yulStmtsContainFuncDef_slotsMap_packedInnerBlock_wordOffsetZero - slotsRest packed + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot mappingPackedWord-write fragment (wordOffset=0) compiles to Yul satisfying `BridgedStmts`. -/ @@ -9968,10 +10456,10 @@ three-stmt inner block `YulStmt.block [sload-let, cleared-let, sstore-expr]` produced by the multi-slot wordOffset≠0 packed-write shape satisfies `BridgedStmt`. -/ private theorem bridgedStmt_packedInnerBlock_wordOffsetNonzero - (slot wordOffset : Nat) (packed : PackedBits) : + (isTransient : Bool) (slot wordOffset : Nat) (packed : PackedBits) : BridgedStmt (Compiler.Yul.YulStmt.block [ Compiler.Yul.YulStmt.let_ "__compat_slot_word" - (Compiler.Yul.YulExpr.call "sload" [ + (Compiler.Yul.YulExpr.call (if isTransient then "tload" else "sload") [ Compiler.Yul.YulExpr.call "add" [ Compiler.Yul.YulExpr.call "mappingSlot" [ Compiler.Yul.YulExpr.lit slot, @@ -9983,7 +10471,7 @@ private theorem bridgedStmt_packedInnerBlock_wordOffsetNonzero Compiler.Yul.YulExpr.call "not" [ Compiler.Yul.YulExpr.lit (packedShiftedMaskNat packed)]]), Compiler.Yul.YulStmt.expr ( - Compiler.Yul.YulExpr.call "sstore" [ + Compiler.Yul.YulExpr.call (if isTransient then "tstore" else "sstore") [ Compiler.Yul.YulExpr.call "add" [ Compiler.Yul.YulExpr.call "mappingSlot" [ Compiler.Yul.YulExpr.lit slot, @@ -10024,11 +10512,13 @@ private theorem bridgedStmt_packedInnerBlock_wordOffsetNonzero rcases hMem with rfl | rfl | rfl · -- let_ __compat_slot_word (sload(add(mappingSlot, lit wordOffset))) refine BridgedStmt.straight _ (BridgedStraightStmt.let_ _ _ ?_) - apply BridgedExpr.call - · exact Or.inl (by decide) - · intro arg hArg - simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg - subst hArg; exact hWriteSlot + cases isTransient + · apply BridgedExpr.call + · exact Or.inl (by simp [bridgedBuiltins]) + · intro arg hArg + simp only [List.mem_cons, List.not_mem_nil, or_false] at hArg + subst hArg; exact hWriteSlot + · exact bridgedExpr_tload _ hWriteSlot · -- let_ __compat_slot_cleared (and(ident, not(lit shiftedMaskNat))) refine BridgedStmt.straight _ (BridgedStraightStmt.let_ _ _ ?_) apply BridgedExpr.call @@ -10066,21 +10556,66 @@ private theorem bridgedStmt_packedInnerBlock_wordOffsetNonzero · subst hArg'; exact BridgedExpr.lit _ · subst hArg'; exact BridgedExpr.ident "__compat_packed" exact BridgedStmt.straight _ - (BridgedStraightStmt.expr_sstore_add + (bridgedStraightStmt_storageStore_add isTransient (Compiler.Yul.YulExpr.call "mappingSlot" [Compiler.Yul.YulExpr.lit slot, Compiler.Yul.YulExpr.ident "__compat_key"]) (Compiler.Yul.YulExpr.lit wordOffset) _ hMappingBase (BridgedExpr.lit wordOffset) hVal) +private theorem bridgedStmt_packedInnerBlock_wordOffsetNonzero_field + (fields : List Field) (field : String) + (slot wordOffset : Nat) (packed : PackedBits) : + BridgedStmt (Compiler.Yul.YulStmt.block [ + Compiler.Yul.YulStmt.let_ "__compat_slot_word" + (Compiler.Yul.YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tload" else "sload" + | none => "sload") [ + Compiler.Yul.YulExpr.call "add" [ + Compiler.Yul.YulExpr.call "mappingSlot" [ + Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"], + Compiler.Yul.YulExpr.lit wordOffset]]), + Compiler.Yul.YulStmt.let_ "__compat_slot_cleared" + (Compiler.Yul.YulExpr.call "and" [ + Compiler.Yul.YulExpr.ident "__compat_slot_word", + Compiler.Yul.YulExpr.call "not" [ + Compiler.Yul.YulExpr.lit (packedShiftedMaskNat packed)]]), + Compiler.Yul.YulStmt.expr ( + Compiler.Yul.YulExpr.call + (match findFieldWithResolvedSlot fields field with + | some (f, _) => if f.isTransient = true then "tstore" else "sstore" + | none => "sstore") [ + Compiler.Yul.YulExpr.call "add" [ + Compiler.Yul.YulExpr.call "mappingSlot" [ + Compiler.Yul.YulExpr.lit slot, + Compiler.Yul.YulExpr.ident "__compat_key"], + Compiler.Yul.YulExpr.lit wordOffset], + Compiler.Yul.YulExpr.call "or" [ + Compiler.Yul.YulExpr.ident "__compat_slot_cleared", + Compiler.Yul.YulExpr.call "shl" [ + Compiler.Yul.YulExpr.lit packed.offset, + Compiler.Yul.YulExpr.ident "__compat_packed"]]])]) := by + cases hField : findFieldWithResolvedSlot fields field with + | none => + simpa [hField] using + bridgedStmt_packedInnerBlock_wordOffsetNonzero false slot wordOffset packed + | some found => + cases found with + | mk f resolvedSlot => + cases hTransient : f.isTransient <;> + simpa [hField, hTransient] using + bridgedStmt_packedInnerBlock_wordOffsetNonzero f.isTransient slot wordOffset packed + /-- Helper: every element of `slots.map innerBlockFn` (wordOffset ≠ 0) satisfies `BridgedStmt` via the single-slot inner-block helper. -/ private theorem bridgedStmts_slotsMap_packedInnerBlock_wordOffsetNonzero - (slots : List Nat) (wordOffset : Nat) (packed : PackedBits) : + (isTransient : Bool) (slots : List Nat) (wordOffset : Nat) (packed : PackedBits) : ∀ stmt ∈ slots.map (fun slot => Compiler.Yul.YulStmt.block [ Compiler.Yul.YulStmt.let_ "__compat_slot_word" - (Compiler.Yul.YulExpr.call "sload" [ + (Compiler.Yul.YulExpr.call (if isTransient then "tload" else "sload") [ Compiler.Yul.YulExpr.call "add" [ Compiler.Yul.YulExpr.call "mappingSlot" [ Compiler.Yul.YulExpr.lit slot, @@ -10092,7 +10627,7 @@ private theorem bridgedStmts_slotsMap_packedInnerBlock_wordOffsetNonzero Compiler.Yul.YulExpr.call "not" [ Compiler.Yul.YulExpr.lit (packedShiftedMaskNat packed)]]), Compiler.Yul.YulStmt.expr ( - Compiler.Yul.YulExpr.call "sstore" [ + Compiler.Yul.YulExpr.call (if isTransient then "tstore" else "sstore") [ Compiler.Yul.YulExpr.call "add" [ Compiler.Yul.YulExpr.call "mappingSlot" [ Compiler.Yul.YulExpr.lit slot, @@ -10108,7 +10643,7 @@ private theorem bridgedStmts_slotsMap_packedInnerBlock_wordOffsetNonzero rw [List.mem_map] at hMem obtain ⟨slot, _, hEq⟩ := hMem subst hEq - exact bridgedStmt_packedInnerBlock_wordOffsetNonzero slot wordOffset packed + exact bridgedStmt_packedInnerBlock_wordOffsetNonzero isTransient slot wordOffset packed private theorem yulStmtsContainFuncDef_slotsMap_packedInnerBlock_wordOffsetNonzero (slots : List Nat) (wordOffset : Nat) (packed : PackedBits) : @@ -10227,13 +10762,16 @@ theorem compileStmt_setMappingPackedWord_multiSlot_nonzero_bridged · subst hArg; exact BridgedExpr.lit _ -- Remaining: slots.map (inner_block_fn) for slot0 :: slot1 :: slotsRest. rcases hMem with rfl | hMem - · exact bridgedStmt_packedInnerBlock_wordOffsetNonzero slot0 - wordOffset packed + · exact bridgedStmt_packedInnerBlock_wordOffsetNonzero_field + fields field slot0 wordOffset packed rcases hMem with rfl | hMem - · exact bridgedStmt_packedInnerBlock_wordOffsetNonzero slot1 - wordOffset packed - · exact bridgedStmts_slotsMap_packedInnerBlock_wordOffsetNonzero - slotsRest wordOffset packed stmt hMem + · exact bridgedStmt_packedInnerBlock_wordOffsetNonzero_field + fields field slot1 wordOffset packed + · rw [List.mem_map] at hMem + obtain ⟨slot, _, hEq⟩ := hMem + subst hEq + exact bridgedStmt_packedInnerBlock_wordOffsetNonzero_field + fields field slot wordOffset packed theorem compileStmt_setMappingPackedWord_multiSlot_nonzero_noFuncDefs (fields : List Field) (events : List EventDef) (errors : List ErrorDef) @@ -10267,9 +10805,11 @@ theorem compileStmt_setMappingPackedWord_multiSlot_nonzero_noFuncDefs hMapping, hPacked, hSlots, hBeq, Pure.pure, Except.pure] at hOk subst out simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] - simpa using - yulStmtsContainFuncDef_slotsMap_packedInnerBlock_wordOffsetNonzero - slotsRest wordOffset packed + clear hSlots + induction slotsRest with + | nil => simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef] + | cons slot rest ih => + simp [Native.yulStmtContainsFuncDef, Native.yulStmtsContainFuncDef, ih] /-- Each statement in the multi-slot wordOffset≠0 mappingPackedWord-write fragment compiles to Yul satisfying `BridgedStmts`. -/ diff --git a/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanSourceExprClosure.lean b/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanSourceExprClosure.lean index 8c4495d7c..76b19d1bb 100644 --- a/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanSourceExprClosure.lean +++ b/Compiler/Proofs/YulGeneration/Backends/EvmYulLeanSourceExprClosure.lean @@ -574,6 +574,20 @@ private theorem bridgedExpr_sload {slot : YulExpr} (hSlot : BridgedExpr slot) : subst arg exact hSlot +private theorem bridgedExpr_storageLoad (isTransient : Bool) + {slot : YulExpr} (hSlot : BridgedExpr slot) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") [slot]) := by + cases isTransient + · exact bridgedExpr_sload hSlot + · exact bridgedExpr_tload slot hSlot + +private theorem bridgedExpr_storageLoad_lit (isTransient : Bool) (slot : Nat) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [YulExpr.lit slot]) := + bridgedExpr_storageLoad isTransient (BridgedExpr.lit slot) + /-- `mappingSlot(base, key)` is in the native bridged expression fragment whenever both slot arguments are bridged. -/ private theorem bridgedExpr_mappingSlot {base key : YulExpr} @@ -590,6 +604,15 @@ private theorem bridgedExpr_sload_mappingSlot_lit bridgedExpr_sload (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey) +private theorem bridgedExpr_storageLoad_mappingSlot_lit + (isTransient : Bool) (slot : Nat) {key : YulExpr} + (hKey : BridgedExpr key) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key]]) := + bridgedExpr_storageLoad isTransient + (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey) + /-- `sload(add(mappingSlot(lit slot, key), lit wordOffset))` is bridged for bridged keys. -/ private theorem bridgedExpr_sload_mappingSlot_lit_add @@ -604,6 +627,37 @@ private theorem bridgedExpr_sload_mappingSlot_lit_add (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey) (BridgedExpr.lit wordOffset)) +private theorem bridgedExpr_storageLoad_mappingSlot_lit_add + (isTransient : Bool) (slot wordOffset : Nat) {key : YulExpr} + (hKey : BridgedExpr key) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [YulExpr.call "add" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key], + YulExpr.lit wordOffset]]) := + bridgedExpr_storageLoad isTransient + (bridgedExpr_binopBuiltin (by simp [bridgedBuiltins]) + (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey) + (BridgedExpr.lit wordOffset)) + +private theorem bridgedExpr_storageLoad_mappingSlot_lit_offset + (isTransient : Bool) (slot wordOffset : Nat) {key : YulExpr} + (hKey : BridgedExpr key) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [if wordOffset = 0 then + YulExpr.call "mappingSlot" [YulExpr.lit slot, key] + else + YulExpr.call "add" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key], + YulExpr.lit wordOffset]]) := by + by_cases hOffset : wordOffset = 0 + · simp [hOffset] + exact bridgedExpr_storageLoad_mappingSlot_lit isTransient slot hKey + · simp [hOffset] + exact bridgedExpr_storageLoad_mappingSlot_lit_add + isTransient slot wordOffset hKey + /-- `sload(mappingSlot(mappingSlot(lit slot, key1), key2))` is bridged for bridged nested mapping keys. -/ private theorem bridgedExpr_sload_mappingSlot2_lit @@ -618,6 +672,18 @@ private theorem bridgedExpr_sload_mappingSlot2_lit (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey1) hKey2) +private theorem bridgedExpr_storageLoad_mappingSlot2_lit + (isTransient : Bool) (slot : Nat) {key1 key2 : YulExpr} + (hKey1 : BridgedExpr key1) (hKey2 : BridgedExpr key2) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2]]) := + bridgedExpr_storageLoad isTransient + (bridgedExpr_mappingSlot + (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey1) + hKey2) + /-- `sload(add(mappingSlot(mappingSlot(lit slot, key1), key2), lit wordOffset))` is bridged for bridged nested mapping keys. -/ private theorem bridgedExpr_sload_mappingSlot2_lit_add @@ -636,6 +702,93 @@ private theorem bridgedExpr_sload_mappingSlot2_lit_add hKey2) (BridgedExpr.lit wordOffset)) +private theorem bridgedExpr_storageLoad_mappingSlot2_lit_add + (isTransient : Bool) (slot wordOffset : Nat) {key1 key2 : YulExpr} + (hKey1 : BridgedExpr key1) (hKey2 : BridgedExpr key2) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [YulExpr.call "add" + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2], + YulExpr.lit wordOffset]]) := + bridgedExpr_storageLoad isTransient + (bridgedExpr_binopBuiltin (by simp [bridgedBuiltins]) + (bridgedExpr_mappingSlot + (bridgedExpr_mappingSlot (BridgedExpr.lit slot) hKey1) + hKey2) + (BridgedExpr.lit wordOffset)) + +private theorem bridgedExpr_storageLoad_mappingSlot2_lit_offset + (isTransient : Bool) (slot wordOffset : Nat) {key1 key2 : YulExpr} + (hKey1 : BridgedExpr key1) (hKey2 : BridgedExpr key2) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [if wordOffset = 0 then + YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2] + else + YulExpr.call "add" + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2], + YulExpr.lit wordOffset]]) := by + by_cases hOffset : wordOffset = 0 + · simp [hOffset] + exact bridgedExpr_storageLoad_mappingSlot2_lit + isTransient slot hKey1 hKey2 + · simp [hOffset] + exact bridgedExpr_storageLoad_mappingSlot2_lit_add + isTransient slot wordOffset hKey1 hKey2 + +private theorem bridgedExpr_resolvedStorageLoad_mappingSlot2_lit + (fields : List CompilationModel.Field) (fieldName : String) + (slot : Nat) {key1 key2 : YulExpr} + (hKey1 : BridgedExpr key1) (hKey2 : BridgedExpr key2) : + BridgedExpr + (YulExpr.call + (match findFieldWithResolvedSlot fields fieldName with + | some (f, _) => if f.isTransient then "tload" else "sload" + | none => "sload") + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2]]) := by + cases hResolved : findFieldWithResolvedSlot fields fieldName with + | none => + simpa [hResolved] using + bridgedExpr_storageLoad_mappingSlot2_lit false slot hKey1 hKey2 + | some resolved => + cases resolved with + | mk f resolvedSlot => + simpa [hResolved] using + bridgedExpr_storageLoad_mappingSlot2_lit f.isTransient slot hKey1 hKey2 + +private theorem bridgedExpr_resolvedStorageLoad_mappingSlot2_lit_offset + (fields : List CompilationModel.Field) (fieldName : String) + (slot wordOffset : Nat) {key1 key2 : YulExpr} + (hKey1 : BridgedExpr key1) (hKey2 : BridgedExpr key2) : + BridgedExpr + (YulExpr.call + (match findFieldWithResolvedSlot fields fieldName with + | some (f, _) => if f.isTransient then "tload" else "sload" + | none => "sload") + [if wordOffset = 0 then + YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2] + else + YulExpr.call "add" + [YulExpr.call "mappingSlot" + [YulExpr.call "mappingSlot" [YulExpr.lit slot, key1], key2], + YulExpr.lit wordOffset]]) := by + cases hResolved : findFieldWithResolvedSlot fields fieldName with + | none => + simpa [hResolved] using + bridgedExpr_storageLoad_mappingSlot2_lit_offset + false slot wordOffset hKey1 hKey2 + | some resolved => + cases resolved with + | mk f resolvedSlot => + simpa [hResolved] using + bridgedExpr_storageLoad_mappingSlot2_lit_offset + f.isTransient slot wordOffset hKey1 hKey2 + /-- A `foldl mappingSlot` chain over bridged key expressions stays in the native bridged expression fragment. -/ private theorem bridgedExpr_foldl_mappingSlot @@ -670,6 +823,37 @@ private theorem bridgedExpr_sload_mappingSlotChain_lit exact bridgedExpr_sload (bridgedExpr_foldl_mappingSlot keys (BridgedExpr.lit slot) hKeys) +private theorem bridgedExpr_storageLoad_mappingSlotChain_lit + (isTransient : Bool) (slot : Nat) (keys : List YulExpr) + (hKeys : ∀ key ∈ keys, BridgedExpr key) : + BridgedExpr + (YulExpr.call (if isTransient then "tload" else "sload") + [compileMappingSlotChain (YulExpr.lit slot) keys]) := by + unfold compileMappingSlotChain + exact bridgedExpr_storageLoad isTransient + (bridgedExpr_foldl_mappingSlot keys (BridgedExpr.lit slot) hKeys) + +private theorem bridgedExpr_resolvedStorageLoad_mappingSlotChain_lit + (fields : List CompilationModel.Field) (fieldName : String) + (slot : Nat) (keys : List YulExpr) + (hKeys : ∀ key ∈ keys, BridgedExpr key) : + BridgedExpr + (YulExpr.call + (match findFieldWithResolvedSlot fields fieldName with + | some (f, _) => if f.isTransient then "tload" else "sload" + | none => "sload") + [compileMappingSlotChain (YulExpr.lit slot) keys]) := by + cases hResolved : findFieldWithResolvedSlot fields fieldName with + | none => + simpa [hResolved] using + bridgedExpr_storageLoad_mappingSlotChain_lit false slot keys hKeys + | some resolved => + cases resolved with + | mk f resolvedSlot => + simpa [hResolved] using + bridgedExpr_storageLoad_mappingSlotChain_lit + f.isTransient slot keys hKeys + /-- The compiler's singleton mapping-read helper emits only native-bridged Yul when field lookup succeeds and the key expression is bridged. @@ -686,15 +870,12 @@ private theorem compileMappingSlotRead_bridged split at hOk · simp at hOk · split at hOk - · rename_i slot hFind + · rename_i f slot hFind dsimp at hOk - split at hOk - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_sload_mappingSlot_lit slot hKey - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_sload_mappingSlot_lit_add slot wordOffset hKey + simp [Pure.pure, Except.pure] at hOk + subst out + exact bridgedExpr_storageLoad_mappingSlot_lit_offset + f.isTransient slot wordOffset hKey · simp at hOk /-- ADT tag reads compile to `and(sload(baseSlot), 0xff)`. -/ @@ -842,11 +1023,12 @@ theorem compileExpr_bridgedSource | none => simp [hPacked, Pure.pure, Except.pure] at hOk subst out - exact bridgedExpr_sload_lit slot + exact bridgedExpr_storageLoad_lit f.isTransient slot | some packed => simp [hPacked, Pure.pure, Except.pure] at hOk subst out - exact bridgedExpr_packed_sload_lit slot packed.offset + exact bridgedExpr_packed_read + (bridgedExpr_storageLoad_lit f.isTransient slot) packed.offset (packedMaskNat packed) · simp at hOk | storageAddr fieldName => @@ -862,11 +1044,12 @@ theorem compileExpr_bridgedSource | none => simp [hTy, hPacked, Pure.pure, Except.pure] at hOk subst out - exact bridgedExpr_sload_lit slot + exact bridgedExpr_storageLoad_lit f.isTransient slot | some packed => simp [hTy, hPacked, Pure.pure, Except.pure] at hOk subst out - exact bridgedExpr_packed_sload_lit slot packed.offset + exact bridgedExpr_packed_read + (bridgedExpr_storageLoad_lit f.isTransient slot) packed.offset (packedMaskNat packed) | uint256 | dynamicArray | mappingTyped | mappingStruct | mappingStruct2 | adt => @@ -939,7 +1122,7 @@ theorem compileExpr_bridgedSource split at hOk · simp at hOk · split at hOk - · rename_i slot hFind + · rename_i f slot hFind simp only [bind, Except.bind] at hOk cases hCompiledKey1 : compileExprWithInternals fields src [] _ with | error err => @@ -955,8 +1138,10 @@ theorem compileExpr_bridgedSource rw [hCompiledKey2] at hOk simp [Pure.pure, Except.pure] at hOk subst out - exact bridgedExpr_sload_mappingSlot2_lit slot - (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2) + simpa [hFind] using + (bridgedExpr_resolvedStorageLoad_mappingSlot2_lit + fields fieldName slot + (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2)) · simp at hOk | mapping2Word fieldName hKey1 hKey2 wordOffset ihKey1 ihKey2 => intro out hOk @@ -964,7 +1149,7 @@ theorem compileExpr_bridgedSource split at hOk · simp at hOk · split at hOk - · rename_i slot hFind + · rename_i f slot hFind simp only [bind, Except.bind] at hOk cases hCompiledKey1 : compileExprWithInternals fields src [] _ with | error err => @@ -979,15 +1164,12 @@ theorem compileExpr_bridgedSource | ok keyExpr2 => rw [hCompiledKey2] at hOk dsimp at hOk - split at hOk - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_sload_mappingSlot2_lit slot - (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2) - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_sload_mappingSlot2_lit_add slot wordOffset - (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2) + simp [Pure.pure, Except.pure] at hOk + subst out + simpa [hFind] using + (bridgedExpr_resolvedStorageLoad_mappingSlot2_lit_offset + fields fieldName slot wordOffset + (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2)) · simp at hOk | structMember fieldName hKey memberName ihKey => intro out hOk @@ -1045,7 +1227,7 @@ theorem compileExpr_bridgedSource · simp at hOk · rename_i member hMember split at hOk - · rename_i slot hFindSlot + · rename_i f slot hFindSlot cases hCompiledKey1 : compileExprWithInternals fields src [] _ with | error err => rw [hCompiledKey1] at hOk @@ -1062,33 +1244,23 @@ theorem compileExpr_bridgedSource | none => rw [hPacked] at hOk simp at hOk - split at hOk - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_sload_mappingSlot2_lit slot - (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2) - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_sload_mappingSlot2_lit_add slot - member.wordOffset - (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2) + simp [Pure.pure, Except.pure] at hOk + subst out + simpa [hFindSlot] using + (bridgedExpr_resolvedStorageLoad_mappingSlot2_lit_offset + fields fieldName slot member.wordOffset + (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2)) | some packed => rw [hPacked] at hOk simp at hOk - split at hOk - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_packed_read - (bridgedExpr_sload_mappingSlot2_lit slot - (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2)) - packed.offset (packedMaskNat packed) - · simp [Pure.pure, Except.pure] at hOk - subst out - exact bridgedExpr_packed_read - (bridgedExpr_sload_mappingSlot2_lit_add slot - member.wordOffset + simp [Pure.pure, Except.pure] at hOk + subst out + simpa [hFindSlot] using + (bridgedExpr_packed_read + (bridgedExpr_resolvedStorageLoad_mappingSlot2_lit_offset + fields fieldName slot member.wordOffset (ihKey1 hCompiledKey1) (ihKey2 hCompiledKey2)) - packed.offset (packedMaskNat packed) + packed.offset (packedMaskNat packed)) · simp at hOk | caller => intro out hOk @@ -1699,14 +1871,15 @@ theorem compileExpr_mappingChain_bridgedSource split at hOk · simp at hOk · split at hOk - · rename_i slot hFind + · rename_i f slot hFind cases hCompiledKeys : compileExprListWithInternals fields src [] keys with | error err => simp [bind, Except.bind, hCompiledKeys] at hOk | ok keyExprs => simp [bind, Except.bind, hCompiledKeys, Pure.pure, Except.pure] at hOk subst out - exact bridgedExpr_sload_mappingSlotChain_lit slot keyExprs + exact bridgedExpr_storageLoad_mappingSlotChain_lit + f.isTransient slot keyExprs (compileExprList_bridgedSource fields src hKeys hCompiledKeys) · simp at hOk diff --git a/Contracts/Smoke/Storage.lean b/Contracts/Smoke/Storage.lean index 8d6593dbc..b4bcf56e9 100644 --- a/Contracts/Smoke/Storage.lean +++ b/Contracts/Smoke/Storage.lean @@ -18,6 +18,22 @@ verity_contract UintMapSmoke where let current ← getMappingUint values key return current +verity_contract TransientStorageSmoke where + storage + transient lock : Uint256 := slot 0 + + function setLock (value : Uint256) : Unit := do + setStorage lock value + + function getLock () : Uint256 := do + let current ← getStorage lock + return current + +example : + TransientStorageSmoke.spec.fields.all (fun field => + if field.name == "lock" then field.isTransient else true) := by + decide + verity_contract MappingChainSmoke where storage approvals : Address → Address → Address → Uint256 := slot 0 diff --git a/PrintAxioms.lean b/PrintAxioms.lean index 54df77c4f..b22ecb997 100644 --- a/PrintAxioms.lean +++ b/PrintAxioms.lean @@ -1656,6 +1656,14 @@ end Verity.AxiomAudit Compiler.Proofs.Frames.writeStorageWordSlots_preserves_storage_except Compiler.Proofs.Frames.writeStorageWordSlots_preserves_address_except Compiler.Proofs.Frames.writeAddressSlots_preserves_address_except + Compiler.Proofs.Frames.writeUintFieldSlots_preserves_storage_except + Compiler.Proofs.Frames.writeUintFieldSlots_preserves_address + Compiler.Proofs.Frames.writeUintFieldSlots_preserves_arrays + Compiler.Proofs.Frames.writeUintFieldSlots_preserves_calldata + Compiler.Proofs.Frames.writeAddressFieldSlots_preserves_address_except + Compiler.Proofs.Frames.writeAddressFieldSlots_preserves_storage + Compiler.Proofs.Frames.writeAddressFieldSlots_preserves_arrays + Compiler.Proofs.Frames.writeAddressFieldSlots_preserves_calldata Compiler.Proofs.Frames.writeStorageArray_preserves_arrays_except Compiler.Proofs.Frames.execStmt_setStorage_execution_summary Compiler.Proofs.Frames.execStmt_setStorageAddr_execution_summary @@ -1793,6 +1801,11 @@ end Verity.AxiomAudit Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeUintKeyedMappingSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMapping2Slots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.fieldIsTransient_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeTransientTargets_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingFieldSlots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeUintKeyedMappingFieldSlots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMapping2FieldSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.wordNormalize_eq Compiler.Proofs.IRGeneration.DenoteAgreement.bindValue_eq Compiler.Proofs.IRGeneration.DenoteAgreement.valuesAsEventArgs_eq @@ -1801,9 +1814,13 @@ end Verity.AxiomAudit Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingWordSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingPackedWordSlots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingPackedWordFieldSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMapping2WordSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMapping2PackedWordSlots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMapping2PackedWordFieldSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingChainSlots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMappingWordFieldSlots_eq + Compiler.Proofs.IRGeneration.DenoteAgreement.writeAddressKeyedMapping2WordFieldSlots_eq Compiler.Proofs.IRGeneration.DenoteAgreement.writeStorageArray_eq Compiler.Proofs.IRGeneration.DenoteAgreement.packedBitsValid_eq Compiler.Proofs.IRGeneration.DenoteAgreement.execForEachLoop_agree @@ -2772,6 +2789,7 @@ end Verity.AxiomAudit -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeAddressSlot -- private -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeUintSlots -- private -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeUintKeyedMappingSlot -- private + -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeTransientTarget -- private -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeAddressKeyedMappingChainSlot -- private -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeAddressKeyedMappingSlot -- private -- Compiler.Proofs.IRGeneration.runtimeStateMatchesIR_writeAddressKeyedMappingWordSlot -- private @@ -2791,6 +2809,7 @@ end Verity.AxiomAudit -- Compiler.Proofs.IRGeneration.validateIdentifierShapes_fieldName_ne_reservedScratch -- private -- Compiler.Proofs.IRGeneration.scopeAvoidsReservedCompilerPrefix_of_validateIdentifierShapes -- private -- Compiler.Proofs.IRGeneration.findFieldWriteSlots_of_findFieldWithResolvedSlot -- private + -- Compiler.Proofs.IRGeneration.findFieldWithResolvedSlot_of_findFieldWriteSlots_singleton -- private Compiler.Proofs.IRGeneration.compiledStmtStep_setStorage_singleSlot -- Compiler.Proofs.IRGeneration.compiledStmtStep_setStorageAddr_singleSlot_preserves -- private Compiler.Proofs.IRGeneration.compiledStmtStep_setStorageAddr_singleSlot @@ -2807,6 +2826,11 @@ end Verity.AxiomAudit Compiler.Proofs.IRGeneration.eval_compileExprList_core_of_scope -- Compiler.Proofs.IRGeneration.evalIRExpr_mappingSlotChain -- private -- Compiler.Proofs.IRGeneration.execIRStmt_sstore_of_eval -- private + -- Compiler.Proofs.IRGeneration.execIRStmt_tstore_of_eval -- private + -- Compiler.Proofs.IRGeneration.evalIRExpr_mappingWordTarget_of_eval -- private + -- Compiler.Proofs.IRGeneration.evalIRExpr_mappingSlot2_of_eval -- private + -- Compiler.Proofs.IRGeneration.evalIRExpr_mappingSlot2_add_of_eval -- private + -- Compiler.Proofs.IRGeneration.evalIRExpr_mapping2WordTarget_of_eval -- private -- Compiler.Proofs.IRGeneration.execIRStmt_sstore_foldl_mappingSlot -- private -- Compiler.Proofs.IRGeneration.compiledStmtStep_setMappingChain_singleSlot_of_slotSafety_preserves -- private Compiler.Proofs.IRGeneration.compiledStmtStep_setMappingChain_singleSlot_of_slotSafety @@ -3627,6 +3651,18 @@ end Verity.AxiomAudit Compiler.Proofs.StorageBounds.writeStorageArray_events_unchanged -- Compiler/Proofs/YulGeneration/Backends/EvmYulLeanBodyClosure/Base.lean + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_mappingSlot_local -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_add_local -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_storageStore_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_storageStore_mapping -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_storageStore_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_local -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_fieldStorageLoad -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_fieldStorageStore_mapping -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_fieldStorageStore_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_fieldStorageStore_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_maybeFieldStorageStore_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStraightStmt_maybeFieldStorageStore_mapping -- private Compiler.Proofs.YulGeneration.Backends.isDynamicParamType_false_of_static_scalar -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_calldataload_lit -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_and_lit_mask -- private @@ -3885,6 +3921,7 @@ end Verity.AxiomAudit Compiler.Proofs.YulGeneration.Backends.compileStmt_mappingPackedWordNonzero_bridged Compiler.Proofs.YulGeneration.Backends.compileStmt_mappingPackedWordNonzero_noFuncDefs -- Compiler.Proofs.YulGeneration.Backends.bridgedStmt_packedInnerBlock_wordOffsetZero -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStmt_packedInnerBlock_wordOffsetZero_field -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedStmts_slotsMap_packedInnerBlock_wordOffsetZero -- private -- Compiler.Proofs.YulGeneration.Backends.yulStmtsContainFuncDef_slotsMap_packedInnerBlock_wordOffsetZero -- private Compiler.Proofs.YulGeneration.Backends.compileStmt_setMappingPackedWord_multiSlot_bridged @@ -3892,6 +3929,7 @@ end Verity.AxiomAudit Compiler.Proofs.YulGeneration.Backends.compileStmt_mappingPackedWordMultiSlot_bridged Compiler.Proofs.YulGeneration.Backends.compileStmt_mappingPackedWordMultiSlot_noFuncDefs -- Compiler.Proofs.YulGeneration.Backends.bridgedStmt_packedInnerBlock_wordOffsetNonzero -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedStmt_packedInnerBlock_wordOffsetNonzero_field -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedStmts_slotsMap_packedInnerBlock_wordOffsetNonzero -- private -- Compiler.Proofs.YulGeneration.Backends.yulStmtsContainFuncDef_slotsMap_packedInnerBlock_wordOffsetNonzero -- private Compiler.Proofs.YulGeneration.Backends.compileStmt_setMappingPackedWord_multiSlot_nonzero_bridged @@ -5551,13 +5589,25 @@ end Verity.AxiomAudit -- Compiler.Proofs.YulGeneration.Backends.compileExpr_unopBuiltin_ok -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload_lit -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_lit -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_mappingSlot -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload_mappingSlot_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlot_lit -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload_mappingSlot_lit_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlot_lit_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlot_lit_offset -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload_mappingSlot2_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlot2_lit -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload_mappingSlot2_lit_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlot2_lit_add -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlot2_lit_offset -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_resolvedStorageLoad_mappingSlot2_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_resolvedStorageLoad_mappingSlot2_lit_offset -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_foldl_mappingSlot -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_sload_mappingSlotChain_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_storageLoad_mappingSlotChain_lit -- private + -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_resolvedStorageLoad_mappingSlotChain_lit -- private -- Compiler.Proofs.YulGeneration.Backends.compileMappingSlotRead_bridged -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_adtTagRead_lit -- private -- Compiler.Proofs.YulGeneration.Backends.bridgedExpr_adtFieldRead_lit -- private @@ -5624,4 +5674,4 @@ end Verity.AxiomAudit Compiler.Proofs.YulGeneration.YulTransaction.ofIR_args ] --- Total: 5266 theorems/lemmas (3645 public, 1621 private, 0 sorry'd) +-- Total: 5316 theorems/lemmas (3662 public, 1654 private, 0 sorry'd) diff --git a/Verity/Core/Model/Denote.lean b/Verity/Core/Model/Denote.lean index 77ebc3f18..ddf0e62eb 100644 --- a/Verity/Core/Model/Denote.lean +++ b/Verity/Core/Model/Denote.lean @@ -281,6 +281,61 @@ def writeAddressSlots (world : Verity.ContractState) (slots : List Nat) (value : storageAddr := fun slot => if targets.contains slot then addr else world.storageAddr slot } +def fieldIsTransient (fields : List Field) (name : String) : Bool := + match findFieldWithResolvedSlot fields name with + | some (field, _) => field.isTransient + | none => false + +def readFieldWord (world : Verity.ContractState) (field : Field) (slot : Nat) : + Verity.Core.Uint256 := + if field.isTransient then + world.readTransient (wordNormalize slot) + else + world.readSlot (wordNormalize slot) + +def writeTransientTargets (world : Verity.ContractState) (targets : List Nat) (value : Nat) : + Verity.ContractState := + let word : Verity.Core.Uint256 := value + let targets := targets.map wordNormalize + { world with + transientStorage := fun slot => + if targets.contains slot then word else world.transientStorage slot } + +def writeUintFieldSlots (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world slots value + else + writeUintSlots world slots value + +def writeStorageWordFieldSlots (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (wordOffset value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world (slots.map (fun slot => slot + wordOffset)) value + else + writeStorageWordSlots world slots wordOffset value + +def writeAddressFieldSlots (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world slots (Verity.wordToAddress (value : Verity.Core.Uint256)).val + else + writeAddressSlots world slots value + +def writeMappingTargets (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (targets : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + writeTransientTargets world targets value + else + let word : Verity.Core.Uint256 := value + { world with + storage := fun slot => + if targets.map wordNormalize |>.contains slot then word else world.storage slot } + /-- Nat-level rendering of `Compiler.Proofs.abstractStoreMappingEntry` over a word-normalized storage view (see header note 3). -/ def storeMappingEntryNat (oracle : DenoteOracle) @@ -358,6 +413,23 @@ def writeAddressKeyedMappingPackedWordSlots (oracle : DenoteOracle) else world.storage slot } +def writeAddressKeyedMappingPackedWordFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key wordOffset : Nat) + (packed : PackedBits) (value : Nat) : + Verity.ContractState := + let targets := slots.map (fun slot => wordNormalize (oracle.mappingSlot slot key + wordOffset)) + if fieldIsTransient fields fieldName then + let wordAt := fun slot => (world.transientStorage slot).val + let updated := targets.map (fun slot => (slot, packedWordWrite (wordAt slot) value packed)) + { world with + transientStorage := fun slot => + match updated.find? (fun entry => entry.fst == slot) with + | some (_, word) => word + | none => world.transientStorage slot } + else + writeAddressKeyedMappingPackedWordSlots oracle world slots key wordOffset packed value + def writeUintKeyedMappingSlots (oracle : DenoteOracle) (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : Verity.ContractState := @@ -411,6 +483,62 @@ def writeAddressKeyedMapping2WordSlots (oracle : DenoteOracle) storage := fun slot => if targets.contains slot then word else world.storage slot } +def writeAddressKeyedMappingWordFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key wordOffset value : Nat) : + Verity.ContractState := + let targets := slots.map (fun slot => wordNormalize (oracle.mappingSlot slot key + wordOffset)) + writeMappingTargets fields fieldName world targets value + +def writeAddressKeyedMappingFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := slots.map (fun slot => wordNormalize (oracle.mappingSlot slot key)) + writeTransientTargets world targets value + else + writeAddressKeyedMappingSlots oracle world slots key value + +def writeAddressKeyedMappingChainFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots keys : List Nat) (value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := slots.map (fun slot => wordNormalize (keys.foldl oracle.mappingSlot slot)) + writeTransientTargets world targets value + else + writeAddressKeyedMappingChainSlots oracle world slots keys value + +def writeAddressKeyedMapping2WordFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key1 key2 wordOffset value : Nat) : + Verity.ContractState := + let targets := slots.map (fun slot => + wordNormalize (oracle.mappingSlot (oracle.mappingSlot slot key1) key2 + wordOffset)) + writeMappingTargets fields fieldName world targets value + +def writeUintKeyedMappingFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := slots.map (fun slot => wordNormalize (oracle.mappingSlot slot key)) + writeTransientTargets world targets value + else + writeUintKeyedMappingSlots oracle world slots key value + +def writeAddressKeyedMapping2FieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key1 key2 value : Nat) : + Verity.ContractState := + if fieldIsTransient fields fieldName then + let targets := slots.map (fun slot => + wordNormalize (oracle.mappingSlot (oracle.mappingSlot slot key1) key2)) + writeTransientTargets world targets value + else + writeAddressKeyedMapping2Slots oracle world slots key1 key2 value + def writeAddressKeyedMapping2PackedWordSlots (oracle : DenoteOracle) (world : Verity.ContractState) (slots : List Nat) (key1 key2 wordOffset : Nat) (packed : PackedBits) (value : Nat) : @@ -425,6 +553,24 @@ def writeAddressKeyedMapping2PackedWordSlots (oracle : DenoteOracle) else world.storage slot } +def writeAddressKeyedMapping2PackedWordFieldSlots (oracle : DenoteOracle) + (fields : List Field) (fieldName : String) + (world : Verity.ContractState) (slots : List Nat) (key1 key2 wordOffset : Nat) + (packed : PackedBits) (value : Nat) : + Verity.ContractState := + let targets := slots.map (fun slot => + wordNormalize (oracle.mappingSlot (oracle.mappingSlot slot key1) key2 + wordOffset)) + if fieldIsTransient fields fieldName then + let wordAt := fun slot => (world.transientStorage slot).val + let updated := targets.map (fun slot => (slot, packedWordWrite (wordAt slot) value packed)) + { world with + transientStorage := fun slot => + match updated.find? (fun entry => entry.fst == slot) with + | some (_, word) => word + | none => world.transientStorage slot } + else + writeAddressKeyedMapping2PackedWordSlots oracle world slots key1 key2 wordOffset packed value + def storageArraySetAt : List Verity.Core.Uint256 → Nat → Verity.Core.Uint256 → Option (List Verity.Core.Uint256) | [], _, _ => none @@ -467,11 +613,15 @@ def evalExpr (oracle : DenoteOracle) (fields : List Field) (state : DenoteState) | .immutable name => some (state.immutable name).val | .storage fieldName => match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.readSlot (wordNormalize slot)).val + | some (field, slot) => some (readFieldWord state.world field slot).val | none => none | .storageAddr fieldName => match findFieldWithResolvedSlot fields fieldName with - | some (_, slot) => some (state.world.readAddrSlot (wordNormalize slot)).val + | some (field, slot) => + if field.isTransient then + some (state.world.readTransient (wordNormalize slot)).val + else + some (state.world.readAddrSlot (wordNormalize slot)).val | none => none | .storageArrayLength fieldName => match findFieldWithResolvedSlot fields fieldName with @@ -653,50 +803,50 @@ def evalExpr (oracle : DenoteOracle) (fields : List Field) (state : DenoteState) (Verity.Core.Uint256.ofNat value)).val | .mapping field key => do let keyVal ← evalExpr oracle fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.readSlot (oracle.mappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (oracle.mappingSlot slot keyVal)).val | none => none | .mappingWord field key wordOffset => do let keyVal ← evalExpr oracle fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.readSlot + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (wordNormalize (oracle.mappingSlot slot keyVal + wordOffset))).val | none => none | .mappingUint field key => do let keyVal ← evalExpr oracle fields state key - match findFieldSlot fields field with - | some slot => - some (state.world.readSlot (oracle.mappingSlot slot keyVal)).val + match findFieldWithResolvedSlot fields field with + | some (field, slot) => + some (readFieldWord state.world field (oracle.mappingSlot slot keyVal)).val | none => none | .mapping2 field key1 key2 => do let key1Val ← evalExpr oracle fields state key1 let key2Val ← evalExpr oracle fields state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := oracle.mappingSlot slot key1Val - some (state.world.readSlot (oracle.mappingSlot innerSlot key2Val)).val + some (readFieldWord state.world field (oracle.mappingSlot innerSlot key2Val)).val | none => none | .mapping2Word field key1 key2 wordOffset => do let key1Val ← evalExpr oracle fields state key1 let key2Val ← evalExpr oracle fields state key2 - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (field, slot) => let innerSlot := oracle.mappingSlot slot key1Val let outerSlot := oracle.mappingSlot innerSlot key2Val - some (state.world.readSlot (wordNormalize (outerSlot + wordOffset))).val + some (readFieldWord state.world field (wordNormalize (outerSlot + wordOffset))).val | none => none -- mappingChain reads: deferred, exactly as in SourceSemantics. | .structMember field key memberName => do let keyVal ← evalExpr oracle fields state key - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let targetSlot := wordNormalize (oracle.mappingSlot slot keyVal + member.wordOffset) - let rawWord := (state.world.readSlot targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -708,14 +858,14 @@ def evalExpr (oracle : DenoteOracle) (fields : List Field) (state : DenoteState) | .structMember2 field key1 key2 memberName => do let key1Val ← evalExpr oracle fields state key1 let key2Val ← evalExpr oracle fields state key2 - match findFieldSlot fields field, findStructMembers fields field with - | some slot, some members => + match findFieldWithResolvedSlot fields field, findStructMembers fields field with + | some (fieldInfo, slot), some members => match findStructMember members memberName with | some member => let innerSlot := oracle.mappingSlot slot key1Val let outerSlot := oracle.mappingSlot innerSlot key2Val let targetSlot := wordNormalize (outerSlot + member.wordOffset) - let rawWord := (state.world.readSlot targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val match member.packed with | none => some rawWord | some packed => @@ -726,11 +876,11 @@ def evalExpr (oracle : DenoteOracle) (fields : List Field) (state : DenoteState) | _, _ => none | .mappingPackedWord field key wordOffset packed => do let keyVal ← evalExpr oracle fields state key - match findFieldSlot fields field with - | some slot => + match findFieldWithResolvedSlot fields field with + | some (fieldInfo, slot) => let targetSlot := wordNormalize (oracle.mappingSlot slot keyVal + wordOffset) - let rawWord := (state.world.readSlot targetSlot).val + let rawWord := (readFieldWord state.world fieldInfo targetSlot).val some (Verity.Core.Uint256.and (Verity.Core.Uint256.shr packed.offset rawWord) (packedMaskNat packed)).val @@ -795,14 +945,14 @@ mutual | state, .setStorage fieldName value => match findFieldWriteSlots fields fieldName, evalExpr oracle fields state value with | some slots, some resolved => - .continue { state with world := writeUintSlots state.world slots resolved } + .continue { state with world := writeUintFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | state, .setStorageWord fieldName wordOffset value => match findFieldWriteSlots fields fieldName, evalExpr oracle fields state value with | some slots, some resolved => .continue { state with - world := writeStorageWordSlots state.world slots wordOffset resolved } + world := writeStorageWordFieldSlots fields fieldName state.world slots wordOffset resolved } | _, _ => .revert | state, .setMapping fieldName key value => match findFieldWriteSlots fields fieldName, @@ -811,8 +961,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingSlots oracle - state.world slots resolvedKey resolved } + world := writeAddressKeyedMappingFieldSlots + oracle fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | state, .setMappingWord fieldName key wordOffset value => match findFieldWriteSlots fields fieldName, @@ -821,8 +971,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeAddressKeyedMappingWordSlots oracle - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + oracle fields fieldName state.world slots resolvedKey wordOffset resolved } | _, _, _ => .revert | state, .setMappingPackedWord fieldName key wordOffset packed value => match findFieldWriteSlots fields fieldName, @@ -832,8 +982,8 @@ mutual if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots oracle - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots oracle + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _, _, _ => .revert @@ -847,14 +997,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMappingWordSlots oracle - state.world slots resolvedKey wordOffset resolved } + world := writeAddressKeyedMappingWordFieldSlots + oracle fields fieldName state.world slots resolvedKey wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMappingPackedWordSlots oracle - state.world slots resolvedKey wordOffset packed resolved } + world := writeAddressKeyedMappingPackedWordFieldSlots oracle + fields fieldName state.world slots resolvedKey wordOffset packed resolved } else .revert | _ => .revert @@ -868,12 +1018,8 @@ mutual .continue { state with world := - writeAddressKeyedMapping2Slots oracle - state.world - slots - resolvedKey1 - resolvedKey2 - resolved } + writeAddressKeyedMapping2FieldSlots + oracle fields fieldName state.world slots resolvedKey1 resolvedKey2 resolved } | _, _, _, _ => .revert | state, .setMapping2Word fieldName key1 key2 wordOffset value => match findFieldWriteSlots fields fieldName, @@ -884,7 +1030,9 @@ mutual .continue { state with world := - writeAddressKeyedMapping2WordSlots oracle + writeAddressKeyedMapping2WordFieldSlots oracle + fields + fieldName state.world slots resolvedKey1 @@ -903,14 +1051,14 @@ mutual | some { wordOffset := wordOffset, packed := none, .. } => .continue { state with - world := writeAddressKeyedMapping2WordSlots oracle - state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } + world := writeAddressKeyedMapping2WordFieldSlots + oracle fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset resolved } | some { wordOffset := wordOffset, packed := some packed, .. } => if packedBitsValid packed then .continue { state with - world := writeAddressKeyedMapping2PackedWordSlots oracle - state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } + world := writeAddressKeyedMapping2PackedWordFieldSlots oracle + fields fieldName state.world slots resolvedKey1 resolvedKey2 wordOffset packed resolved } else .revert | _ => .revert @@ -922,8 +1070,8 @@ mutual | some slots@(_ :: _), some resolvedKey, some resolved => .continue { state with - world := writeUintKeyedMappingSlots oracle - state.world slots resolvedKey resolved } + world := writeUintKeyedMappingFieldSlots + oracle fields fieldName state.world slots resolvedKey resolved } | _, _, _ => .revert | state, .setMappingChain fieldName keys value => match findFieldWriteSlots fields fieldName, @@ -932,8 +1080,8 @@ mutual | some slots@(_ :: _), some resolvedKeys, some resolved => .continue { state with - world := writeAddressKeyedMappingChainSlots oracle - state.world slots resolvedKeys resolved } + world := writeAddressKeyedMappingChainFieldSlots + oracle fields fieldName state.world slots resolvedKeys resolved } | _, _, _ => .revert | state, .storageArrayPush fieldName value => match findFieldWithResolvedSlot fields fieldName, evalExpr oracle fields state value with @@ -962,7 +1110,7 @@ mutual | state, .setStorageAddr fieldName value => match findFieldWriteSlots fields fieldName, evalExpr oracle fields state value with | some slots, some resolved => - .continue { state with world := writeAddressSlots state.world slots resolved } + .continue { state with world := writeAddressFieldSlots fields fieldName state.world slots resolved } | _, _ => .revert | state, .setImmutable name value => match evalExpr oracle fields state value with @@ -987,6 +1135,7 @@ mutual | state, .tstore offset value => match evalExpr oracle fields state offset, evalExpr oracle fields state value with | some resolvedOffset, some resolvedValue => + let resolvedOffset := wordNormalize resolvedOffset .continue { state with world := { diff --git a/Verity/Core/Model/Types.lean b/Verity/Core/Model/Types.lean index 15eb1bd70..24b149b2c 100644 --- a/Verity/Core/Model/Types.lean +++ b/Verity/Core/Model/Types.lean @@ -134,6 +134,10 @@ inductive FieldType structure Field where name : String ty : FieldType + /-- Use EIP-1153 transient storage (`TLOAD`/`TSTORE`) for this field. + Transient fields share the storage field typing and slot discipline, but + their values are transaction-scoped in `ContractState.transientStorage`. -/ + isTransient : Bool := false /-- Optional explicit storage slot override. When omitted, the slot defaults to declaration order (legacy behavior). -/ slot : Option Nat := none diff --git a/Verity/Macro/Syntax.lean b/Verity/Macro/Syntax.lean index 2ffc8008c..6a03354dd 100644 --- a/Verity/Macro/Syntax.lean +++ b/Verity/Macro/Syntax.lean @@ -42,6 +42,7 @@ declare_syntax_cat verityIntrinsicObligation syntax ident " : " term " := " "slot" num : verityStorageField syntax ident " : " term " := " "slot" num : verityStorageItem +syntax "transient " ident " : " term " := " "slot" num : verityStorageItem syntax ident " : " term " @word " num : verityStorageStructMember syntax ident " : " term " @word " num " packed(" num "," num ")" : verityStorageStructMember syntax ident " : " "StorageStruct" "[" sepBy(verityStorageStructMember, ",") "]" " @word " num : verityStorageStructMember diff --git a/Verity/Macro/Translate.lean b/Verity/Macro/Translate.lean index 97a842ab7..8793f7349 100644 --- a/Verity/Macro/Translate.lean +++ b/Verity/Macro/Translate.lean @@ -1983,9 +1983,11 @@ private def mkModelFieldTerm (field : StorageFieldDecl) : CommandElabM Term := d | none => `(none) | some (offset, width) => `(some { offset := $(natTerm offset), width := $(natTerm width) }) + let transientTerm ← if field.isTransient then `(true) else `(false) `(Compiler.CompilationModel.Field.mk $(strTerm field.name) $(← modelFieldTypeTerm field.ty) + $transientTerm (some $(natTerm field.slotNum)) $packedTerm []) @@ -2621,24 +2623,29 @@ def parseContractSyntax firstNamespaceOpt := some offset firstNamespaceLocked := true | none => - match (← parseStorageStructItem parsedNewtypes parsedStructs parsedAdts item) with - | some (structFields, accessor) => - parsedFields := parsedFields ++ - (structFields.map fun field => { field with slotNum := field.slotNum + currentNamespaceOffset }) - parsedStorageStructAccessors := parsedStorageStructAccessors.push - { accessor with tree := offsetStorageAccessorTree currentNamespaceOffset accessor.tree } - -- A field has now been recorded under the active namespace; later - -- in-storage `storage_namespace` items must not retroactively - -- relabel where the first field lives. + match (← parseTransientStorageItem parsedNewtypes parsedStructs parsedAdts item) with + | some field => + parsedFields := parsedFields.push { field with slotNum := field.slotNum + currentNamespaceOffset } firstNamespaceLocked := true | none => - match (← storageFieldFromItem? item) with - | some fieldStx => - let field ← parseStorageField parsedNewtypes parsedStructs parsedAdts fieldStx - parsedFields := parsedFields.push { field with slotNum := field.slotNum + currentNamespaceOffset } + match (← parseStorageStructItem parsedNewtypes parsedStructs parsedAdts item) with + | some (structFields, accessor) => + parsedFields := parsedFields ++ + (structFields.map fun field => { field with slotNum := field.slotNum + currentNamespaceOffset }) + parsedStorageStructAccessors := parsedStorageStructAccessors.push + { accessor with tree := offsetStorageAccessorTree currentNamespaceOffset accessor.tree } + -- A field has now been recorded under the active namespace; later + -- in-storage `storage_namespace` items must not retroactively + -- relabel where the first field lives. firstNamespaceLocked := true | none => - throwErrorAt item "unsupported storage item" + match (← storageFieldFromItem? item) with + | some fieldStx => + let field ← parseStorageField parsedNewtypes parsedStructs parsedAdts fieldStx + parsedFields := parsedFields.push { field with slotNum := field.slotNum + currentNamespaceOffset } + firstNamespaceLocked := true + | none => + throwErrorAt item "unsupported storage item" let parsedRoles ← match roleDecls with | some decls => decls.mapM (parseRoleDecl parsedFields) diff --git a/Verity/Macro/Translate/Expr.lean b/Verity/Macro/Translate/Expr.lean index b1d6af5bd..11d386432 100644 --- a/Verity/Macro/Translate/Expr.lean +++ b/Verity/Macro/Translate/Expr.lean @@ -208,6 +208,7 @@ def immutableStorageFieldDecl | .address => .scalar .address | _ => .scalar imm.ty slotNum := immutableSlotIndex fields idx + isTransient := false adtInfo? := none } diff --git a/Verity/Macro/Translate/Parsing.lean b/Verity/Macro/Translate/Parsing.lean index bae38d67d..3b8325f32 100644 --- a/Verity/Macro/Translate/Parsing.lean +++ b/Verity/Macro/Translate/Parsing.lean @@ -29,6 +29,25 @@ def parseStorageField (newtypes : Array NewtypeDecl) (structDecls : Array Struct } | _ => throwErrorAt stx "invalid storage field declaration" +def parseTransientStorageItem (newtypes : Array NewtypeDecl) (structDecls : Array StructDecl := #[]) (adtDecls : Array AdtDecl := #[]) + (stx : TSyntax `verityStorageItem) : CommandElabM (Option StorageFieldDecl) := do + match stx with + | `(verityStorageItem| transient $name:ident : $ty:term := slot $slotNum:num) => + let parsedTy ← storageTypeFromSyntax newtypes structDecls adtDecls ty + let adtInfo? := + match parsedTy with + | .scalar (.adt adtName maxFields) => some (adtName, maxFields) + | _ => none + pure <| some { + ident := name + name := toString name.getId + ty := parsedTy + slotNum := ← natFromSyntax slotNum + isTransient := true + adtInfo? := adtInfo? + } + | _ => pure none + def pathFieldName (parts : List String) : String := String.intercalate "." parts diff --git a/Verity/Macro/Types.lean b/Verity/Macro/Types.lean index 586e29776..14fae156f 100644 --- a/Verity/Macro/Types.lean +++ b/Verity/Macro/Types.lean @@ -61,6 +61,7 @@ structure StorageFieldDecl where name : String ty : StorageType slotNum : Nat + isTransient : Bool := false adtInfo? : Option (String × Nat) := none packedBits : Option (Nat × Nat) := none emitDef : Bool := true diff --git a/artifacts/macro_property_tests/PropertyTransientStorageSmoke.t.sol b/artifacts/macro_property_tests/PropertyTransientStorageSmoke.t.sol new file mode 100644 index 000000000..2e0244ee4 --- /dev/null +++ b/artifacts/macro_property_tests/PropertyTransientStorageSmoke.t.sol @@ -0,0 +1,35 @@ +// SPDX-License-Identifier: MIT +pragma solidity ^0.8.33; + +import "./yul/YulTestBase.sol"; + +/** + * @title PropertyTransientStorageSmokeTest + * @notice Auto-generated baseline property stubs from `verity_contract` declarations. + * @dev Source: Contracts/Smoke/Storage.lean + */ +contract PropertyTransientStorageSmokeTest is YulTestBase { + address target; + address alice = address(0x1111); + + function setUp() public { + target = deployYul("TransientStorageSmoke"); + require(target != address(0), "Deploy failed"); + } + + // Property 1: setLock has no unexpected revert + function testAuto_SetLock_NoUnexpectedRevert() public { + vm.prank(alice); + (bool ok,) = target.call(abi.encodeWithSignature("setLock(uint256)", uint256(1))); + require(ok, "setLock reverted unexpectedly"); + } + // Property 2: TODO decode and assert `getLock` result + function testTODO_GetLock_DecodeAndAssert() public { + vm.prank(alice); + (bool ok, bytes memory ret) = target.call(abi.encodeWithSignature("getLock()")); + require(ok, "getLock reverted unexpectedly"); + assertEq(ret.length, 32, "getLock ABI return length mismatch (expected 32 bytes)"); + // TODO(#1011): decode `ret` and assert the concrete postcondition from Lean theorem. + ret; + } +} diff --git a/scripts/check_proof_length.py b/scripts/check_proof_length.py index db97c7cdb..d76c377bd 100644 --- a/scripts/check_proof_length.py +++ b/scripts/check_proof_length.py @@ -638,6 +638,18 @@ # rcases branches would produce trivial single-use helpers whose # boilerplate exceeds the save. "compileMappingSlotWrite_multiSlot_bridged", + # `add`-wrapped (wordOffset != 0) twin of the multi-slot closure above: + # same outer `YulStmt.block` of two let-bindings plus N per-slot writes, + # but each store is `sstore/tstore(add(mappingSlot(..), lit wordOffset), ..)`. + # The proof enumerates the same four concrete membership cases (let + # __compat_key, let __compat_value, slot0, slot1) then the generic + # slotsRest map case, each delegating to the shared `hStoreFor` witness + # built from `bridgedStraightStmt_maybeFieldStorageStore_add` (which the + # field-aware transient/sstore selection requires). The inline AST-shape + # witness pads the span without substantive logic; decomposing the rcases + # branches would yield trivial single-use helpers whose boilerplate + # exceeds the save. + "compileMappingSlotWrite_multiSlot_nonzero_bridged", # Multi-slot setMapping2 compatibility branch emits an outer # `YulStmt.block` wrapping three let-bindings (__compat_key1, # __compat_key2, __compat_value) plus N nested-mappingSlot sstore