├── Main.lean
├── lean-toolchain
├── .gitignore
├── vc
    ├── Setup.hs
    ├── src
    │   ├── Properties.hs
    │   ├── PrimOps.hs
    │   ├── Utils.hs
    │   ├── Lexer.x
    │   ├── ProofGenerator.hs
    │   ├── Lean.hs
    │   ├── Parser.y
    │   ├── Preprocessor.hs
    │   └── Types.hs
    ├── Templates
    │   ├── stmt_user
    │   ├── stmt
    │   ├── function
    │   ├── function_user
    │   ├── stmt_gen
    │   ├── for
    │   ├── function_gen
    │   ├── for_gen
    │   └── for_user
    ├── stack.yaml.lock
    ├── package.yaml
    ├── VC.cabal
    └── stack.yaml
├── shell.nix
├── Clear.lean
├── lakefile.lean
├── Generated
    └── peano
    │   └── Peano
    │       ├── addk.lean
    │       ├── Common
    │           ├── if_6183625948864629624.lean
    │           ├── if_6183625948864629624_user.lean
    │           ├── if_6183625948864629624_gen.lean
    │           ├── for_84821961910748561.lean
    │           ├── for_727972558926940900.lean
    │           ├── for_4806375509446804985.lean
    │           ├── for_84821961910748561_gen.lean
    │           ├── for_84821961910748561_user.lean
    │           ├── for_4806375509446804985_user.lean
    │           ├── for_727972558926940900_gen.lean
    │           ├── for_4806375509446804985_gen.lean
    │           └── for_727972558926940900_user.lean
    │       ├── expk.lean
    │       ├── mulk.lean
    │       ├── addk_user.lean
    │       ├── expk_user.lean
    │       ├── mulk_user.lean
    │       ├── addk_gen.lean
    │       ├── expk_gen.lean
    │       └── mulk_gen.lean
├── .github
    └── workflows
    │   └── main.yml
├── Clear
    ├── User.lean
    ├── Wheels.lean
    ├── Utilities.lean
    ├── Ast.lean
    ├── SizeLemmas.lean
    ├── ExecLemmas.lean
    ├── Abstraction.lean
    ├── ReasoningPrinciple.lean
    ├── UInt256.lean
    ├── Interpreter.lean
    ├── EVMState.lean
    ├── PrimOps.lean
    └── YulNotation.lean
├── All.lean
├── README.md
├── out
    └── peano.yul
├── lake-manifest.json
└── LICENSE.MD


/Main.lean:
--------------------------------------------------------------------------------
1 | import Clear
2 | import All
3 | 


--------------------------------------------------------------------------------
/lean-toolchain:
--------------------------------------------------------------------------------
1 | leanprover/lean4:v4.9.1
2 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | *.olean
2 | .lake/
3 | vc/.stack-work/*


--------------------------------------------------------------------------------
/vc/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | 
3 | main = defaultMain
4 | 


--------------------------------------------------------------------------------
/shell.nix:
--------------------------------------------------------------------------------
1 | { pkgs ? import <nixpkgs> {} }:
2 | pkgs.mkShell {
3 |   packages = with pkgs; [ 
4 |     elan
5 |     stack
6 |   ];
7 | }


--------------------------------------------------------------------------------
/vc/src/Properties.hs:
--------------------------------------------------------------------------------
1 | module Properties (isNormal, concreteOfCode) where
2 | 
3 | isNormal :: String -> String
4 | isNormal = ("isNormal " ++ )
5 | 
6 | concreteOfCode :: String -> String
7 | concreteOfCode = (++ "_concr_of_code")


--------------------------------------------------------------------------------
/Clear.lean:
--------------------------------------------------------------------------------
 1 | import Clear.Abstraction
 2 | import Clear.Ast
 3 | import Clear.EVMState
 4 | import Clear.ExecLemmas
 5 | import Clear.Instr
 6 | import Clear.Interpreter
 7 | import Clear.JumpLemmas
 8 | import Clear.OutOfFuelLemmas
 9 | import Clear.PrimOps
10 | import Clear.ReasoningPrinciple
11 | import Clear.SizeLemmas
12 | import Clear.State
13 | import Clear.UInt256
14 | import Clear.User
15 | import Clear.Utilities
16 | import Clear.Wheels
17 | import Clear.YulNotation
18 | 


--------------------------------------------------------------------------------
/vc/Templates/stmt_user:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<contract>
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
10 | 
11 | def A_\<statement_name> (s₀ s₉ : State) : Prop := sorry
12 | 
13 | lemma \<statement_name>_abs_of_concrete {s₀ s₉ : State} :
14 |   Spec \<statement_name>_concrete_of_code s₀ s₉ →
15 |   Spec A_\<statement_name> s₀ s₉ := by
16 |   sorry
17 | 
18 | end
19 | 
20 | end \<contract>
21 | 


--------------------------------------------------------------------------------
/vc/Templates/stmt:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<contract>
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
10 | 
11 | lemma \<statement_name>_abs_of_code {s₀ : State} {fuel : Nat} :
12 |   ∀ s₉, exec fuel \<statement_name> s₀ = s₉ →
13 |         Spec A_\<statement_name> s₀ s₉ :=
14 |   λ _ h ↦ \<statement_name>_abs_of_concrete (\<statement_name>_concrete_of_code.2 h)
15 | 
16 | end
17 | 
18 | end \<contract>
19 | 


--------------------------------------------------------------------------------
/lakefile.lean:
--------------------------------------------------------------------------------
 1 | import Lake
 2 | open Lake DSL
 3 | 
 4 | require mathlib from git
 5 |   "https://github.com/leanprover-community/mathlib4.git"@"v4.9.1"
 6 | 
 7 | package «clear» {
 8 |   leanOptions := #[⟨`autoImplicit, false⟩]
 9 | }
10 | 
11 | lean_lib «Clear» {
12 |   -- add any library configuration options here
13 | }
14 | 
15 | lean_lib «Generated» {
16 |   -- add any library configuration options here
17 | }
18 | 
19 | lean_lib «All» {
20 |   -- add any library configuration options here
21 | }
22 | 
23 | @[default_target]
24 | lean_lib «Main» {
25 |   -- add any library configuration options here
26 | }
27 | 


--------------------------------------------------------------------------------
/vc/stack.yaml.lock:
--------------------------------------------------------------------------------
 1 | # This file was autogenerated by Stack.
 2 | # You should not edit this file by hand.
 3 | # For more information, please see the documentation at:
 4 | #   https://docs.haskellstack.org/en/stable/topics/lock_files
 5 | 
 6 | packages: []
 7 | snapshots:
 8 | - completed:
 9 |     sha256: a3501d1b61a539371d85305fe73e1134fc08e7c97498a42952455f011fd97ecf
10 |     size: 684278
11 |     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/25.yaml
12 |   original:
13 |     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/25.yaml
14 | 


--------------------------------------------------------------------------------
/vc/Templates/function:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<namespace>
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
10 | 
11 | lemma \<statement_name>_abs_of_code {s₀ s₉ : State} \<ret_vals_and_args> {fuel : Nat} :
12 |   execCall fuel \<statement_name> [\<return_value>] (s₀, [\<args_sep_comma>]) = s₉ →
13 |   Spec (A_\<statement_name> \<return_value_space> \<args_sep_space>) s₀ s₉
14 | := λ h ↦ \<statement_name>_abs_of_concrete (\<statement_name>_concrete_of_code.2 h)
15 | 
16 | end
17 | 
18 | end \<namespace>
19 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/addk.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.for_84821961910748561
 4 | 
 5 | import Generated.peano.Peano.addk_gen
 6 | 
 7 | import Generated.peano.Peano.addk_user
 8 | 
 9 | 
10 | namespace Generated.peano.Peano
11 | 
12 | section
13 | 
14 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common 
15 | 
16 | lemma addk_abs_of_code {s₀ s₉ : State} {y x k} {fuel : Nat} :
17 |   execCall fuel addk [y] (s₀, [x, k]) = s₉ →
18 |   Spec (A_addk y x k) s₀ s₉
19 | := λ h ↦ addk_abs_of_concrete (addk_concrete_of_code.2 h)
20 | 
21 | end
22 | 
23 | end Generated.peano.Peano
24 | 


--------------------------------------------------------------------------------
/.github/workflows/main.yml:
--------------------------------------------------------------------------------
 1 | name: Build
 2 | 
 3 | on:
 4 |   push:
 5 |     branches: [ main ]
 6 |   pull_request:
 7 |     branches: [ main ]
 8 | 
 9 |   workflow_dispatch:
10 | 
11 | jobs:
12 |   build:
13 |     runs-on: ubuntu-latest
14 | 
15 |     steps:
16 |       - uses: actions/checkout@v4.2.0
17 |       - name: The Determinate Nix Installer
18 |         uses: DeterminateSystems/nix-installer-action@v14
19 |       - name: Magic Nix Cache
20 |         uses: DeterminateSystems/magic-nix-cache-action@v8
21 |       - name: Get Mathlib cache
22 |         run: nix-shell --run "lake exe cache get"
23 |       - name: Build vc tool
24 |         run: nix-shell --run "cd vc; stack --nix build"
25 |       - name: Build Lean files
26 |         run: nix-shell --run "lake build"
27 | 


--------------------------------------------------------------------------------
/Clear/User.lean:
--------------------------------------------------------------------------------
 1 | import Mathlib.Data.List.AList
 2 | 
 3 | import Clear.UInt256
 4 | import Clear.Ast
 5 | import Clear.YulNotation
 6 | 
 7 | namespace Clear.User
 8 | 
 9 | namespace Def
10 | 
11 | open Clear.Ast (FunctionDefinition)
12 | open YulNotation
13 | 
14 | def test : FunctionDefinition := <f
15 | function test(a) -> x
16 | {x := 10
17 |  leave}
18 | >
19 | 
20 | def test1 : FunctionDefinition := <f
21 | function test1(a, b) -> x, y
22 | {
23 |     let x := test(12)
24 |     leave
25 | }
26 | >
27 | 
28 | @[simp]
29 | def mapping : AList (fun (_ : String) => FunctionDefinition)
30 | := [ ⟨"test", test⟩
31 |    , ⟨"test1", test1⟩
32 |    ].toAList
33 | 
34 | @[simp]
35 | def find : String → Option FunctionDefinition := mapping.lookup
36 | 
37 | end Def
38 | 
39 | end Clear.User
40 | 


--------------------------------------------------------------------------------
/vc/Templates/function_user:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<namespace>
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
10 | 
11 | def A_\<statement_name> \<ret_vals> \<fargs> (s₀ s₉ : State) : Prop := sorry
12 | 
13 | lemma \<statement_name>_abs_of_concrete {s₀ s₉ : State} \<ret_vals_and_args> :
14 |   Spec (\<statement_name>_concrete_of_code.1 \<return_value_space> \<args_sep_space>) s₀ s₉ →
15 |   Spec (A_\<statement_name> \<return_value_space> \<args_sep_space>) s₀ s₉ := by
16 |   unfold \<statement_name>_concrete_of_code A_\<statement_name>
17 |   sorry
18 | 
19 | end
20 | 
21 | end \<namespace>
22 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/if_6183625948864629624.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | 
 4 | import Generated.peano.Peano.Common.if_6183625948864629624_gen
 5 | 
 6 | import Generated.peano.Peano.Common.if_6183625948864629624_user
 7 | 
 8 | 
 9 | namespace Peano.Common
10 | 
11 | section
12 | 
13 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities 
14 | 
15 | lemma if_6183625948864629624_abs_of_code {s₀ : State} {fuel : Nat} :
16 |   ∀ s₉, exec fuel if_6183625948864629624 s₀ = s₉ →
17 |         Spec A_if_6183625948864629624 s₀ s₉ :=
18 |   λ _ h ↦ if_6183625948864629624_abs_of_concrete (if_6183625948864629624_concrete_of_code.2 h)
19 | 
20 | end
21 | 
22 | end Peano.Common
23 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/expk.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.for_727972558926940900
 4 | import Generated.peano.Peano.mulk
 5 | 
 6 | import Generated.peano.Peano.expk_gen
 7 | 
 8 | import Generated.peano.Peano.expk_user
 9 | 
10 | 
11 | namespace Generated.peano.Peano
12 | 
13 | section
14 | 
15 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
16 | 
17 | lemma expk_abs_of_code {s₀ s₉ : State} {y x k} {fuel : Nat} :
18 |   execCall fuel expk [y] (s₀, [x, k]) = s₉ →
19 |   Spec (A_expk y x k) s₀ s₉
20 | := λ h ↦ expk_abs_of_concrete (expk_concrete_of_code.2 h)
21 | 
22 | end
23 | 
24 | end Generated.peano.Peano
25 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/mulk.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.for_4806375509446804985
 4 | import Generated.peano.Peano.addk
 5 | 
 6 | import Generated.peano.Peano.mulk_gen
 7 | 
 8 | import Generated.peano.Peano.mulk_user
 9 | 
10 | 
11 | namespace Generated.peano.Peano
12 | 
13 | section
14 | 
15 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
16 | 
17 | lemma mulk_abs_of_code {s₀ s₉ : State} {y x k} {fuel : Nat} :
18 |   execCall fuel mulk [y] (s₀, [x, k]) = s₉ →
19 |   Spec (A_mulk y x k) s₀ s₉
20 | := λ h ↦ mulk_abs_of_concrete (mulk_concrete_of_code.2 h)
21 | 
22 | end
23 | 
24 | end Generated.peano.Peano
25 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/if_6183625948864629624_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | 
 4 | import Generated.peano.Peano.Common.if_6183625948864629624_gen
 5 | 
 6 | 
 7 | namespace Peano.Common
 8 | 
 9 | section
10 | 
11 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities 
12 | 
13 | def A_if_6183625948864629624 (s₀ s₉ : State) : Prop := s₉ = if s₀["k"]!! = 0 then 💔 s₀ else s₀
14 | 
15 | lemma if_6183625948864629624_abs_of_concrete {s₀ s₉ : State} :
16 |   Spec if_6183625948864629624_concrete_of_code s₀ s₉ →
17 |   Spec A_if_6183625948864629624 s₀ s₉ := by
18 |   unfold if_6183625948864629624_concrete_of_code A_if_6183625948864629624
19 |   aesop_spec
20 | 
21 | end
22 | 
23 | end Peano.Common
24 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/addk_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.for_84821961910748561
 4 | 
 5 | import Generated.peano.Peano.addk_gen
 6 | 
 7 | 
 8 | namespace Generated.peano.Peano
 9 | 
10 | section
11 | 
12 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common 
13 | 
14 | def A_addk (y : Identifier) (x k : Literal) (s₀ s₉ : State) : Prop := s₉ = s₀⟦y ↦ (x + k)⟧
15 | 
16 | lemma addk_abs_of_concrete {s₀ s₉ : State} {y x k}
17 | : Spec (addk_concrete_of_code.1 y x k) s₀ s₉ →
18 |   Spec (A_addk y x k) s₀ s₉ := by
19 |   unfold addk_concrete_of_code A_addk AFor_for_84821961910748561
20 |   rcases s₀ with ⟨evm, varstore⟩ | _ | _ <;> [simp only; aesop_spec; aesop_spec]
21 |   apply spec_eq
22 |   rintro h ⟨h₁, ⟨ss, h₂⟩⟩
23 |   clr_funargs at ss
24 |   clr_spec at ss
25 |   aesop_spec
26 |   congr
27 |   symm; assumption
28 |   aesop_spec
29 | 
30 | end
31 | 
32 | end Generated.peano.Peano
33 | 


--------------------------------------------------------------------------------
/vc/Templates/stmt_gen:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<contract>
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
10 | 
11 | def \<statement_name> := <s
12 |   \<code>
13 | >
14 | 
15 | set_option maxRecDepth 5000
16 | set_option maxHeartbeats 400000
17 | 
18 | def \<statement_name>_concrete_of_code : {
19 |     C : State → State → Prop
20 |     // ∀ {s₀ s₉ fuel}
21 |     , exec fuel \<statement_name> s₀ = s₉
22 |     → Spec C s₀ s₉
23 |   } := by
24 |   constructor
25 |   intros s₀ s₉ fuel
26 | 
27 |   unfold Spec \<statement_name>
28 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
29 |   rotate_left 1
30 |   · generalize If _ _ = f; aesop
31 |   · generalize If _ _ = f; aesop
32 |   swap
33 |   generalize hok : Ok evm₀ store₀ = s₀
34 |   intros h _
35 |   revert h
36 | 
37 |   rw [If']
38 | 
39 |   -- AST-specific tactics
40 | 
41 | \<tacs>
42 | 
43 | end
44 | 
45 | end \<contract>
46 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/expk_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.for_727972558926940900
 4 | import Generated.peano.Peano.mulk
 5 | 
 6 | import Generated.peano.Peano.expk_gen
 7 | 
 8 | 
 9 | namespace Generated.peano.Peano
10 | 
11 | section
12 | 
13 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
14 | 
15 | def A_expk (y : Identifier) (x k : Literal) (s₀ s₉ : State) : Prop := s₉ = s₀⟦y ↦ (x ^ k)⟧
16 | 
17 | lemma expk_abs_of_concrete {s₀ s₉ : State} {y x k}
18 | : Spec (expk_concrete_of_code.1 y x k) s₀ s₉ →
19 |   Spec (A_expk y x k) s₀ s₉ := by
20 |   unfold expk_concrete_of_code A_expk AFor_for_727972558926940900
21 |   rcases s₀ with ⟨evm, varstore⟩ | _ | _ <;> [simp only; aesop_spec; aesop_spec]
22 |   apply spec_eq
23 |   rintro h ⟨h₁, ⟨ss, h₂⟩⟩
24 |   clr_funargs at ss
25 |   clr_spec at ss
26 |   aesop_spec
27 |   congr
28 |   aesop_spec
29 | 
30 | end
31 | 
32 | end Generated.peano.Peano
33 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/mulk_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.for_4806375509446804985
 4 | import Generated.peano.Peano.addk
 5 | 
 6 | import Generated.peano.Peano.mulk_gen
 7 | 
 8 | 
 9 | namespace Generated.peano.Peano
10 | 
11 | section
12 | 
13 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
14 | 
15 | def A_mulk (y : Identifier) (x k : Literal) (s₀ s₉ : State) : Prop := s₉ = s₀⟦y ↦ (x * k)⟧
16 | 
17 | lemma mulk_abs_of_concrete {s₀ s₉ : State} {y x k} :
18 |   Spec (mulk_concrete_of_code.1 y x k) s₀ s₉ →
19 |   Spec (A_mulk y x k) s₀ s₉ := by
20 |   unfold mulk_concrete_of_code A_mulk AFor_for_4806375509446804985
21 |   rcases s₀ with ⟨evm, varstore⟩ | _ | _ <;> [simp only; aesop_spec; aesop_spec]
22 |   apply spec_eq
23 |   rintro h ⟨h₁, ⟨ss, h₂⟩⟩
24 |   clr_funargs at ss
25 |   clr_spec at ss
26 |   aesop_spec
27 |   congr
28 |   aesop_spec
29 | 
30 | end
31 | 
32 | end Generated.peano.Peano
33 | 


--------------------------------------------------------------------------------
/All.lean:
--------------------------------------------------------------------------------
 1 | import Generated.peano.Peano.addk
 2 | import Generated.peano.Peano.addk_user
 3 | import Generated.peano.Peano.expk_user
 4 | import Generated.peano.Peano.mulk_user
 5 | import Generated.peano.Peano.mulk
 6 | import Generated.peano.Peano.expk
 7 | import Generated.peano.Peano.mulk_gen
 8 | import Generated.peano.Peano.expk_gen
 9 | import Generated.peano.Peano.addk_gen
10 | import Generated.peano.Peano.Common.for_84821961910748561
11 | import Generated.peano.Peano.Common.if_6183625948864629624_gen
12 | import Generated.peano.Peano.Common.for_4806375509446804985_gen
13 | import Generated.peano.Peano.Common.for_727972558926940900_gen
14 | import Generated.peano.Peano.Common.for_84821961910748561_user
15 | import Generated.peano.Peano.Common.if_6183625948864629624_user
16 | import Generated.peano.Peano.Common.for_727972558926940900_user
17 | import Generated.peano.Peano.Common.for_727972558926940900
18 | import Generated.peano.Peano.Common.for_4806375509446804985
19 | import Generated.peano.Peano.Common.for_84821961910748561_gen
20 | import Generated.peano.Peano.Common.for_4806375509446804985_user
21 | import Generated.peano.Peano.Common.if_6183625948864629624
22 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # Clear.
 2 | 
 3 | <img width="600" alt="Clear - Github (1)" src="https://github.com/NethermindEth/Clear/assets/114106639/9d92cbbc-5a55-4808-ae48-525647c1c0d6">
 4 | 
 5 | 
 6 | 
 7 | Prove anything* about Yul programs.
 8 | 
 9 | There are two parts.
10 |   - A Lean framework with a Yul model.
11 |   - A verification condition generator.
12 | 
13 | ## The Lean framework
14 | Download and install Lean 4. One can follow https://lean-lang.org/lean4/doc/quickstart.html.
15 | 
16 | To obtain precompiled files for the dependency Mathlib, run the following in the root directory (this is optional, it saves time): 
17 | ```
18 | lake exe cache get
19 | ```
20 | 
21 | Then simply run the following in the root directory:
22 | ```
23 | lake build
24 | ```
25 | 
26 | ## The verification condition generator (vc)
27 | 
28 | Download and install Stack. One can follow https://docs.haskellstack.org/en/stable/install_and_upgrade/.
29 | 
30 | Then simply run the following in the `vc` directory:
31 | ```
32 | stack build
33 | ```
34 | 
35 | ## Verifying it all works
36 | In the `vc` directory, run:
37 | ```
38 | stack run vc ../out/peano.yul
39 | ```
40 | 
41 | You should get a `Generated` folder corresponding with the structure of the Peano example
42 | in the `out/peano.yul` file.
43 | 


--------------------------------------------------------------------------------
/out/peano.yul:
--------------------------------------------------------------------------------
 1 | object "Peano" {
 2 |     code {
 3 |     }
 4 |     object "Peano_deployed" {
 5 |         code {
 6 |             function addk(x, k) -> y
 7 |             {
 8 |                 for {} 1 {k := sub(k, 1)} {
 9 |                     if eq(k, 0)
10 |                     {
11 |                         break
12 |                     }
13 |                     x := add(x, 1)
14 |                 }
15 |                 y := x
16 |             }
17 |             function mulk(x, k) -> y
18 |             {
19 |                 let y := 0
20 |                 for {} 1 {k := sub(k, 1)} {
21 |                     if eq(k, 0)
22 |                     {
23 |                         break
24 |                     }
25 |                     y := addk(y, x)
26 |                 }
27 |             }
28 |             function expk(x, k) -> y
29 |             {
30 |                 let y := 1
31 |                 for {} 1 {k := sub(k, 1)} {
32 |                     if eq(k, 0)
33 |                     {
34 |                         break
35 |                     }
36 |                     y := mulk(y, x)
37 |                 }
38 |             }
39 |         }
40 |         data ".metadata" hex"a264697066735822122067106f228801aa898d329c27cddd7517e178492c852b664d920e4c3c137b297464736f6c63430008130033"
41 |     }
42 | }


--------------------------------------------------------------------------------
/vc/package.yaml:
--------------------------------------------------------------------------------
 1 | name:                VC
 2 | version:             0.1.0.0
 3 | #synopsis:
 4 | #description:
 5 | homepage:            https://github.com/githubuser/VC#readme
 6 | license:             BSD3
 7 | author:              Author name here
 8 | maintainer:          example@example.com
 9 | copyright:           2023 Author name here
10 | category:            Web
11 | 
12 | dependencies:
13 |   - base >= 4.7 && < 5
14 |   - containers >= 0.6.5.1
15 |   - exceptions >= 0.10.4
16 |   - bytestring
17 |   - array
18 |   - hashable
19 |   - directory >= 1.3.6.2
20 |   - process >= 1.6.16.0
21 |   - transformers >= 0.5.6.2
22 |   - filepath
23 |   - relude
24 |   - algebraic-graphs
25 |   - mtl
26 |   - regex-compat >=0.95.2.1
27 |   - extra
28 |   - split
29 | 
30 | build-tools:
31 |   - alex
32 |   - happy
33 | 
34 | ghc-options:
35 | - -Wall
36 | - -Wcompat
37 | - -Widentities
38 | - -Wincomplete-record-updates
39 | - -Wincomplete-uni-patterns
40 | - -Wmissing-export-lists
41 | - -Wmissing-home-modules
42 | - -Wpartial-fields
43 | - -Wredundant-constraints
44 | - -Wno-name-shadowing
45 | 
46 | 
47 | executables:
48 |   vc:
49 |     source-dirs:      src
50 |     main:             Main.hs
51 |     other-modules:
52 |       - Lean
53 |       - Lexer
54 |       - Parser
55 |       - Preprocessor
56 |       - PrimOps
57 |       - ProofGenerator
58 |       - Properties
59 |       - Types
60 |       - Utils
61 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/if_6183625948864629624_gen.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | 
 4 | 
 5 | namespace Peano.Common
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities 
10 | 
11 | def if_6183625948864629624 := <s
12 |   if eq(k, 0) 
13 | {break}
14 | >
15 | 
16 | set_option maxRecDepth 5000
17 | set_option maxHeartbeats 400000
18 | 
19 | def if_6183625948864629624_concrete_of_code : {
20 |     C : State → State → Prop
21 |     // ∀ {s₀ s₉ fuel}
22 |     , exec fuel if_6183625948864629624 s₀ = s₉
23 |     → Spec C s₀ s₉
24 |   } := by
25 |   constructor
26 |   intros s₀ s₉ fuel
27 | 
28 |   unfold Spec if_6183625948864629624
29 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
30 |   rotate_left 1
31 |   · generalize If _ _ = f; aesop
32 |   · generalize If _ _ = f; aesop
33 |   swap
34 |   generalize hok : Ok evm₀ store₀ = s₀
35 |   intros h _
36 |   revert h
37 | 
38 |   rw [If']
39 | 
40 |   -- AST-specific tactics
41 | 
42 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
43 |   rw [EVMEq']
44 |   rw [cons, Break']
45 |   
46 |   
47 |   -- tacticsOfStmt offsetting
48 |   try rw [nil]
49 |   try simp [Bool.toUInt256, UInt256.size]
50 |   intros h
51 |   exact h
52 | 
53 | 
54 | end
55 | 
56 | end Peano.Common
57 | 


--------------------------------------------------------------------------------
/vc/VC.cabal:
--------------------------------------------------------------------------------
 1 | cabal-version: 1.12
 2 | 
 3 | -- This file has been generated from package.yaml by hpack version 0.36.0.
 4 | --
 5 | -- see: https://github.com/sol/hpack
 6 | 
 7 | name:           VC
 8 | version:        0.1.0.0
 9 | category:       Web
10 | homepage:       https://github.com/githubuser/VC#readme
11 | author:         Author name here
12 | maintainer:     example@example.com
13 | copyright:      2023 Author name here
14 | license:        BSD3
15 | build-type:     Simple
16 | 
17 | executable vc
18 |   main-is: Main.hs
19 |   other-modules:
20 |       Lean
21 |       Lexer
22 |       Parser
23 |       Preprocessor
24 |       PrimOps
25 |       ProofGenerator
26 |       Properties
27 |       Types
28 |       Utils
29 |   hs-source-dirs:
30 |       src
31 |   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-name-shadowing
32 |   build-tools:
33 |       alex
34 |     , happy
35 |   build-depends:
36 |       algebraic-graphs
37 |     , array
38 |     , base >=4.7 && <5
39 |     , bytestring
40 |     , containers >=0.6.5.1
41 |     , directory >=1.3.6.2
42 |     , exceptions >=0.10.4
43 |     , extra
44 |     , filepath
45 |     , hashable
46 |     , mtl
47 |     , process >=1.6.16.0
48 |     , regex-compat >=0.95.2.1
49 |     , relude
50 |     , split
51 |     , transformers >=0.5.6.2
52 |   default-language: Haskell2010
53 | 


--------------------------------------------------------------------------------
/vc/src/PrimOps.hs:
--------------------------------------------------------------------------------
 1 | module PrimOps (yulPrimOps) where
 2 | 
 3 | yulPrimOps :: [String]
 4 | yulPrimOps =
 5 |   [ "stop"
 6 |   , "add"
 7 |   , "mul"
 8 |   , "sub"
 9 |   , "div"
10 |   , "sdiv"
11 |   , "mod"
12 |   , "smod"
13 |   , "addmod"
14 |   , "mulmod"
15 |   , "exp"
16 |   , "signextend"
17 |   , "lt"
18 |   , "gt"
19 |   , "slt"
20 |   , "sgt"
21 |   , "eq"
22 |   , "iszero"
23 |   , "and"
24 |   , "or"
25 |   , "xor"
26 |   , "not"
27 |   , "byte"
28 |   , "shl"
29 |   , "shr"
30 |   , "sar"
31 |   , "keccak256"
32 |   , "address"
33 |   , "balance"
34 |   , "origin"
35 |   , "caller"
36 |   , "callvalue"
37 |   , "calldataload"
38 |   , "calldatasize"
39 |   , "calldatacopy"
40 |   , "codesize"
41 |   , "codecopy"
42 |   , "gasprice"
43 |   , "extcodesize"
44 |   , -- "extcodecopy", ?
45 |     "returndatasize"
46 |   , "returndatacopy"
47 |   , "extcodehash"
48 |   , "blockhash"
49 |   , "coinbase"
50 |   , "timestamp"
51 |   , "number"
52 |   , "prevrandao"
53 |   , "gaslimit"
54 |   , "chainid"
55 |   , "selfbalance"
56 |   , "basefee"
57 |   , "mload"
58 |   , "mstore"
59 |   , "mstore8"
60 |   , "sload"
61 |   , "sstore"
62 |   , "msize"
63 |   , "gas"
64 |   , "log0"
65 |   , "log1"
66 |   , "log2"
67 |   , "log3"
68 |   , "log4"
69 |   , "create"
70 |   , "call"
71 |   , "pop"
72 |   , "callcode"
73 |   , "return"
74 |   , "delegatecall"
75 |   , "create2"
76 |   , "staticcall"
77 |   , "revert"
78 |   , "selfdesruct"
79 |   , -- Yul linker primitives
80 |     "linkersymbol"
81 |   , "setimmutable"
82 |   , "loadimmutable"
83 |   ]
84 | 


--------------------------------------------------------------------------------
/vc/Templates/for:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<contract>
 6 | 
 7 | set_option autoImplicit false
 8 | 
 9 | section
10 | 
11 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
12 | 
13 | lemma \<statement_name>_post_abs_of_code {s₀ : State} {fuel : Nat} :
14 |   ∀ s₉, exec fuel (Block \<statement_name>_post) s₀ = s₉ →
15 |         Spec APost_\<statement_name> s₀ s₉ :=
16 |     λ _ h ↦ \<statement_name>_concrete_of_post_abs (\<statement_name>_post_concrete_of_code.2 h)
17 | 
18 | lemma \<statement_name>_body_abs_of_code {s₀ : State} {fuel : Nat} :
19 |   ∀ s₉, exec fuel (Block \<statement_name>_body) s₀ = s₉ →
20 |         Spec ABody_\<statement_name> s₀ s₉ :=
21 |     λ _ h ↦ \<statement_name>_concrete_of_body_abs (\<statement_name>_body_concrete_of_code.2 h)
22 | 
23 | -- | Code → Abstract (autogenerated).
24 | lemma \<statement_name>_abs_of_code {s₀ fuel} : ∀ s₉, exec fuel \<statement_name> s₀ = s₉ → Spec AFor_\<statement_name> s₀ s₉ := by
25 |   intros s₉
26 |   intros hcode
27 |   apply reasoning_principle_3 \<statement_name>_cond \<statement_name>_post \<statement_name>_body ACond_\<statement_name> APost_\<statement_name> ABody_\<statement_name> AFor_\<statement_name> AZero_\<statement_name> AOk_\<statement_name> AContinue_\<statement_name> ABreak_\<statement_name> ALeave_\<statement_name> @\<statement_name>_cond_abs_of_code @\<statement_name>_post_abs_of_code @\<statement_name>_body_abs_of_code hcode
28 | 
29 | end
30 | 
31 | end \<contract>
32 | 


--------------------------------------------------------------------------------
/Clear/Wheels.lean:
--------------------------------------------------------------------------------
 1 | import Aesop
 2 | 
 3 | import Mathlib.Tactic.ApplyAt
 4 | 
 5 | declare_aesop_rule_sets [Clear.aesop_ok, Clear.aesop_spec, Clear.aesop_varstore]
 6 | 
 7 | set_option hygiene false in
 8 | open Lean Elab Tactic in
 9 | /--
10 | `aesop_spec` encapsulates general patterns pertaining to reasoning about verification conditions
11 | generated by the `vc`.
12 | * `aesop_spec` is equivalent to `aesop (rule_sets [Clear.aesop_spec])` (+nf).
13 | -/
14 | elab "aesop_spec" : tactic => do
15 |   evalTactic <| ← `(tactic|
16 |     aesop (rule_sets := [Clear.aesop_spec]) (config := { warnOnNonterminal := false })
17 |   )
18 | 
19 | set_option hygiene false in
20 | open Lean Elab Tactic in
21 | /--
22 | `aesop_ok` addresses problems pertaining to preservation of Ok states.
23 | * `aesop_ok` is equivalent to `aesop (rule_sets [Clear.aesop_ok])` (+nf).
24 | -/
25 | elab "aesop_ok" : tactic => do
26 |   evalTactic <| ← `(tactic|
27 |     aesop (rule_sets := [Clear.aesop_ok]) (config := { warnOnNonterminal := false })
28 |   )
29 | 
30 | set_option hygiene false in
31 | open Lean Elab Tactic in
32 | /--
33 | `aesop_varstore` addresses problems pertaining to preservation of Ok states.
34 | * `aesop_varstore` is equivalent to `aesop (rule_sets [Clear.aesop_varstore])` (+nf).
35 | -/
36 | elab "aesop_varstore" : tactic => do
37 |   evalTactic <| ← `(tactic|
38 |     aesop (rule_sets := [Clear.aesop_varstore]) (config := { warnOnNonterminal := false })
39 |   )
40 | 
41 | set_option hygiene false in
42 | open Lean Elab Tactic in
43 | elab "clr_varstore" : tactic => do
44 |   evalTactic <| ← `(tactic| (
45 |     repeat (
46 |       first | rw [State.lookup_insert (by assumption)] at * |
47 |               rw [State.lookup_insert' (by aesop_spec)] at * |
48 |               rw [State.lookup_insert_of_ne (by decide)] at *
49 |     )
50 |   )
51 |   )
52 | 


--------------------------------------------------------------------------------
/vc/Templates/function_gen:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<namespace>
 6 | 
 7 | section
 8 | 
 9 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
10 | 
11 | def \<statement_name> : FunctionDefinition := <f
12 |     function \<statement_name>(\<args_sep_comma>)\<return_modifiers>\<return_value>
13 |     
14 | \<func_body>
15 |     
16 | >
17 | 
18 | set_option maxRecDepth 4000
19 | set_option maxHeartbeats 300000
20 | 
21 | def \<statement_name>_concrete_of_code
22 | : {
23 |     C :
24 |       \<underscores_return_value_args>
25 |       State → State → Prop
26 |     // ∀ {s₀ s₉ : State} {\<return_value_space> \<args_sep_space> fuel},
27 |          execCall fuel \<statement_name> [\<return_value>] (s₀, [\<args_sep_comma>]) = s₉ →
28 |          Spec (C \<return_value_space> \<args_sep_space>) s₀ s₉
29 |   } := by
30 |   constructor
31 |   intros s₀ s₉ \<return_value_space> \<args_sep_space> fuel
32 |   unfold \<statement_name>
33 | 
34 |   unfold Spec
35 |   rcases s₀ with ⟨evm, store⟩ | _ | c <;> dsimp only
36 |   rotate_left 1
37 |   · generalize Def _ _ _ = f; aesop
38 |   · generalize Def _ _ _ = f; aesop
39 |   swap
40 |   generalize hok : Ok evm store = s₀
41 |   intros h _
42 |   revert h
43 | 
44 |   unfold execCall
45 |   unfold call
46 |   unfold params body rets
47 |   conv => simp_match
48 |   conv => pattern List.map _ _; simp
49 |   conv => pattern mkOk _; rw [← hok]; simp
50 |   conv => pattern setStore _; rw [← hok]; simp
51 | 
52 |   generalize hs₁ : initcall _ _ _ = s₁
53 |   let_unfold s₁
54 |   generalize hbody : exec _ _ _ = s₂
55 |   revert hbody
56 |   generalize hs₉ : multifill' _ _ = s₉'
57 | 
58 | \<func_tactics>
59 | 
60 | end
61 | 
62 | end \<namespace>
63 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_84821961910748561.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.if_6183625948864629624
 4 | 
 5 | import Generated.peano.Peano.Common.for_84821961910748561_gen
 6 | 
 7 | import Generated.peano.Peano.Common.for_84821961910748561_user
 8 | 
 9 | 
10 | namespace Peano.Common
11 | 
12 | set_option autoImplicit false
13 | 
14 | section
15 | 
16 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common 
17 | 
18 | lemma for_84821961910748561_post_abs_of_code {s₀ : State} {fuel : Nat} :
19 |   ∀ s₉, exec fuel (Block for_84821961910748561_post) s₀ = s₉ →
20 |         Spec APost_for_84821961910748561 s₀ s₉ :=
21 |     λ _ h ↦ for_84821961910748561_concrete_of_post_abs (for_84821961910748561_post_concrete_of_code.2 h)
22 | 
23 | lemma for_84821961910748561_body_abs_of_code {s₀ : State} {fuel : Nat} :
24 |   ∀ s₉, exec fuel (Block for_84821961910748561_body) s₀ = s₉ →
25 |         Spec ABody_for_84821961910748561 s₀ s₉ :=
26 |     λ _ h ↦ for_84821961910748561_concrete_of_body_abs (for_84821961910748561_body_concrete_of_code.2 h)
27 | 
28 | -- | Code → Abstract (autogenerated).
29 | lemma for_84821961910748561_abs_of_code {s₀ fuel} : ∀ s₉, exec fuel for_84821961910748561 s₀ = s₉ → Spec AFor_for_84821961910748561 s₀ s₉ := by
30 |   intros s₉
31 |   intros hcode
32 |   apply reasoning_principle_3 for_84821961910748561_cond for_84821961910748561_post for_84821961910748561_body ACond_for_84821961910748561 APost_for_84821961910748561 ABody_for_84821961910748561 AFor_for_84821961910748561 AZero_for_84821961910748561 AOk_for_84821961910748561 AContinue_for_84821961910748561 ABreak_for_84821961910748561 ALeave_for_84821961910748561 @for_84821961910748561_cond_abs_of_code @for_84821961910748561_post_abs_of_code @for_84821961910748561_body_abs_of_code hcode
33 | 
34 | end
35 | 
36 | end Peano.Common
37 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_727972558926940900.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.if_6183625948864629624
 4 | import Generated.peano.Peano.mulk
 5 | 
 6 | import Generated.peano.Peano.Common.for_727972558926940900_gen
 7 | 
 8 | import Generated.peano.Peano.Common.for_727972558926940900_user
 9 | 
10 | 
11 | namespace Peano.Common
12 | 
13 | set_option autoImplicit false
14 | 
15 | section
16 | 
17 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
18 | 
19 | lemma for_727972558926940900_post_abs_of_code {s₀ : State} {fuel : Nat} :
20 |   ∀ s₉, exec fuel (Block for_727972558926940900_post) s₀ = s₉ →
21 |         Spec APost_for_727972558926940900 s₀ s₉ :=
22 |     λ _ h ↦ for_727972558926940900_concrete_of_post_abs (for_727972558926940900_post_concrete_of_code.2 h)
23 | 
24 | lemma for_727972558926940900_body_abs_of_code {s₀ : State} {fuel : Nat} :
25 |   ∀ s₉, exec fuel (Block for_727972558926940900_body) s₀ = s₉ →
26 |         Spec ABody_for_727972558926940900 s₀ s₉ :=
27 |     λ _ h ↦ for_727972558926940900_concrete_of_body_abs (for_727972558926940900_body_concrete_of_code.2 h)
28 | 
29 | -- | Code → Abstract (autogenerated).
30 | lemma for_727972558926940900_abs_of_code {s₀ fuel} : ∀ s₉, exec fuel for_727972558926940900 s₀ = s₉ → Spec AFor_for_727972558926940900 s₀ s₉ := by
31 |   intros s₉
32 |   intros hcode
33 |   apply reasoning_principle_3 for_727972558926940900_cond for_727972558926940900_post for_727972558926940900_body ACond_for_727972558926940900 APost_for_727972558926940900 ABody_for_727972558926940900 AFor_for_727972558926940900 AZero_for_727972558926940900 AOk_for_727972558926940900 AContinue_for_727972558926940900 ABreak_for_727972558926940900 ALeave_for_727972558926940900 @for_727972558926940900_cond_abs_of_code @for_727972558926940900_post_abs_of_code @for_727972558926940900_body_abs_of_code hcode
34 | 
35 | end
36 | 
37 | end Peano.Common
38 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_4806375509446804985.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.if_6183625948864629624
 4 | import Generated.peano.Peano.addk
 5 | 
 6 | import Generated.peano.Peano.Common.for_4806375509446804985_gen
 7 | 
 8 | import Generated.peano.Peano.Common.for_4806375509446804985_user
 9 | 
10 | 
11 | namespace Peano.Common
12 | 
13 | set_option autoImplicit false
14 | 
15 | section
16 | 
17 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
18 | 
19 | lemma for_4806375509446804985_post_abs_of_code {s₀ : State} {fuel : Nat} :
20 |   ∀ s₉, exec fuel (Block for_4806375509446804985_post) s₀ = s₉ →
21 |         Spec APost_for_4806375509446804985 s₀ s₉ :=
22 |     λ _ h ↦ for_4806375509446804985_concrete_of_post_abs (for_4806375509446804985_post_concrete_of_code.2 h)
23 | 
24 | lemma for_4806375509446804985_body_abs_of_code {s₀ : State} {fuel : Nat} :
25 |   ∀ s₉, exec fuel (Block for_4806375509446804985_body) s₀ = s₉ →
26 |         Spec ABody_for_4806375509446804985 s₀ s₉ :=
27 |     λ _ h ↦ for_4806375509446804985_concrete_of_body_abs (for_4806375509446804985_body_concrete_of_code.2 h)
28 | 
29 | -- | Code → Abstract (autogenerated).
30 | lemma for_4806375509446804985_abs_of_code {s₀ fuel} : ∀ s₉, exec fuel for_4806375509446804985 s₀ = s₉ → Spec AFor_for_4806375509446804985 s₀ s₉ := by
31 |   intros s₉
32 |   intros hcode
33 |   apply reasoning_principle_3 for_4806375509446804985_cond for_4806375509446804985_post for_4806375509446804985_body ACond_for_4806375509446804985 APost_for_4806375509446804985 ABody_for_4806375509446804985 AFor_for_4806375509446804985 AZero_for_4806375509446804985 AOk_for_4806375509446804985 AContinue_for_4806375509446804985 ABreak_for_4806375509446804985 ALeave_for_4806375509446804985 @for_4806375509446804985_cond_abs_of_code @for_4806375509446804985_post_abs_of_code @for_4806375509446804985_body_abs_of_code hcode
34 | 
35 | end
36 | 
37 | end Peano.Common
38 | 


--------------------------------------------------------------------------------
/vc/Templates/for_gen:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<contract>
 6 | 
 7 | set_option autoImplicit false
 8 | 
 9 | section
10 | 
11 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
12 | 
13 | def \<statement_name>_cond := <<
14 |     \<code_cond>
15 | >>
16 | 
17 | def \<statement_name>_post : List Stmt := <ss
18 |     \<code_post>
19 | >
20 | 
21 | def \<statement_name>_body : List Stmt := <ss
22 | \<code_body>
23 | >
24 | 
25 | def \<statement_name> := <s
26 | \<code>
27 | >
28 | 
29 | set_option maxRecDepth 4000
30 | 
31 | -- =============================================================================
32 | --  POST
33 | -- =============================================================================
34 | 
35 | def \<statement_name>_post_concrete_of_code
36 | : {
37 |     C : State → State → Prop
38 |     // ∀ {s₀ s₉ fuel}
39 |     , exec fuel (Block \<statement_name>_post) s₀ = s₉
40 |     → Spec C s₀ s₉
41 |   } := by
42 |   constructor
43 |   intros s₀ s₉ fuel
44 | 
45 |   unfold Spec \<statement_name>_post
46 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
47 |   rotate_left 1
48 |   · aesop
49 |   · aesop
50 |   swap
51 |   generalize hok : Ok evm₀ store₀ = s₀
52 |   intros h _
53 |   revert h
54 | 
55 | \<tacs_post>
56 | 
57 | -- =============================================================================
58 | --  BODY
59 | -- =============================================================================
60 | 
61 | def \<statement_name>_body_concrete_of_code
62 | : {
63 |     C : State → State → Prop
64 |     // ∀ {s₀ s₉ fuel}
65 |     , exec fuel (Block \<statement_name>_body) s₀ = s₉
66 |     → Spec C s₀ s₉
67 |   }
68 | := by
69 |   constructor
70 |   intros s₀ s₉ fuel
71 | 
72 |   unfold Spec \<statement_name>_body
73 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
74 |   rotate_left 1
75 |   · aesop
76 |   · aesop
77 |   swap
78 |   generalize hok : Ok evm₀ store₀ = s₀
79 |   intros h _
80 |   revert h
81 | 
82 | \<tacs_body>
83 | 
84 | end
85 | 
86 | end \<contract>
87 | 


--------------------------------------------------------------------------------
/vc/Templates/for_user:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | \<imports>
 4 | 
 5 | namespace \<contract>
 6 | 
 7 | set_option autoImplicit false
 8 | 
 9 | section
10 | 
11 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities \<opens>
12 | 
13 | def ACond_\<statement_name> (s₀ : State) : Literal := sorry 
14 | def APost_\<statement_name> (s₀ s₉ : State) : Prop := sorry
15 | def ABody_\<statement_name> (s₀ s₉ : State) : Prop := sorry
16 | def AFor_\<statement_name> (s₀ s₉ : State) : Prop := sorry
17 | 
18 | lemma \<statement_name>_cond_abs_of_code {s₀ fuel} : eval fuel \<statement_name>_cond (s₀) = (s₀, ACond_\<statement_name> (s₀)) := by
19 |   unfold eval ACond_\<statement_name>
20 |   sorry
21 | 
22 | lemma \<statement_name>_concrete_of_post_abs {s₀ s₉ : State} :
23 |   Spec \<statement_name>_post_concrete_of_code s₀ s₉ →
24 |   Spec APost_\<statement_name> s₀ s₉ := by
25 |   sorry
26 | 
27 | lemma \<statement_name>_concrete_of_body_abs {s₀ s₉ : State} :
28 |   Spec \<statement_name>_body_concrete_of_code s₀ s₉ →
29 |   Spec ABody_\<statement_name> s₀ s₉ := by
30 |   sorry
31 | 
32 | lemma AZero_\<statement_name> : ∀ s₀, isOk s₀ → ACond_\<statement_name> (👌 s₀) = 0 → AFor_\<statement_name> s₀ s₀ := sorry
33 | lemma AOk_\<statement_name> : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isOk s₂ → ¬ ❓ s₅ → ¬ ACond_\<statement_name> s₀ = 0 → ABody_\<statement_name> s₀ s₂ → APost_\<statement_name> s₂ s₄ → Spec AFor_\<statement_name> s₄ s₅ → AFor_\<statement_name> s₀ s₅
34 | := sorry
35 | lemma AContinue_\<statement_name> : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isContinue s₂ → ¬ ACond_\<statement_name> s₀ = 0 → ABody_\<statement_name> s₀ s₂ → Spec APost_\<statement_name> (🧟s₂) s₄ → Spec AFor_\<statement_name> s₄ s₅ → AFor_\<statement_name> s₀ s₅ := sorry
36 | lemma ABreak_\<statement_name> : ∀ s₀ s₂, isOk s₀ → isBreak s₂ → ¬ ACond_\<statement_name> s₀ = 0 → ABody_\<statement_name> s₀ s₂ → AFor_\<statement_name> s₀ (🧟s₂) := sorry
37 | lemma ALeave_\<statement_name> : ∀ s₀ s₂, isOk s₀ → isLeave s₂ → ¬ ACond_\<statement_name> s₀ = 0 → ABody_\<statement_name> s₀ s₂ → AFor_\<statement_name> s₀ s₂ := sorry
38 | 
39 | end
40 | 
41 | end \<contract>
42 | 


--------------------------------------------------------------------------------
/vc/src/Utils.hs:
--------------------------------------------------------------------------------
 1 | module Utils (
 2 |   exec,
 3 |   rm,
 4 |   rmr,
 5 |   capitalize,
 6 |   injectSecond,
 7 |   splitAtLast,
 8 |   takeWhile',
 9 |   replaceFile,
10 |   replaceMany,
11 |   traverseDir,
12 |   wordsWhen,
13 |   strip
14 | ) where
15 | 
16 | import Control.Monad (join, foldM)
17 | import Data.Char (toUpper, isSpace)
18 | import System.Process (callCommand)
19 | import Data.Foldable (foldl')
20 | import System.Directory (listDirectory, doesDirectoryExist)
21 | import System.FilePath ((</>))
22 | import Control.Monad.Extra (partitionM)
23 | import Data.List.Extra (replace)
24 | 
25 | -- | Print a shell command and then run it.
26 | exec :: String -> IO ()
27 | exec cmd = putStrLn cmd >> callCommand cmd
28 | 
29 | rm :: FilePath -> IO ()
30 | rm path = exec $ "rm -f " ++ path
31 | 
32 | rmr :: FilePath -> IO ()
33 | rmr path = exec $ "rm -rf " ++ path
34 | 
35 | replaceFile :: FilePath -> FilePath -> IO ()
36 | replaceFile dst src = exec $ "mv " ++ src ++ " " ++ dst
37 | 
38 | injectSecond :: [a] -> a -> [a]
39 | injectSecond [] x = [x]
40 | injectSecond (y : ys) x = y : x : ys
41 | 
42 | splitAtLast :: [a] -> ([a], [a])
43 | splitAtLast l = splitAt (length l - 1) l
44 | 
45 | takeWhile' :: (b -> Bool) -> [b] -> [b]
46 | takeWhile' = ((map snd . takeWhile fst) .) . join . ((zip . (True :)) .) . map -- Ad eundum quo nemo ante iit
47 | 
48 | capitalize :: String -> String
49 | capitalize [] = []
50 | capitalize (hd : tl) = toUpper hd : tl
51 | 
52 | replaceMany :: [(String, String)] -> String -> String
53 | replaceMany = flip $ foldl' ((flip . uncurry) replace)
54 | 
55 | traverseDir :: (b -> FilePath -> IO b) -> b -> FilePath -> IO b
56 | traverseDir f = go
57 |     where go state dir =
58 |              do (dirPaths, filePaths) <- listDirectory dir >>= partitionM doesDirectoryExist . map (dir </>)
59 |                 state' <- foldM f state filePaths
60 |                 foldM go state' dirPaths
61 | 
62 | -- Based on 'Prelude.words'.
63 | wordsWhen :: (Char -> Bool) -> String -> [String]
64 | wordsWhen p s =
65 |   case dropWhile p s of
66 |          "" -> []
67 |          s' -> w : wordsWhen p s''
68 |                where (w, s'') = break p s'
69 | 
70 | strip :: String -> String
71 | strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
72 | 
73 | 


--------------------------------------------------------------------------------
/lake-manifest.json:
--------------------------------------------------------------------------------
 1 | {"version": "1.0.0",
 2 |  "packagesDir": ".lake/packages",
 3 |  "packages":
 4 |  [{"url": "https://github.com/leanprover-community/batteries",
 5 |    "type": "git",
 6 |    "subDir": null,
 7 |    "rev": "dcea9ce8aba248927fb2ea8d5752bfe1e3fe7b44",
 8 |    "name": "batteries",
 9 |    "manifestFile": "lake-manifest.json",
10 |    "inputRev": "v4.9.1",
11 |    "inherited": true,
12 |    "configFile": "lakefile.lean"},
13 |   {"url": "https://github.com/leanprover-community/quote4",
14 |    "type": "git",
15 |    "subDir": null,
16 |    "rev": "a7bfa63f5dddbcab2d4e0569c4cac74b2585e2c6",
17 |    "name": "Qq",
18 |    "manifestFile": "lake-manifest.json",
19 |    "inputRev": "master",
20 |    "inherited": true,
21 |    "configFile": "lakefile.lean"},
22 |   {"url": "https://github.com/leanprover-community/aesop",
23 |    "type": "git",
24 |    "subDir": null,
25 |    "rev": "06cca4bd36b2af743d4858c5cc31604aa9da26bc",
26 |    "name": "aesop",
27 |    "manifestFile": "lake-manifest.json",
28 |    "inputRev": "master",
29 |    "inherited": true,
30 |    "configFile": "lakefile.toml"},
31 |   {"url": "https://github.com/leanprover-community/ProofWidgets4",
32 |    "type": "git",
33 |    "subDir": null,
34 |    "rev": "87c1e7a427d8e21b6eaf8401f12897f52e2c3be9",
35 |    "name": "proofwidgets",
36 |    "manifestFile": "lake-manifest.json",
37 |    "inputRev": "v0.0.38",
38 |    "inherited": true,
39 |    "configFile": "lakefile.lean"},
40 |   {"url": "https://github.com/leanprover/lean4-cli",
41 |    "type": "git",
42 |    "subDir": null,
43 |    "rev": "a11566029bd9ec4f68a65394e8c3ff1af74c1a29",
44 |    "name": "Cli",
45 |    "manifestFile": "lake-manifest.json",
46 |    "inputRev": "main",
47 |    "inherited": true,
48 |    "configFile": "lakefile.lean"},
49 |   {"url": "https://github.com/leanprover-community/import-graph.git",
50 |    "type": "git",
51 |    "subDir": null,
52 |    "rev": "c29c3cdce415240e9dcec5c583ad5d36f83f9c71",
53 |    "name": "importGraph",
54 |    "manifestFile": "lake-manifest.json",
55 |    "inputRev": "main",
56 |    "inherited": true,
57 |    "configFile": "lakefile.toml"},
58 |   {"url": "https://github.com/leanprover-community/mathlib4.git",
59 |    "type": "git",
60 |    "subDir": null,
61 |    "rev": "09d33efc68d3ad52db77b731d7253675395a14aa",
62 |    "name": "mathlib",
63 |    "manifestFile": "lake-manifest.json",
64 |    "inputRev": "v4.9.1",
65 |    "inherited": false,
66 |    "configFile": "lakefile.lean"}],
67 |  "name": "clear",
68 |  "lakeDir": ".lake"}
69 | 


--------------------------------------------------------------------------------
/vc/stack.yaml:
--------------------------------------------------------------------------------
 1 | # This file was automatically generated by 'stack init'
 2 | #
 3 | # Some commonly used options have been documented as comments in this file.
 4 | # For advanced use and comprehensive documentation of the format, please see:
 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/
 6 | 
 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version.
 8 | # A snapshot resolver dictates the compiler version and the set of packages
 9 | # to be used for project dependencies. For example:
10 | #
11 | # resolver: lts-3.5
12 | # resolver: nightly-2015-09-21
13 | # resolver: ghc-7.10.2
14 | #
15 | # The location of a snapshot can be provided as a file or url. Stack assumes
16 | # a snapshot provided as a file might change, whereas a url resource does not.
17 | #
18 | # resolver: ./custom-snapshot.yaml
19 | # resolver: https://example.com/snapshots/2018-01-01.yaml
20 | resolver:
21 |   url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/25.yaml
22 | 
23 | # User packages to be built.
24 | # Various formats can be used as shown in the example below.
25 | #
26 | # packages:
27 | # - some-directory
28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz
29 | #   subdirs:
30 | #   - auto-update
31 | #   - wai
32 | packages:
33 | - .
34 | # Dependency packages to be pulled from upstream that are not in the resolver.
35 | # These entries can reference officially published versions as well as
36 | # forks / in-progress versions pinned to a git hash. For example:
37 | #
38 | # extra-deps:
39 | # - acme-missiles-0.3
40 | # - git: https://github.com/commercialhaskell/stack.git
41 | #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
42 | #
43 | # extra-deps: []
44 | 
45 | # Override default flag values for local packages and extra-deps
46 | # flags: {}
47 | 
48 | # Extra package databases containing global packages
49 | # extra-package-dbs: []
50 | 
51 | # Control whether we use the GHC we find on the path
52 | # system-ghc: true
53 | #
54 | # Require a specific version of Stack, using version ranges
55 | # require-stack-version: -any # Default
56 | # require-stack-version: ">=2.9"
57 | #
58 | # Override the architecture used by Stack, especially useful on Windows
59 | # arch: i386
60 | # arch: x86_64
61 | #
62 | # Extra directories used by Stack for building
63 | # extra-include-dirs: [/path/to/dir]
64 | # extra-lib-dirs: [/path/to/dir]
65 | #
66 | # Allow a newer minor version of GHC than the snapshot specifies
67 | # compiler-check: newer-minor
68 | 
69 | configure-options:
70 |   $targets: []
71 | 


--------------------------------------------------------------------------------
/Clear/Utilities.lean:
--------------------------------------------------------------------------------
 1 | import Clear.Abstraction
 2 | import Clear.Wheels
 3 | 
 4 | namespace Clear.Utilities
 5 | 
 6 | open Clear
 7 | open Clear.Abstraction
 8 | open Clear.State
 9 | 
10 | @[aesop safe apply (rule_sets := [Clear.aesop_spec])]
11 | lemma spec_eq {P P' : State → State  → Prop} {s₀ s₉ : State} :
12 |     (¬❓ s₉ → P s₀ s₉ →  P' s₀ s₉) → Spec P s₀ s₉ → Spec P' s₀ s₉ := by
13 |   intros P'_of_P h
14 |   match s₀ with
15 |   | .Ok e σ =>
16 |     unfold Spec at *
17 |     simp only at h
18 |     simp only
19 |     intros h'
20 |     exact (P'_of_P h' ∘ h) h'
21 |   | .Checkpoint j =>
22 |     unfold Spec at *
23 |     simp only at h
24 |     simp only
25 |     exact h
26 |   | .OutOfFuel =>
27 |     unfold Spec at *
28 |     simp only at h
29 |     simp only
30 |     exact h
31 | 
32 | @[simp]
33 | lemma checkpt_insert_elim {var} {val} {j} : (.Checkpoint j)⟦var ↦ val⟧ = .Checkpoint j := by
34 |   simp only [State.insert]
35 | 
36 | @[simp]
37 | lemma checkpt_setBreak_elim {j} : 💔Checkpoint j = Checkpoint j := by
38 |   simp only [State.setBreak]
39 | 
40 | def isPure (s₀ : State) (s₁ : State) : Prop :=
41 |   match s₀, s₁ with
42 |   | .Ok e₀ _, .Ok e₁ _ => e₀ = e₁
43 |   | _, _ => True
44 | 
45 | @[simp]
46 | lemma isPure_insert {s : State} {var val} : isPure s (s⟦var↦val⟧) := by
47 |   unfold State.insert isPure
48 |   aesop
49 | 
50 | @[simp]
51 | lemma isPure_trans {s₀ s₁ s₂ : State} : isOk s₁ → isPure s₀ s₁ → isPure s₁ s₂ → isPure s₀ s₂ := by
52 |   unfold isPure
53 |   match s₀ with
54 |   | .OutOfFuel | .Checkpoint _ => simp
55 |   | .Ok e₀ σ₀ =>
56 |     match s₂ with
57 |     | .OutOfFuel | .Checkpoint _ => simp
58 |     | .Ok e₂ σ₂ =>
59 |       match s₁ with
60 |       | .Ok e₁ σ₁ | .OutOfFuel | .Checkpoint _ => aesop
61 | 
62 | @[simp]
63 | lemma isPure_rfl {s : State} : isPure s s := by
64 |   unfold isPure; aesop
65 | 
66 | @[simp]
67 | lemma mload_eq_of_isPure {s s' : State} {a : UInt256} : isOk s → isOk s' → isPure s s' → State.mload a s = State.mload a s' := by
68 |   unfold mload isOk isPure
69 |   cases s <;> cases s' <;> aesop
70 | 
71 | @[aesop safe norm (rule_sets := [Clear.aesop_spec])]
72 | lemma isPure_ok_insert_of_ok_ok {s s'} {var} {val}
73 |   (h : s.isOk) :
74 |   isPure (s⟦var↦val⟧) s' ↔ isPure s s' := by aesop_spec
75 | 
76 | @[aesop unsafe 5% (rule_sets := [Clear.aesop_spec])]
77 | lemma evm_eq_of_isPure_ok_ok {evm evm'} {vs vs'} (h : isPure (Ok evm vs) (Ok evm' vs')) : evm = evm' := by
78 |   aesop_spec
79 | 
80 | @[aesop unsafe 5% (rule_sets := [Clear.aesop_spec])]
81 | lemma evm_eq_symm_of_isPure_ok_ok {evm evm'} {vs vs'} (h : isPure (Ok evm vs) (Ok evm' vs')) : evm' = evm := by
82 |   symm
83 |   aesop_spec
84 | 
85 | end Clear.Utilities
86 | 


--------------------------------------------------------------------------------
/vc/src/Lexer.x:
--------------------------------------------------------------------------------
 1 | {
 2 | module Lexer (Token (..), lexer) where
 3 | 
 4 | import Data.List (dropWhileEnd)
 5 | }
 6 | 
 7 | %wrapper "posn"
 8 | 
 9 | tokens :-
10 |   $white+                           ;
11 |   "{"                               { \_ _ -> TokenLCurl }
12 |   "}"                               { \_ _ -> TokenRCurl }
13 |   "("                               { \_ _ -> TokenLPar }
14 |   ")"                               { \_ _ -> TokenRPar }
15 |   "->"                              { \_ _ -> TokenArrow }
16 |   ":="                              { \_ _ -> TokenColonEq }
17 |   ","                               { \_ _ -> TokenComma }
18 |   ":"                               { \_ _ -> TokenColon }
19 |   function                          { \_ _ -> TokenFunction }
20 |   let                               { \_ _ -> TokenLet }
21 |   if                                { \_ _ -> TokenIf }
22 |   switch                            { \_ _ -> TokenSwitch }
23 |   case                              { \_ _ -> TokenCase }
24 |   default                           { \_ _ -> TokenDefault }
25 |   for                               { \_ _ -> TokenFor }
26 |   break                             { \_ _ -> TokenBreak }
27 |   continue                          { \_ _ -> TokenContinue }
28 |   leave                             { \_ _ -> TokenLeave }
29 |   true                              { \_ _ -> TokenTrue }
30 |   false                             { \_ _ -> TokenFalse }
31 |   object                            { \_ _ -> TokenObject }
32 |   code                              { \_ _ -> TokenCode }
33 |   [a-zA-Z\_\$]+ [a-zA-Z\_\$0-9\.]*  { \_ s -> TokenIdentifier s}
34 |   \" ([^\"\r\n\\] | '\\' .)* \"     { \_ s -> TokenString (trimQuotes s) }
35 |   0x [0-9a-fA-F]+                   { \_ s -> TokenHex s }
36 |   [0-9]+                            { \_ s -> TokenDecimal s }
37 |   "///" .*$                         { \_ s -> TokenInlineComment s }
38 |   "/**" [.]* "*/"                   ;
39 | 
40 | {
41 | lexer :: String -> [Token]
42 | lexer = alexScanTokens
43 | 
44 | trimQuotes :: String -> String
45 | trimQuotes = dropWhileEnd (== '"') . dropWhile (== '"')
46 | 
47 | data Token
48 |       = TokenLCurl
49 |       | TokenRCurl
50 |       | TokenLPar
51 |       | TokenRPar
52 |       | TokenArrow
53 |       | TokenColonEq
54 |       | TokenComma
55 |       | TokenColon
56 |       | TokenFunction
57 |       | TokenLet
58 |       | TokenIf
59 |       | TokenSwitch
60 |       | TokenCase
61 |       | TokenDefault
62 |       | TokenFor
63 |       | TokenBreak
64 |       | TokenContinue
65 |       | TokenLeave
66 |       | TokenTrue
67 |       | TokenFalse
68 |       | TokenObject
69 |       | TokenCode
70 |       | TokenIdentifier String
71 |       | TokenString String
72 |       | TokenHex String
73 |       | TokenDecimal String
74 |       | TokenInlineComment String
75 |       | TokenMultilineComment String
76 |   deriving Show
77 | }
78 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/addk_gen.lean:
--------------------------------------------------------------------------------
  1 | import Clear.ReasoningPrinciple
  2 | 
  3 | import Generated.peano.Peano.Common.for_84821961910748561
  4 | 
  5 | 
  6 | namespace Generated.peano.Peano
  7 | 
  8 | section
  9 | 
 10 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common 
 11 | 
 12 | def addk : FunctionDefinition := <f
 13 |     function addk(x, k) -> y
 14 |     
 15 | {
 16 |     for { } 1 {k := sub(k, 1)} {
 17 |         if eq(k, 0) 
 18 |         {break}
 19 |         x := add(x, 1)
 20 |     }
 21 |     y := x
 22 | }
 23 |     
 24 | >
 25 | 
 26 | set_option maxRecDepth 4000
 27 | set_option maxHeartbeats 300000
 28 | 
 29 | def addk_concrete_of_code
 30 | : {
 31 |     C :
 32 |       _ → _ → _ → 
 33 |       State → State → Prop
 34 |     // ∀ {s₀ s₉ : State} {y x k fuel},
 35 |          execCall fuel addk [y] (s₀, [x, k]) = s₉ →
 36 |          Spec (C y x k) s₀ s₉
 37 |   } := by
 38 |   constructor
 39 |   intros s₀ s₉ y x k fuel
 40 |   unfold addk
 41 | 
 42 |   unfold Spec
 43 |   rcases s₀ with ⟨evm, store⟩ | _ | c <;> dsimp only
 44 |   rotate_left 1
 45 |   · generalize Def _ _ _ = f; aesop
 46 |   · generalize Def _ _ _ = f; aesop
 47 |   swap
 48 |   generalize hok : Ok evm store = s₀
 49 |   intros h _
 50 |   revert h
 51 | 
 52 |   unfold execCall
 53 |   unfold call
 54 |   unfold params body rets
 55 |   conv => simp_match
 56 |   conv => pattern List.map _ _; simp
 57 |   conv => pattern mkOk _; rw [← hok]; simp
 58 |   conv => pattern setStore _; rw [← hok]; simp
 59 | 
 60 |   generalize hs₁ : initcall _ _ _ = s₁
 61 |   let_unfold s₁
 62 |   generalize hbody : exec _ _ _ = s₂
 63 |   revert hbody
 64 |   generalize hs₉ : multifill' _ _ = s₉'
 65 | 
 66 |   -- abstraction offsetting
 67 |   rw [cons]
 68 |   generalize hxs : Block _ = xs
 69 |   abstract for_84821961910748561_abs_of_code for_84821961910748561 with ss hs
 70 |   try rw [← hs₁, hok] at hs
 71 |   intros h
 72 |   try intros h'
 73 |   refine' Exists.intro ss (And.intro hs ?_)
 74 |   swap; clear hs
 75 |   try revert h'
 76 |   revert h
 77 |   subst xs
 78 |   
 79 |   rw [cons]; simp only [LetEq', Assign', Lit', Var']
 80 |   -- finish offsetting
 81 |   subst hs₉
 82 |   intros hbody
 83 |   subst hbody
 84 |   subst hs₁
 85 |   rw [← hok]
 86 |   repeat {rw [lookup_insert' (by aesop)]}
 87 |   repeat {rw [lookup_insert_of_ne (by decide)]}
 88 |   try rw [lookup_initcall_1]
 89 |   try rw [lookup_initcall_2 ?_]
 90 |   try rw [lookup_initcall_3 ?_]
 91 |   try rw [lookup_initcall_4 ?_]
 92 |   try rw [lookup_initcall_5 ?_]
 93 |   all_goals try decide
 94 |   let_unfold s₂
 95 |   simp [multifill']
 96 |   try {rw [reviveJump_insert (by aesop)]}
 97 |   repeat {rw [lookup_insert' (by aesop)]}
 98 |   try simp
 99 |   rw [hok]
100 |   intros h
101 |   exact h
102 | 
103 | 
104 | end
105 | 
106 | end Generated.peano.Peano
107 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/expk_gen.lean:
--------------------------------------------------------------------------------
  1 | import Clear.ReasoningPrinciple
  2 | 
  3 | import Generated.peano.Peano.Common.for_727972558926940900
  4 | import Generated.peano.Peano.mulk
  5 | 
  6 | 
  7 | namespace Generated.peano.Peano
  8 | 
  9 | section
 10 | 
 11 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
 12 | 
 13 | def expk : FunctionDefinition := <f
 14 |     function expk(x, k) -> y
 15 |     
 16 | {
 17 |     let y := 1
 18 |     for { } 1 {k := sub(k, 1)} {
 19 |         if eq(k, 0) 
 20 |         {break}
 21 |         y := mulk(y, x)
 22 |     }
 23 | }
 24 |     
 25 | >
 26 | 
 27 | set_option maxRecDepth 4000
 28 | set_option maxHeartbeats 300000
 29 | 
 30 | def expk_concrete_of_code
 31 | : {
 32 |     C :
 33 |       _ → _ → _ → 
 34 |       State → State → Prop
 35 |     // ∀ {s₀ s₉ : State} {y x k fuel},
 36 |          execCall fuel expk [y] (s₀, [x, k]) = s₉ →
 37 |          Spec (C y x k) s₀ s₉
 38 |   } := by
 39 |   constructor
 40 |   intros s₀ s₉ y x k fuel
 41 |   unfold expk
 42 | 
 43 |   unfold Spec
 44 |   rcases s₀ with ⟨evm, store⟩ | _ | c <;> dsimp only
 45 |   rotate_left 1
 46 |   · generalize Def _ _ _ = f; aesop
 47 |   · generalize Def _ _ _ = f; aesop
 48 |   swap
 49 |   generalize hok : Ok evm store = s₀
 50 |   intros h _
 51 |   revert h
 52 | 
 53 |   unfold execCall
 54 |   unfold call
 55 |   unfold params body rets
 56 |   conv => simp_match
 57 |   conv => pattern List.map _ _; simp
 58 |   conv => pattern mkOk _; rw [← hok]; simp
 59 |   conv => pattern setStore _; rw [← hok]; simp
 60 | 
 61 |   generalize hs₁ : initcall _ _ _ = s₁
 62 |   let_unfold s₁
 63 |   generalize hbody : exec _ _ _ = s₂
 64 |   revert hbody
 65 |   generalize hs₉ : multifill' _ _ = s₉'
 66 | 
 67 |   rw [cons]; simp only [LetEq', Assign', Lit', Var']
 68 |   -- abstraction offsetting
 69 |   rw [cons]
 70 |   generalize hxs : Block _ = xs
 71 |   abstract for_727972558926940900_abs_of_code for_727972558926940900 with ss hs
 72 |   try rw [← hs₁, hok] at hs
 73 |   intros h
 74 |   try intros h'
 75 |   refine' Exists.intro ss (And.intro hs ?_)
 76 |   swap; clear hs
 77 |   try revert h'
 78 |   revert h
 79 |   subst xs
 80 |   
 81 |   -- finish offsetting
 82 |   subst hs₉
 83 |   intros hbody
 84 |   subst hbody
 85 |   subst hs₁
 86 |   rw [← hok]
 87 |   repeat {rw [lookup_insert' (by aesop)]}
 88 |   repeat {rw [lookup_insert_of_ne (by decide)]}
 89 |   try rw [lookup_initcall_1]
 90 |   try rw [lookup_initcall_2 ?_]
 91 |   try rw [lookup_initcall_3 ?_]
 92 |   try rw [lookup_initcall_4 ?_]
 93 |   try rw [lookup_initcall_5 ?_]
 94 |   all_goals try decide
 95 |   let_unfold s₂
 96 |   simp [multifill']
 97 |   try {rw [reviveJump_insert (by aesop)]}
 98 |   repeat {rw [lookup_insert' (by aesop)]}
 99 |   try simp
100 |   rw [hok]
101 |   intros h
102 |   exact h
103 | 
104 | 
105 | end
106 | 
107 | end Generated.peano.Peano
108 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/mulk_gen.lean:
--------------------------------------------------------------------------------
  1 | import Clear.ReasoningPrinciple
  2 | 
  3 | import Generated.peano.Peano.Common.for_4806375509446804985
  4 | import Generated.peano.Peano.addk
  5 | 
  6 | 
  7 | namespace Generated.peano.Peano
  8 | 
  9 | section
 10 | 
 11 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
 12 | 
 13 | def mulk : FunctionDefinition := <f
 14 |     function mulk(x, k) -> y
 15 |     
 16 | {
 17 |     let y := 0
 18 |     for { } 1 {k := sub(k, 1)} {
 19 |         if eq(k, 0) 
 20 |         {break}
 21 |         y := addk(y, x)
 22 |     }
 23 | }
 24 |     
 25 | >
 26 | 
 27 | set_option maxRecDepth 4000
 28 | set_option maxHeartbeats 300000
 29 | 
 30 | def mulk_concrete_of_code
 31 | : {
 32 |     C :
 33 |       _ → _ → _ → 
 34 |       State → State → Prop
 35 |     // ∀ {s₀ s₉ : State} {y x k fuel},
 36 |          execCall fuel mulk [y] (s₀, [x, k]) = s₉ →
 37 |          Spec (C y x k) s₀ s₉
 38 |   } := by
 39 |   constructor
 40 |   intros s₀ s₉ y x k fuel
 41 |   unfold mulk
 42 | 
 43 |   unfold Spec
 44 |   rcases s₀ with ⟨evm, store⟩ | _ | c <;> dsimp only
 45 |   rotate_left 1
 46 |   · generalize Def _ _ _ = f; aesop
 47 |   · generalize Def _ _ _ = f; aesop
 48 |   swap
 49 |   generalize hok : Ok evm store = s₀
 50 |   intros h _
 51 |   revert h
 52 | 
 53 |   unfold execCall
 54 |   unfold call
 55 |   unfold params body rets
 56 |   conv => simp_match
 57 |   conv => pattern List.map _ _; simp
 58 |   conv => pattern mkOk _; rw [← hok]; simp
 59 |   conv => pattern setStore _; rw [← hok]; simp
 60 | 
 61 |   generalize hs₁ : initcall _ _ _ = s₁
 62 |   let_unfold s₁
 63 |   generalize hbody : exec _ _ _ = s₂
 64 |   revert hbody
 65 |   generalize hs₉ : multifill' _ _ = s₉'
 66 | 
 67 |   rw [cons]; simp only [LetEq', Assign', Lit', Var']
 68 |   -- abstraction offsetting
 69 |   rw [cons]
 70 |   generalize hxs : Block _ = xs
 71 |   abstract for_4806375509446804985_abs_of_code for_4806375509446804985 with ss hs
 72 |   try rw [← hs₁, hok] at hs
 73 |   intros h
 74 |   try intros h'
 75 |   refine' Exists.intro ss (And.intro hs ?_)
 76 |   swap; clear hs
 77 |   try revert h'
 78 |   revert h
 79 |   subst xs
 80 |   
 81 |   -- finish offsetting
 82 |   subst hs₉
 83 |   intros hbody
 84 |   subst hbody
 85 |   subst hs₁
 86 |   rw [← hok]
 87 |   repeat {rw [lookup_insert' (by aesop)]}
 88 |   repeat {rw [lookup_insert_of_ne (by decide)]}
 89 |   try rw [lookup_initcall_1]
 90 |   try rw [lookup_initcall_2 ?_]
 91 |   try rw [lookup_initcall_3 ?_]
 92 |   try rw [lookup_initcall_4 ?_]
 93 |   try rw [lookup_initcall_5 ?_]
 94 |   all_goals try decide
 95 |   let_unfold s₂
 96 |   simp [multifill']
 97 |   try {rw [reviveJump_insert (by aesop)]}
 98 |   repeat {rw [lookup_insert' (by aesop)]}
 99 |   try simp
100 |   rw [hok]
101 |   intros h
102 |   exact h
103 | 
104 | 
105 | end
106 | 
107 | end Generated.peano.Peano
108 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_84821961910748561_gen.lean:
--------------------------------------------------------------------------------
  1 | import Clear.ReasoningPrinciple
  2 | 
  3 | import Generated.peano.Peano.Common.if_6183625948864629624
  4 | 
  5 | 
  6 | namespace Peano.Common
  7 | 
  8 | set_option autoImplicit false
  9 | 
 10 | section
 11 | 
 12 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common 
 13 | 
 14 | def for_84821961910748561_cond := <<
 15 |     1
 16 | >>
 17 | 
 18 | def for_84821961910748561_post : List Stmt := <ss
 19 |     {k := sub(k, 1)}
 20 | >
 21 | 
 22 | def for_84821961910748561_body : List Stmt := <ss
 23 | {
 24 |     if eq(k, 0) 
 25 |     {break}
 26 |     x := add(x, 1)
 27 | }
 28 | >
 29 | 
 30 | def for_84821961910748561 := <s
 31 | for { } 1 {k := sub(k, 1)} {
 32 |     if eq(k, 0) 
 33 |     {break}
 34 |     x := add(x, 1)
 35 | }
 36 | >
 37 | 
 38 | set_option maxRecDepth 4000
 39 | 
 40 | -- =============================================================================
 41 | --  POST
 42 | -- =============================================================================
 43 | 
 44 | def for_84821961910748561_post_concrete_of_code
 45 | : {
 46 |     C : State → State → Prop
 47 |     // ∀ {s₀ s₉ fuel}
 48 |     , exec fuel (Block for_84821961910748561_post) s₀ = s₉
 49 |     → Spec C s₀ s₉
 50 |   } := by
 51 |   constructor
 52 |   intros s₀ s₉ fuel
 53 | 
 54 |   unfold Spec for_84821961910748561_post
 55 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
 56 |   rotate_left 1
 57 |   · aesop
 58 |   · aesop
 59 |   swap
 60 |   generalize hok : Ok evm₀ store₀ = s₀
 61 |   intros h _
 62 |   revert h
 63 | 
 64 |   rw [cons]; simp only [LetPrimCall', AssignPrimCall']
 65 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
 66 |   rw [EVMSub']
 67 |   try simp
 68 |   
 69 |   
 70 |   -- tacticsOfStmt offsetting
 71 |   try rw [nil]
 72 |   try simp [Bool.toUInt256, UInt256.size]
 73 |   intros h
 74 |   exact h
 75 | 
 76 | 
 77 | -- =============================================================================
 78 | --  BODY
 79 | -- =============================================================================
 80 | 
 81 | def for_84821961910748561_body_concrete_of_code
 82 | : {
 83 |     C : State → State → Prop
 84 |     // ∀ {s₀ s₉ fuel}
 85 |     , exec fuel (Block for_84821961910748561_body) s₀ = s₉
 86 |     → Spec C s₀ s₉
 87 |   }
 88 | := by
 89 |   constructor
 90 |   intros s₀ s₉ fuel
 91 | 
 92 |   unfold Spec for_84821961910748561_body
 93 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
 94 |   rotate_left 1
 95 |   · aesop
 96 |   · aesop
 97 |   swap
 98 |   generalize hok : Ok evm₀ store₀ = s₀
 99 |   intros h _
100 |   revert h
101 | 
102 |   -- abstraction offsetting
103 |   rw [cons]
104 |   generalize hxs : Block _ = xs
105 |   abstract if_6183625948864629624_abs_of_code if_6183625948864629624 with ss hs
106 |   try rw [← hs₁, hok] at hs
107 |   intros h
108 |   try intros h'
109 |   refine' Exists.intro ss (And.intro hs ?_)
110 |   swap; clear hs
111 |   try revert h'
112 |   revert h
113 |   subst xs
114 |   
115 |   rw [cons]; simp only [LetPrimCall', AssignPrimCall']
116 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
117 |   rw [EVMAdd']
118 |   try simp
119 |   
120 |   
121 |   -- tacticsOfStmt offsetting
122 |   try rw [nil]
123 |   try simp [Bool.toUInt256, UInt256.size]
124 |   intros h
125 |   exact h
126 | 
127 | 
128 | end
129 | 
130 | end Peano.Common
131 | 


--------------------------------------------------------------------------------
/Clear/Ast.lean:
--------------------------------------------------------------------------------
  1 | /- Yul specification:
  2 | https://docs.soliditylang.org/en/v0.8.9/yul.html
  3 | -/
  4 | 
  5 | import Batteries.Tactic.Basic
  6 | import Mathlib.Data.Fin.Basic
  7 | import Clear.UInt256
  8 | 
  9 | namespace Clear.Ast
 10 | 
 11 | open Clear UInt256
 12 | 
 13 | abbrev Literal := UInt256
 14 | def Identifier := String
 15 | 
 16 | instance : Inhabited Identifier := ⟨""⟩
 17 | instance : DecidableEq Identifier := String.decEq
 18 | 
 19 | inductive P where
 20 |   | Add
 21 |   | Sub
 22 |   | Mul
 23 |   | Div
 24 |   | Sdiv
 25 |   | Mod
 26 |   | Smod
 27 |   | Addmod
 28 |   | Mulmod
 29 |   | Exp
 30 |   | Signextend
 31 |   | Lt
 32 |   | Gt
 33 |   | Slt
 34 |   | Sgt
 35 |   | Eq
 36 |   | Iszero
 37 |   | And
 38 |   | Or
 39 |   | Xor
 40 |   | Not
 41 |   -- Rename to `Byteat`?
 42 |   | Byte
 43 |   | Shl
 44 |   | Shr
 45 |   | Sar
 46 |   | Keccak256
 47 |   | Address
 48 |   | Balance
 49 |   | Origin
 50 |   | Caller
 51 |   | Callvalue
 52 |   | Calldataload
 53 |   | Calldatacopy
 54 |   | Calldatasize
 55 |   | Codesize
 56 |   | Codecopy
 57 |   | Gasprice
 58 |   | Extcodesize
 59 |   | Extcodecopy
 60 |   | Extcodehash
 61 |   | Returndatasize
 62 |   | Returndatacopy
 63 |   | Blockhash
 64 |   | Coinbase
 65 |   | Timestamp
 66 |   | Gaslimit
 67 |   | Chainid
 68 |   | Selfbalance
 69 |   | Mload
 70 |   | Mstore
 71 |   | Sload
 72 |   | Sstore
 73 |   | Msize
 74 |   | Gas
 75 |   | Revert
 76 |   | Return
 77 |   | Pop
 78 |   | Call
 79 |   | Staticcall
 80 |   | Delegatecall
 81 |   | Loadimmutable
 82 |   | Log1
 83 |   | Log2
 84 |   | Log3
 85 |   | Log4
 86 |   | Number
 87 | deriving Repr
 88 | 
 89 | abbrev PrimOp := P
 90 | 
 91 | def P.toString (primOp : P) : String :=
 92 |   (ToString.toString <| repr primOp).splitOn "." |>.getLast!
 93 | 
 94 | -- https://docs.soliditylang.org/en/latest/yul.html#informal-description-of-yul
 95 | 
 96 | mutual
 97 |   inductive FunctionDefinition where
 98 |     | Def : List Identifier → List Identifier → List Stmt → FunctionDefinition
 99 | 
100 |   inductive Expr where
101 |     | PrimCall : PrimOp → List Expr → Expr
102 |     | Call : FunctionDefinition → List Expr → Expr
103 |     | Var : Identifier → Expr
104 |     | Lit : Literal → Expr
105 | 
106 |   -- | The loop constructor 'Stmt.For' has no initialiser because of 
107 |   -- https://docs.soliditylang.org/en/latest/internals/optimizer.html#forloopinitrewriter
108 |   inductive Stmt where
109 |     | Block : List Stmt → Stmt
110 |     | Let : List Identifier → Stmt
111 |     | LetEq : Identifier → Expr → Stmt
112 |     | LetCall : List Identifier → FunctionDefinition → List Expr → Stmt
113 |     | LetPrimCall : List Identifier → PrimOp → List Expr → Stmt
114 |     | Assign : Identifier → Expr → Stmt
115 |     | AssignCall : List Identifier → FunctionDefinition → List Expr → Stmt
116 |     | AssignPrimCall : List Identifier → PrimOp → List Expr → Stmt
117 |     | ExprStmtCall : FunctionDefinition → List Expr -> Stmt
118 |     | ExprStmtPrimCall : PrimOp → List Expr -> Stmt
119 |     | Switch : Expr → List (Literal × List Stmt) → List Stmt → Stmt
120 |     | For : Expr → List Stmt → List Stmt → Stmt
121 |     | If : Expr → List Stmt → Stmt
122 |     | Continue : Stmt
123 |     | Break : Stmt
124 |     | Leave : Stmt
125 | end
126 | 
127 | namespace FunctionDefinition
128 | 
129 | def params : FunctionDefinition → List Identifier
130 |   | Def params _ _ => params
131 | 
132 | def rets : FunctionDefinition → List Identifier
133 |   | Def _ rets _ => rets
134 | 
135 | def body : FunctionDefinition → List Stmt
136 |   | Def _ _ body => body
137 | 
138 | end FunctionDefinition
139 | 
140 | 
141 | end Clear.Ast
142 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_84821961910748561_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.if_6183625948864629624
 4 | 
 5 | import Generated.peano.Peano.Common.for_84821961910748561_gen
 6 | 
 7 | 
 8 | namespace Peano.Common
 9 | 
10 | set_option autoImplicit false
11 | 
12 | section
13 | 
14 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common 
15 | 
16 | def ACond_for_84821961910748561 (s₀ : State) : Literal := 1 
17 | def APost_for_84821961910748561 (s₀ s₉ : State) : Prop := s₉ = s₀⟦"k"↦(s₀["k"]!!) - 1⟧
18 | def ABody_for_84821961910748561 (s₀ s₉ : State) : Prop := s₉ = if s₀["k"]!! = 0 then 💔 s₀ else s₀⟦"x"↦(s₀["x"]!!) + 1⟧
19 | def AFor_for_84821961910748561 (s₀ s₉ : State) : Prop := (s₀["x"]!!) + (s₀["k"]!!) = (s₉["x"]!!) ∧ isPure s₀ s₉ ∧ s₉.isOk
20 | 
21 | lemma for_84821961910748561_cond_abs_of_code {s₀ fuel} : eval fuel for_84821961910748561_cond (s₀) = (s₀, ACond_for_84821961910748561 (s₀)) := by
22 |   unfold eval ACond_for_84821961910748561
23 |   aesop_spec
24 | 
25 | lemma for_84821961910748561_concrete_of_post_abs {s₀ s₉ : State} :
26 |   Spec for_84821961910748561_post_concrete_of_code s₀ s₉ →
27 |   Spec APost_for_84821961910748561 s₀ s₉ := by
28 |   unfold APost_for_84821961910748561 for_84821961910748561_post_concrete_of_code
29 |   aesop_spec
30 | 
31 | lemma for_84821961910748561_concrete_of_body_abs {s₀ s₉ : State} :
32 |   Spec for_84821961910748561_body_concrete_of_code s₀ s₉ →
33 |   Spec ABody_for_84821961910748561 s₀ s₉ := by
34 |   unfold for_84821961910748561_body_concrete_of_code ABody_for_84821961910748561 A_if_6183625948864629624
35 |   apply spec_eq; simp
36 |   aesop_spec
37 | 
38 | lemma AZero_for_84821961910748561 : ∀ s₀, isOk s₀ → ACond_for_84821961910748561 (👌 s₀) = 0 → AFor_for_84821961910748561 s₀ s₀ := by
39 |   unfold ACond_for_84821961910748561
40 |   aesop_spec
41 | 
42 | lemma AOk_for_84821961910748561 : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isOk s₂ → ¬ ❓ s₅ → ¬ ACond_for_84821961910748561 s₀ = 0 → ABody_for_84821961910748561 s₀ s₂ → APost_for_84821961910748561 s₂ s₄ → Spec AFor_for_84821961910748561 s₄ s₅ → AFor_for_84821961910748561 s₀ s₅ := by
43 |   unfold ABody_for_84821961910748561 APost_for_84821961910748561 AFor_for_84821961910748561
44 |   intros s₀ s₂ s₄ s₅ h₁ h₂ h₃ h₄ h₅ h₆ h₇
45 |   rcases s₄ with _ | _ | _ <;> [skip; aesop_spec; skip]
46 |   · clr_spec at h₇
47 |     split_ands <;> [skip; aesop_spec; tauto]
48 |     by_cases eq : s₀["k"]!! = 0 <;> simp [eq] at h₅ <;> [simp [h₅] at h₂; skip]
49 |     rw [h₆] at h₇; rw [h₇.1.symm, h₅]; clr_varstore
50 |     ring
51 |   · have h : isOk (s₂⟦"k"↦(s₂["k"]!!) - 1⟧) := by aesop
52 |     simp [h₆.symm] at h
53 | 
54 | lemma AContinue_for_84821961910748561 : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isContinue s₂ → ¬ ACond_for_84821961910748561 s₀ = 0 → ABody_for_84821961910748561 s₀ s₂ → Spec APost_for_84821961910748561 (🧟s₂) s₄ → Spec AFor_for_84821961910748561 s₄ s₅ → AFor_for_84821961910748561 s₀ s₅ := by
55 |   unfold ABody_for_84821961910748561
56 |   aesop_spec
57 | 
58 | lemma ABreak_for_84821961910748561 : ∀ s₀ s₂, isOk s₀ → isBreak s₂ → ¬ ACond_for_84821961910748561 s₀ = 0 → ABody_for_84821961910748561 s₀ s₂ → AFor_for_84821961910748561 s₀ (🧟s₂) := by
59 |   unfold ABody_for_84821961910748561 AFor_for_84821961910748561
60 |   aesop_spec
61 | 
62 | lemma ALeave_for_84821961910748561 : ∀ s₀ s₂, isOk s₀ → isLeave s₂ → ¬ ACond_for_84821961910748561 s₀ = 0 → ABody_for_84821961910748561 s₀ s₂ → AFor_for_84821961910748561 s₀ s₂ := by
63 |   unfold ABody_for_84821961910748561
64 |   aesop_spec
65 | 
66 | end
67 | 
68 | end Peano.Common
69 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_4806375509446804985_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.if_6183625948864629624
 4 | import Generated.peano.Peano.addk
 5 | 
 6 | import Generated.peano.Peano.Common.for_4806375509446804985_gen
 7 | 
 8 | 
 9 | namespace Peano.Common
10 | 
11 | set_option autoImplicit false
12 | 
13 | section
14 | 
15 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
16 | 
17 | def ACond_for_4806375509446804985 (s₀ : State) : Literal := 1 
18 | def APost_for_4806375509446804985 (s₀ s₉ : State) : Prop := s₉ = s₀⟦"k"↦(s₀["k"]!!) - 1⟧
19 | def ABody_for_4806375509446804985 (s₀ s₉ : State) : Prop := s₉ = if s₀["k"]!! = 0 then 💔 s₀ else s₀⟦"y"↦(s₀["y"]!!) + (s₀["x"]!!)⟧
20 | def AFor_for_4806375509446804985 (s₀ s₉ : State) : Prop := (s₉["y"]!!) = (s₀["y"]!!) + (s₀["x"]!!) * (s₀["k"]!!) ∧ isPure s₀ s₉ ∧ s₉.isOk
21 | 
22 | lemma for_4806375509446804985_cond_abs_of_code {s₀ fuel} : eval fuel for_4806375509446804985_cond (s₀) = (s₀, ACond_for_4806375509446804985 (s₀)) := by
23 |   unfold eval ACond_for_4806375509446804985
24 |   aesop_spec
25 | 
26 | lemma for_4806375509446804985_concrete_of_post_abs {s₀ s₉ : State} :
27 |   Spec for_4806375509446804985_post_concrete_of_code s₀ s₉ →
28 |   Spec APost_for_4806375509446804985 s₀ s₉ := by
29 |   unfold for_4806375509446804985_post_concrete_of_code APost_for_4806375509446804985 Spec
30 |   aesop_spec
31 | 
32 | lemma for_4806375509446804985_concrete_of_body_abs {s₀ s₉ : State} :
33 |   Spec for_4806375509446804985_body_concrete_of_code s₀ s₉ →
34 |   Spec ABody_for_4806375509446804985 s₀ s₉ := by
35 |   unfold for_4806375509446804985_body_concrete_of_code ABody_for_4806375509446804985 A_if_6183625948864629624 Spec
36 |   aesop_spec
37 | 
38 | lemma AZero_for_4806375509446804985 : ∀ s₀, isOk s₀ → ACond_for_4806375509446804985 (👌 s₀) = 0 → AFor_for_4806375509446804985 s₀ s₀ := by
39 |   unfold ACond_for_4806375509446804985 
40 |   aesop_spec
41 | 
42 | lemma AOk_for_4806375509446804985 : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isOk s₂ → ¬ ❓ s₅ → ¬ ACond_for_4806375509446804985 s₀ = 0 → ABody_for_4806375509446804985 s₀ s₂ → APost_for_4806375509446804985 s₂ s₄ → Spec AFor_for_4806375509446804985 s₄ s₅ → AFor_for_4806375509446804985 s₀ s₅
43 | := by
44 |   unfold AFor_for_4806375509446804985 APost_for_4806375509446804985 ABody_for_4806375509446804985
45 |   intros s₀ s₂ s₄ s₅ h₁ h₂ h₃ h₄ h₅ h₆ h₇
46 |   rcases s₄ with ⟨evm, vs⟩ | _ | v <;> [skip; aesop_spec; skip]
47 |   · clr_spec at h₇
48 |     split_ands <;> [rw [h₆] at h₇; aesop_spec; tauto]
49 |     · split_ifs at h₅
50 |       · aesop_spec
51 |       · simp only [h₇, h₅] at *
52 |         clr_varstore
53 |         ring
54 |   · have : isOk (s₂⟦"k"↦s₂["k"]!! - 1⟧) := by aesop
55 |     simp [h₆.symm] at this
56 | 
57 | lemma AContinue_for_4806375509446804985 : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isContinue s₂ → ¬ ACond_for_4806375509446804985 s₀ = 0 → ABody_for_4806375509446804985 s₀ s₂ → Spec APost_for_4806375509446804985 (🧟s₂) s₄ → Spec AFor_for_4806375509446804985 s₄ s₅ → AFor_for_4806375509446804985 s₀ s₅ := by
58 |   unfold ABody_for_4806375509446804985
59 |   aesop_spec
60 | 
61 | lemma ABreak_for_4806375509446804985 : ∀ s₀ s₂, isOk s₀ → isBreak s₂ → ¬ ACond_for_4806375509446804985 s₀ = 0 → ABody_for_4806375509446804985 s₀ s₂ → AFor_for_4806375509446804985 s₀ (🧟s₂) := by
62 |   unfold ABody_for_4806375509446804985 AFor_for_4806375509446804985
63 |   aesop_spec
64 | 
65 | lemma ALeave_for_4806375509446804985 : ∀ s₀ s₂, isOk s₀ → isLeave s₂ → ¬ ACond_for_4806375509446804985 s₀ = 0 → ABody_for_4806375509446804985 s₀ s₂ → AFor_for_4806375509446804985 s₀ s₂ := by
66 |   unfold ABody_for_4806375509446804985
67 |   aesop_spec
68 | 
69 | end
70 | 
71 | end Peano.Common
72 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_727972558926940900_gen.lean:
--------------------------------------------------------------------------------
  1 | import Clear.ReasoningPrinciple
  2 | 
  3 | import Generated.peano.Peano.Common.if_6183625948864629624
  4 | import Generated.peano.Peano.mulk
  5 | 
  6 | 
  7 | namespace Peano.Common
  8 | 
  9 | set_option autoImplicit false
 10 | 
 11 | section
 12 | 
 13 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
 14 | 
 15 | def for_727972558926940900_cond := <<
 16 |     1
 17 | >>
 18 | 
 19 | def for_727972558926940900_post : List Stmt := <ss
 20 |     {k := sub(k, 1)}
 21 | >
 22 | 
 23 | def for_727972558926940900_body : List Stmt := <ss
 24 | {
 25 |     if eq(k, 0) 
 26 |     {break}
 27 |     y := mulk(y, x)
 28 | }
 29 | >
 30 | 
 31 | def for_727972558926940900 := <s
 32 | for { } 1 {k := sub(k, 1)} {
 33 |     if eq(k, 0) 
 34 |     {break}
 35 |     y := mulk(y, x)
 36 | }
 37 | >
 38 | 
 39 | set_option maxRecDepth 4000
 40 | 
 41 | -- =============================================================================
 42 | --  POST
 43 | -- =============================================================================
 44 | 
 45 | def for_727972558926940900_post_concrete_of_code
 46 | : {
 47 |     C : State → State → Prop
 48 |     // ∀ {s₀ s₉ fuel}
 49 |     , exec fuel (Block for_727972558926940900_post) s₀ = s₉
 50 |     → Spec C s₀ s₉
 51 |   } := by
 52 |   constructor
 53 |   intros s₀ s₉ fuel
 54 | 
 55 |   unfold Spec for_727972558926940900_post
 56 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
 57 |   rotate_left 1
 58 |   · aesop
 59 |   · aesop
 60 |   swap
 61 |   generalize hok : Ok evm₀ store₀ = s₀
 62 |   intros h _
 63 |   revert h
 64 | 
 65 |   rw [cons]; simp only [LetPrimCall', AssignPrimCall']
 66 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
 67 |   rw [EVMSub']
 68 |   try simp
 69 |   
 70 |   
 71 |   -- tacticsOfStmt offsetting
 72 |   try rw [nil]
 73 |   try simp [Bool.toUInt256, UInt256.size]
 74 |   intros h
 75 |   exact h
 76 | 
 77 | 
 78 | -- =============================================================================
 79 | --  BODY
 80 | -- =============================================================================
 81 | 
 82 | def for_727972558926940900_body_concrete_of_code
 83 | : {
 84 |     C : State → State → Prop
 85 |     // ∀ {s₀ s₉ fuel}
 86 |     , exec fuel (Block for_727972558926940900_body) s₀ = s₉
 87 |     → Spec C s₀ s₉
 88 |   }
 89 | := by
 90 |   constructor
 91 |   intros s₀ s₉ fuel
 92 | 
 93 |   unfold Spec for_727972558926940900_body
 94 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
 95 |   rotate_left 1
 96 |   · aesop
 97 |   · aesop
 98 |   swap
 99 |   generalize hok : Ok evm₀ store₀ = s₀
100 |   intros h _
101 |   revert h
102 | 
103 |   -- abstraction offsetting
104 |   rw [cons]
105 |   generalize hxs : Block _ = xs
106 |   abstract if_6183625948864629624_abs_of_code if_6183625948864629624 with ss hs
107 |   try rw [← hs₁, hok] at hs
108 |   intros h
109 |   try intros h'
110 |   refine' Exists.intro ss (And.intro hs ?_)
111 |   swap; clear hs
112 |   try revert h'
113 |   revert h
114 |   subst xs
115 |   
116 |   rw [cons]; simp only [LetCall', AssignCall']
117 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
118 |   -- EXPR 
119 |   try simp
120 |   generalize hs : execCall _ _ _ _ = s; try rw [← hs₁, hok] at hs
121 |   intros h
122 |   try intros h'
123 |   refine' Exists.intro s (And.intro (mulk_abs_of_code hs) ?_)
124 |   swap; clear hs
125 |   try revert h'
126 |   revert h
127 |   
128 |   
129 |   -- tacticsOfStmt offsetting
130 |   try rw [nil]
131 |   try simp [Bool.toUInt256, UInt256.size]
132 |   intros h
133 |   exact h
134 | 
135 | 
136 | end
137 | 
138 | end Peano.Common
139 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_4806375509446804985_gen.lean:
--------------------------------------------------------------------------------
  1 | import Clear.ReasoningPrinciple
  2 | 
  3 | import Generated.peano.Peano.Common.if_6183625948864629624
  4 | import Generated.peano.Peano.addk
  5 | 
  6 | 
  7 | namespace Peano.Common
  8 | 
  9 | set_option autoImplicit false
 10 | 
 11 | section
 12 | 
 13 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
 14 | 
 15 | def for_4806375509446804985_cond := <<
 16 |     1
 17 | >>
 18 | 
 19 | def for_4806375509446804985_post : List Stmt := <ss
 20 |     {k := sub(k, 1)}
 21 | >
 22 | 
 23 | def for_4806375509446804985_body : List Stmt := <ss
 24 | {
 25 |     if eq(k, 0) 
 26 |     {break}
 27 |     y := addk(y, x)
 28 | }
 29 | >
 30 | 
 31 | def for_4806375509446804985 := <s
 32 | for { } 1 {k := sub(k, 1)} {
 33 |     if eq(k, 0) 
 34 |     {break}
 35 |     y := addk(y, x)
 36 | }
 37 | >
 38 | 
 39 | set_option maxRecDepth 4000
 40 | 
 41 | -- =============================================================================
 42 | --  POST
 43 | -- =============================================================================
 44 | 
 45 | def for_4806375509446804985_post_concrete_of_code
 46 | : {
 47 |     C : State → State → Prop
 48 |     // ∀ {s₀ s₉ fuel}
 49 |     , exec fuel (Block for_4806375509446804985_post) s₀ = s₉
 50 |     → Spec C s₀ s₉
 51 |   } := by
 52 |   constructor
 53 |   intros s₀ s₉ fuel
 54 | 
 55 |   unfold Spec for_4806375509446804985_post
 56 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
 57 |   rotate_left 1
 58 |   · aesop
 59 |   · aesop
 60 |   swap
 61 |   generalize hok : Ok evm₀ store₀ = s₀
 62 |   intros h _
 63 |   revert h
 64 | 
 65 |   rw [cons]; simp only [LetPrimCall', AssignPrimCall']
 66 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
 67 |   rw [EVMSub']
 68 |   try simp
 69 |   
 70 |   
 71 |   -- tacticsOfStmt offsetting
 72 |   try rw [nil]
 73 |   try simp [Bool.toUInt256, UInt256.size]
 74 |   intros h
 75 |   exact h
 76 | 
 77 | 
 78 | -- =============================================================================
 79 | --  BODY
 80 | -- =============================================================================
 81 | 
 82 | def for_4806375509446804985_body_concrete_of_code
 83 | : {
 84 |     C : State → State → Prop
 85 |     // ∀ {s₀ s₉ fuel}
 86 |     , exec fuel (Block for_4806375509446804985_body) s₀ = s₉
 87 |     → Spec C s₀ s₉
 88 |   }
 89 | := by
 90 |   constructor
 91 |   intros s₀ s₉ fuel
 92 | 
 93 |   unfold Spec for_4806375509446804985_body
 94 |   rcases s₀ with ⟨evm₀, store₀⟩ | _ | c <;> dsimp only
 95 |   rotate_left 1
 96 |   · aesop
 97 |   · aesop
 98 |   swap
 99 |   generalize hok : Ok evm₀ store₀ = s₀
100 |   intros h _
101 |   revert h
102 | 
103 |   -- abstraction offsetting
104 |   rw [cons]
105 |   generalize hxs : Block _ = xs
106 |   abstract if_6183625948864629624_abs_of_code if_6183625948864629624 with ss hs
107 |   try rw [← hs₁, hok] at hs
108 |   intros h
109 |   try intros h'
110 |   refine' Exists.intro ss (And.intro hs ?_)
111 |   swap; clear hs
112 |   try revert h'
113 |   revert h
114 |   subst xs
115 |   
116 |   rw [cons]; simp only [LetCall', AssignCall']
117 |   simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]
118 |   -- EXPR 
119 |   try simp
120 |   generalize hs : execCall _ _ _ _ = s; try rw [← hs₁, hok] at hs
121 |   intros h
122 |   try intros h'
123 |   refine' Exists.intro s (And.intro (addk_abs_of_code hs) ?_)
124 |   swap; clear hs
125 |   try revert h'
126 |   revert h
127 |   
128 |   
129 |   -- tacticsOfStmt offsetting
130 |   try rw [nil]
131 |   try simp [Bool.toUInt256, UInt256.size]
132 |   intros h
133 |   exact h
134 | 
135 | 
136 | end
137 | 
138 | end Peano.Common
139 | 


--------------------------------------------------------------------------------
/Clear/SizeLemmas.lean:
--------------------------------------------------------------------------------
  1 | import Clear.Ast
  2 | 
  3 | namespace Clear.SizeLemmas
  4 | 
  5 | section
  6 | 
  7 | open Clear Ast Expr Stmt FunctionDefinition
  8 | 
  9 | variable {expr arg : Expr}
 10 |          {stmt : Stmt}
 11 |          {exprs args args' : List Expr}
 12 |          {stmts : List Stmt}
 13 |          {f : FunctionDefinition}
 14 |          {prim : PrimOp}
 15 |          {α : Type}
 16 |          {xs ys : List α}
 17 | 
 18 | -- ============================================================================
 19 | --  SIZEOF LEMMAS
 20 | -- ============================================================================
 21 | 
 22 | @[simp]
 23 | lemma Zero.zero_le {n : ℕ} : Zero.zero ≤ n := by ring_nf; exact Nat.zero_le _
 24 | 
 25 | @[simp]
 26 | lemma List.zero_lt_sizeOf : 0 < sizeOf xs
 27 | := by
 28 |   rcases xs <;> simp_arith
 29 | 
 30 | @[simp]
 31 | lemma List.reverseAux_size : sizeOf (List.reverseAux args args') = sizeOf args + sizeOf args' - 1 := by
 32 |   induction args generalizing args' with
 33 |     | nil => simp_arith
 34 |     | cons z zs ih =>
 35 |       aesop (config := {warnOnNonterminal := false}); omega
 36 | 
 37 | @[simp]
 38 | lemma List.reverse_size : sizeOf (args.reverse) = sizeOf args := by
 39 |   unfold List.reverse
 40 |   rw [List.reverseAux_size]
 41 |   simp_arith
 42 | 
 43 | /--
 44 |   Expressions have positive size.
 45 | -/ 
 46 | @[simp]
 47 | lemma Expr.zero_lt_sizeOf : 0 < sizeOf expr := by
 48 |   rcases expr <;> simp_arith
 49 | 
 50 | @[simp]
 51 | lemma Stmt.sizeOf_stmt_ne_0 : sizeOf stmt ≠ 0 := by cases stmt <;> aesop
 52 | 
 53 | /--
 54 |   Statements have positive size.
 55 | -/
 56 | @[simp]
 57 | lemma Stmt.zero_lt_sizeOf : 0 < sizeOf stmt := by
 58 |   have : sizeOf stmt ≠ 0 := by simp
 59 |   omega
 60 | 
 61 | /--
 62 |   Lists of expressions have positive size.
 63 | -/
 64 | @[simp]
 65 | lemma Expr.zero_lt_sizeOf_List : 0 < sizeOf exprs := by
 66 |   have : sizeOf exprs ≠ 0 := by cases exprs <;> aesop
 67 |   omega
 68 | 
 69 | @[simp]
 70 | lemma Expr.sizeOf_head_lt_sizeOf_List : sizeOf expr < sizeOf (expr :: exprs) := by
 71 |   simp_arith
 72 | 
 73 | @[simp]
 74 | lemma Expr.sizeOf_tail_lt_sizeOf_List : sizeOf exprs < sizeOf (expr :: exprs) := by
 75 |   simp_arith
 76 | 
 77 | /--
 78 |   Lists of statements have positive size.
 79 | -/
 80 | @[simp]
 81 | lemma Stmt.zero_lt_sizeOf_List : 0 < sizeOf stmts := by cases stmts <;> aesop
 82 | 
 83 | /--
 84 |   Function definitions have positive size.
 85 | -/
 86 | @[simp]
 87 | lemma FunctionDefinition.zero_lt_sizeOf : 0 < sizeOf f := by cases f; aesop
 88 | 
 89 | @[simp]
 90 | lemma Expr.sizeOf_args_lt_sizeOf_Call : sizeOf args < sizeOf (Call f args) := by
 91 |   simp_arith
 92 | 
 93 | @[simp]
 94 | lemma Expr.sizeOf_args_lt_sizeOf_PrimCall : sizeOf args < sizeOf (PrimCall prim args) := by
 95 |   simp_arith
 96 | 
 97 | /--
 98 |   The size of the body of a function is less than the size of the function itself.
 99 | -/
100 | @[simp]
101 | lemma FunctionDefinition.sizeOf_body_lt_sizeOf : sizeOf (body f) < sizeOf f := by unfold body; aesop
102 | 
103 | lemma FunctionDefinition.sizeOf_body_succ_lt_sizeOf : sizeOf (FunctionDefinition.body f) + 1 < sizeOf f := by
104 |   cases f
105 |   unfold body
106 |   simp_arith
107 |   exact le_add_right List.zero_lt_sizeOf
108 | 
109 | /--
110 |   The size of the head of a list of statements is less than the size of a block containing the whole list.
111 | -/
112 | @[simp]
113 | lemma Stmt.sizeOf_head_lt_sizeOf : sizeOf stmt < sizeOf (Block (stmt :: stmts)) := by
114 |   simp only [Block.sizeOf_spec, List.cons.sizeOf_spec]
115 |   linarith
116 | 
117 | /--
118 |   The size of the head of a list of statements is less than the size of a block containing the whole list.
119 | -/
120 | @[simp]
121 | lemma Stmt.sizeOf_head_lt_sizeOf_tail : sizeOf (Block stmts) < sizeOf (Block (stmt :: stmts)) := by simp
122 | 
123 | end
124 | 
125 | end Clear.SizeLemmas
126 | 


--------------------------------------------------------------------------------
/Generated/peano/Peano/Common/for_727972558926940900_user.lean:
--------------------------------------------------------------------------------
 1 | import Clear.ReasoningPrinciple
 2 | 
 3 | import Generated.peano.Peano.Common.if_6183625948864629624
 4 | import Generated.peano.Peano.mulk
 5 | 
 6 | import Generated.peano.Peano.Common.for_727972558926940900_gen
 7 | 
 8 | 
 9 | namespace Peano.Common
10 | 
11 | set_option autoImplicit false
12 | 
13 | section
14 | 
15 | open Clear EVMState Ast Expr Stmt FunctionDefinition State Interpreter ExecLemmas OutOfFuelLemmas Abstraction YulNotation PrimOps ReasoningPrinciple Utilities Peano.Common Generated.peano Peano
16 | 
17 | def ACond_for_727972558926940900 (s₀ : State) : Literal := 1
18 | def APost_for_727972558926940900 (s₀ s₉ : State) : Prop := s₉ = s₀⟦"k"↦(s₀["k"]!!) - 1⟧
19 | def ABody_for_727972558926940900 (s₀ s₉ : State) : Prop := s₉ = if s₀["k"]!! = 0 then 💔 s₀ else s₀⟦"y"↦(s₀["y"]!!) * (s₀["x"]!!)⟧
20 | def AFor_for_727972558926940900 (s₀ s₉ : State) : Prop := (s₉["y"]!!) =  (s₀["y"]!!) * (s₀["x"]!!) ^ (s₀["k"]!!) ∧ isPure s₀ s₉ ∧ s₉.isOk
21 | 
22 | lemma for_727972558926940900_cond_abs_of_code {s₀ fuel} : eval fuel for_727972558926940900_cond (s₀) = (s₀, ACond_for_727972558926940900 (s₀)) :=
23 |   by unfold eval ACond_for_727972558926940900; aesop_spec
24 | 
25 | def for_727972558926940900_concrete_of_post_abs {s₀ s₉ : State} :
26 |   Spec for_727972558926940900_post_concrete_of_code s₀ s₉ →
27 |   Spec APost_for_727972558926940900 s₀ s₉ := by
28 |   unfold for_727972558926940900_post_concrete_of_code APost_for_727972558926940900
29 |   aesop_spec
30 | 
31 | def for_727972558926940900_concrete_of_body_abs {s₀ s₉ : State} :
32 |   Spec for_727972558926940900_body_concrete_of_code s₀ s₉ →
33 |   Spec ABody_for_727972558926940900 s₀ s₉ := by
34 |   unfold for_727972558926940900_body_concrete_of_code ABody_for_727972558926940900 A_if_6183625948864629624 A_mulk
35 |   apply spec_eq; simp; aesop_spec
36 | 
37 | lemma AZero_for_727972558926940900 : ∀ s₀, isOk s₀ →
38 |   ACond_for_727972558926940900 (👌 s₀) = 0 →
39 |   AFor_for_727972558926940900 s₀ s₀ := by unfold ACond_for_727972558926940900; aesop_spec
40 | 
41 | lemma UInt256_zero_unfold : (0 : UInt256) = ⟨0, by decide⟩ := by rfl
42 | lemma UInt256_one_unfold : (1 : UInt256) = ⟨1, by decide⟩ := by rfl
43 | 
44 | lemma coe_sub {a b : UInt256} (h : a ≤ b) : (((b - a) : UInt256) : ℕ) = b.val - a.val :=
45 |   Fin.coe_sub_iff_le.mpr h
46 | 
47 | lemma fin_eq_lem {a : UInt256} (h : a ≠ 0) : (a - 1).val = a.val - 1 := by
48 |   have : 1 ≤ a := by rcases a with ⟨_ | a, ha⟩ <;> [simp at h; (simp [Fin.le_iff_val_le_val])]
49 |   rw [coe_sub] <;> simp_all
50 | 
51 | lemma AOk_for_727972558926940900 : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isOk s₂ → ¬ ❓ s₅ → ¬ ACond_for_727972558926940900 s₀ = 0 → ABody_for_727972558926940900 s₀ s₂ → APost_for_727972558926940900 s₂ s₄ → Spec AFor_for_727972558926940900 s₄ s₅ → AFor_for_727972558926940900 s₀ s₅ := by
52 |   unfold APost_for_727972558926940900 ABody_for_727972558926940900 AFor_for_727972558926940900
53 |   intros s₀ s₂ s₄ s₅ h₁ h₂ h₃ h₄ h₅ h₆ h₇
54 |   rcases s₄ with _ | _ | _ <;> [skip; aesop_spec; skip]
55 |   · clr_spec at h₇
56 |     split_ands <;> [skip; aesop_spec; tauto]
57 |     by_cases eq : s₀["k"]!! = 0 <;> simp [eq] at h₅ <;> [simp [h₅] at h₂; skip]
58 |     rw [h₆] at h₇; rw [h₇.1, h₅]; clr_varstore
59 |     have : ↑(s₀["k"]!! - 1) + 1 < UInt256.size := by simp_arith [fin_eq_lem eq]; zify; omega
60 |     rw [mul_assoc, UInt256.UInt256_pow_succ this]; ring
61 |   · have h : isOk (s₂⟦"k"↦(s₂["k"]!!) - 1⟧) := by aesop
62 |     simp [h₆.symm] at h
63 | 
64 | lemma AContinue_for_727972558926940900 : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isContinue s₂ → ¬ ACond_for_727972558926940900 s₀ = 0 → ABody_for_727972558926940900 s₀ s₂ → Spec APost_for_727972558926940900 (🧟s₂) s₄ → Spec AFor_for_727972558926940900 s₄ s₅ → AFor_for_727972558926940900 s₀ s₅ := by
65 |   unfold ABody_for_727972558926940900
66 |   aesop_spec
67 | 
68 | lemma ABreak_for_727972558926940900 : ∀ s₀ s₂, isOk s₀ → isBreak s₂ → ¬ ACond_for_727972558926940900 s₀ = 0 → ABody_for_727972558926940900 s₀ s₂ → AFor_for_727972558926940900 s₀ (🧟s₂) := by
69 |   unfold ABody_for_727972558926940900 AFor_for_727972558926940900
70 |   have {a : UInt256} : a ^ (0 : Literal) = 1 := rfl
71 |   aesop_spec
72 |   
73 | lemma ALeave_for_727972558926940900 :  ∀ s₀ s₂, isOk s₀ → isLeave s₂ → ¬ ACond_for_727972558926940900 s₀ = 0 → ABody_for_727972558926940900 s₀ s₂ → AFor_for_727972558926940900 s₀ s₂ := by
74 |   unfold ABody_for_727972558926940900
75 |   aesop_spec
76 | 
77 | end
78 | 
79 | end Peano.Common
80 | 


--------------------------------------------------------------------------------
/Clear/ExecLemmas.lean:
--------------------------------------------------------------------------------
  1 | import Clear.Interpreter
  2 | 
  3 | namespace Clear.ExecLemmas
  4 | 
  5 | open Clear Ast EVMState State Interpreter PrimOps
  6 | 
  7 | section
  8 | 
  9 | variable {s s' : State}
 10 |          {expr rhs cond : Expr}
 11 |          {args : List Expr}
 12 |          {prim : PrimOp}
 13 |          {stmt : Stmt}
 14 |          {stmts pre post body default': List Stmt}
 15 |          {fuel : ℕ}
 16 |          {var : String}
 17 |          {vars : List String}
 18 |          {fname : Identifier}
 19 |          {cases' : List (Literal × List Stmt)}
 20 |          {f : FunctionDefinition}
 21 | 
 22 | -- ============================================================================
 23 | --  EXEC LEMMAS
 24 | -- ============================================================================
 25 | 
 26 | -- | Executing a continue is the same as setting the `jump` field to `Continue`.
 27 | lemma Continue' : exec fuel .Continue s = 🔁 s := by unfold exec; rfl
 28 | 
 29 | -- | Executing a break is the same as setting the `jump` field to `Break`.
 30 | lemma Break' : exec fuel .Break s = 💔 s := by unfold exec; rfl
 31 | 
 32 | -- | Executing a `Leave` is the same as setting the `jump` field to `Leave`.
 33 | lemma Leave' : exec fuel .Leave s = 🚪 s := by unfold exec; rfl
 34 | 
 35 | -- | Executing a `Let` binds the given variable names with value 0.
 36 | lemma Let' : exec fuel (.Let vars) s = List.foldr (λ var s ↦ s.insert var 0) s vars := by unfold exec; rfl
 37 | 
 38 | -- | Executing a `LetEq` evaluates the RHS and binds the given variable name to the resulting literal.
 39 | lemma LetEq' : exec fuel (.LetEq var rhs) s =
 40 |   let (s', x) := eval fuel rhs s
 41 |   s'⟦var↦x⟧ := by unfold exec; rfl
 42 | 
 43 | -- | Executing an `Assign` evaluates the RHS and binds the given variable name to the resulting literal.
 44 | lemma Assign' : exec fuel (.Assign var rhs) s =
 45 |   let (s', x) := eval fuel rhs s
 46 |   s'⟦var↦x⟧ := by unfold exec; rfl
 47 | 
 48 | -- | Executing an `If` evaluates the condition and traverses the body if its nonzero (is the identity on states otherwise).
 49 | lemma If' : exec fuel (.If cond body) s =
 50 |   let (s, cond) := eval fuel cond s
 51 |   if cond ≠ 0
 52 |     then exec fuel (.Block body) s
 53 |     else s := by conv => lhs; unfold exec
 54 | 
 55 | -- | Executing a function call as a statement is the same as an assignment to an empty list of variables.
 56 | lemma ExprStmtCall' : exec fuel (.ExprStmtCall f args) s =
 57 |   execCall fuel f [] (reverse' (evalArgs fuel args.reverse s)) := by unfold exec; rfl
 58 | 
 59 | -- | Executing a primop call as a statement is the same as an assignment to an empty list of variables.
 60 | lemma ExprStmtPrimCall' : exec fuel (.ExprStmtPrimCall prim args) s =
 61 |   execPrimCall prim [] (reverse' (evalArgs fuel args.reverse s)) := by unfold exec; rfl
 62 | 
 63 | -- | Executing a `LetPrimCall` evaluates the arguments and calls the function, multifilling the return values.
 64 | lemma LetPrimCall' : exec fuel (.LetPrimCall vars prim args) s =
 65 |   execPrimCall prim vars (reverse' (evalArgs fuel args.reverse s)) := by unfold exec; rfl
 66 | 
 67 | -- | Executing a `AssignPrimCall` evaluates the arguments and calls the function, multifilling the return values.
 68 | lemma AssignPrimCall' : exec fuel (.AssignPrimCall vars prim args) s =
 69 |   execPrimCall prim vars (reverse' (evalArgs fuel args.reverse s)) := by unfold exec; rfl
 70 | 
 71 | -- | Executing a `LetCall` evaluates the arguments and calls the function, multifilling the return values.
 72 | lemma LetCall' : exec fuel (.LetCall vars f args) s =
 73 |   execCall fuel f vars (reverse' (evalArgs fuel args.reverse s)) := by unfold exec; rfl
 74 | 
 75 | -- | Executing an `AssignCall` evaluates the arguments and calls the function, multifilling the return values.
 76 | lemma AssignCall' : exec fuel (.AssignCall vars f args) s =
 77 |   execCall fuel f vars (reverse' (evalArgs fuel args.reverse s)) := by unfold exec; rfl
 78 | 
 79 | -- | Executing a `For` evaluates the condition, short-circuiting if its zero, and recursing otherwise.
 80 | lemma For' : exec fuel (.For cond post body) s =
 81 |   match fuel with
 82 |     | 0 => diverge s
 83 |     | 1 => diverge s
 84 |     | fuel + 1 + 1 =>
 85 |       let (s₁, x) := eval fuel cond (👌s)
 86 |       if x = 0
 87 |         then s₁✏️⟦s⟧?
 88 |         else
 89 |           let s₂ := exec fuel (.Block body) s₁
 90 |           match s₂ with
 91 |             | .OutOfFuel                      => s₂✏️⟦s⟧?
 92 |             | .Checkpoint (.Break _ _)      => 🧟s₂✏️⟦s⟧?
 93 |             | .Checkpoint (.Leave _ _)      => s₂✏️⟦s⟧?
 94 |             | .Checkpoint (.Continue _ _) 
 95 |             | _ =>
 96 |               let s₃ := exec fuel (.Block post) (🧟 s₂)
 97 |               let s₄ := s₃✏️⟦s⟧?
 98 |               let s₅ := exec fuel (.For cond post body) s₄
 99 |               let s₆ := s₅✏️⟦s⟧?
100 |               s₆ := by            
101 |   conv_lhs => unfold exec loop
102 |   try rfl -- TODO(update Lean version): rfl is necessary in 4.8.0 because conv no longer does it
103 | 
104 | -- | Executing a `Switch` evaluates the condition, short-circuiting if its zero, and recursing otherwise.
105 | lemma Switch' : exec fuel (.Switch cond cases' default') s =
106 |       let (s₁, cond) := eval fuel cond s
107 |       let branches := execSwitchCases fuel s₁ cases'
108 |       let s₂ := exec fuel (.Block default') s₁
109 |       List.foldr (λ (valᵢ, sᵢ) s ↦ if valᵢ = cond then sᵢ else s) s₂ branches
110 | := by conv => lhs; unfold exec; rfl
111 | 
112 | end
113 | 
114 | namespace Clear.ExecLemmas
115 | 


--------------------------------------------------------------------------------
/Clear/Abstraction.lean:
--------------------------------------------------------------------------------
  1 | import Clear.Interpreter
  2 | import Clear.ExecLemmas
  3 | import Clear.OutOfFuelLemmas
  4 | import Clear.JumpLemmas
  5 | import Clear.YulNotation
  6 | 
  7 | namespace Clear.Abstraction
  8 | 
  9 | section
 10 | 
 11 | open Clear Ast EVMState State Interpreter PrimOps ExecLemmas
 12 | 
 13 | variable {s s₀ s₁ sEnd : State}
 14 |          {rest : List Stmt}
 15 |          {stmt : Stmt}
 16 |          {n : ℕ}
 17 |          {R : State → State → Prop}
 18 | 
 19 | -- | General form for relational specs (concrete and abstract).
 20 | @[aesop safe 0 unfold (rule_sets := [Clear.aesop_spec])]
 21 | def Spec (R : State → State → Prop) (s₀ s₁ : State) : Prop :=
 22 |   match s₀ with
 23 |     | OutOfFuel => ❓ s₁
 24 |     | Checkpoint c => s₁.isJump c
 25 |     | Ok _ _ => ¬ ❓ s₁ → R s₀ s₁
 26 | 
 27 | @[simp]
 28 | lemma Spec_ok_unfold {P : State → State → Prop} :
 29 |   ∀ {s s' : State}, s.isOk → ¬ ❓ s' → Spec P s s' → P s s' := by
 30 |     intros s s' h h'
 31 |     unfold Spec
 32 |     aesop
 33 | 
 34 | open Lean Elab Tactic in
 35 | elab "clr_spec" "at" h:ident : tactic => do
 36 |   evalTactic <| ← `(tactic| (
 37 |     apply Spec_ok_unfold (by aesop_spec) (by aesop_spec) at $h
 38 |   ))
 39 | 
 40 | -- | Specs preserve infinite loops.
 41 | lemma isOutOfFuel_Spec (spec : Spec R s₀ s₁) (h : isOutOfFuel s₀) : isOutOfFuel s₁ := by
 42 |   aesop_spec
 43 | 
 44 | -- | Non-divergentness propagates backwards through specs.
 45 | lemma not_isOutOfFuel_Spec (spec : Spec R s₀ s₁) (h : ¬ isOutOfFuel s₁) : ¬ isOutOfFuel s₀ := by
 46 |   intros hs₀
 47 |   aesop_spec
 48 | 
 49 | -- ============================================================================
 50 | --  TACTICS
 51 | -- ============================================================================
 52 | 
 53 | open Lean Elab Parser Tactic in
 54 | /--
 55 | Abstract a statement given a lemma (code → abs) and an abstract spec.
 56 | -/
 57 | elab "abstract " hcodeabs:ident stmt:ident " with " sname₁:ident hname:ident : tactic =>
 58 |   withMainContext do
 59 |     evalTactic <| ← `(tactic|
 60 |       -- Find the end-of-abstraction state.
 61 |       rw [←$stmt]; generalize hs₁ : exec _ $stmt _ = $sname₁;
 62 | 
 63 |       -- Specialize the (code → abs) lemma with the aforementioned state.
 64 |       have $hname := $hcodeabs $sname₁ hs₁;
 65 |     )
 66 | 
 67 | end
 68 | 
 69 | section
 70 | 
 71 | open Lean Elab Tactic Conv
 72 | 
 73 | syntax (name := let_unfold) " let_unfold " ident : conv
 74 | 
 75 | def letUnfold (e : Expr) (id : Name) : Expr :=
 76 |   e.replace λ e =>
 77 |     if e.isLet && e.letName! = id then
 78 |       some (e.letBody!.instantiate1 e.letValue!)
 79 |     else
 80 |       none
 81 | 
 82 | @[tactic let_unfold]
 83 | def convLetUnfold : Tactic
 84 |   | `(conv| let_unfold $id:ident) => do
 85 |     (← getMainGoal).withContext do
 86 |       let lhs ← getLhs
 87 | 
 88 |       changeLhs (letUnfold lhs id.getId)
 89 |   | _ => Lean.Elab.throwUnsupportedSyntax
 90 | 
 91 | macro " let_unfold " id:ident : tactic => `(tactic| conv => let_unfold $id)
 92 | 
 93 | end
 94 | 
 95 | 
 96 | end Clear.Abstraction
 97 | 
 98 | namespace Clear
 99 | 
100 | open Abstraction State
101 | 
102 | lemma spec_of_ok {s₀ s₉ : State} {S₁ S₂ : State → State → Prop}
103 |   (h : ¬❓ s₀ → (↑S₁ : State → State → Prop) s₀ s₉ → S₂ s₀ s₉) :
104 |   Spec S₁ s₀ s₉ → Spec S₂ s₀ s₉ := by unfold Spec; aesop
105 | 
106 | @[aesop norm 100 simp (rule_sets := [Clear.aesop_spec])]
107 | lemma isOutOfFuel_iff_s_eq_OutOfFuel {s : State} : ❓ s ↔ (s = OutOfFuel) := by unfold isOutOfFuel; aesop
108 | 
109 | @[simp]
110 | lemma setBreak_OutOfFuel_eq_OutOfFuel : 💔OutOfFuel = OutOfFuel := rfl  
111 | 
112 | @[aesop norm 100 simp (rule_sets := [Clear.aesop_spec])]
113 | lemma setBreak_ok_eq_checkpoint {evm : EVM} {varstore : VarStore} :
114 |   💔Ok evm varstore = Checkpoint (.Break evm varstore) := rfl
115 | 
116 | @[aesop norm 100 simp (rule_sets := [Clear.aesop_spec])]
117 | lemma isJump_jump_eq {s : State} {jmp : Jump} :
118 |   isJump jmp s ↔ Checkpoint jmp = s := by
119 |   unfold isJump; aesop
120 | 
121 | @[aesop safe 0 apply (rule_sets := [Clear.aesop_spec])]
122 | lemma isOk_of_insert {s} (h : isOk s) {k} {v} :
123 |   isOk (s⟦k↦v⟧) := by unfold isOk State.insert at *; aesop
124 | 
125 | -- @[aesop norm 0 simp (rule_sets := [Clear.aesop_varstore])]
126 | -- lemma lookup_of_ok {var} {evm} {varstore} :
127 | --   State.lookup! var (.Ok evm varstore) = (varstore.lookup var).get! := rfl
128 | 
129 | -- @[aesop safe apply (rule_sets := [Clear.aesop_spec])]
130 | -- lemma isPure_of_isPure_ok {s} {evm} {vs} (h : isPure (Ok evm vs) s) : isPure s := by
131 | --   done
132 | 
133 | open Lean Elab Tactic in
134 | elab "clr_funargs" : tactic => do
135 |   evalTactic <| ← `(tactic| (
136 |     unfold State.initcall
137 |     try unfold State.insert
138 |     unfold State.setStore
139 |     simp only [multifill_cons, multifill_nil', isOk_insert, isOk_Ok, isOutOfFuel_Ok,
140 |       not_false_eq_true, imp_false, Ok.injEq, and_imp, forall_apply_eq_imp_iff₂,
141 |       forall_apply_eq_imp_iff]
142 |     repeat (rw [←State.insert])
143 |   ))
144 | 
145 | open Lean Elab Tactic in
146 | elab "clr_funargs" "at" h:ident : tactic => do
147 |   evalTactic <| ← `(tactic| (
148 |     unfold State.initcall at $h:ident
149 |     try unfold State.insert at $h:ident
150 |     unfold State.setStore at $h:ident
151 |     simp only [multifill_cons, multifill_nil', isOk_insert, isOk_Ok, isOutOfFuel_Ok,
152 |       not_false_eq_true, imp_false, Ok.injEq, and_imp, forall_apply_eq_imp_iff₂,
153 |       forall_apply_eq_imp_iff] at $h:ident
154 |     repeat (rw [←State.insert] at $h:ident)    
155 |   ))
156 | 
157 | end Clear
158 | 


--------------------------------------------------------------------------------
/vc/src/ProofGenerator.hs:
--------------------------------------------------------------------------------
  1 | module ProofGenerator (tacticsOfStmt, tacticsOfStmt', finish) where
  2 | 
  3 | import Types (
  4 |   Expr (..),
  5 |   Stmt (..), nameOfNode,
  6 |  )
  7 | 
  8 | import PrimOps (yulPrimOps)
  9 | import Utils (
 10 |   capitalize,
 11 |  )
 12 | 
 13 | tacticsOfExpr :: Expr -> String
 14 | tacticsOfExpr (Call f _) = rwPrimop f
 15 | tacticsOfExpr (CrossContractCall {}) = "Expression splitter failed to split the expression. kekW"
 16 | tacticsOfExpr (Var {}) = "-- simp [Var']"
 17 | tacticsOfExpr (Lit {}) = "-- simp [Lit']"
 18 | 
 19 | tacticsOfCond :: String
 20 | tacticsOfCond = "simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]"
 21 | 
 22 | assignCall :: String -> String
 23 | assignCall name = unlines [
 24 |     "rw [cons]; simp only [LetCall', AssignCall']",
 25 |     "simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]",
 26 |     "-- EXPR \6",
 27 |     "try simp",
 28 |     "generalize hs : execCall _ _ _ _ = s; try rw [← hs₁, hok] at hs",
 29 |     "intros h",
 30 |     "try intros h'",
 31 |     "refine' Exists.intro s (And.intro (" ++ name ++ "_abs_of_code hs) ?_)",
 32 |     "swap; clear hs",
 33 |     "try revert h'",
 34 |     "revert h"
 35 |   ]
 36 | 
 37 | abstraction :: String -> String
 38 | abstraction name = unlines [
 39 |   "-- abstraction offsetting",
 40 |   "rw [cons]",
 41 |   "generalize hxs : Block _ = xs",
 42 |   "abstract " ++ name ++ "_abs_of_code " ++ name ++ " with ss hs",
 43 |   "try rw [← hs₁, hok] at hs",
 44 |   "intros h",
 45 |   "try intros h'",
 46 |   "refine' Exists.intro ss (And.intro hs ?_)",
 47 |   "swap; clear hs",
 48 |   "try revert h'",
 49 |   "revert h",
 50 |   "subst xs"]
 51 | 
 52 | rwPrimop :: String -> String
 53 | rwPrimop primop = if primop == "delegatecall" then "-- delegate call" else "rw [EVM" ++ capitalize primop ++ "']"
 54 | 
 55 | finish :: String
 56 | finish = unlines [
 57 |     "-- finish offsetting",
 58 |     "subst hs₉",
 59 |     "intros hbody",
 60 |     "subst hbody",
 61 |     "subst hs₁",
 62 |     "rw [← hok]",
 63 |     "repeat {rw [lookup_insert' (by aesop)]}",
 64 |     "repeat {rw [lookup_insert_of_ne (by decide)]}",
 65 |     "try rw [lookup_initcall_1]",
 66 |     "try rw [lookup_initcall_2 ?_]",
 67 |     "try rw [lookup_initcall_3 ?_]",
 68 |     "try rw [lookup_initcall_4 ?_]",
 69 |     "try rw [lookup_initcall_5 ?_]",
 70 |     "all_goals try decide",
 71 |     "let_unfold s₂",
 72 |     "simp [multifill']",
 73 |     "try {rw [reviveJump_insert (by aesop)]}",
 74 |     "repeat {rw [lookup_insert' (by aesop)]}",
 75 |     "try simp",
 76 |     "rw [hok]",
 77 |     "intros h",
 78 |     "exact h"
 79 |   ]
 80 | 
 81 | tacticsOfStmt' :: Bool -> Stmt -> String
 82 | tacticsOfStmt' _ (Block body) = foldMap (\s -> tacticsOfStmt' True s ++ "\n") body
 83 | tacticsOfStmt' _ (LetInit _ (Call f _)) =
 84 |     if f `elem` yulPrimOps
 85 |     then unlines [
 86 |           "rw [cons]; simp only [LetPrimCall', AssignPrimCall']",
 87 |           "simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]",
 88 |           rwPrimop f,
 89 |           "try simp"]
 90 |     else assignCall f
 91 | tacticsOfStmt' _ (LetInit {}) = "rw [cons]; simp only [LetEq', Assign', Lit', Var']"
 92 | tacticsOfStmt' _ (Assignment _ (Call f _)) =
 93 |   if f `elem` yulPrimOps
 94 |   then unlines [
 95 |          "rw [cons]; simp only [LetPrimCall', AssignPrimCall']",
 96 |          "simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]",
 97 |          rwPrimop f,
 98 |          "try simp"]
 99 |   else assignCall f
100 | tacticsOfStmt' _ (Assignment {}) = "rw [cons]; simp only [LetEq', Assign', Lit', Var']"
101 | tacticsOfStmt' _ (Declaration {}) = "rw [cons, Let']"
102 | tacticsOfStmt' _ (ExpressionStmt (Call f args)) =
103 |   if f `elem` yulPrimOps
104 |   then unlines [
105 |     "rw [cons, ExprStmtPrimCall']; try simp only",
106 |     "simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]",
107 |     "-- EXPR \4",
108 |     rwPrimop f,
109 |     "try simp"]
110 |   else let preamble = unlines [
111 |              "rw [cons, ExprStmtCall']; try simp only",
112 |              "simp [evalArgs, head', reverse', multifill', PrimCall', Lit', Var', execPrimCall, evalPrimCall]"]
113 |            postamble = unlines [
114 |              "try simp",
115 |              "",
116 |              "generalize hs : execCall _ _ _ _ = s; try rw [← hs₁, hok] at hs",
117 |              "intros h",
118 |              "try intros h'",
119 |              "refine' Exists.intro s (And.intro (" ++ f ++ "_abs_of_code hs) ?_)",
120 |              "swap; clear hs",
121 |              "try revert h'",
122 |              "revert h"] in
123 |        preamble ++ foldMap (\e -> tacticsOfExpr e ++ "\n") args ++ postamble
124 | tacticsOfStmt' _ (ExpressionStmt (CrossContractCall {})) = "Cross contract call not implemented yet."
125 | tacticsOfStmt' _ (ExpressionStmt e) = tacticsOfExpr e
126 | tacticsOfStmt' abs node@(Switch c legs dflt) =
127 |   if abs
128 |   then abstraction (nameOfNode node)
129 |   else
130 |     unlines [
131 |     "unfold execSwitchCases",
132 |     tacticsOfCond,
133 |     tacticsOfExpr c,
134 |     concatMap ((tacticsOfStmt' abs . Block) . snd) legs,
135 |     "generalize hdefault : exec _ _ _ = sdef",
136 |     "unfold execSwitchCases",
137 |     "subst hdefault",
138 |     tacticsOfStmt' abs (Block dflt)]
139 | tacticsOfStmt' abs node@(For {}) =
140 |   if abs
141 |   then abstraction (nameOfNode node) else "TOP LEVEL FOR?!"
142 | tacticsOfStmt' abs node@(If c body) =
143 |   if not abs
144 |   then unlines [tacticsOfCond, tacticsOfExpr c, tacticsOfStmt' True (Block body)]
145 |   else abstraction (nameOfNode node)
146 | tacticsOfStmt' _ Continue = "rw [cons, Continue']"
147 | tacticsOfStmt' _ Break = "rw [cons, Break']"
148 | tacticsOfStmt' _ Leave = "rw [cons, Leave']"
149 | tacticsOfStmt' _ stmt = "-- " ++ show stmt
150 | 
151 | tacticsOfStmt :: Stmt -> String
152 | tacticsOfStmt stmt =
153 |   unlines . map ("  " ++ ) . lines $
154 |   unlines [
155 |     tacticsOfStmt' False stmt,
156 |     "-- tacticsOfStmt offsetting",
157 |     "try rw [nil]",
158 |     "try simp [Bool.toUInt256, UInt256.size]",
159 |     "intros h",
160 |     "exact h"
161 |   ]


--------------------------------------------------------------------------------
/LICENSE.MD:
--------------------------------------------------------------------------------
 1 | **Copyright Demerzel Solutions Limited (t/a Nethermind) 2024. All rights reserved.**
 2 | 
 3 | **1. IP Ownership.**
 4 | You (the “Licensee”) acknowledge and agree that Demerzel Solutions Limited (“Nethermind”, “Licensor”) own all legal right, title and interest in and to the work, software, application, source code, documentation and any other documents in this repository (collectively, the “Program”), including any intellectual property rights which subsist in the Program (whether those rights happen to be registered or not, and wherever in the world those rights may exist), whether in Source form or any other form.
 5 | 
 6 | **2. Definitions.**
 7 | “Licence” shall mean this Licence Agreement setting out the terms and conditions for any use, modification, reproduction and distribution of the Program.
 8 | "Source form” shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files.
 9 | "Object form” shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types.
10 | "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Program and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. 
11 | "Commercial Purposes" refers to any activity undertaken with the primary intention of generating profit, revenue, or financial gain and shall include, without limitation, the offering of the Program or Derivative Works through a computer network or an interface, enabling third parties to interact with the functionality of the Program or Derivative Works in distributed form or remotely through a computer network, offering a product or service, the value of which entirely or primarily derives from the value of the Program or Derivative Works, or offering a product or service that accomplishes for users the primary purpose of the Program or Derivative Works.
12 | 
13 | **3. License.**
14 | Subject to the terms and conditions of this Licence, Nethermind hereby grants to the Licensee a worldwide, non-exclusive, no-charge, royalty-free, non-transferable, non-sublicensable, limited copyright licence to copy, modify, adapt, make error corrections of, prepare Derivative Works of, publicly display, and distribute the Program and such Derivative Works in Source or Object form, solely for Non-Commercial Use.
15 | **3.1. Non-Commercial Use.**
16 | “Non-Commercial Use” means each use as described in subclauses (A)-(B) below, as reasonably determined by Nethermind in its sole discretion:
17 | A) personal use for research, personal study, private entertainment or hobby projects, in each case without any anticipated commercial application; or
18 | B) use by any charitable organization, educational institution, public research organization, public safety or health organization, environmental protection organization or government institution except when used for Commercial Purposes.
19 | **3.2. Restrictions on Third-Party Usage for Commercial Purposes.**
20 | A) The Licensee agrees that the the Licensee shall not make the Program, as defined in this licence, or any modified version thereof available for use by third parties for Commercial Purposes, including for selling formal verification services, or for verifying any third parties' products with the intent of commercial gain. The Licensee shall take reasonable measures to prevent unauthorised use of the Program for such Commercial Purposes. 
21 | B) This clause does not restrict the Licensee from using the Program for internal purposes, research, or personal projects, provided that such usage remains non-commercial in nature.
22 | 
23 | **4. Source Code Modification, Distribution and Attribution.**
24 | 4.1. The Licensee agrees that any Derivative Work created using the Program's Source code, and any distribution, publication, copy, modification, merger therewith, combination with another program or derivative works thereof, shall be subject to the same restrictions as set forth herein, including but not limited to the Non-Commercial Use restriction.
25 | 4.2. The Licensee shall prominently include notices within the Derivative Works documentation and source code, indicating the use of the Program and its original source code, as well as referencing this licence agreement. These notices shall be provided in a manner that is visible and easily accessible to any end-users of the Derivative Works.
26 | 4.3. This clause shall not apply to modifications that are performed solely for the Licensee's internal use and are not distributed externally.
27 | 4.4. The Licensee must give appropriate credit, provide a link to the licence, and indicate if changes were made while distributing, copying or modifying the Program. The Licensee may do so in any reasonable manner, but not in any way that suggests the Licensor endorses the Licensee or their use of the Program.
28 | 4.5. The Licensee acknowledges and agrees that Nethermind is granted a non-exclusive, royalty-free licence to use (commercially and non-commercially), reproduce, distribute, publicly perform, and publicly display any modifications made to the source code of the Program by the Licensee i.e. the Derivative Works.
29 | 
30 | **5. Limitations.**
31 | Except as expressly stated in clause 3 above, the Licensee has no right (and shall not permit any third party) to copy, reverse engineer, decompile, disassemble, modify, adapt, prepare Derivative Works of, transfer (by sale, resale, licence, sublicence, download or otherwise) or make error corrections to the Program in whole or in part.
32 | 
33 | **6. Trademarks.**
34 | This Licence does not grant permission to use the trade names, trademarks, service marks, or product names of Nethermind, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the LICENCE file.
35 | 
36 | **7. Disclaimer of Warranty.**
37 | Unless required by applicable law or agreed to in writing, Nethermind provides the Program on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. The Licensee is solely responsible for determining the appropriateness of using or redistributing the Program and assume any risks associated with the Licensee’s exercise of permissions under this Licence.
38 | 
39 | **8. Limitation of Liability.**
40 | In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall Nethermind be liable to the Licensee or any third parties for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this Licence or out of the use or inability to use the Program (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if Nethermind has been advised of the possibility of such damages.
41 | 


--------------------------------------------------------------------------------
/vc/src/Lean.hs:
--------------------------------------------------------------------------------
  1 | module Lean (
  2 |   LeanName,
  3 |   Lemma (..),
  4 |   LemmaOption (..),
  5 |   Tactic (..),
  6 |   addTacs,
  7 |   isBasic,
  8 |   modifyLemmaType,
  9 |   setFirstRun,
 10 |   Implicity (..),
 11 |   explicitArityOfLemma,
 12 | ) where
 13 | 
 14 | import Data.Char (toLower)
 15 | import Data.List (intercalate)
 16 | 
 17 | type LeanName = String
 18 | 
 19 | data Tactic
 20 |   = -- Atomic
 21 |     Repeat [Tactic]
 22 |   | AllGoals Tactic
 23 |   | Chain [Tactic]
 24 |   | Constructor
 25 |   | Exact String
 26 |   | Intros [String]
 27 |   | Rewrite [LeanName]
 28 |   | Rfl
 29 |   | Skip
 30 |   | Sorry
 31 |   | Swap
 32 |   | Tauto
 33 |   | Try Tactic
 34 |   | Unfold [LeanName]
 35 |   | First [Tactic]
 36 |   | RefactorMe String
 37 |   | OnProof [Tactic]
 38 |   | OnProofSorry [Tactic]
 39 |   | OnGeneration [Tactic]
 40 |   | WithSimpleConclusion Tactic
 41 |   | Zeta
 42 |   | -- Simplification
 43 |     YulDeclOrAssignSimp
 44 |   | YulDefaultInitSimp
 45 |   | YulDeclOrAssignSome
 46 |   | YulDeclOrAssignNone
 47 |   | YulEvalArgs
 48 |   | YulFoldHappy
 49 |   | AesopNormal
 50 |   | Assign
 51 |   | Next
 52 |   | Refuel
 53 |   | YulNormLiteral
 54 |   | YulNorm LeanName
 55 |   | YulResultPopToSimp
 56 |   | YulSeqSimp
 57 |   | YulStateSimp
 58 |   | Terminate
 59 |   | YulUnifyMetavars
 60 |   | -- Basic
 61 |     YulCall
 62 |   | YulIdentifier
 63 |   | YulLiteral
 64 |   | YulBlock
 65 |   | YulVariableDeclarationNone
 66 |   | YulVariableDeclarationSome
 67 |   | YulAssignment
 68 |   | YulIf
 69 |   | YulExpressionStmt
 70 |   | YulSwitch
 71 |   | YulFor
 72 |   | YulBreak
 73 |   | YulContinue
 74 |   | YulLeave
 75 |   | -- Misc
 76 |     DumpGoal String
 77 |   | DumpHyp LeanName String
 78 |   | LeanComment String
 79 |   | Invisible
 80 |   deriving (Eq)
 81 | 
 82 | isBasic :: Tactic -> Bool
 83 | isBasic YulCall = True
 84 | isBasic YulIdentifier = True
 85 | isBasic YulLiteral = True
 86 | isBasic YulBlock = True
 87 | isBasic YulVariableDeclarationNone = True
 88 | isBasic YulVariableDeclarationSome = True
 89 | isBasic YulAssignment = True
 90 | isBasic YulIf = True
 91 | isBasic YulExpressionStmt = True
 92 | isBasic YulSwitch = True
 93 | isBasic YulFor = True
 94 | isBasic YulBreak = True
 95 | isBasic YulContinue = True
 96 | isBasic YulLeave = True
 97 | isBasic _ = False
 98 | 
 99 | instance Show Tactic where
100 |   -- Atomic
101 |   show (Repeat tacs) = "repeat (" <> intercalate ", " (map show tacs) <> ")"
102 |   show (AllGoals tac) = "all_goals (" <> show tac <> ")"
103 |   show (Chain tacs) = intercalate "; " (map show tacs)
104 |   show Constructor = "constructor"
105 |   show (Exact term) = "exact " <> term
106 |   show (Intros idents) = "intros " ++ unwords idents
107 |   show (Rewrite lemmas) = "rewrite [" <> intercalate ", " lemmas <> "]"
108 |   show Rfl = "rfl"
109 |   show Skip = "skip"
110 |   show Sorry = "sorry"
111 |   show Swap = "swap"
112 |   show Tauto = "tauto"
113 |   show (Try tac) = "try ( " <> show tac <> " )"
114 |   show (Unfold defs) = "unfold " <> unwords defs
115 |   show (First tactics) = "first | " <> intercalate " | " (map show tactics)
116 |   show (OnProof tactics) = "on_proof (" <> intercalate "; " (map show tactics) <> ")"
117 |   show (OnProofSorry tactics) = "on_proof_sorry (" <> intercalate "; " (map show tactics) <> ")"
118 |   show (OnGeneration tactics) = "on_generation (" <> intercalate "; " (map show tactics) <> ")"
119 |   show (WithSimpleConclusion tac) = "with_simple_conclusion " ++ show tac
120 |   show Zeta = "zeta"
121 |   -- Simplification
122 |   show YulDeclOrAssignSimp = "YUL_declOrAssign_simp"
123 |   show YulDeclOrAssignSome = "YUL_declOrAssign_some"
124 |   show YulDeclOrAssignNone = "YUL_declOrAssign_none"
125 |   show YulDefaultInitSimp = "YUL_defaultInit_simp"
126 |   show YulEvalArgs = "YUL_eval_args"
127 |   show YulFoldHappy = "YUL_fold_happy"
128 |   show AesopNormal = "aesop_normal"
129 |   show Assign = "assign"
130 |   show Next = "next"
131 |   show Refuel = "refuel"
132 |   show YulNormLiteral = "YUL_norm_literal"
133 |   show (YulNorm f) = "YUL_norm_" ++ f
134 |   show YulResultPopToSimp = "YUL_resultPopTo_simp"
135 |   show YulSeqSimp = "YUL_seq_simp"
136 |   show YulStateSimp = "YUL_state_simp"
137 |   show Terminate = "terminate"
138 |   show YulUnifyMetavars = "YUL_unify_metavars"
139 |   -- Misc
140 |   show (DumpGoal path) = "dump_goal \"" ++ path ++ "\""
141 |   show (DumpHyp h path) = "dump_hyp " <> h <> " \"" <> path <> "\"" 
142 |   -- Basic
143 |   show YulCall = "YUL_functionCall"
144 |   show YulIdentifier = "YUL_identifier"
145 |   show YulLiteral = "YUL_literal"
146 |   show YulBlock = show (Rewrite ["Block'"])
147 |   show YulVariableDeclarationNone = "YUL_variableDeclaration_none"
148 |   show YulVariableDeclarationSome = "YUL_variableDeclaration_some"
149 |   show YulAssignment = "YUL_assignment"
150 |   show YulIf = "YUL_if"
151 |   show YulExpressionStmt = "YUL_expressionStmt"
152 |   show YulSwitch = "YUL_switch"
153 |   show YulFor = "YUL_for"
154 |   show YulBreak = "YUL_break"
155 |   show YulContinue = "YUL_continue"
156 |   show YulLeave = "YUL_leave"
157 |   show (LeanComment comment) = "\n  -- " ++ comment
158 |   show (RefactorMe str) = str
159 |   show Invisible = ""
160 | 
161 | data LemmaOption
162 |   = DisplayRhsOfEq Bool
163 |   | PpProofsWithType Bool
164 |   | MaxRecDepth Integer
165 |   | FirstRun Bool
166 | 
167 | instance Show LemmaOption where
168 |   show (DisplayRhsOfEq opt) = "displayRhsOfEq " <> map toLower (show opt)
169 |   show (PpProofsWithType opt) = "pp.proofs.withType " <> map toLower (show opt)
170 |   show (MaxRecDepth depth) = "maxRecDepth " <> show depth
171 |   show (FirstRun isFirstRun) = "firstRun " <> map toLower (show isFirstRun)
172 | 
173 | setOption :: LemmaOption -> String
174 | setOption option = "set_option " <> show option <> " in"
175 | 
176 | replaceOptionFirstRun :: Bool -> [LemmaOption] -> [LemmaOption]
177 | replaceOptionFirstRun newValue [] = [FirstRun newValue]
178 | replaceOptionFirstRun newValue ((FirstRun _) : os) = FirstRun newValue : os
179 | replaceOptionFirstRun newValue (o : os) = o : replaceOptionFirstRun newValue os
180 | 
181 | setFirstRun :: Bool -> Lemma -> Lemma
182 | setFirstRun newFirstRun lem@(Lemma _ _ _ options _) = lem {lmOptions = replaceOptionFirstRun newFirstRun options}
183 | 
184 | data Implicity = Implicit | Explicit deriving (Eq)
185 | 
186 | data Lemma = Lemma
187 |   { lmName :: LeanName
188 |   , lmHyps :: [(LeanName, LeanName, Implicity)]
189 |   , lmType :: LeanName
190 |   , lmOptions :: [LemmaOption]
191 |   , lmProof :: [Tactic]
192 |   }
193 | 
194 | modifyLemmaType :: (LeanName -> LeanName) -> Lemma -> Lemma
195 | modifyLemmaType f lemma@(Lemma _ _ prop _ _) = lemma {lmType = f prop}
196 | 
197 | addTacs :: Lemma -> [Tactic] -> Lemma
198 | addTacs lemma@(Lemma _ _ _ _ proof) tacs = lemma {lmProof = proof ++ tacs}
199 | 
200 | arityOfLemma :: Lemma -> Int
201 | arityOfLemma = length . lmHyps
202 | 
203 | explicitArityOfLemma :: Lemma -> Int
204 | explicitArityOfLemma = length . filter (\(_, _, implicity) -> implicity == Explicit) . lmHyps
205 | 
206 | instance Show Lemma where
207 |   show (Lemma lmName lmHyps lmType lmOptions lmProof) =
208 |     unlines (map setOption lmOptions)
209 |       <> "lemma "
210 |       <> lmName
211 |       <> " "
212 |       <> unwords (map showHyp lmHyps)
213 |       <> " : "
214 |       <> lmType
215 |       <> " := by\n  "
216 |       <> intercalate "\n  " (map show lmProof)
217 |     where
218 |       showHypInner name "" = name
219 |       showHypInner name ty = name <> " : " <> ty
220 |       showHyp (name, ty, Implicit) = "{" <> showHypInner name ty <> "}"
221 |       showHyp (name, ty, Explicit) = "(" <> showHypInner name ty <> ")"
222 | 


--------------------------------------------------------------------------------
/vc/src/Parser.y:
--------------------------------------------------------------------------------
  1 | {
  2 | module Parser (calc, lexer) where
  3 | 
  4 | import Data.List.NonEmpty (NonEmpty (..), (<|))
  5 | import qualified Data.List.NonEmpty as NE
  6 | 
  7 | import Lexer (Token (..), lexer)
  8 | import Types (Identifier, Literal (..), Expr (..), FuncDef' (..), Stmt (..), TopLvlStmt (..), InnerObject (..), Object (..))
  9 | }
 10 | 
 11 | %name calc
 12 | %tokentype { Token }
 13 | %error { parseError }
 14 | 
 15 | %token
 16 |       '{'             { TokenLCurl }
 17 |       '}'             { TokenRCurl }
 18 |       '('             { TokenLPar }
 19 |       ')'             { TokenRPar }
 20 |       '->'            { TokenArrow }
 21 |       ':='            { TokenColonEq }
 22 |       ','             { TokenComma }
 23 |       ':'             { TokenColon }
 24 |       function        { TokenFunction }
 25 |       let             { TokenLet }
 26 |       if              { TokenIf }
 27 |       switch          { TokenSwitch }
 28 |       case            { TokenCase }
 29 |       default         { TokenDefault }
 30 |       for             { TokenFor }
 31 |       break           { TokenBreak }
 32 |       continue        { TokenContinue }
 33 |       leave           { TokenLeave }
 34 |       true            { TokenTrue }
 35 |       false           { TokenFalse }
 36 |       ident           { TokenIdentifier $$ }
 37 |       str             { TokenString $$ }
 38 |       hex             { TokenHex $$ }
 39 |       dec             { TokenDecimal $$ }
 40 |       inlcomment      { TokenInlineComment $$ }
 41 |       multicomment    { TokenMultilineComment $$ }
 42 |       object          { TokenObject }
 43 |       code            { TokenCode }
 44 | 
 45 | %%
 46 | 
 47 | Objects     : {- empty -}                 { [] }
 48 |             | Objects Object              { $2 : $1 }
 49 | 
 50 | Object      : inlcomment object str '{' Code InnerObject '}'          { Object $1 $3 $5 $6 }
 51 |             |            object str '{' Code InnerObject '}'          { Object "" $2 $4 $5 }
 52 | 
 53 | InnerObject : inlcomment object str '{' Code ident str ident str '}'  { InnerObject $1 $3 $5 }
 54 |             |            object str '{' Code ident str ident str '}'  { InnerObject "" $2 $4 }
 55 | 
 56 | Code        : code TopLvlBlock            { $2 }
 57 | 
 58 | Block       : '{' Statements '}'          { reverse $2 }
 59 | 
 60 | TopLvlBlock : '{' TopLvlStmts '}'         { reverse $2 }
 61 | 
 62 | Statements  : {- empty -}                 { [] }
 63 |             | Statements Statement        { $2 : $1 }
 64 | 
 65 | TopLvlStmts : {- empty -}                 { [] }
 66 |             | TopLvlStmts TopLvlStmt      { $2 : $1 }
 67 | 
 68 | TopLvlStmt  : Block                       { UnusedBlock }
 69 |             | FuncDef                     { FuncDefStmt $1 }
 70 |             | inlcomment                  { UnusedBlock }
 71 |             | multicomment                { UnusedBlock }
 72 | 
 73 | Statement   : Block                       { Block $1 }
 74 |             | VariableDeclaration         { let (idens, mbExpr) = $1 in
 75 |                                                 case mbExpr of
 76 |                                                   Just expr -> LetInit idens expr
 77 |                                                   Nothing   -> Declaration idens
 78 |                                           }
 79 |             | Assignment                  { (uncurry Assignment) $1 }
 80 |             | If                          { (uncurry If) $1 }
 81 |             | Expression                  { ExpressionStmt $1 }
 82 |             | Switch                      { (uncurry3 Switch) $1 }
 83 |             | ForLoop                     { (uncurry4 For) $1 }
 84 |             | continue                    { Continue }
 85 |             | break                       { Break }
 86 |             | leave                       { Leave }
 87 |             | inlcomment                  { InlineComment $1 }
 88 |             | multicomment                { MultilineComment $1 }
 89 | 
 90 | FuncDef : function ident '(' ')' Block                                         { FuncDef' $2 [] [] $5 }
 91 |         | function ident '(' TypedIdentifiers ')' Block                        { FuncDef' $2 (reverse (NE.toList $4)) [] $6 }
 92 |         | function ident '(' ')' '->' TypedIdentifiers Block                   { FuncDef' $2 [] (reverse (NE.toList $6)) $7 }
 93 |         | function ident '(' TypedIdentifiers ')' '->' TypedIdentifiers Block  { FuncDef' $2 (reverse (NE.toList $4)) (reverse (NE.toList $7)) $8 }
 94 | 
 95 | VariableDeclaration : let TypedIdentifiers                  { (NE.reverse $2, Nothing) }
 96 |                     | let TypedIdentifiers ':=' Expression  { (NE.reverse $2, Just $4) }
 97 | 
 98 | Assignment  : Identifiers ':=' Expression { (NE.reverse $1, $3) }
 99 | 
100 | Expression  : FunctionCall                { (uncurry Call) $1 }
101 |             | ident                       { Var $1 }
102 |             | Literal                     { Lit $1 }
103 | 
104 | If          : if Expression Block                         { ($2, $3) }
105 |             | if multicomment Expression Block            { ($3, $4) }
106 |             | if Expression inlcomment Block              { ($2, $4) }
107 |             | if multicomment Expression inlcomment Block { ($3, $5) }
108 | 
109 | Switch      : switch Expression Cases          { ($2, reverse $3, []) }
110 |             | switch Expression Cases Default  { ($2, reverse $3, $4) }
111 |             | switch Expression Default        { ($2, [],         $3) }
112 | 
113 | Cases       : Case                        { [$1] }
114 |             | Cases Case                  { $2 : $1 }
115 | 
116 | Case        : case Literal Block          { ($2, $3) }
117 | 
118 | Default     : default Block               { $2 }
119 |             | default inlcomment Block    { $3 }
120 | 
121 | ForLoop     : for Block Expression Block Block    { ($2, $3, $4, $5) }
122 | 
123 | FunctionCall : ident '(' Arguments ')'    { ($1, reverse $3) }
124 | 
125 | ExpressionPrecComment : multicomment Expression { $2 }
126 |                       |              Expression { $1 }
127 | 
128 | Arguments   : {- empty -}                         { [] }
129 |             | ExpressionPrecComment               { [$1] }
130 |             | Arguments ',' ExpressionPrecComment { $3 : $1 }
131 | 
132 | Identifiers : ident                       { $1 :| [] }
133 |             | Identifiers ',' ident       { $3 <| $1 }
134 | 
135 | TypeName    : ident                       { $1 }
136 | 
137 | TypedIdentifiers : ident                                    { $1 :| [] }
138 |                  | ident ':' TypeName                       { $1 :| [] }
139 |                  | TypedIdentifiers ',' ident               { $3 <| $1 }
140 |                  | TypedIdentifiers ',' ident ':' TypeName  { $3 <| $1 }
141 | 
142 | Literal     : NumberLiteral               { Number $1 }
143 |             | NumberLiteral ':' TypeName  { Number $1 }
144 |             | str                         { Str $1 }
145 |             | str ':' TypeName            { Str $1 }
146 |             | true                        { Number 1 }
147 |             | true ':' TypeName           { Number 1 }
148 |             | false                       { Number 0 }
149 |             | false ':' TypeName          { Number 0 }
150 | 
151 | NumberLiteral : hex                       { (read $1) }
152 |               | dec                       { (read $1) }
153 | 
154 | {
155 | parseError :: [Token] -> a
156 | parseError ts = error ("Can't parse tokens: " ++ show (take 10 ts))
157 | 
158 | uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
159 | uncurry3 f (x, y, z) = f x y z
160 | 
161 | uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
162 | uncurry4 f (w, x, y, z) = f w x y z
163 | }
164 | 


--------------------------------------------------------------------------------
/Clear/ReasoningPrinciple.lean:
--------------------------------------------------------------------------------
  1 | import Mathlib.Tactic
  2 | import Clear.Abstraction
  3 | import Clear.Utilities
  4 | open Clear Ast Expr Stmt State Interpreter ExecLemmas OutOfFuelLemmas JumpLemmas Abstraction PrimOps
  5 | namespace Clear.ReasoningPrinciple
  6 | 
  7 | variable {s₀ s₉ : State}
  8 |          {fuel : ℕ}
  9 | 
 10 | -- | "Concrete" spec of a loop.
 11 | --
 12 | -- This recursive predicate is a sort of intermediate step between the code and
 13 | -- the abstract spec of the loop. It is more or less just a description of how
 14 | -- the interpreter handles loops.
 15 | def C (ABody : State → State → Prop) (APost : State → State → Prop) (ACond : State → Literal) (fuel : ℕ) (s₀ s₉ : State) : Prop :=
 16 |   match fuel with
 17 |     | 0 => diverge s₀ = s₉
 18 |     | 1 => diverge s₀ = s₉
 19 |     | fuel + 1 + 1 =>
 20 |       ∃ s₂ s₃ s₅,
 21 |       let s₄ := s₃✏️⟦s₀⟧?
 22 |       let s₆ := s₅✏️⟦s₀⟧?
 23 |       (Spec ABody (👌s₀) s₂)
 24 |       ∧ (Spec APost (🧟s₂) s₃)
 25 |       ∧ (Spec (C ABody APost ACond fuel) s₄ s₅)
 26 |       ∧ (if ACond (👌 s₀) = 0 then (👌s₀)✏️⟦s₀⟧?
 27 |         else
 28 |           match s₂ with
 29 |             | .OutOfFuel                      => s₂✏️⟦s₀⟧?
 30 |             | .Checkpoint (.Break _ _)      => 🧟s₂✏️⟦s₀⟧?
 31 |             | .Checkpoint (.Leave _ _)      => s₂✏️⟦s₀⟧?
 32 |             | .Checkpoint (.Continue _ _)
 33 |             | _ => s₆
 34 |         ) = s₉
 35 | 
 36 | -- | Proof that the code of a `For` loop entails `C`, our recursive predicate for loops.
 37 | lemma reasoning_principle_1
 38 |   (cond : Expr)
 39 |   (post : List Stmt)
 40 |   (body : List Stmt)
 41 |   (ACond : State → Literal)
 42 |   (APost : State → State → Prop)
 43 |   (ABody : State → State → Prop)
 44 |   -- TODO: This will need to change to handle function calls, but one thing at a time.
 45 |   (hcond : ∀ s₀ fuel, eval fuel cond s₀ = (s₀, ACond s₀))
 46 |   (hpost : ∀ {s₀ : State} {fuel : ℕ} (s₉ : State), exec fuel (.Block post) s₀ = s₉ → Spec APost s₀ s₉)
 47 |   (hbody : ∀ {s₀ : State} {fuel : ℕ} (s₉ : State), exec fuel (.Block body) s₀ = s₉ → Spec ABody s₀ s₉) :
 48 |   exec fuel (.For cond post body) s₀ = s₉ → Spec (C ABody APost ACond fuel) s₀ s₉ := by
 49 |   intros hcode; unfold Spec
 50 |   induction fuel using Nat.case_strong_induction_on generalizing s₀ s₉ with
 51 |   | hz =>
 52 |     rw [For'] at hcode
 53 |     rcases s₀ with ⟨evm, store⟩ | - | _ <;> aesop
 54 |   | hi fuel ih =>
 55 |     revert hcode
 56 |     rcases s₀ with ⟨evm, store⟩ | _ | c <;> dsimp only <;> [skip; aesop; aesop]
 57 |     intros h hfuel; revert h
 58 |     rw [For']
 59 |     rcases fuel with _ | fuel <;> [aesop; skip]
 60 |     dsimp only
 61 |     generalize hs₂ : exec _ (.Block body) _ = s₂; specialize hbody _ hs₂
 62 |     generalize hs₃ : exec _ (.Block post) _ = s₃; specialize hpost _ hs₃
 63 |     generalize hs₅ : exec _ (.For cond post body) _ = s₅; specialize ih fuel (by linarith) hs₅
 64 |     intros h
 65 |     refine' ⟨s₂, ⟨s₃, ⟨s₅, _⟩⟩⟩
 66 |     unfold Spec
 67 |     aesop
 68 | 
 69 | lemma ABody_notOutOfFuel_of_ABody_ok {s₀ s₂ : State} {ABody} (h : s₀.isOk) :
 70 |   Spec ABody (👌s₀) s₂ → ¬❓ s₂ → ABody s₀ s₂ := by
 71 |   unfold Spec mkOk; unfold isOk at h
 72 |   aesop
 73 | 
 74 | set_option maxHeartbeats 400000 in
 75 | -- | Proof that if `C` holds for some set of abstract specs, and we know
 76 | -- certain relations hold among these specs, then the abstract spec for the
 77 | -- loop must hold.
 78 | lemma reasoning_principle_2
 79 |   (ACond : State → Literal)
 80 |   (APost : State → State → Prop)
 81 |   (ABody : State → State → Prop)
 82 |   (AFor : State → State → Prop)
 83 |   -- TODO: Probably we need some extra hypotheses here about fuel/errors.
 84 |   (AZero : ∀ s₀, isOk s₀ → ACond (👌 s₀) = 0 → AFor s₀ s₀)
 85 |   (AOk : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isOk s₂ → ¬ ❓ s₅ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → APost s₂ s₄ → Spec AFor s₄ s₅ → AFor s₀ s₅)
 86 |   (AContinue : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isContinue s₂ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → Spec APost (🧟s₂) s₄ → Spec AFor s₄ s₅ → AFor s₀ s₅)
 87 |   (ABreak : ∀ s₀ s₂, isOk s₀ → isBreak s₂ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → AFor s₀ (🧟s₂))
 88 |   (ALeave : ∀ s₀ s₂, isOk s₀ → isLeave s₂ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → AFor s₀ s₂)
 89 | : Spec (C ABody APost ACond fuel) s₀ s₉ → Spec AFor s₀ s₉
 90 | := by
 91 |   unfold Spec
 92 |   induction fuel using Nat.case_strong_induction_on generalizing s₀ s₉ with
 93 |   | hz =>
 94 |     unfold C; intros h
 95 |     rcases s₀ with ⟨evm, store⟩ | - | _ <;> aesop
 96 |   | hi fuel ih =>
 97 |     intros h
 98 |     rcases s₀ with ⟨evm, store⟩ | _ | c <;> dsimp only at * <;> [skip; assumption; assumption]
 99 |     intros hfuel
100 |     specialize h hfuel
101 |     unfold C at h
102 |     generalize hs₀ : Ok evm store = s₀ at *
103 |     have hok : isOk s₀ := by rw [← hs₀]; simp
104 | 
105 |     -- Refuel
106 |     revert h
107 |     rcases fuel with _ | fuel <;> [aesop; skip]
108 |     rw [Nat.succ_eq_add_one] at *
109 |     intros h
110 | 
111 |     dsimp (config := {zeta := False}) only at h
112 |     obtain ⟨s₂, s₃, s₅, hbody, hpost, hrecurse, hs₉⟩ := h
113 |     split_ifs at hs₉ with hcond <;> [aesop; skip]
114 |     rw [@mkOk_of_isOk _ hok] at hcond
115 |     generalize hs₄ : s₃✏️⟦s₀⟧? = s₄ at *
116 |     specialize ih fuel (by linarith) hrecurse
117 |     clear hrecurse
118 |     have hbody : ¬❓ s₂ → ABody s₀ s₂ := ABody_notOutOfFuel_of_ABody_ok (hs₀ ▸ isOk_Ok) hbody
119 |     rcases s₂ with ⟨evm₂, store₂⟩ | _ | c₂
120 |       <;> simp at *
121 |       <;> rw [← hs₉] at hfuel ⊢
122 |       <;> clear hs₉
123 |       <;> rw [overwrite?_of_isOk (by rw [← hs₀]; simp)] at *
124 |     · generalize hs₂ : Ok evm₂ store₂ = s₂ at *
125 |       unfold Spec at hpost
126 |       rw [←hs₂] at hpost
127 |       simp at hpost
128 |       rw [hs₂] at hpost
129 |       have herr₃ : ¬ ❓ s₃ := by rw [hs₄]; apply not_isOutOfFuel_Spec ih hfuel
130 |       specialize hpost herr₃
131 |       rw [hs₄] at herr₃
132 |       have hok₂ : isOk s₂ := by rw [← hs₂]; simp
133 |       rw [hs₄] at hpost
134 |       exact AOk s₀ s₂ s₄ s₅ hok hok₂ hfuel hcond hbody hpost ih
135 |     · aesop
136 |     · rcases c₂ with ⟨evm, store⟩ <;> simp at * <;> try rw [overwrite?_of_isOk (by rw [←hs₀]; simp)] at * <;> rw [hs₄] at hpost
137 |       · exact AContinue s₀ _ s₄ s₅ hok (by simp only [isContinue_Continue]) hcond hbody hpost ih
138 |       · aesop
139 |       · aesop
140 | 
141 | -- | Code → Abstract for a loop.
142 | --
143 | -- Given:
144 | --  * code → abs for cond
145 | --  * code → abs for post
146 | --  * code → abs for body
147 | --  * Abstract spec for loop is entailed by abstract specs for cond, post, body in all possible cases
148 | --
149 | -- We get that executing a loop implies its abstract spec.
150 | lemma reasoning_principle_3
151 |   (cond : Expr)
152 |   (post : List Stmt)
153 |   (body : List Stmt)
154 |   (ACond : State → Literal)
155 |   (APost : State → State → Prop)
156 |   (ABody : State → State → Prop)
157 |   (AFor : State → State → Prop)
158 |   -- TODO: Probably we need some extra hypotheses here about fuel/errors.
159 |   (AZero : ∀ s₀, isOk s₀ → ACond (👌 s₀) = 0 → AFor s₀ s₀)
160 |   (AOk : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isOk s₂ → ¬ ❓ s₅ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → APost s₂ s₄ → Spec AFor s₄ s₅ → AFor s₀ s₅)
161 |   (AContinue : ∀ s₀ s₂ s₄ s₅, isOk s₀ → isContinue s₂ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → Spec APost (🧟s₂) s₄ → Spec AFor s₄ s₅ → AFor s₀ s₅)
162 |   (ABreak : ∀ s₀ s₂, isOk s₀ → isBreak s₂ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → AFor s₀ (🧟s₂))
163 |   (ALeave : ∀ s₀ s₂, isOk s₀ → isLeave s₂ → ¬ ACond s₀ = 0 → ABody s₀ s₂ → AFor s₀ s₂)
164 |   -- TODO: This will need to change to handle function calls, but one thing at a time.
165 |   (hcond : ∀ s₀ fuel, eval fuel cond ( s₀) = ( s₀, ACond ( s₀)))
166 |   (hpost : ∀ {s₀ : State} {fuel : ℕ} (s₉ : State), exec fuel (.Block post) s₀ = s₉ → Spec APost s₀ s₉)
167 |   (hbody : ∀ {s₀ : State} {fuel : ℕ} (s₉ : State), exec fuel (.Block body) s₀ = s₉ → Spec ABody s₀ s₉)
168 | : exec fuel (.For cond post body) s₀ = s₉ → Spec AFor s₀ s₉
169 | := by
170 |   intros hcode
171 |   apply @reasoning_principle_2 _ _ fuel ACond APost ABody AFor AZero AOk AContinue ABreak ALeave
172 |   apply @reasoning_principle_1 _ _ fuel cond post body ACond APost ABody hcond hpost hbody hcode
173 | 
174 | end Clear.ReasoningPrinciple
175 | 


--------------------------------------------------------------------------------
/Clear/UInt256.lean:
--------------------------------------------------------------------------------
  1 | import Init.Data.Nat.Div
  2 | import Mathlib.Data.Nat.Defs
  3 | import Mathlib.Data.Fin.Basic
  4 | import Mathlib.Data.Vector.Basic
  5 | import Mathlib.Algebra.Group.Defs
  6 | import Mathlib.Algebra.GroupWithZero.Defs
  7 | import Mathlib.Algebra.Ring.Basic
  8 | import Mathlib.Algebra.Order.Floor
  9 | import Mathlib.Data.ZMod.Defs
 10 | import Mathlib.Tactic
 11 | 
 12 | -- 2^256
 13 | @[simp]
 14 | def UInt256.size : ℕ := 115792089237316195423570985008687907853269984665640564039457584007913129639936
 15 | 
 16 | instance : NeZero UInt256.size := ⟨by decide⟩
 17 | 
 18 | abbrev UInt256 := Fin UInt256.size
 19 | 
 20 | instance : SizeOf UInt256 where
 21 |   sizeOf := 1
 22 | 
 23 | instance (n : ℕ) : OfNat UInt256 n := ⟨Fin.ofNat n⟩
 24 | instance : Inhabited UInt256 := ⟨0⟩
 25 | instance : NatCast UInt256 := ⟨Fin.ofNat⟩
 26 | 
 27 | abbrev Nat.toUInt256 : ℕ → UInt256 := Fin.ofNat
 28 | abbrev UInt8.toUInt256 (a : UInt8) : UInt256 := a.toNat.toUInt256
 29 | 
 30 | def Bool.toUInt256 (b : Bool) : UInt256 := if b then 1 else 0
 31 | 
 32 | @[simp]
 33 | lemma Bool.toUInt256_true : true.toUInt256 = 1
 34 | := rfl
 35 | 
 36 | @[simp]
 37 | lemma Bool.toUInt256_false : false.toUInt256 = 0
 38 | := rfl
 39 | 
 40 | def Clear.UInt256.complement (a : UInt256) : UInt256 := -a - 1
 41 | 
 42 | instance : Complement UInt256 := ⟨Clear.UInt256.complement⟩
 43 | instance : HMod UInt256 ℕ UInt256 := ⟨Fin.modn⟩
 44 | -- instance : HPow UInt256 ℕ UInt256 where
 45 | --   hPow a n := (a.1 ^ n : ℕ)
 46 | instance : HPow UInt256 UInt256 UInt256 where
 47 |   hPow a n := a ^ n.val
 48 | instance : DecidableEq UInt256 := instDecidableEqFin UInt256.size
 49 | 
 50 | namespace Clear.UInt256
 51 | 
 52 | def eq0 (a : UInt256) : Bool := a = 0
 53 | 
 54 | def lnot (a : UInt256) : UInt256 := (UInt256.size - 1) - a
 55 | 
 56 | def byteAt (a b : UInt256) : UInt256 :=
 57 |   b >>> (31 - a) * 8 <<< 248
 58 | 
 59 | def sgn (a : UInt256) : UInt256 :=
 60 |   if a ≥ 2 ^ 255 then -1
 61 |   else if a = 0 then 0 else 1
 62 | 
 63 | def abs (a : UInt256) : UInt256 :=
 64 |   if a ≥ 2 ^ 255
 65 |     then a * (- 1)
 66 |     else a
 67 | 
 68 | def sdiv (a b : UInt256) : UInt256 :=
 69 |   if a ≥ 2 ^ 255 then
 70 |     if b ≥ 2 ^ 255 then
 71 |       abs a / abs b
 72 |     else (abs a / b) * (- 1)
 73 |   else
 74 |     if b ≥ 2 ^ 255 then
 75 |        (a / abs b) * (- 1)
 76 |     else a / b
 77 | 
 78 | def smod (a b : UInt256) : UInt256 :=
 79 |   if a ≥ 2 ^ 255 then
 80 |     if b ≥ 2 ^ 255 then
 81 |       Fin.mod (abs a) (abs b)
 82 |     else (-1) * Fin.mod (abs a) b
 83 |   else
 84 |     if b ≥ 2 ^ 255 then
 85 |       (-1) * Fin.mod a (abs b)
 86 |     else Fin.mod a b
 87 | 
 88 | def slt (a b : UInt256) : Bool :=
 89 |   if a ≥ 2 ^ 255 then
 90 |     if b ≥ 2 ^ 255 then
 91 |       a < b
 92 |     else true
 93 |   else
 94 |     if b ≥ 2 ^ 255 then false
 95 |     else a < b
 96 | 
 97 | def sgt (a b : UInt256) : Bool :=
 98 |   if a ≥ 2 ^ 255 then
 99 |     if b ≥ 2 ^ 255 then
100 |       a > b
101 |     else false
102 |   else
103 |     if b ≥ 2 ^ 255 then true
104 |     else a > b
105 | 
106 | def sar (a b : UInt256) : UInt256 :=
107 |   if a ≥ 256
108 |     then if b ≥ 0 then 0 else -1
109 |     else Fin.land (Fin.shiftLeft b a) (UInt256.size - 1)
110 | 
111 | def signextend (a b : UInt256) : UInt256 :=
112 |   if a ≤ 31 then
113 |     let test_bit := a * 8 + 7
114 |     let sign_bit := Fin.shiftLeft 1 test_bit
115 |     if Fin.land b sign_bit ≠ 0 then
116 |       Fin.lor b (UInt256.size - sign_bit)
117 |     else Fin.land b (sign_bit - 1)
118 |   else b
119 | 
120 | -- | Convert from a list of little-endian bytes to a natural number.
121 | def fromBytes' : List UInt8 → ℕ
122 | | [] => 0
123 | | b :: bs => b.val.val + 2^8 * fromBytes' bs
124 | 
125 | variable {bs : List UInt8}
126 |          {n : ℕ}
127 | 
128 | -- | A bound for the natural number value of a list of bytes.
129 | private lemma fromBytes'_le : fromBytes' bs < 2^(8 * bs.length) := by
130 |   induction bs with
131 |   | nil => unfold fromBytes'; simp
132 |   | cons b bs ih =>
133 |     unfold fromBytes'
134 |     have h := b.val.isLt
135 |     simp only [List.length_cons, Nat.mul_succ, Nat.add_comm, Nat.pow_add]
136 |     have :=
137 |       Nat.add_le_of_le_sub
138 |         (Nat.one_le_pow _ _ (by decide))
139 |         (Nat.le_sub_one_of_lt ih)
140 |     linarith
141 | 
142 | -- | The natural number value of a length 32 list of bytes is < 2^256.
143 | private lemma fromBytes'_UInt256_le (h : bs.length = 32) : fromBytes' bs < 2^256 := by
144 |     have h' := @fromBytes'_le bs
145 |     rw [h] at h'
146 |     exact h'
147 | 
148 | -- | Convert a natural number into a list of bytes.
149 | private def toBytes' : ℕ → List UInt8
150 |   | 0 => []
151 |   | n@(.succ n') =>
152 |     let byte : UInt8 := ⟨Nat.mod n UInt8.size, Nat.mod_lt _ (by linarith)⟩
153 |     have : n / UInt8.size < n' + 1 := by
154 |       rename_i h
155 |       rw [h]
156 |       apply Nat.div_lt_self <;> simp
157 |     byte :: toBytes' (n / UInt8.size)
158 | 
159 | -- | If n < 2⁸ᵏ, then (toBytes' n).length ≤ k.
160 | private lemma toBytes'_le {k : ℕ} (h : n < 2 ^ (8 * k)) : (toBytes' n).length ≤ k := by
161 |   induction k generalizing n with
162 |   | zero =>
163 |     simp at h
164 |     rw [h]
165 |     simp [toBytes']
166 |   | succ e ih =>
167 |     match n with
168 |     | .zero => simp [toBytes']
169 |     | .succ n =>
170 |       unfold toBytes'
171 |       simp [Nat.succ_le_succ_iff]
172 |       apply ih (Nat.div_lt_of_lt_mul _)
173 |       rw [Nat.mul_succ, Nat.pow_add] at h
174 |       linarith
175 | 
176 | -- | If n < 2²⁵⁶, then (toBytes' n).length ≤ 32.
177 | private lemma toBytes'_UInt256_le (h : n < UInt256.size) : (toBytes' n).length ≤ 32 := toBytes'_le h
178 | 
179 | -- | Zero-pad a list of bytes up to some length, adding the zeroes on the right.
180 | private def zeroPadBytes (n : ℕ) (bs : List UInt8) : List UInt8 :=
181 |   bs ++ (List.replicate (n - bs.length)) 0
182 | 
183 | -- | The length of a `zeroPadBytes` call is its first argument.
184 | lemma zeroPadBytes_len (h : bs.length ≤ n) : (zeroPadBytes n bs).length = n := by
185 |   unfold zeroPadBytes
186 |   aesop
187 | 
188 | -- | Appending a bunch of zeroes to a little-endian list of bytes doesn't change its value.
189 | @[simp]
190 | private lemma extend_bytes_zero : fromBytes' (bs ++ List.replicate n 0) = fromBytes' bs := by
191 |   induction bs with
192 |   | nil =>
193 |     simp [fromBytes']
194 |     induction n with
195 |     | zero => simp [List.replicate, fromBytes']
196 |     | succ _ ih => simp [List.replicate, fromBytes']; norm_cast
197 |   | cons _ _ ih => simp [fromBytes', ih]
198 | 
199 | -- | The ℕ value of a little-endian list of bytes is invariant under right zero-padding up to length 32.
200 | @[simp]
201 | private lemma fromBytes'_zeroPadBytes_32_eq : fromBytes' (zeroPadBytes 32 bs) = fromBytes' bs := extend_bytes_zero
202 | 
203 | -- | Casting a natural number to a list of bytes and back is the identity.
204 | @[simp]
205 | private lemma fromBytes'_toBytes' {x : ℕ} : fromBytes' (toBytes' x) = x := by
206 |   match x with
207 |   | .zero => simp [toBytes', fromBytes']
208 |   | .succ n =>
209 |     unfold toBytes' fromBytes'
210 |     simp only
211 |     have := Nat.div_lt_self (Nat.zero_lt_succ n) (by decide : 1 < UInt8.size)
212 |     rw [fromBytes'_toBytes']
213 |     simp [UInt8.size, add_comm]
214 |     apply Nat.div_add_mod
215 | 
216 | def fromBytes! (bs : List UInt8) : ℕ := fromBytes' (bs.take 32)
217 | 
218 | private lemma fromBytes_was_good_all_year_long
219 |   (h : bs.length ≤ 32) : fromBytes' bs < 2^256 := by
220 |   have h' := @fromBytes'_le bs
221 |   rw [pow_mul] at h'
222 |   refine lt_of_lt_of_le (b := (2 ^ 8) ^ List.length bs) h' ?lenBs
223 |   case lenBs => rw [←pow_mul]; exact pow_le_pow_right (by decide) (by linarith)
224 | 
225 | @[simp]
226 | lemma fromBytes_wasnt_naughty : fromBytes! bs < 2^256 := fromBytes_was_good_all_year_long (by simp)
227 | 
228 | -- Convenience function for spooning into UInt256.
229 | -- Given that I 'accept' UInt8, might as well live with UInt256.
230 | def fromBytes_if_you_really_must? (bs : List UInt8) : UInt256 :=
231 |   ⟨fromBytes! bs, fromBytes_wasnt_naughty⟩
232 | 
233 | def toBytes! (n : UInt256) : List UInt8 := zeroPadBytes 32 (toBytes' n)
234 | 
235 | @[simp]
236 | lemma length_toBytes! {n : UInt256} : (toBytes! n).length = 32 := zeroPadBytes_len (toBytes'_UInt256_le n.2)
237 | 
238 | lemma UInt256_pow_def {a b : UInt256} : a ^ b = a ^ b.val := by
239 |   rfl
240 | 
241 | lemma UInt256_pow_succ {a b : UInt256} (h : b.val + 1 < UInt256.size) : a * a ^ b = a ^ (b + 1) := by
242 |   rw [UInt256_pow_def, UInt256_pow_def]
243 |   have : (↑(b + 1) : ℕ) = (b + 1 : ℕ) := by rw [Fin.val_add, Nat.mod_eq_of_lt (by norm_cast)]; rfl
244 |   rw [this]
245 |   ring
246 | 
247 | lemma UInt256_zero_pow {a : UInt256} (h : a.val ≠ 0) : (0 : UInt256) ^ a = 0 := zero_pow h
248 | 
249 | lemma UInt256_pow_zero {a : UInt256} : a ^ (0 : UInt256) = 1 := by
250 |   unfold HPow.hPow instHPowUInt256
251 |   simp
252 | 
253 | end Clear.UInt256
254 | 


--------------------------------------------------------------------------------
/Clear/Interpreter.lean:
--------------------------------------------------------------------------------
  1 | import Mathlib.Data.Finmap
  2 | import Mathlib.Init.Data.List.Lemmas
  3 | 
  4 | import Clear.Ast
  5 | import Clear.State
  6 | import Clear.PrimOps
  7 | import Clear.EVMState
  8 | import Clear.SizeLemmas
  9 | 
 10 | namespace Clear.Interpreter
 11 | 
 12 | open Clear Ast State PrimOps SizeLemmas
 13 | 
 14 | -- ============================================================================
 15 | --  INTERPRETER
 16 | -- ============================================================================
 17 | 
 18 | def head' : State × List Literal → State × Literal
 19 |   | (s, rets) => (s, List.head! rets)
 20 | 
 21 | def cons' (arg : Literal) : State × List Literal → State × List Literal
 22 |   | (s, args) => (s, arg :: args)
 23 | 
 24 | def reverse' : State × List Literal → State × List Literal
 25 |   | (s, args) => (s, args.reverse)
 26 | 
 27 | def multifill' (vars : List Identifier) : State × List Literal → State
 28 |   | (s, rets) => s.multifill vars rets
 29 | 
 30 | mutual
 31 |   def evalTail (fuel : Nat) (args : List Expr) : State × Literal → State × List Literal
 32 |     | (s, arg) => cons' arg (evalArgs fuel args s)
 33 |   termination_by _ => 1 + fuel + sizeOf args
 34 | 
 35 |   /--
 36 |     `evalArgs` evaluates a list of arguments.
 37 |   -/
 38 |   def evalArgs (fuel : Nat) (args : List Expr) (s : State) : State × List Literal :=
 39 |     match args with
 40 |       | [] => (s, [])
 41 |       | arg :: args =>
 42 |         evalTail fuel args (eval fuel arg s)
 43 |   termination_by fuel + sizeOf args
 44 |   decreasing_by
 45 |     all_goals simp_wf; try simp_arith
 46 |     try apply Expr.zero_lt_sizeOf
 47 | 
 48 |   /--
 49 |     `call` executes a call of a user-defined function.
 50 |   -/
 51 |   def call (fuel : Nat) (args : List Literal) (f : FunctionDefinition) (s : State) : State × List Literal :=
 52 |     let s₁ := 👌 initcall f.params args s
 53 |     let s₂ := exec fuel (.Block f.body) s₁
 54 |     let s₃ := reviveJump s₂ |>.overwrite? s |>.setStore s
 55 |     (s₃, List.map s₂.lookup! f.rets)
 56 |   termination_by fuel + sizeOf f
 57 |   decreasing_by
 58 |     all_goals simp_wf
 59 |     simp_arith
 60 |     apply FunctionDefinition.sizeOf_body_succ_lt_sizeOf
 61 | 
 62 |   -- Safe to call `List.head!` on return values, because the compiler throws an
 63 |   -- error when coarity is > 0 in (1) and when coarity is > 1 in all other
 64 |   -- cases.
 65 | 
 66 |   def evalPrimCall (prim : PrimOp) : State × List Literal → State × Literal
 67 |     | (s, args) => head' (primCall s prim args)
 68 | 
 69 |   def evalCall (fuel : Nat) (f : FunctionDefinition) : State × List Literal → State × Literal
 70 |     | (s, args) => head' (call fuel args f s)
 71 |   termination_by _ => 1 + fuel + sizeOf f
 72 | 
 73 |   def execPrimCall (prim : PrimOp) (vars : List Identifier) : State × List Literal → State
 74 |     | (s, args) => multifill' vars (primCall s prim args)
 75 | 
 76 |   def execCall (fuel : Nat) (f : FunctionDefinition) (vars : List Identifier) : State × List Literal → State
 77 |     | (s, args) => multifill' vars (call fuel args f s)
 78 |   termination_by _ => 1 + fuel + sizeOf f
 79 | 
 80 |   /--
 81 |     `execSwitchCases` executes each case of a `switch` statement.
 82 |   -/
 83 |   def execSwitchCases (fuel : Nat) (s : State) : List (Literal × List Stmt) → List (Literal × State)
 84 |     | [] => []
 85 |     | ((val, stmts) :: cases') => (val, exec fuel (.Block stmts) s) :: execSwitchCases fuel s cases'
 86 |   termination_by x => fuel + sizeOf x
 87 | 
 88 |   /--
 89 |     `eval` evaluates an expression.
 90 | 
 91 |     - calls evaluated here are assumed to have coarity 1
 92 |   -/
 93 |   def eval (fuel : Nat) (expr : Expr) (s : State) : State × Literal :=
 94 |     match expr with
 95 | 
 96 |       -- We hit these two cases (`PrimCall` and `Call`) when evaluating:
 97 |       --
 98 |       --  1. f()                 (expression statements)
 99 |       --  2. g(f())              (calls in function arguments)
100 |       --  3. if f() {...}        (if conditions)
101 |       --  4. for {...} f() ...   (for conditions)
102 |       --  5. switch f() ...      (switch conditions)
103 | 
104 |       | .PrimCall prim args => evalPrimCall prim (reverse' (evalArgs fuel args.reverse s))
105 |       | .Call f args        => evalCall fuel f (reverse' (evalArgs fuel args.reverse s))
106 |       | .Var id             => (s, s[id]!!)
107 |       | .Lit val            => (s, val)
108 |   termination_by fuel + sizeOf expr
109 |   decreasing_by
110 |     all_goals
111 |     simp_wf
112 |     try simp_arith
113 |     try apply Expr.zero_lt_sizeOf_List
114 | 
115 |   /--
116 |     `exec` executs a single statement.
117 |   -/
118 |   def exec (fuel : Nat) (stmt : Stmt) (s : State) : State :=
119 |     match stmt with
120 |       | .Block [] => s
121 |       | .Block (stmt :: stmts) =>
122 |         let s₁ := exec fuel stmt s
123 |         exec fuel (.Block stmts) s₁
124 | 
125 |       | .Let vars => List.foldr (λ var s ↦ s.insert var 0) s vars
126 | 
127 |       | .LetEq var rhs =>
128 |         let (s, val) := eval fuel rhs s
129 |         s.insert var val
130 | 
131 |       | .LetCall vars f args => execCall fuel f vars (reverse' (evalArgs fuel args.reverse s))
132 | 
133 |       | .LetPrimCall vars prim args => execPrimCall prim vars (reverse' (evalArgs fuel args.reverse s))
134 | 
135 |       | .Assign var rhs =>
136 |         let (s, x) := eval fuel rhs s
137 |         s.insert var x
138 | 
139 |       | .AssignCall vars f args => execCall fuel f vars (reverse' (evalArgs fuel args.reverse s))
140 | 
141 |       | .AssignPrimCall vars prim args => execPrimCall prim vars (reverse' (evalArgs fuel args.reverse s))
142 | 
143 |       | .If cond body =>
144 |         let (s, cond) := eval fuel cond s
145 |         if cond ≠ 0 then exec fuel (.Block body) s else s
146 | 
147 |       -- "Expressions that are also statements (i.e. at the block level) have
148 |       -- to evaluate to zero values."
149 |       --
150 |       -- (https://docs.soliditylang.org/en/latest/yul.html#restrictions-on-the-grammar)
151 |       --
152 |       -- Thus, we cannot have literals or variables on the RHS.
153 |       | .ExprStmtCall f args => execCall fuel f [] (reverse' (evalArgs fuel args.reverse s))
154 |       | .ExprStmtPrimCall prim args => execPrimCall prim [] (reverse' (evalArgs fuel args.reverse s))
155 | 
156 |       | .Switch cond cases' default' =>
157 | 
158 |         let (s₁, cond) := eval fuel cond s
159 |         let branches := execSwitchCases fuel s₁ cases'
160 |         let s₂ := exec fuel (.Block default') s₁
161 |         List.foldr (λ (valᵢ, sᵢ) s ↦ if valᵢ = cond then sᵢ else s) s₂ branches
162 | 
163 |       -- A `Break` or `Continue` in the pre or post is a compiler error,
164 |       -- so we assume it can't happen and don't modify the state in these
165 |       -- cases. (https://docs.soliditylang.org/en/v0.8.23/yul.html#loops)
166 |       | .For cond post body => loop fuel cond post body s
167 |       | .Continue => 🔁 s
168 |       | .Break => 💔 s
169 |       | .Leave => 🚪 s
170 |   termination_by fuel + sizeOf stmt
171 |   decreasing_by
172 |     all_goals
173 |     simp_wf
174 |     try simp_arith
175 |     try apply le_add_right
176 |     try apply List.zero_lt_sizeOf
177 |     try apply Expr.zero_lt_sizeOf
178 |     try apply Expr.zero_lt_sizeOf_List
179 | 
180 |   /--
181 |     `loop` executes a for-loop.
182 |   -/
183 |   def loop (fuel : Nat) (cond : Expr) (post body : List Stmt) (s : State) : State :=
184 |     match fuel with
185 |       | 0 => diverge s
186 |       | 1 => diverge s
187 |       | fuel + 1 + 1 =>
188 |         let (s₁, x) := eval fuel cond (👌s)
189 |         if x = 0
190 |           then s₁✏️⟦s⟧?
191 |           else
192 |             let s₂ := exec fuel (.Block body) s₁
193 |             match s₂ with
194 |               | .OutOfFuel                      => s₂✏️⟦s⟧?
195 |               | .Checkpoint (.Break _ _)      => 🧟s₂✏️⟦s⟧?
196 |               | .Checkpoint (.Leave _ _)      => s₂✏️⟦s⟧?
197 |               | .Checkpoint (.Continue _ _) 
198 |               | _ =>
199 |                 let s₃ := exec fuel (.Block post) (🧟 s₂)
200 |                 let s₄ := s₃✏️⟦s⟧?
201 |                 let s₅ := exec fuel (.For cond post body) s₄
202 |                 let s₆ := s₅✏️⟦s⟧?
203 |                 s₆
204 |   termination_by fuel + sizeOf cond + sizeOf post + sizeOf body
205 |   decreasing_by
206 |     all_goals
207 |     simp_wf
208 |     simp_arith
209 | 
210 | end
211 | 
212 | notation "🍄" => exec
213 | notation "🌸" => eval
214 | 
215 | section
216 | 
217 | open EVMState
218 | 
219 | variable {s s₀ s₁ : State}
220 |          {arg expr rhs cond : Expr}
221 |          {args : List Expr}
222 |          {evm : EVM}
223 |          {store : VarStore}
224 |          {stmt : Stmt}
225 |          {stmts pre body post rest : List Stmt}
226 |          {fuel m n k : ℕ}
227 |          {var var' fname : String}
228 |          {x : Literal}
229 |          {xs : List Literal}
230 |          {f : FunctionDefinition}
231 |          {prim : PrimOp}
232 | 
233 | -- ============================================================================
234 | --  TRAVERSE LEMMAS
235 | -- ============================================================================
236 | 
237 | /-
238 |   Traversing an empty list is the identity on states.
239 | -/
240 | @[simp]
241 | lemma nil : exec fuel (.Block []) s = s := by unfold exec; rfl
242 | 
243 | /--
244 |   Traversing a nonempty list is the same traversing the tail from the state yielded from executing the head.
245 | -/
246 | lemma cons : exec fuel (.Block (stmt :: stmts)) s = exec fuel (.Block stmts) (exec fuel stmt s) := by
247 |   conv_lhs => unfold exec
248 | 
249 | -- ============================================================================
250 | --  EVAL LEMMAS
251 | -- ============================================================================
252 | 
253 | /--
254 |   Evaluating a literal gives you back that literal and the state you started in.
255 | -/
256 | lemma Lit' : eval fuel (.Lit x) s = (s, x) := by unfold eval; rfl
257 | 
258 | /--
259 |   Evaluating a variable does a varstore lookup.
260 | -/
261 | lemma Var' : eval fuel (.Var var) s = (s, s[var]!!) := by unfold eval; rfl
262 | 
263 | /--
264 |   A call in an expression.
265 | -/
266 | lemma Call' : eval fuel (.Call f args) s = evalCall fuel f (reverse' (evalArgs fuel args.reverse s)) := by unfold eval; rfl
267 | 
268 | /--
269 |   Evaluating an EVM builtin evaluates the arguments, calls the builtin on
270 | the resulting literals, and then returns the resulting state and the first
271 | literal return value.
272 | -/
273 | lemma PrimCall' : eval fuel (.PrimCall prim args) s = evalPrimCall prim (reverse' (evalArgs fuel args.reverse s)) := by unfold eval; rfl
274 | 
275 | -- ============================================================================
276 | --  HELPER FUNCTION LEMMAS
277 | -- ============================================================================
278 | 
279 | /--
280 |   Executing a user-defined function with the `call` interpreter helper
281 |   function loads all the arguments and return variables into the varstore,
282 |   traverses the body, restores the saved checkpoint to the top-level.
283 | -/
284 | lemma call_def : call fuel xs f s =
285 |   let s₁ := 👌 initcall f.params xs s
286 |   let s₂ := exec fuel (.Block f.body) s₁
287 |   let s₃ := reviveJump s₂ |>.overwrite? s |>.setStore s
288 |   (s₃, List.map s₂.lookup! f.rets) := by unfold call; rfl
289 | 
290 | @[simp]
291 | lemma evalTail_nil : evalTail fuel [] (s, x) = (s, [x]) := by
292 |   conv_lhs => unfold evalTail cons' evalArgs
293 | 
294 | @[simp]
295 | lemma evalTail_cons : evalTail fuel (arg :: args) (s, x) =
296 |   match evalTail fuel args (🌸 fuel arg s) with
297 |     | (s, args) => (s, x :: args) := by conv_lhs => unfold evalTail cons' evalArgs
298 | 
299 | end
300 | 
301 | end Clear.Interpreter
302 | 


--------------------------------------------------------------------------------
/vc/src/Preprocessor.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TupleSections #-}
  2 | 
  3 | module Preprocessor (preprocess, preprocessFile, preprocessDefs) where
  4 | 
  5 | import Algebra.Graph.AdjacencyMap (stars)
  6 | import Algebra.Graph.AdjacencyMap.Algorithm (topSort)
  7 | import Control.Arrow (second)
  8 | import Data.List (intercalate, sortBy, foldl', findIndex, isPrefixOf, tails)
  9 | import qualified Data.List.NonEmpty as NE
 10 | import Data.Map (Map)
 11 | import qualified Data.Map as M
 12 | import Data.Maybe (fromMaybe)
 13 | import Relude.Extra.Foldable1 (foldMap1)
 14 | import qualified Data.List.Split as SP (splitOn, split, onSublist)
 15 | import Types (
 16 |   ContractName,
 17 |   Expr (..),
 18 |   FuncDef (..),
 19 |   FuncName,
 20 |   FuncNamePair,
 21 |   Literal (..),
 22 |   Stmt (..),
 23 |   funcDefDeps, Identifier,
 24 |  )
 25 | import Utils (replaceMany, strip)
 26 | import qualified Data.Bifunctor
 27 | 
 28 | -- | Transform e.g. `@src 18:5006:5080  "a.g(..."` -> `a.g.(...`.
 29 | --
 30 | -- i.e. Drop everything until the first `"`, and then unwrap the quoted a thing.
 31 | unquote :: String -> String
 32 | unquote = reverse . dropWhile (== '"') . reverse . dropWhile (== '"') . dropWhile (/= '"')
 33 | 
 34 | -- | Parse contract name and function name from delegatecall comment.
 35 | parseDelegateCallNames :: String -> (ContractName, FuncName)
 36 | parseDelegateCallNames comment =
 37 |   case SP.splitOn "." . takeWhile (/= '(') . unquote $ comment of
 38 |     [contract, fname] -> (contract, fname)
 39 |     _ -> error $ "Bad delegatecall comment: " ++ comment
 40 | 
 41 | -- | Substitute all delegate calls in a *reversed* block with normal calls.
 42 | subDelegateCalls :: [Stmt] -> [Stmt]
 43 | subDelegateCalls [] = []
 44 | subDelegateCalls
 45 |   ( LetInit vars (Call "delegatecall" _)
 46 |       : LetInit _ (Call _ args)
 47 |       : InlineComment comment
 48 |       : stmts
 49 |     ) = call' : subDelegateCalls stmts
 50 |     where
 51 |       (contract, fname) = parseDelegateCallNames comment
 52 |       call' = LetInit vars (CrossContractCall fname contract (drop 1 args))
 53 | subDelegateCalls (stmt : stmts) = stmt : subDelegateCalls stmts
 54 | 
 55 | subLinkerSymbol :: Stmt -> Stmt
 56 | subLinkerSymbol (LetInit name (Call "linkersymbol" _)) = LetInit name (Lit (Number 1))
 57 | subLinkerSymbol stmt = stmt
 58 | 
 59 | -- | Map a function over all blocks in a function definition, recursively.
 60 | transformDef :: ([Stmt] -> [Stmt]) -> FuncDef -> FuncDef
 61 | transformDef f (FuncDef name contract args rets body) = FuncDef name contract args rets (mapStmts f body)
 62 | 
 63 | -- | Map a function over all blocks contained in a statement, recursively.
 64 | transform :: ([Stmt] -> [Stmt]) -> Stmt -> Stmt
 65 | transform f (Block xs) = Block (mapStmts f xs)
 66 | transform f (Switch e cases stmts) = Switch e (map (second (mapStmts f)) cases) (mapStmts f stmts)
 67 | transform f (For init cond body post) = For (mapStmts f init) cond (mapStmts f body) (mapStmts f post)
 68 | transform f (If cond body) = If cond (mapStmts f body)
 69 | transform _ stmt = stmt
 70 | 
 71 | -- | Map a function over all blocks in a block, recursively.
 72 | mapStmts :: ([Stmt] -> [Stmt]) -> [Stmt] -> [Stmt]
 73 | mapStmts f = f . map (transform f)
 74 | 
 75 | linkStmts :: [Stmt] -> [Stmt]
 76 | linkStmts = reverse . subDelegateCalls . reverse . map subLinkerSymbol
 77 | 
 78 | lookup' :: (Show a, Ord a) => Map a b -> a -> b
 79 | lookup' m k = fromMaybe (error $ "Not found: " ++ show k) (M.lookup k m)
 80 | 
 81 | -- | Get names of all functions reachable from `fname` (recursively).
 82 | getAllCalled :: Map FuncNamePair FuncDef -> FuncNamePair -> [FuncNamePair]
 83 | getAllCalled funcMap = recurse . funcDefDeps . lookup' funcMap
 84 |   where
 85 |     recurse xs = xs ++ concatMap (getAllCalled funcMap) xs
 86 | 
 87 | mapDefs :: [FuncDef] -> Map FuncNamePair FuncDef
 88 | mapDefs = M.fromList . map (\f@(FuncDef fname c _ _ _) -> ((c, fname), f))
 89 | 
 90 | -- | Get all functions reachable from a list of entry points across all contracts.
 91 | reach :: [FuncDef] -> [FuncNamePair] -> [FuncNamePair]
 92 | reach fs = concatMap (getAllCalled (mapDefs fs))
 93 | 
 94 | -- | Is `f` reachable from the entrypoints?
 95 | isCalled :: [FuncNamePair] -> [FuncDef] -> FuncDef -> Bool
 96 | isCalled entrypoints defs f = namePair f `elem` (entrypoints ++ reach defs entrypoints)
 97 | 
 98 | -- | Filter-out functions in each contract not reachable from `entrypoints`.
 99 | filterDefs :: [FuncNamePair] -> [FuncDef] -> [FuncDef]
100 | filterDefs entrypoints defs = filter (isCalled entrypoints defs) defs
101 | 
102 | -- | Given a map of contracts and the `:`-separated parts of an entry point
103 | -- argument, return all (contractName, functionName) pairs specified by this
104 | -- entry point argument.
105 | getEntryPoint :: Map ContractName [FuncDef] -> [String] -> [FuncNamePair]
106 | getEntryPoint _ [c, f] = [(c, f)]
107 | getEntryPoint m [c] = map ((c,) . fdName) . lookup' m $ c
108 | getEntryPoint _ parts = error $ "Malformed entrypoint: '" ++ intercalate ":" parts ++ "'"
109 | 
110 | contractOrdering :: FuncDef -> FuncDef -> Ordering
111 | contractOrdering f g = compare (fdContract f) (fdContract g)
112 | 
113 | data Contract = Contract ContractName [FuncDef]
114 | 
115 | instance Semigroup Contract where
116 |   (Contract c fs) <> (Contract d gs)
117 |     | c == d = Contract c (fs ++ gs)
118 |     | otherwise = error $ "Contract grouping failed: " ++ show c ++ ", " ++ show d
119 | 
120 | mkContract :: FuncDef -> Contract
121 | mkContract f = Contract (fdName f) [f]
122 | 
123 | unContract :: Contract -> (ContractName, [FuncDef])
124 | unContract (Contract name fs) = (name, fs)
125 | 
126 | mapContracts :: [FuncDef] -> Map ContractName [FuncDef]
127 | mapContracts = M.fromList . agg' . groupBy' . sort'
128 |   where
129 |     agg' = map (unContract . foldMap1 mkContract)
130 |     sort' = sortBy contractOrdering
131 |     groupBy' = NE.groupBy (\f g -> fdContract f == fdContract g)
132 | 
133 | getEntryPoints :: [String] -> [FuncDef] -> [FuncNamePair]
134 | getEntryPoints args fs = concatMap (getEntryPoint (mapContracts fs) . SP.splitOn ":") args
135 | 
136 | namePair :: FuncDef -> FuncNamePair
137 | namePair (FuncDef name c _ _ _) = (c, name)
138 | 
139 | -- | A star is a center vertex and directed edges to each called function.
140 | mkStar :: Map FuncNamePair FuncDef -> FuncDef -> (FuncDef, [FuncDef])
141 | mkStar m f = (f, map (lookup' m) (getAllCalled m (namePair f)))
142 | 
143 | mkStars :: [FuncDef] -> [(FuncDef, [FuncDef])]
144 | mkStars fs = map (mkStar (mapDefs fs)) fs
145 | 
146 | -- | Do a topological sort on functions in a contract (so we process dependencies first).
147 | sortDefs :: [FuncDef] -> [FuncDef]
148 | sortDefs = either (\fs -> error $ "Call cycle:" ++ show fs) reverse . topSort . stars . mkStars
149 | 
150 | -- | Replace linkersymbols with constants and delegate calls with normal calls.
151 | link :: [FuncDef] -> [FuncDef]
152 | link = map (transformDef (mapStmts linkStmts))
153 | 
154 | -- | Only filter if entrypoints are specified.
155 | preprocess :: [String] -> [FuncDef] -> [FuncDef]
156 | preprocess [] fs = sortDefs . link $ fs
157 | preprocess args fs = sortDefs . filterDefs (getEntryPoints args fs) . link $ fs
158 | 
159 | -- TODO(very ugly, refactor -- also quite slow performance wise, oh well)
160 | preprocessFile :: String -> String
161 | preprocessFile = sansAssignedLiterals . sansInlineComment . sansComments . replaceMany [("Optimized IR:", "")]
162 |   where sansComments = unlines . map (\line -> if "//" `isPrefixOf` strip line then "" else line) . lines
163 | 
164 |         commentBegin = "/**"
165 |         commentEnd = "*/"
166 |         sansInlineComment = fst . foldl' go ("", False)
167 |                                 . concatMap (SP.split (SP.onSublist commentEnd)) . SP.split (SP.onSublist commentBegin)
168 |           where go (res, inComment) chunk =
169 |                   (res ++ if inComment || chunk == commentEnd || chunk == commentBegin
170 |                           then ""
171 |                           else chunk, -- only append chunks that are not delimiters themselves or between them
172 |                    (chunk /= commentEnd) && (chunk == commentBegin)) -- enter/exit the inComment state
173 | 
174 |         -- TODO(this is a hack inherited from the old version)
175 |         sansAssignedLiterals = unlines . map (\line -> case findString ":= \"" line of
176 |                                                          Nothing -> line
177 |                                                          Just idx -> take idx line ++ ":= 0"
178 |                                                        ) . lines
179 |           where findString needle heystack = findIndex (isPrefixOf needle) (tails heystack)
180 | 
181 | -- TOOD(some of these are hacks, as per the initial design actually)
182 | preprocessDefs :: [FuncDef] -> [FuncDef]
183 | preprocessDefs = rejectExternals . map (delegateCallHack . expressionSplitterFix . (\fd ->
184 |   fd {
185 |     fdArgs    = map sanitiseVariableName (fdArgs fd),
186 |     fdReturns = map sanitiseVariableName (fdReturns fd),
187 |     fdBody    = map sanitiseVariableNames (fdBody fd)
188 |   }))
189 |   where leanKeywords = ["end"] -- TODO(Do this properly, there's a good chance some variables will collide.)
190 | 
191 |         sanitiseVariableName :: Identifier -> Identifier
192 |         sanitiseVariableName var = if var `elem` leanKeywords then var ++ "_clear_sanitised_hrafn" else var
193 | 
194 |         sanitiseExpr :: Expr -> Expr
195 |         sanitiseExpr (Var var) = Var (sanitiseVariableName var)
196 |         sanitiseExpr (Call f args) = Call f (map sanitiseExpr args)
197 |         sanitiseExpr expr      = expr
198 | 
199 |         sanitiseVariableNames :: Stmt -> Stmt
200 |         sanitiseVariableNames (ExpressionStmt e)    = ExpressionStmt (sanitiseExpr e)
201 |         sanitiseVariableNames (LetInit idents e)    = LetInit (NE.map sanitiseVariableName idents) (sanitiseExpr e)
202 |         sanitiseVariableNames (Assignment idents e) = Assignment (NE.map sanitiseVariableName idents) (sanitiseExpr e)
203 |         sanitiseVariableNames (Declaration idents)  = Declaration (NE.map sanitiseVariableName idents)
204 |         sanitiseVariableNames (Switch c legs dflt)  = Switch (sanitiseExpr c)
205 |                                                              (map (Data.Bifunctor.second (map sanitiseVariableNames)) legs)
206 |                                                              (map sanitiseVariableNames dflt)
207 |         sanitiseVariableNames (For pre c post body) = For (map sanitiseVariableNames pre)
208 |                                                           (sanitiseExpr c)
209 |                                                           (map sanitiseVariableNames post)
210 |                                                           (map sanitiseVariableNames body)
211 |         sanitiseVariableNames (If c body)           = If (sanitiseExpr c) (map sanitiseVariableNames body)
212 |         sanitiseVariableNames stmt                  = stmt
213 | 
214 |         rejectExternals :: [FuncDef] -> [FuncDef]
215 |         rejectExternals = filter rejectExternal
216 |           where rejectExternal = not . isPrefixOf "external_" . fdName
217 | 
218 |         delegateCallHack :: FuncDef -> FuncDef
219 |         delegateCallHack (FuncDef a b c d body) = FuncDef a b c d $ map go body
220 |           where
221 |             go :: Stmt -> Stmt
222 |             go (LetInit idents (Call "linkersymbol" _)) = LetInit idents (Lit (Number 42))
223 |             go s = s
224 | 
225 |         expressionSplitterFix :: FuncDef -> FuncDef
226 |         expressionSplitterFix (FuncDef a b c d body) =
227 |           FuncDef a b c d . foldl' (\acc stmt ->
228 |               case splitPop stmt of
229 |                 Nothing -> acc ++ [stmt] -- your antipatterns can't stop me
230 |                 Just (pop, expr) -> acc ++ [LetInit (NE.fromList ["cheat"]) expr, pop]
231 |             ) [] $ body
232 |           where splitPop :: Stmt -> Maybe (Stmt, Expr)
233 |                 splitPop (ExpressionStmt (Call "pop" [arg])) =
234 |                   Just (ExpressionStmt (Call "pop" [Var "cheat"]), arg)
235 |                 splitPop _ = Nothing
236 | 


--------------------------------------------------------------------------------
/vc/src/Types.hs:
--------------------------------------------------------------------------------
  1 | module Types (
  2 |   Formattable (..),
  3 |   Identifier,
  4 |   FuncName,
  5 |   ContractName,
  6 |   FuncNamePair,
  7 |   Literal (..),
  8 |   Expr (..),
  9 |   FuncDef (..),
 10 |   FuncDef' (..),
 11 |   Stmt (..),
 12 |   TopLvlStmt (..),
 13 |   InnerObject (..),
 14 |   Object (..),
 15 |   objStmts,
 16 |   funcDefOfStmt,
 17 |   getContracts,
 18 |   mkDef,
 19 |   mkDefs,
 20 |   uninitializedNames,
 21 |   SegName,
 22 |   Segment (..),
 23 |   funcDefDeps,
 24 |   stmtDeps,
 25 |   nameOfNode,
 26 |   FileName,
 27 |   Code,
 28 |   Import,
 29 |   Imports
 30 | ) where
 31 | 
 32 | import Control.Arrow (second)
 33 | import Control.Monad.Trans.State
 34 | import Data.Foldable (foldrM)
 35 | import qualified Data.List as L
 36 | 
 37 | import Data.List.NonEmpty (NonEmpty (..))
 38 | import qualified Data.List.NonEmpty as NE
 39 | import Data.Maybe (mapMaybe)
 40 | import Data.Set (Set)
 41 | import qualified Data.Set as S
 42 | 
 43 | import PrimOps (yulPrimOps)
 44 | import Data.Hashable
 45 | 
 46 | -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ YUL AST ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 47 | 
 48 | type FuncName = String
 49 | type Identifier = String
 50 | type ContractName = String
 51 | type FuncNamePair = (ContractName, FuncName)
 52 | type FileName     = String
 53 | type Import       = (String, (ContractName, Bool))
 54 | type Imports      = [Import]
 55 | type Code         = Stmt
 56 | 
 57 | data Literal
 58 |   = Number Integer
 59 |   | Str String
 60 |   deriving (Eq, Ord, Show)
 61 | 
 62 | instance (Hashable Literal) where
 63 |   hashWithSalt s (Number n) = hashWithSalt s n
 64 |   hashWithSalt s (Str str) = hashWithSalt s str
 65 | 
 66 | data Expr
 67 |   = Call FuncName [Expr]
 68 |   | CrossContractCall FuncName Identifier [Expr]
 69 |   | Var Identifier
 70 |   | Lit Literal
 71 |   deriving (Eq, Ord, Show)
 72 | 
 73 | instance (Hashable Expr) where
 74 |   hashWithSalt s (Call fName body) = s `hashWithSalt` fName `hashWithSalt` sum (map (hashWithSalt s) body) -- Are these qualified to just hash the name?
 75 |   hashWithSalt s (CrossContractCall fName ident body) = s `hashWithSalt` fName `hashWithSalt` ident `hashWithSalt` sum (map (hashWithSalt s) body)
 76 |   hashWithSalt s (Var ident) = hashWithSalt s ident
 77 |   hashWithSalt s (Lit lit) = hashWithSalt s lit
 78 | 
 79 | data FuncDef' = FuncDef' FuncName [Identifier] [Identifier] [Stmt]
 80 |   deriving (Eq, Show)
 81 | 
 82 | data FuncDef = FuncDef
 83 |   { fdName :: FuncName
 84 |   , fdContract :: Identifier
 85 |   , fdArgs :: [Identifier]
 86 |   , fdReturns :: [Identifier]
 87 |   , fdBody :: [Stmt]
 88 |   }
 89 |   deriving (Eq, Ord, Show)
 90 | 
 91 | data TopLvlStmt = UnusedBlock | FuncDefStmt FuncDef'
 92 |   deriving (Show)
 93 | 
 94 | data Stmt
 95 |   = Block [Stmt]
 96 |   | LetInit (NonEmpty Identifier) Expr
 97 |   | Assignment (NonEmpty Identifier) Expr
 98 |   | Declaration (NonEmpty Identifier)
 99 |   | ExpressionStmt Expr
100 |   | Switch Expr [(Literal, [Stmt])] [Stmt]
101 |   | For [Stmt] Expr [Stmt] [Stmt]
102 |   | If Expr [Stmt]
103 |   | Continue
104 |   | Break
105 |   | Leave
106 |   | InlineComment String
107 |   | MultilineComment String
108 |   deriving (Eq, Ord, Show)
109 | 
110 | instance (Hashable Stmt) where
111 |   hashWithSalt s (Block body) = sum (map (hashWithSalt s) body)
112 |   hashWithSalt s (LetInit idn e) = s `hashWithSalt` idn `hashWithSalt` e
113 |   hashWithSalt s (Assignment lhs e) = s `hashWithSalt` lhs `hashWithSalt` e
114 |   hashWithSalt s (Declaration idn) = hashWithSalt s idn
115 |   hashWithSalt s (ExpressionStmt e) = hashWithSalt s e
116 |   hashWithSalt s (Switch what cases dflt) = s `hashWithSalt` what `hashWithSalt` cases `hashWithSalt` dflt
117 |   hashWithSalt s (For pre init post body) = s `hashWithSalt` pre `hashWithSalt` init `hashWithSalt` post `hashWithSalt` body
118 |   hashWithSalt s (If cnd body) = s `hashWithSalt` cnd `hashWithSalt` body
119 |   hashWithSalt s Continue = hashWithSalt s "Continue"
120 |   hashWithSalt s Break = hashWithSalt s "Break"
121 |   hashWithSalt s Leave = hashWithSalt s "Leave"
122 |   hashWithSalt s (InlineComment _) = s
123 |   hashWithSalt s (MultilineComment _) = s
124 | 
125 | data InnerObject = InnerObject String String [TopLvlStmt]
126 |   deriving (Show)
127 | 
128 | data Object = Object String String [TopLvlStmt] InnerObject
129 |   deriving (Show)
130 | 
131 | objStmts :: Object -> (ContractName, [TopLvlStmt])
132 | objStmts (Object _ objId _ (InnerObject _ _ ys)) = (takeWhile (/= '_') objId, ys)
133 | 
134 | funcDefOfStmt :: TopLvlStmt -> Maybe FuncDef'
135 | funcDefOfStmt (FuncDefStmt f) = Just f
136 | funcDefOfStmt _ = Nothing
137 | 
138 | getContracts :: [Object] -> [(ContractName, [FuncDef'])]
139 | getContracts = map (second (mapMaybe funcDefOfStmt) . objStmts)
140 | 
141 | mkDef :: ContractName -> FuncDef' -> FuncDef
142 | mkDef c (FuncDef' name args rets body) = FuncDef name c args rets body
143 | 
144 | mkDefs :: (ContractName, [FuncDef']) -> [FuncDef]
145 | mkDefs (c, fs') = map (mkDef c) fs'
146 | 
147 | _funcDefNotation :: FuncDef -> String
148 | _funcDefNotation fd = "<f " <> src fd <> ">"
149 | 
150 | nameOfNode :: Stmt -> String
151 | nameOfNode node =
152 |   case node of
153 |     (For {})                    -> forPrefix ++ show nodeHash
154 |     (ExpressionStmt (Call f _)) -> f -- Functions are already named; fortuitous!
155 |     (If {})                     -> ifPrefix ++ show nodeHash
156 |     (Switch {})                 -> switchPrefix ++ show nodeHash
157 |     _                           -> "<<ERROR>> - No abstraction associated with: " ++ show node
158 |   where ifPrefix  = "if_"
159 |         forPrefix = "for_"
160 |         switchPrefix = "switch_"
161 |         nodeHash  = abs . hash $ node
162 | 
163 | ----------------------------------------------------------------------------
164 | -- searching for names not initialized in scope of the current statement  --
165 | ----------------------------------------------------------------------------
166 | 
167 | -- basic types and infrastructure
168 | 
169 | type DefinedNames = S.Set Identifier
170 | type CollectM a = State DefinedNames a
171 | 
172 | -- including defined identifiers in the monad
173 | 
174 | addDefinedNames :: NonEmpty Identifier -> CollectM ()
175 | addDefinedNames ids = modify (\defs -> foldr S.insert defs ids)
176 | 
177 | -- checking if an identifier is a defined name
178 | 
179 | isDefinedName :: Identifier -> CollectM Bool
180 | isDefinedName n = gets (n `S.member`)
181 | 
182 | -- type class and instances for the algorithm of getting uninitialized names.
183 | 
184 | class CollectNames a where
185 |   collect :: a -> CollectM (S.Set Identifier)
186 | 
187 | instance (CollectNames a) => CollectNames [a] where
188 |   collect xs = S.unions <$> mapM collect xs
189 | 
190 | instance CollectNames Stmt where
191 |   collect (Block stmts) = collect stmts
192 |   collect (LetInit ids e) = do
193 |     addDefinedNames ids
194 |     collect e
195 |   collect (Assignment ids e) = do
196 |     idsE <- collect e
197 |     let ins x ac = do
198 |           b <- isDefinedName x
199 |           pure $ if b then ac else S.insert x ac
200 |     foldrM ins idsE ids
201 |   collect (Declaration ids) = addDefinedNames ids >> pure S.empty
202 |   collect (ExpressionStmt e) = collect e
203 |   collect (Switch e binds deft) =
204 |     S.unions <$> mapM collect (ExpressionStmt e : concatMap snd binds ++ deft)
205 |   collect (For inits e stmts post) =
206 |     S.unions <$> mapM collect (ExpressionStmt e : inits ++ stmts ++ post)
207 |   collect (If e stmts) =
208 |     S.unions <$> mapM collect (ExpressionStmt e : stmts)
209 |   collect _ = pure S.empty
210 | 
211 | instance CollectNames Expr where
212 |   collect (Call _ es) = collect es
213 |   collect (CrossContractCall _ _ es) = collect es
214 |   collect (Var n) = do
215 |     b <- isDefinedName n
216 |     pure $
217 |       if b
218 |         then S.empty
219 |         else S.singleton n
220 |   collect _ = pure S.empty
221 | 
222 | uninitializedNames :: Stmt -> S.Set Identifier
223 | uninitializedNames s = evalState (collect s) S.empty
224 | 
225 | extensionallyModeledFunctions :: [FuncName]
226 | extensionallyModeledFunctions = []
227 | 
228 | isPrimitive :: FuncName -> Bool
229 | isPrimitive i = (i `elem` yulPrimOps) || (i `elem` extensionallyModeledFunctions)
230 | 
231 | exprDeps :: ContractName -> Expr -> Set FuncNamePair
232 | exprDeps c (Call name args)
233 |   | not (isPrimitive name) = S.insert (c, name) subDeps
234 |   | otherwise = subDeps
235 |   where
236 |     subDeps = S.unions (map (exprDeps c) args)
237 | exprDeps _ (CrossContractCall name c args) = S.insert (c, name) (S.unions $ map (exprDeps c) args)
238 | exprDeps _ _ = S.empty
239 | 
240 | stmtDeps :: ContractName -> Stmt -> Set FuncNamePair
241 | stmtDeps c (Block blk) = S.unions (map (stmtDeps c) blk)
242 | stmtDeps c (If e body) = S.unions $ exprDeps c e : map (stmtDeps c) body
243 | stmtDeps c (LetInit _ e) = exprDeps c e
244 | stmtDeps c (Assignment _ e) = exprDeps c e
245 | stmtDeps c (ExpressionStmt e) = exprDeps c e
246 | stmtDeps c (Switch e cases def) = S.unions $ exprDeps c e : (map (stmtDeps c) . concat $ def : map snd cases)
247 | stmtDeps c (For init cond body post) = S.unions $ exprDeps c cond : map (stmtDeps c) (init ++ body ++ post)
248 | stmtDeps _ _ = S.empty
249 | 
250 | -- | Get names of all functions called within a block (non-recursively).
251 | funcDefDeps :: FuncDef -> [FuncNamePair]
252 | funcDefDeps (FuncDef _ c _ _ body) = S.toList . S.unions . map (stmtDeps c) $ body
253 | 
254 | data Segment = Segment
255 |   { segName         :: String
256 |   , segAbstractions :: Imports
257 |   , segCode         :: Stmt
258 |   , segContract     :: (FuncDef, (ContractName, Bool))
259 |   } deriving Show
260 | 
261 | -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ PRETTY PRINTING ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
262 | 
263 | -- | Print the Yul source of something with indentation.
264 | class Formattable a where
265 |   src :: a -> String
266 | 
267 | -- | Indent each line of a string by 4 spaces.
268 | tab :: String -> String
269 | tab = L.intercalate "\n" . map ("    " ++) . lines
270 | 
271 | sep :: [Identifier] -> String
272 | sep = L.intercalate ", "
273 | 
274 | fmtSep :: (Formattable a) => [a] -> String
275 | fmtSep = sep . map src
276 | 
277 | decl :: FuncName -> [Identifier] -> String
278 | decl name [] = "function " ++ name ++ "()"
279 | decl name args = "function " ++ name ++ "(" ++ sep args ++ ")"
280 | 
281 | returns :: [Identifier] -> String
282 | returns [] = ""
283 | returns [ret] = "-> " ++ ret
284 | returns rets = "-> " ++ sep rets
285 | 
286 | fmtCase :: (Literal, [Stmt]) -> String
287 | fmtCase (x, stmts) = unwords ["case", src x, src (Block stmts)]
288 | 
289 | -- A handful of helpers, I am not sure how 'robust' we want to build this.
290 | type SegName = String
291 | 
292 | instance Formattable Expr where
293 |   src (CrossContractCall name c args) = c ++ "." ++ name ++ "(" ++ fmtSep args ++ ")"
294 |   src (Call name args) = name ++ "(" ++ fmtSep args ++ ")"
295 |   src (Var name) = name
296 |   src (Lit x) = src x
297 | 
298 | instance Formattable Literal where
299 |   src (Number n) = show n
300 |   src (Str s) = s
301 | 
302 | instance Formattable FuncDef' where
303 |   src (FuncDef' name args rets stmts) = unwords [decl name args, returns rets, "\n" ++ src (Block stmts)]
304 | 
305 | instance Formattable FuncDef where
306 |   src (FuncDef name _ args rets stmts) = unwords [decl name args, returns rets, "\n" ++ src (Block stmts)]
307 | 
308 | instance Formattable Stmt where
309 |   src (Block []) = "{ }"
310 |   src (Block [a@(Assignment _ _)]) = "{" ++ src a ++ "}"
311 |   src (Block [e@(ExpressionStmt _)]) = "{" ++ src e ++ "}"
312 |   src (Block [Continue]) = "{" ++ src Continue ++ "}"
313 |   src (Block [Break]) = "{" ++ src Break ++ "}"
314 |   src (Block [Leave]) = "{" ++ src Leave ++ "}"
315 |   src (Block stmts) = "{\n" ++ L.intercalate "\n" (map (tab . src) stmts) ++ "\n}"
316 |   src (Declaration names) = "let " ++ sep (NE.toList names)
317 |   src (LetInit names expr) = "let " ++ sep (NE.toList names) ++ " := " ++ src expr
318 |   src (Assignment names expr) = sep (NE.toList names) ++ " := " ++ src expr
319 |   src (If cond stmts) = unwords ["if", src cond, "\n" ++ src (Block stmts)]
320 |   src (ExpressionStmt expr) = src expr
321 |   src (Switch expr cases stmts) =
322 |     "switch "
323 |       ++ src expr
324 |       ++ " "
325 |       ++ unlines (map fmtCase cases)
326 |       ++ "default\n"
327 |       ++ src (Block stmts)
328 |   src (For pre cond post body) = "for " ++ unwords (map src [Block pre, ExpressionStmt cond, Block post, Block body])
329 |   src Continue = "continue"
330 |   src Break = "break"
331 |   src Leave = "leave"
332 |   src (InlineComment _) = ""
333 |   src (MultilineComment _) = ""
334 | 


--------------------------------------------------------------------------------
/Clear/EVMState.lean:
--------------------------------------------------------------------------------
  1 | import Mathlib.Data.Finmap
  2 | import Mathlib.Data.Fin.Basic
  3 | import Clear.Ast
  4 | import Clear.Instr
  5 | import Clear.UInt256
  6 | 
  7 | open Clear Instr UInt256
  8 | 
  9 | def Array.extractFill {A : Type} [Zero A] (v₀ size : ℕ) (arr : Array A) : Array A :=
 10 |   let return_size := v₀ + size - 1
 11 |   if arr.size < return_size
 12 |   then
 13 |     let zeros := List.toArray (List.replicate (return_size - arr.size - 1) 0)
 14 |     let arr1 := zeros.append arr
 15 |     arr1.extract v₀ return_size
 16 |   else arr.extract v₀ return_size
 17 | 
 18 | def ByteArray.extractBytes (v₀ : ℕ) (size : ℕ) (arr : ByteArray) : ByteArray :=
 19 |   ByteArray.mk (Array.extractFill v₀ size arr.data)
 20 | 
 21 | def ByteArray.byteArrayToUInt256 (μ₀ : UInt256) (size : ℕ) (Id : ByteArray) : UInt256 :=
 22 |   open Array in
 23 |   let v₀ := μ₀.val
 24 |   let arr : ByteArray := extractBytes v₀ size Id
 25 |   let arr1 : Array UInt8 := arr.data
 26 |   -- converting to big endian
 27 |   let step p v := (p.1 - 8, Fin.lor p.2 (Nat.shiftLeft v.val p.1))
 28 |   let r : (ℕ × UInt256) := Array.foldl step ((size - 1) * 8, 0) arr1
 29 |   r.2
 30 | 
 31 | 
 32 | namespace Clear
 33 | 
 34 | -- 2^160 https://www.wolframalpha.com/input?i=2%5E160
 35 | def Address.size : Nat := 1461501637330902918203684832716283019655932542976
 36 | 
 37 | abbrev Address : Type := Fin Address.size
 38 | 
 39 | instance : Inhabited Address := ⟨Fin.ofNat 0⟩
 40 | 
 41 | def Address.ofNat {n : ℕ} : Address := Fin.ofNat n
 42 | def Address.ofUInt256 (v : UInt256) : Address := Fin.ofNat (v.val  % Address.size)
 43 | instance {n : Nat} : OfNat Address n := ⟨Fin.ofNat n⟩
 44 | 
 45 | instance byteArrayDecEq : DecidableEq ByteArray := λ xs ys => by {
 46 |   rcases xs with ⟨ xs1 ⟩ ; rcases ys with ⟨ ys1 ⟩
 47 |   simp
 48 |   apply decEq
 49 | }
 50 | 
 51 | -- definition of the account data
 52 | 
 53 | structure Account : Type where
 54 |   balance   : UInt256
 55 |   code      : List Instr
 56 |   code_hash : UInt256
 57 |   storage   : Finmap (λ _ : UInt256 => UInt256)
 58 | deriving DecidableEq
 59 | 
 60 | instance : Inhabited Account := ⟨ Account.mk 0 [] 0 default ⟩
 61 | 
 62 | def Account.lookupStorage (act : Account) (k : UInt256) : UInt256 :=
 63 |   match act.storage.lookup k with
 64 |   | .some val => val
 65 |   | _ => 0
 66 | 
 67 | def Account.updateStorage (act : Account) (k v : UInt256) : Account :=
 68 |   if v == 0 then
 69 |     { act with storage := act.storage.erase k }
 70 |   else
 71 |     { act with storage := Finmap.insert k v act.storage}
 72 | 
 73 | -- definition of the machine state
 74 | 
 75 | structure MachineState : Type where
 76 |   memory        : Finmap (λ _ : UInt256 => UInt8)
 77 |   max_address   : UInt256
 78 |   gas_available : UInt256
 79 |   return_data   : List UInt256
 80 | deriving DecidableEq
 81 | 
 82 | instance : Inhabited MachineState := ⟨ MachineState.mk ∅ 0 0 [] ⟩
 83 | 
 84 | -- @langfield: Nit, but definitions should be camelCase.
 85 | 
 86 | def UInt256.offsets : List UInt256 :=
 87 |   [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,
 88 |   17,18,19,20,21,22,23,24,25,26,27,28,29,30,31]
 89 | 
 90 | def MachineState.updateMemory (m : MachineState) (addr v : UInt256) : MachineState :=
 91 |   {m with memory := let offsets := List.range 32
 92 |                     let addrs   := offsets.map (·+addr)
 93 |                     let inserts := addrs.zipWith Finmap.insert (UInt256.toBytes! v)
 94 |                     inserts.foldl (init := m.memory) (flip id)
 95 |           max_address := max addr m.max_address }
 96 | 
 97 | lemma cheeky_proof {a b : Int} : (if a > b then a else b) = max a b := by rw [max_comm, max_def_lt]
 98 | 
 99 | def MachineState.lookupMemory (m : MachineState) (addr : UInt256) : UInt256 :=
100 |   UInt256.fromBytes! (List.map (fun i => (m.memory.lookup (addr + i)).get!) UInt256.offsets)
101 | 
102 | def MachineState.setReturnData (m : MachineState) (r : List UInt256) : MachineState :=
103 |   {m with return_data := r}
104 | 
105 | def MachineState.msize (m : MachineState) : UInt256 :=
106 |   m.max_address
107 | 
108 | 
109 | -- definition of the blocks
110 | 
111 | structure BlockHeader : Type where
112 |   parent_hash : UInt256
113 |   beneficiary : Address
114 |   timestamp   : UInt256
115 |   number      : UInt256
116 |   difficulty  : UInt256
117 |   gas_limit   : UInt256
118 |   chain_id    : UInt256
119 | deriving DecidableEq
120 | 
121 | instance : Inhabited BlockHeader :=
122 |   ⟨ BlockHeader.mk 0 default 0 0 0 0 0 ⟩
123 | 
124 | structure EVMBlock : Type where
125 |   header : BlockHeader
126 | deriving DecidableEq
127 | 
128 | instance : Inhabited EVMBlock := ⟨ EVMBlock.mk default ⟩
129 | 
130 | -- definition of the execution environment
131 | 
132 | structure ExecutionEnv : Type where
133 |   code_owner : Address
134 |   sender     : Address
135 |   source     : Address
136 |   wei_value  : UInt256
137 |   input_data : ByteArray
138 |   code       : List Instr
139 |   gas_price  : ℕ
140 |   header     : BlockHeader
141 | deriving DecidableEq
142 | 
143 | instance : Inhabited ExecutionEnv :=
144 |   ⟨ ExecutionEnv.mk default default default 0 default [] 0 default ⟩
145 | 
146 | -- definition of the evm state
147 | 
148 | structure EVMState : Type where
149 |   -- account map
150 |   account_map : Finmap (λ _ : Address => Account)
151 |   -- machine state
152 |   machine_state : MachineState
153 |   -- execution environment
154 |   execution_env : ExecutionEnv
155 |   -- keccak map
156 |   keccak_map   : Finmap (λ _ : List UInt256 => UInt256)
157 |   keccak_range : List UInt256
158 |   used_range   : Finset UInt256
159 |   -- blocks
160 |   blocks : List EVMBlock
161 |   hash_collision : Bool
162 | deriving DecidableEq
163 | 
164 | instance : Inhabited EVMState :=
165 |   ⟨ ∅ , default, default , ∅ , default, ∅ , default , False ⟩
166 | 
167 | abbrev EVM := EVMState
168 | 
169 | -- functions for querying balance
170 | 
171 | namespace EVMState
172 | 
173 | section
174 | 
175 | open Array ByteArray
176 | 
177 | -- | Add an error to the EVMState indicating that we hit a hash collision in `keccak256`.
178 | def addHashCollision (σ : EVMState) : EVMState := { σ with hash_collision := True }
179 | 
180 | def lookupAccount (σ : EVMState) (addr : Address) : Option Account :=
181 |   σ.account_map.lookup addr
182 | 
183 | def updateAccount (σ : EVMState) (addr : Address) (act : Account) : EVMState :=
184 |   {σ with account_map := Finmap.insert addr act σ.account_map}
185 | 
186 | def balanceOf (σ : EVMState) (k : UInt256) : UInt256 :=
187 |   let addr : Address := Address.ofUInt256 k
188 |   match Finmap.lookup addr σ.account_map with
189 |   | .some act => act.balance
190 |   | .none => Fin.ofNat 0
191 | 
192 | -- functions for accessing memory
193 | 
194 | def updateMemory (σ : EVMState) (addr v : UInt256) : EVMState :=
195 |   {σ with machine_state := σ.machine_state.updateMemory addr v}
196 | 
197 | -- functions for manipulating call data
198 | 
199 | def calldataload (σ : EVMState) (v : UInt256) : UInt256 :=
200 |   byteArrayToUInt256 v 32 σ.execution_env.input_data
201 | 
202 | def calldatacopy (σ : EVMState) (mstart datastart s : UInt256) : EVMState :=
203 |   let size := s.val
204 |   let arr := extractBytes datastart.val size σ.execution_env.input_data
205 |   let r := arr.foldl (λ (sa , j) i => (EVMState.updateMemory sa j i.val, j + 1)) (σ , mstart)
206 |   r.1
207 | 
208 | def mkInterval (ms : MachineState) (p n : UInt256) : List UInt256 :=
209 |   let i : ℕ := p.val
210 |   let f : ℕ := n.val
211 |   let m     := (List.range' i f).map Fin.ofNat
212 |   m.map ms.lookupMemory
213 | 
214 | def keccak256 (σ : EVMState) (p n : UInt256) : Option (UInt256 × EVMState) :=
215 |   let interval : List UInt256 := mkInterval σ.machine_state p n
216 |   match Finmap.lookup interval σ.keccak_map with
217 |   | .some val => .some (val, σ)
218 |   | .none     =>
219 |     match σ.keccak_range.partition (λ x => x ∈ σ.used_range) with
220 |     | (_,(r :: rs)) =>
221 |       .some (r, {σ with keccak_map := σ.keccak_map.insert interval r,
222 |                         keccak_range := rs,
223 |                         used_range := {r} ∪ σ.used_range })
224 |     | (_, []) => .none
225 | 
226 | -- code copy
227 | 
228 | def codeCopy (σ : EVMState) (mstart cstart s : UInt256) : EVMState :=
229 |   let Ib : ByteArray := ByteArray.mk ((σ.execution_env.code.map serializeInstr).toArray)
230 |   let Ib1 := extractBytes cstart.val s.val Ib
231 |   let r := Ib1.foldl (λ (sa, j) i => (EVMState.updateMemory sa j i.toUInt256, j + 1)) (σ, mstart)
232 |   r.1
233 | 
234 | def extCodeSize (σ : EVMState) (a : UInt256) : UInt256 :=
235 |   let addr := Address.ofUInt256 a
236 |   match σ.lookupAccount addr with
237 |   | .some act => act.code.length
238 |   | .none => 0
239 | 
240 | def extCodeCopy (σ : EVMState) (act mstart cstart s : UInt256) : EVMState :=
241 |   let addr := Address.ofUInt256 act
242 |   match σ.lookupAccount addr with
243 |   | .some act1 =>
244 |     let Ib : ByteArray := ByteArray.mk ((act1.code.map serializeInstr).toArray)
245 |     let Ib1 := extractBytes cstart.val s.val Ib
246 |     let r := Ib1.foldl (λ (sa , j) i => (EVMState.updateMemory sa j i.toUInt256, j + 1)) (σ, mstart)
247 |     r.1
248 |   | _ =>
249 |     let size := s.val
250 |     let r := size.fold (λ _ (sa , j) => (EVMState.updateMemory sa j 0, j + 1)) (σ, mstart)
251 |     r.1
252 | 
253 | def extCodeHash (σ : EVMState) (v : UInt256) : UInt256 :=
254 |   let addr := Address.ofUInt256 v
255 |   match σ.lookupAccount addr with
256 |   | .some act => act.code_hash
257 |   | _ => 0
258 | 
259 | -- blocks
260 | 
261 | def blockHash (σ : EVMState) (block_number : UInt256) : UInt256 :=
262 |   let v := σ.execution_env.header.number
263 |   if v ≤ block_number ∨ v > block_number + 256 then 0
264 |   else
265 |     let bs := σ.blocks.map (λ b => b.header.parent_hash)
266 |     let pos := v - block_number
267 |     bs.getD pos 0
268 | 
269 | def coinBase (σ : EVMState) : Address :=
270 |   σ.execution_env.header.beneficiary
271 | 
272 | def timeStamp (σ : EVMState) : UInt256 :=
273 |   σ.execution_env.header.timestamp
274 | 
275 | def number (σ : EVMState) : UInt256 :=
276 |   σ.execution_env.header.number
277 | 
278 | def difficulty (σ : EVMState) : UInt256 :=
279 |   σ.execution_env.header.difficulty
280 | 
281 | def gasLimit (σ : EVMState) : UInt256 :=
282 |   σ.execution_env.header.gas_limit
283 | 
284 | def chainId (σ : EVMState) : UInt256 :=
285 |   σ.execution_env.header.chain_id
286 | 
287 | def selfbalance (σ : EVMState) : UInt256 :=
288 |   let addr := σ.execution_env.code_owner
289 |   match Finmap.lookup addr σ.account_map with
290 |   | .some act => act.balance
291 |   | .none => Fin.ofNat 0
292 | 
293 | -- memory and storage operations
294 | 
295 | def mload (σ : EVMState) (spos : UInt256) : UInt256 :=
296 |   σ.machine_state.lookupMemory spos
297 | 
298 | def mstore (σ : EVMState) (spos sval : UInt256) : EVMState :=
299 |   σ.updateMemory spos sval
300 | 
301 | def mstore8 (σ : EVMState) (spos sval : UInt256) : EVMState :=
302 |   σ.updateMemory spos (Fin.ofNat (sval.val % 256))
303 | 
304 | def sload (σ : EVMState) (spos : UInt256) : UInt256 :=
305 |   match σ.lookupAccount σ.execution_env.code_owner with
306 |   | .some act => act.lookupStorage spos
307 |   | .none => 0
308 | 
309 | def sstore (σ : EVMState) (spos sval : UInt256) : EVMState :=
310 |   match σ.lookupAccount σ.execution_env.code_owner with
311 |   | .some act =>
312 |     let σ' := σ.updateAccount σ.execution_env.code_owner (act.updateStorage spos sval)
313 |     {σ' with used_range := {spos} ∪ σ'.used_range}
314 |   | .none => σ
315 | 
316 | def msize (σ : EVMState) : UInt256 :=
317 |   σ.machine_state.msize
318 | 
319 | def gas (σ : EVMState) : UInt256 :=
320 |   σ.machine_state.gas_available
321 | 
322 | def returndatasize (σ : EVMState) : UInt256 :=
323 |   σ.machine_state.return_data.length
324 | 
325 | def returndataat (σ : EVMState) (pos : UInt256) : UInt256 :=
326 |   σ.machine_state.return_data.getD pos.val 0
327 | 
328 | def returndatacopy (σ : EVMState) (mstart rstart s : UInt256) : Option EVMState :=
329 |   let pos := rstart.val + s.val
330 |   if pos ≥ UInt256.size ∨ pos ≥ σ.returndatasize.val then .none
331 |   else
332 |     let arr := σ.machine_state.return_data.toArray
333 |     let rdata := arr.extract rstart.val (rstart.val + s.val - 1)
334 |     let s := rdata.data.foldr (λ v (ac,p) => (ac.updateMemory p v, p +1)) (σ , mstart)
335 |     .some s.1
336 | 
337 | def evm_return (σ : EVMState) (mstart s : UInt256) : EVMState :=
338 |   let arr := σ.machine_state.return_data.toArray
339 |   let vals := extractFill mstart.val s.val arr
340 |   {σ with machine_state := σ.machine_state.setReturnData vals.data}
341 | 
342 | def evm_revert (σ : EVMState) (mstart s : UInt256) : EVMState :=
343 |   σ.evm_return mstart s
344 | 
345 | end
346 | 
347 | end Clear.EVMState
348 | 


--------------------------------------------------------------------------------
/Clear/PrimOps.lean:
--------------------------------------------------------------------------------
  1 | import Clear.State
  2 | import Clear.EVMState
  3 | 
  4 | open Clear Ast EVMState UInt256
  5 | 
  6 | namespace Clear.PrimOps
  7 | 
  8 | set_option autoImplicit true
  9 | 
 10 | @[simp]
 11 | abbrev fromBool := Bool.toUInt256
 12 | 
 13 | def evmAddMod (a b c : UInt256) : UInt256 :=
 14 |   if c = 0 then 0 else
 15 |   Fin.mod (a + b) c
 16 | 
 17 | def evmMulMod (a b c : UInt256) : UInt256 :=
 18 |   if c = 0 then 0 else
 19 |   Fin.mod (a * b) c
 20 | 
 21 | def evmExp (a b : UInt256) : UInt256 :=
 22 |   a ^ b.val
 23 | 
 24 | set_option linter.unusedVariables false in
 25 | def primCall (s : State) : PrimOp → List Literal → State × List Literal
 26 |   | .Add, [a,b]               => (s, [a + b])
 27 |   | .Sub, [a,b]               => (s, [a - b])
 28 |   | .Mul, [a,b]               => (s, [a * b])
 29 |   | .Div, [a,b]               => (s, [a / b])
 30 |   | .Sdiv, [a,b]              => (s, [UInt256.sdiv a b])
 31 |   | .Mod, [a,b]               => (s, [Fin.mod a b])
 32 |   | .Smod, [a,b]              => (s, [UInt256.smod a b])
 33 |   | .Addmod, [a,b,c]          => (s, [evmAddMod a b c])
 34 |   | .Mulmod, [a,b,c]          => (s, [evmMulMod a b c])
 35 |   | .Exp, [a,b]               => (s, [evmExp a b])
 36 |   | .Signextend, [a,b]        => (s, [UInt256.signextend a b])
 37 |   | .Lt, [a,b]                => (s, [fromBool (a < b)])
 38 |   | .Gt, [a,b]                => (s, [fromBool (a > b)])
 39 |   | .Slt, [a,b]               => (s, [fromBool (UInt256.slt a b)])
 40 |   | .Sgt, [a,b]               => (s, [fromBool (UInt256.sgt a b)])
 41 |   | .Eq, [a,b]                => (s, [fromBool (a = b)])
 42 |   | .Iszero, [a]              => (s, [fromBool (a = 0)])
 43 |   | .And, [a,b]               => (s, [Fin.land a b])
 44 |   | .Or, [a,b]                => (s, [Fin.lor a b])
 45 |   | .Xor, [a,b]               => (s, [Fin.xor a b])
 46 |   | .Not, [a]                 => (s, [UInt256.lnot a])
 47 |   | .Byte, [a,b]              => (s, [UInt256.byteAt a b])
 48 |   | .Shl, [a,b]               => (s, [Fin.shiftLeft b a])
 49 |   | .Shr, [a,b]               => (s, [Fin.shiftRight b a])
 50 |   | .Sar, [a,b]               => (s, [UInt256.sar a b])
 51 |   | .Keccak256, [a,b]         =>
 52 |     match s.evm.keccak256 a b with
 53 |     | .some a => (s.setEvm a.snd, [a.fst])
 54 |     -- This is the hash collision case. It's essentially an unrecoverable
 55 |     -- error, and we model it similar to how we model infinite loops, except we
 56 |     -- put the error in the EVM instead, so we don't have to bother with it in
 57 |     -- the interpreter.
 58 |     | .none => (s.setEvm s.evm.addHashCollision, [0])
 59 |   | .Address, []              => (s, [s.evm.execution_env.code_owner])
 60 |   | .Balance, [a]             => (s, [s.evm.balanceOf a])
 61 |   | .Origin, []               => (s, [s.evm.execution_env.sender])
 62 |   | .Caller, []               => (s, [s.evm.execution_env.source])
 63 |   | .Callvalue, []            => (s, [s.evm.execution_env.wei_value])
 64 |   | .Calldataload, [a]        => (s, [s.evm.calldataload a])
 65 |   | .Calldatasize, []         => (s, [s.evm.execution_env.input_data.size])
 66 |   | .Calldatacopy, [a,b,c]    => (s.setEvm (s.evm.calldatacopy a b c), [])
 67 |   | .Codesize, []             => (s, [s.evm.execution_env.code.length])
 68 |   | .Codecopy, [a,b,c]        => (s.setEvm (s.evm.codeCopy a b c), [])
 69 |   | .Gasprice, []             => (s, [s.evm.execution_env.gas_price])
 70 |   | .Extcodesize, [a]         => (s, [s.evm.extCodeSize a])
 71 |   | .Extcodecopy, [a,b,c,d]   => (s.setEvm (s.evm.extCodeCopy a b c d), [])
 72 |   | .Returndatasize, []       => (s, [s.evm.returndatasize])
 73 |   | .Returndatacopy, [a,b,c]  =>
 74 |     match s.evm.returndatacopy a b c with
 75 |     | .some evm' => (s.setEvm evm', [])
 76 |     | .none => (s.setEvm (s.evm.evm_revert a c), [])
 77 |   | .Extcodehash, [a]         => (s, [s.evm.extCodeHash a])
 78 |   | .Blockhash, [a]           => (s, [s.evm.blockHash a])
 79 |   | .Coinbase, []             => (s, [s.evm.coinBase])
 80 |   | .Timestamp, []            => (s, [s.evm.timeStamp])
 81 |   | .Gaslimit, []             => (s, [s.evm.gasLimit])
 82 |   | .Chainid, []              => (s, [s.evm.chainId])
 83 |   | .Selfbalance, []          => (s, [s.evm.selfbalance])
 84 |   | .Mload, [a]               => (s, [s.evm.mload a])
 85 |   | .Mstore, [a,b]            => (s.setEvm (s.evm.mstore a b), [])
 86 |   | .Sload, [a]               => (s, [s.evm.sload a])
 87 |   | .Sstore, [a,b]            => (s.setEvm (s.evm.sstore a b), [])
 88 |   | .Msize, []                => (s, [s.evm.msize])
 89 |   | .Gas, []                  => (s, [s.evm.gas])
 90 |   | .Revert, [a,b]            => (s.setEvm (s.evm.evm_revert a b), [])
 91 |   | .Return, [a,b]            => (s.setEvm (s.evm.evm_return a b), [])
 92 |   -- TODO: These are just dummy implementations, need to be carefully rewritten.
 93 |   | .Pop, [a]                 => (s, [])
 94 |   | .Call, [a, b, c, d, e, f, g]    => (s, [])
 95 |   | .Staticcall, [a, b, c, d, e, f] => (s, [])
 96 |   | .Delegatecall, []         => (s, [])
 97 |   | .Loadimmutable, [a]       => (s, [])
 98 |   | .Log1, [a, b, c]          => (s, [])
 99 |   | .Log2, [a, b, c, d]       => (s, [])
100 |   | .Log3, [a, b, c, d, e]    => (s, [])
101 |   | .Log4, []                 => (s, [])
102 |   | .Number, []               => (s, [])
103 |   -- Since the compiler should disallow argument mismatches, it is safe to
104 |   -- return the default here.
105 |   | _, _                      => (s, [])
106 | 
107 | lemma EVMAdd'            : primCall s .Add [a,b]                     = (s, [a + b]) := rfl
108 | lemma EVMSub'            : primCall s .Sub [a,b]                     = (s, [a - b]) := rfl
109 | lemma EVMMul'            : primCall s .Mul [a,b]                     = (s, [a * b]) := rfl
110 | lemma EVMDiv'            : primCall s .Div [a,b]                     = (s, [a / b]) := rfl
111 | lemma EVMSdiv'           : primCall s .Sdiv [a,b]                    = (s, [UInt256.sdiv a b]) := rfl
112 | lemma EVMMod'            : primCall s .Mod [a,b]                     = (s, [Fin.mod a b]) := rfl
113 | lemma EVMSmod'           : primCall s .Smod [a,b]                    = (s, [UInt256.smod a b]) := rfl
114 | lemma EVMAddmod'         : primCall s .Addmod [a,b,c]                = (s, [evmAddMod a b c]) := rfl
115 | lemma EVMMulmod'         : primCall s .Mulmod [a,b,c]                = (s, [evmMulMod a b c]) := rfl
116 | lemma EVMExp'            : primCall s .Exp [a,b]                     = (s, [evmExp a b]) := rfl
117 | lemma EVMSignextend'     : primCall s .Signextend [a,b]              = (s, [UInt256.signextend a b]) := rfl
118 | lemma EVMLt'             : primCall s .Lt [a,b]                      = (s, [fromBool (a < b)]) := rfl
119 | lemma EVMGt'             : primCall s .Gt [a,b]                      = (s, [fromBool (a > b)]) := rfl
120 | lemma EVMSlt'            : primCall s .Slt [a,b]                     = (s, [fromBool (UInt256.slt a b)]) := rfl
121 | lemma EVMSgt'            : primCall s .Sgt [a,b]                     = (s, [fromBool (UInt256.sgt a b)]) := rfl
122 | lemma EVMEq'             : primCall s .Eq [a,b]                      = (s, [fromBool (a = b)]) := rfl
123 | lemma EVMIszero'         : primCall s .Iszero [a]                    = (s, [fromBool (a = 0)]) := rfl
124 | lemma EVMAnd'            : primCall s .And [a,b]                     = (s, [Fin.land a b]) := rfl
125 | lemma EVMOr'             : primCall s .Or [a,b]                      = (s, [Fin.lor a b]) := rfl
126 | lemma EVMXor'            : primCall s .Xor [a,b]                     = (s, [Fin.xor a b]) := rfl
127 | lemma EVMNot'            : primCall s .Not [a]                       = (s, [UInt256.lnot a]) := rfl
128 | lemma EVMByte'           : primCall s .Byte [a,b]                    = (s, [UInt256.byteAt a b]) := rfl
129 | lemma EVMShl'            : primCall s .Shl [a,b]                     = (s, [Fin.shiftLeft b a]) := rfl
130 | lemma EVMShr'            : primCall s .Shr [a,b]                     = (s, [Fin.shiftRight b a]) := rfl
131 | lemma EVMSar'            : primCall s .Sar [a,b]                     = (s, [UInt256.sar a b]) := rfl
132 | lemma EVMKeccak256'      : primCall s .Keccak256 [a,b]               = match s.evm.keccak256 a b with | .some a => (s.setEvm a.snd, [a.fst]) | .none => (s.setEvm s.evm.addHashCollision, [0]) := rfl
133 | lemma EVMAddress'        : primCall s .Address []                    = (s, ([s.evm.execution_env.code_owner] : List Literal)) := rfl
134 | lemma EVMBalance'        : primCall s .Balance [a]                   = (s, [s.evm.balanceOf a]) := rfl
135 | lemma EVMOrigin'         : primCall s .Origin []                     = (s, ([s.evm.execution_env.sender] : List Literal)) := rfl
136 | lemma EVMCaller'         : primCall s .Caller []                     = (s, ([s.evm.execution_env.source] : List Literal)) := rfl
137 | lemma EVMCallvalue'      : primCall s .Callvalue []                  = (s, [s.evm.execution_env.wei_value]) := rfl
138 | lemma EVMCalldataload'   : primCall s .Calldataload [a]              = (s, [s.evm.calldataload a]) := rfl
139 | lemma EVMCalldatasize'   : primCall s .Calldatasize []               = (s, ([s.evm.execution_env.input_data.size] : List Literal)) := rfl
140 | lemma EVMCalldatacopy'   : primCall s .Calldatacopy [a,b,c]          = (s.setEvm (s.evm.calldatacopy a b c), []) := rfl
141 | lemma EVMCodesize'       : primCall s .Codesize []                   = (s, ([s.evm.execution_env.code.length] : List Literal)) := rfl
142 | lemma EVMCodecopy'       : primCall s .Codecopy [a,b,c]              = (s.setEvm (s.evm.codeCopy a b c), []) := rfl
143 | lemma EVMGasprice'       : primCall s .Gasprice []                   = (s, ([s.evm.execution_env.gas_price] : List Literal)) := rfl
144 | lemma EVMExtcodesize'    : primCall s .Extcodesize [a]               = (s, [s.evm.extCodeSize a]) := rfl
145 | lemma EVMExtcodecopy'    : primCall s .Extcodecopy [a,b,c,d]         = (s.setEvm (s.evm.extCodeCopy a b c d), []) := rfl
146 | lemma EVMReturndatasize' : primCall s .Returndatasize []             = (s, [s.evm.returndatasize]) := rfl
147 | lemma EVMReturndatacopy' : primCall s .Returndatacopy [a,b,c]        = match s.evm.returndatacopy a b c with | .some evm' => (s.setEvm evm', []) | .none => (s.setEvm (s.evm.evm_revert a c), []) := rfl
148 | lemma EVMExtcodehash'    : primCall s .Extcodehash [a]               = (s, [s.evm.extCodeHash a]) := rfl
149 | lemma EVMBlockhash'      : primCall s .Blockhash [a]                 = (s, [s.evm.blockHash a]) := rfl
150 | lemma EVMCoinbase'       : primCall s .Coinbase []                   = (s, ([s.evm.coinBase] : List Literal)) := rfl
151 | lemma EVMTimestamp'      : primCall s .Timestamp []                  = (s, [s.evm.timeStamp]) := rfl
152 | lemma EVMGaslimit'       : primCall s .Gaslimit []                   = (s, [s.evm.gasLimit]) := rfl
153 | lemma EVMChainid'        : primCall s .Chainid []                    = (s, [s.evm.chainId]) := rfl
154 | lemma EVMSelfbalance'    : primCall s .Selfbalance []                = (s, [s.evm.selfbalance]) := rfl
155 | lemma EVMMload'          : primCall s .Mload [a]                     = (s, [s.evm.mload a]) := rfl
156 | lemma EVMMstore'         : primCall s .Mstore [a,b]                  = (s.setEvm (s.evm.mstore a b), []) := rfl
157 | lemma EVMSload'          : primCall s .Sload [a]                     = (s, [s.evm.sload a]) := rfl
158 | lemma EVMSstore'         : primCall s .Sstore [a,b]                  = (s.setEvm (s.evm.sstore a b), []) := rfl
159 | lemma EVMMsize'          : primCall s .Msize []                      = (s, [s.evm.msize]) := rfl
160 | lemma EVMGas'            : primCall s .Gas []                        = (s, [s.evm.gas]) := rfl
161 | lemma EVMRevert'         : primCall s .Revert [a, b]                 = (s.setEvm (s.evm.evm_revert a b), []) := rfl
162 | lemma EVMReturn'         : primCall s .Return [a, b]                 = (s.setEvm (s.evm.evm_return a b), []) := rfl
163 | lemma EVMPop'            : primCall s .Pop [a]                       = (s, []) := rfl
164 | lemma EVMCall'           : primCall s .Call [a, b, c, d, e, f, g]    = (s, []) := rfl
165 | lemma EVMStaticcall'     : primCall s .Staticcall [a, b, c, d, e, f] = (s, []) := rfl
166 | lemma EVMDelegatecall'   : primCall s .Delegatecall []               = (s, []) := rfl
167 | lemma EVMLoadimmutable'  : primCall s .Loadimmutable [a]             = (s, []) := rfl
168 | lemma EVMLog1'           : primCall s .Log1 [a, b, c]                = (s, []) := rfl
169 | lemma EVMLog2'           : primCall s .Log2 [a, b, c, d]             = (s, []) := rfl
170 | lemma EVMLog3'           : primCall s .Log3 [a, b, c, d, e]          = (s, []) := rfl
171 | lemma EVMLog4'           : primCall s .Log4 []                       = (s, []) := rfl
172 | lemma EVMNumber'         : primCall s .Number []                     = (s, []) := rfl
173 | 
174 | end Clear.PrimOps
175 | 


--------------------------------------------------------------------------------
/Clear/YulNotation.lean:
--------------------------------------------------------------------------------
  1 | import Clear.Ast
  2 | import Mathlib.Lean.Expr
  3 | import Lean.Parser
  4 | 
  5 | namespace Clear.YulNotation
  6 | 
  7 | open Ast Lean Parser
  8 | 
  9 | def yulKeywords := ["let", "if", "default", "switch", "case"]
 10 | 
 11 | def idFirstChar : Array Char := Id.run <| do
 12 |   let mut arr := #[]
 13 |   for i in [0:26] do
 14 |     arr := arr.push (Char.ofNat ('a'.toNat + i))
 15 |   for i in [0:26] do
 16 |     arr := arr.push (Char.ofNat ('A'.toNat + i))
 17 |   arr := (arr.push '_').push '$'
 18 |   return arr
 19 | 
 20 | def idSubsequentChar : Array Char := Id.run <| do
 21 |   let mut arr := idFirstChar
 22 |   for i in [0:10] do
 23 |     arr := arr.push (Char.ofNat ('0'.toNat + i))
 24 |   return arr.push '.'
 25 | 
 26 | def idFn : ParserFn := fun c s => Id.run do
 27 |   let input := c.input
 28 |   let start := s.pos
 29 |   if h : input.atEnd start then
 30 |     s.mkEOIError
 31 |   else
 32 |     let fst := input.get' start h
 33 |     if not (idFirstChar.contains fst) then
 34 |       return s.mkError "yul identifier"
 35 |     let s := takeWhileFn idSubsequentChar.contains c (s.next input start)
 36 |     let stop := s.pos
 37 |     let name := .str .anonymous (input.extract start stop)
 38 |     if yulKeywords.contains name.lastComponentAsString then
 39 |       return s.mkError "yul identifier"
 40 |     mkIdResult start none name c s
 41 | 
 42 | def idNoAntiquot : Parser := { fn := idFn }
 43 | 
 44 | section
 45 | open PrettyPrinter Parenthesizer Syntax.MonadTraverser Formatter
 46 | 
 47 | @[combinator_formatter idNoAntiquot]
 48 | def idNoAntiquot.formatter : Formatter := do
 49 |   Formatter.checkKind identKind
 50 |   let Syntax.ident info _ idn _ ← getCur
 51 |     | throwError m!"not an ident: {← getCur}"
 52 |   Formatter.pushToken info idn.toString
 53 |   goLeft
 54 | 
 55 | @[combinator_parenthesizer idNoAntiquot]
 56 | def idNoAntiquot.parenthesizer := Parenthesizer.visitToken
 57 | end
 58 | 
 59 | @[run_parser_attribute_hooks]
 60 | def ident : Parser := withAntiquot (mkAntiquot "ident" identKind) idNoAntiquot
 61 | 
 62 | declare_syntax_cat expr
 63 | declare_syntax_cat stmt
 64 | 
 65 | syntax identifier_list := ident,*
 66 | syntax typed_identifier_list := ident,*
 67 | syntax function_call := ident "(" expr,* ")"
 68 | syntax block := "{" stmt* "}"
 69 | syntax if' := "if" expr block
 70 | syntax function_definition :=
 71 |   "function" ident "(" typed_identifier_list ")"
 72 |     ("->" typed_identifier_list)?
 73 |     block
 74 | syntax params_list := "[" typed_identifier_list "]"
 75 | syntax variable_declaration := "let" ident (":=" expr)?
 76 | -- syntax let_str_literal := "let" ident ":=" str -- TODO(fix)
 77 | syntax variable_declarations := "let" typed_identifier_list (":=" expr)?
 78 | syntax for_loop := "for" block expr block block
 79 | syntax assignment := identifier_list ":=" expr
 80 | 
 81 | syntax stmtlist := stmt*
 82 | 
 83 | syntax block : stmt
 84 | syntax if' : stmt
 85 | syntax function_definition : stmt
 86 | syntax variable_declarations : stmt
 87 | syntax assignment : stmt
 88 | syntax expr : stmt
 89 | -- syntax let_str_literal : stmt -- TODO(fix)
 90 | syntax for_loop : stmt
 91 | syntax "break" : stmt
 92 | syntax "continue" : stmt
 93 | syntax "leave" : stmt
 94 | 
 95 | syntax ident : expr
 96 | syntax numLit : expr
 97 | syntax function_call: expr
 98 | 
 99 | syntax default := "default" "{" stmt* "}"
100 | syntax case := "case" expr "{" stmt* "}"
101 | syntax switch := "switch" expr case+ (default)?
102 | syntax switch_default := "switch" expr default
103 | 
104 | syntax switch : stmt
105 | syntax switch_default : stmt
106 | 
107 | scoped syntax:max "<<" expr ">>" : term
108 | scoped syntax:max "<f" function_definition ">" : term
109 | scoped syntax:max "<s" stmt ">" : term
110 | scoped syntax:max "<ss" stmt ">" : term
111 | scoped syntax:max "<params" params_list ">" : term
112 | 
113 | partial def translatePrimOp' (primOp : P) : TSyntax `term :=
114 |   Syntax.mkStrLit primOp.toString 
115 | 
116 | partial def translateIdent (idn : TSyntax `ident) : TSyntax `term :=
117 |   Syntax.mkStrLit idn.getId.lastComponentAsString
118 | 
119 | open P in
120 | def parseFunction : String → PrimOp ⊕ Identifier
121 |   | "add" => .inl Add
122 |   | "sub" => .inl Sub
123 |   | "mul" => .inl Mul
124 |   | "div" => .inl Div
125 |   | "sdiv" => .inl Sdiv
126 |   | "mod" => .inl Mod
127 |   | "smod" => .inl Smod
128 |   | "addmod" => .inl Addmod
129 |   | "mulmod" => .inl Mulmod
130 |   | "exp" => .inl Exp
131 |   | "signextend" => .inl Signextend
132 |   | "lt" => .inl Lt
133 |   | "gt" => .inl Gt
134 |   | "slt" => .inl Slt
135 |   | "sgt" => .inl Sgt
136 |   | "eq" => .inl Eq
137 |   | "iszero" => .inl Iszero
138 |   | "and" => .inl And
139 |   | "or" => .inl Or
140 |   | "xor" => .inl Xor
141 |   | "not" => .inl Not
142 |   | "byte" => .inl Byte
143 |   | "shl" => .inl Shl
144 |   | "shr" => .inl Shr
145 |   | "sar" => .inl Sar
146 |   | "keccak256" => .inl Keccak256
147 |   | "address" => .inl Address
148 |   | "balance" => .inl Balance
149 |   | "origin" => .inl Origin
150 |   | "caller" => .inl Caller
151 |   | "callvalue" => .inl Callvalue
152 |   | "calldataload" => .inl Calldataload
153 |   | "calldatacopy" => .inl Calldatacopy
154 |   | "calldatasize" => .inl Calldatasize
155 |   | "codesize" => .inl Codesize
156 |   | "codecopy" => .inl Codecopy
157 |   | "gasprice" => .inl Gasprice
158 |   | "extcodesize" => .inl Extcodesize
159 |   | "extcodecopy" => .inl Extcodecopy
160 |   | "extcodehash" => .inl Extcodehash
161 |   | "returndatasize" => .inl Returndatasize
162 |   | "returndatacopy" => .inl Returndatacopy
163 |   | "blockhash" => .inl Blockhash
164 |   | "coinbase" => .inl Coinbase
165 |   | "timestamp" => .inl Timestamp
166 |   | "gaslimit" => .inl Gaslimit
167 |   | "chainid" => .inl Chainid
168 |   | "selfbalance" => .inl Selfbalance
169 |   | "mload" => .inl Mload
170 |   | "mstore" => .inl Mstore
171 |   | "sload" => .inl Sload
172 |   | "sstore" => .inl Sstore
173 |   | "msize" => .inl Msize
174 |   | "gas" => .inl Gas
175 |   | "revert" => .inl Revert
176 |   | "return" => .inl Return
177 |   | "pop" => .inl Pop
178 |   | "call" => .inl Call
179 |   | "staticcall" => .inl Staticcall
180 |   | "delegatecall" => .inl Delegatecall
181 |   | "loadimmutable" => .inl Loadimmutable
182 |   | "log1" => .inl Log1
183 |   | "log2" => .inl Log2
184 |   | "log3" => .inl Log3
185 |   | "log4" => .inl Log4
186 |   | "number" => .inl Number
187 |   | userF => .inr userF 
188 | 
189 | partial def translateExpr (expr : TSyntax `expr) : MacroM (TSyntax `term) :=
190 |   match expr with
191 |   | `(expr| $idn:ident) => `(Expr.Var $(translateIdent idn))
192 |   | `(expr| $num:num) => `(Expr.Lit $num)
193 |   | `(expr| $name:ident($args:expr,*)) => do
194 |     let args' ← (args : TSyntaxArray `expr).mapM translateExpr
195 |     let f' := parseFunction (TSyntax.getId name).lastComponentAsString
196 |     match f' with
197 |       | .inl primOp =>
198 |         let primOp' := Lean.mkIdent (Name.fromComponents [`P, primOp.toString.toName])
199 |         `(Expr.PrimCall $primOp' [$args',*])
200 |       | .inr _ =>
201 |         `(Expr.Call $name [$args',*])
202 |   | _ => Macro.throwError "unknown expr"
203 | 
204 | partial def translateExpr' (expr : TSyntax `expr) : MacroM (TSyntax `term) :=
205 |   match expr with
206 |   | `(expr| $num:num) => `($num)
207 |   | exp => translateExpr exp
208 | 
209 | partial def translateParamsList
210 |   (params : TSyntax `Clear.YulNotation.params_list)
211 | : MacroM (TSyntax `term) :=
212 |   match params with
213 |   | `(params_list| [ $args:ident,* ]) => do
214 |     let args' := (args : TSyntaxArray _).map translateIdent
215 |     `([$args',*])
216 |   | _ => Macro.throwError (toString params.raw)
217 | 
218 | mutual
219 | partial def translateFdef
220 |   (fdef : TSyntax `Clear.YulNotation.function_definition)
221 | : MacroM (TSyntax `term) :=
222 |   match fdef with
223 |   | `(function_definition| function $_:ident($args:ident,*) {$body:stmt*}) => do
224 |     let args' := (args : TSyntaxArray _).map translateIdent
225 |     let body' ← body.mapM translateStmt
226 |     `(Clear.Ast.FunctionDefinition.Def [$args',*] [] [$body',*])
227 |   | `(function_definition| function $_:ident($args:ident,*) -> $rets,* {$body:stmt*}) => do
228 |     let args' := (args : TSyntaxArray _).map translateIdent
229 |     let rets' := (rets : TSyntaxArray _).map translateIdent
230 |     let body' ← body.mapM translateStmt
231 |     `(Clear.Ast.FunctionDefinition.Def [$args',*] [$rets',*] [$body',*])
232 |   | _ => Macro.throwError (toString fdef.raw)
233 | 
234 | partial def translateStmt (stmt : TSyntax `stmt) : MacroM (TSyntax `term) :=
235 |   match stmt with
236 | 
237 |   -- Block
238 |   | `(stmt| {$stmts:stmt*}) => do
239 |     let stmts' ← stmts.mapM translateStmt
240 |     `(Stmt.Block ([$stmts',*]))
241 | 
242 |   -- If
243 |   | `(stmt| if $cond:expr {$body:stmt*}) => do
244 |     let cond' ← translateExpr cond
245 |     let body' ← body.mapM translateStmt
246 |     `(Stmt.If $cond' [$body',*])
247 | 
248 |   -- Function Definition
249 |   | `(stmt| $fdef:function_definition) => do
250 |     let fdef' ← translateFdef fdef
251 |     `(Stmt.FunctionDefinition $fdef')
252 | 
253 |   -- Switch
254 |   | `(stmt| switch $expr:expr $[case $lits { $cs:stmt* }]* $[default { $dflts:stmt* }]?) => do
255 |     let expr ← translateExpr expr
256 |     let lits ← lits.mapM translateExpr'
257 |     let cases ← cs.mapM (λ cc ↦ cc.mapM translateStmt)
258 |     let f (litCase : TSyntax `term × Array (TSyntax `term)) : MacroM (TSyntax `term) := do
259 |       let (lit, cs) := litCase; `(($lit, [$cs,*]))
260 |     let switchCases ← lits.zip cases |>.mapM f
261 |     let dflt ← match dflts with
262 |                  | .none => `([.Break])
263 |                  | .some dflts => `([$(←dflts.mapM translateStmt),*])
264 |     `(Stmt.Switch $expr [$switchCases,*] $dflt)
265 | 
266 |   -- Switch
267 |   | `(stmt| switch $expr:expr default {$dflts:stmt*}) => do
268 |     let expr ← translateExpr expr
269 |     let dflt ← dflts.mapM translateStmt
270 |     `(Stmt.Switch $expr [] ([$dflt,*]))
271 |   
272 |   -- LetCall
273 |   | `(stmt| let $ids:ident,* := $f:ident ( $es:expr,* )) => do
274 |     let ids' := (ids : TSyntaxArray _).map translateIdent
275 |     let f' := parseFunction (TSyntax.getId f).lastComponentAsString
276 |     let es' ← (es : TSyntaxArray _).mapM translateExpr
277 |     match f' with
278 |       | .inl primOp =>
279 |         let primOp' := Lean.mkIdent (Name.fromComponents [`P, primOp.toString.toName])
280 |         `(Stmt.LetPrimCall [$ids',*] $primOp' [$es',*])
281 |       | .inr _ =>
282 |         `(Stmt.LetCall [$ids',*] $f [$es',*])
283 | 
284 |   -- LetEq
285 |   | `(stmt| let $idn:ident := $init:expr) => do
286 |     let idn' := translateIdent idn
287 |     let expr' ← translateExpr init
288 |     `(Stmt.LetEq $idn' $expr')
289 | 
290 |   -- TODO(fix)
291 |   -- | `(stmt| let $idn:ident := $s:str) => do
292 |   --   let idn' := translateIdent idn
293 |   --   `(Stmt.LetEq $idn' _)
294 | 
295 |   -- Let
296 |   | `(stmt| let $ids:ident,*) => do
297 |     let ids' := (ids : TSyntaxArray _).map translateIdent
298 |     `(Stmt.Let [$ids',*])
299 | 
300 |   -- AssignCall
301 |   | `(stmt| $ids:ident,* := $f:ident ( $es:expr,* )) => do
302 |     let ids' := (ids : TSyntaxArray _).map translateIdent
303 |     let f' := parseFunction (TSyntax.getId f).lastComponentAsString
304 |     let es' ← (es : TSyntaxArray _).mapM translateExpr
305 |     match f' with
306 |       | .inl primOp =>
307 |         let primOp' := Lean.mkIdent (Name.fromComponents [`P, primOp.toString.toName])
308 |         `(Stmt.AssignPrimCall [$ids',*] $primOp' [$es',*])
309 |       | .inr _ =>
310 |         `(Stmt.AssignCall [$ids',*] $f [$es',*])
311 | 
312 |   -- Assign
313 |   | `(stmt| $idn:ident := $init:expr) => do
314 |     let idn' := translateIdent idn
315 |     let expr' ← translateExpr init
316 |     `(Stmt.Assign $idn' $expr')
317 | 
318 |   -- ExprStmt
319 |   | `(stmt| $f:ident ( $es:expr,* )) => do
320 |     let f' := parseFunction (TSyntax.getId f).lastComponentAsString
321 |     let es' ← (es : TSyntaxArray _).mapM translateExpr
322 |     match f' with
323 |       | .inl primOp =>
324 |         let primOp' := Lean.mkIdent (Name.fromComponents [`P, primOp.toString.toName])
325 |         `(Stmt.ExprStmtPrimCall $primOp' [$es',*])
326 |       | .inr _ =>
327 |         `(Stmt.ExprStmtCall $f [$es',*])
328 | 
329 |   -- For
330 |   | `(stmt| for {} $cond:expr {$post:stmt*} {$body:stmt*}) => do
331 |     let cond' ← translateExpr cond
332 |     let post' ← post.mapM translateStmt
333 |     let body' ← body.mapM translateStmt
334 |     `(Stmt.For $cond' [$post',*] [$body',*])
335 | 
336 |   -- Break
337 |   | `(stmt| break) => `(Stmt.Break)
338 | 
339 |   -- Continue
340 |   | `(stmt| continue) => `(Stmt.Continue)
341 | 
342 |   -- Leave
343 |   | `(stmt| leave) => `(Stmt.Leave)
344 | 
345 |   -- Anything else
346 |   | _ => Macro.throwError (toString stmt.raw)
347 | end
348 | 
349 | partial def translateStmtList (stmt : TSyntax `stmt) : MacroM (TSyntax `term) :=
350 |   match stmt with
351 |   | `(stmt| {$stmts:stmt*}) => do
352 |     let stmts' ← stmts.mapM translateStmt
353 |     `([$stmts',*])
354 |   | _ => Macro.throwError (toString stmt.raw)
355 | 
356 | scoped macro_rules
357 | | `(term|<< $expr:expr >>) => translateExpr expr
358 | | `(term|<f $fdef:function_definition >) => translateFdef fdef
359 | | `(term|<s $stmt:stmt >) => translateStmt stmt
360 | | `(term|<ss $stmt:stmt >) => translateStmtList stmt
361 | | `(term|<params $params:params_list >) => translateParamsList params
362 | 
363 | def f : FunctionDefinition := <f
364 |   function sort2(a, b) -> x, y {
365 |     if lt(a, b) {
366 |       x := a
367 |       y := b
368 |       leave
369 |     }
370 |     x := b
371 |     y := a
372 |   }
373 | >
374 | 
375 | example : <params [a,b,c] > = ["a", "b", "c"] := rfl
376 | example : << bar >> = Expr.Var "bar" := rfl
377 | example : << 42 >> = Expr.Lit 42 := rfl
378 | example : <s break > = Stmt.Break := rfl
379 | example : <s let a, b := f(42) > = Stmt.LetCall ["a", "b"] f [Expr.Lit 42] := rfl
380 | example : <s let a > = Stmt.Let ["a"] := rfl
381 | example : <s let a := 5 > = Stmt.LetEq "a" (.Lit 5) := rfl
382 | example : <s a, b := f(42) > = Stmt.AssignCall ["a", "b"] f [Expr.Lit 42] := rfl
383 | example : <s a := 42 > = Stmt.Assign "a" (.Lit 42) := rfl
384 | example : <s c := add(a, b) > = Stmt.AssignPrimCall ["c"] P.Add [Expr.Var "a", Expr.Var "b"] := rfl
385 | example : <s let c := sub(a, b) > = Stmt.LetPrimCall ["c"] P.Sub [Expr.Var "a", Expr.Var "b"] := rfl
386 | example : <s let a := 5 > = Stmt.LetEq "a" (.Lit 5) := rfl
387 | example : <s {} >
388 |   = Stmt.Block [] := rfl
389 | example : <s
390 | {
391 |   break
392 |   let a := 5
393 |   break
394 | }
395 | > = Stmt.Block [<s break>, <s let a := 5>, <s break>] := rfl
396 | example : <s
397 |   if a {
398 |     let b := 5
399 |     break
400 |   }
401 | > = Stmt.If <<a>> [<s let b := 5>, <s break >] := rfl
402 | 
403 | example : <ss {
404 |   let a
405 |   let b
406 |   let c
407 | } > = [<s let a>, <s let b>, <s let c>] := rfl
408 | 
409 | example : <s for {} 0 {} {} > = Stmt.For (.Lit 0) [] [] := by rfl
410 | 
411 | example : <s
412 |   for {} lt(i, exponent) { i := add(i, 1) }
413 |   {
414 |     result := mul(result, base)
415 |   }
416 | > = Stmt.For <<lt(i, exponent)>> [<s i := add(i, 1)>]
417 |       [<s result := mul(result, base)>] := rfl
418 | 
419 | def sort2 : FunctionDefinition := <f
420 |   function sort2(a, b) -> x, y {
421 |     if lt(a, b) {
422 |       x := a
423 |       y := b
424 |       leave
425 |     }
426 |     x := b
427 |     y := a
428 |   }
429 | >
430 | def no_rets : FunctionDefinition := <f
431 |   function no_rets(a, b) {
432 |   }
433 | >
434 | example : <s
435 |   switch a
436 |   case 42 { continue }
437 |   default { break }
438 | > = Stmt.Switch (Expr.Var "a") [(42, [.Continue])] [.Break] := rfl
439 | 
440 | example : <s let a, b, c > = Stmt.Let ["a", "b", "c"] := rfl
441 | example : <s revert(0, 0) > = Stmt.ExprStmtPrimCall P.Revert [(Expr.Lit 0), (Expr.Lit 0)] := rfl
442 | example : <s if 1 { leave } > = Stmt.If (.Lit 1) [Stmt.Leave] := rfl
443 | example : <s {
444 |     if 1 { leave }
445 |     leave
446 |   }
447 | > = Stmt.Block [Stmt.If (.Lit 1) [.Leave], .Leave] := rfl
448 | 
449 | end Clear.YulNotation
450 | 


--------------------------------------------------------------------------------