Skip to content

Commit 3cf6ffe

Browse files
shigoelshigoel
committed
Add an initial implementation of the explode_step tactic
1 parent 8e471a7 commit 3cf6ffe

File tree

3 files changed

+195
-1
lines changed

3 files changed

+195
-1
lines changed

‎Proofs/Sha512_block_armv8.lean

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ Author(s): Shilpi Goel
55
-/
66
import Arm.Exec
77
import Arm.Util
8-
import Tactics.Sym
8+
import Tactics
99
import Tests.SHA512ProgramTest
1010

1111
section SHA512_proof
@@ -171,6 +171,7 @@ theorem sha512_block_armv8_test_4_sym (s0 s_final : ArmState)
171171
(try dsimp only at h_step_2)
172172
(try clear h_s1_program h_s1_err)
173173
-- exec_inst h_step_2
174+
-- explode_step h_step_1
174175
have h_s1_gpr31 : r (StateField.GPR 31#5) s1 = (r (StateField.GPR 31#5) s0 + 18446744073709551600#64) := by
175176
simp_all only [stepi, state_simp_rules, minimal_theory, bitvec_rules]
176177
simp (config := { decide := true }) only [*, -h_step_1, exec_inst, state_simp_rules, minimal_theory, bitvec_rules] at h_step_2

‎Tactics.lean

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,3 +6,4 @@ Author(s): Shilpi Goel
66
-- This module serves as the root of the `Tactics` library.
77
-- Import modules here that should be built as part of the library.
88
import «Tactics».Sym
9+
import «Tactics».ExplodeStep

‎Tactics/ExplodeStep.lean

Lines changed: 192 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,192 @@
1+
import Arm.Exec
2+
import Lean
3+
4+
/-
5+
Tactic `explode_step h`:
6+
7+
The tactic `explode_step` operates on a given declaration `h` in the
8+
goal, where `h` is of the form
9+
`state_var_new = write ... (write ... state_var_old)`.
10+
It then introduces corresponding `read` terms in the context, and also
11+
attempts to prove them.
12+
13+
Here is an example:
14+
15+
Goal:
16+
h : s1 = w (StateField.GPR 31#5) 1#64 (w StateField.PC 2#64 s0)
17+
...
18+
|-
19+
conclusion
20+
21+
`explode_step h` modifies the goal as follows; note the new hypotheses
22+
`h_s1_x31` and `h_s1_pc`. `explode_step h` also attempts to prove each
23+
of these new hypotheses; any new hypotheses that couldn't be proven by
24+
`explode_step` are pushed on to the stack of unsolved goals.
25+
26+
Goal:
27+
h : s1 = w (StateField.GPR 31#5) 1#64 (w StateField.PC 2#64 s0)
28+
h_s1_x31 : r (StateField.GPR 31#5) s1 = 1#64
29+
h_s1_pc : r StateField.PC s1 = 2#64
30+
...
31+
|-
32+
conclusion
33+
-/
34+
35+
open Lean Elab Tactic Expr Meta
36+
open BitVec
37+
38+
/- Get the string representation of `e` if it denotes a bitvector
39+
literal. The bitvector's width is not represented in the resulting
40+
string. -/
41+
def getBitVecString? (e : Expr) : MetaM (Option String) := do
42+
let maybe_e_literal ← getBitVecValue? e
43+
match maybe_e_literal with
44+
| some ⟨_, value⟩ => return some (ToString.toString value.toNat)
45+
| none => return none
46+
47+
/- Get the string representation of `e` if it denotes a `PFlag`. -/
48+
def getPFlagString? (e : Expr) : MetaM (Option String) := OptionT.run do
49+
match_expr e with
50+
| PFlag.N => return "n_flag"
51+
| PFlag.Z => return "z_flag"
52+
| PFlag.C => return "c_flag"
53+
| PFlag.V => return "v_flag"
54+
| _ => panic s!"[getPFlagString?] Unexpected expression: {e}"
55+
56+
/- Get the string representation of `e` if it denotes a `StateField`. -/
57+
def getStateFieldString? (e : Expr) : MetaM (Option String) := OptionT.run do
58+
match_expr e with
59+
| StateField.GPR iExpr => return ("x" ++ (← getBitVecString? iExpr))
60+
| StateField.SFP iExpr => return ("q" ++ (← getBitVecString? iExpr))
61+
| StateField.PC => return "pc"
62+
| StateField.FLAG pExpr => getPFlagString? pExpr
63+
| StateField.ERR => return "err"
64+
| _ => panic s!"[getStateFieldName?] Unexpected expression: {e}"
65+
66+
partial def explodeWriteNest (goal : MVarId)
67+
(st_var : Expr) (e : Expr) (seen_fields : List String)
68+
(rest_goals : List MVarId) : TacticM (List MVarId) := do
69+
if e.isFVar then
70+
return (goal :: rest_goals)
71+
else
72+
match_expr e with
73+
| w field val rest =>
74+
-- logInfo m!"field: {field} val: {val} rest: {rest}"
75+
let some field_str ←
76+
getStateFieldString? field |
77+
logInfo m!"[explodeWriteNest] Unexpected field argument of function w: {field}";
78+
return (goal :: rest_goals)
79+
if field_str ∈ seen_fields then
80+
-- Skip if we have already generated a hypothesis for this field.
81+
explodeWriteNest goal st_var rest seen_fields rest_goals
82+
else
83+
let val_type ← inferType val
84+
let new_prop_type :=
85+
mkAppN (Expr.const ``Eq [1])
86+
#[val_type,
87+
(mkAppN (Expr.const ``r []) #[field, st_var]),
88+
val]
89+
let st_var_decl ← (getFVarLocalDecl st_var)
90+
let name := Lean.Name.mkSimple
91+
("h_" ++ (toString st_var_decl.userName) ++ "_" ++ field_str)
92+
let new_prop_val ← mkFreshExprMVar new_prop_type MetavarKind.syntheticOpaque name
93+
let maybe_new_prop_val ← substVar? new_prop_val.mvarId! st_var.fvarId!
94+
match maybe_new_prop_val with
95+
| none =>
96+
logInfo m!"[explodeWriteNest] Could not substitute {st_var} in \
97+
goal {new_prop_val.mvarId!}";
98+
return (goal :: rest_goals)
99+
| some p =>
100+
-- logInfo m!"p: {p}"
101+
let new_goals ←
102+
evalTacticAt
103+
(← `(tactic|
104+
(try (repeat
105+
(simp (config := {decide := true}) only
106+
[state_simp_rules, minimal_theory, bitvec_rules])))))
107+
p
108+
-- logInfo m!"new_goals: {new_goals}"
109+
let (_, goal') ← MVarId.intro1P $ ← Lean.MVarId.assert goal name new_prop_type new_prop_val
110+
explodeWriteNest goal' st_var rest (field_str :: seen_fields) (rest_goals ++ new_goals)
111+
112+
| write_mem_bytes n addr val rest =>
113+
let n ← (if n.hasExprMVar || n.hasFVar then pure n else whnf n)
114+
let addr ← (if addr.hasExprMVar || addr.hasFVar then pure addr else whnf addr)
115+
let val ← (if val.hasExprMVar || val.hasFVar then pure val else whnf val)
116+
logInfo m!"Skipping hypothesis generation for memory writes for now. \
117+
\nn: {n} \naddr: {addr}\n val: {val}"
118+
explodeWriteNest goal st_var rest seen_fields rest_goals
119+
120+
| _ =>
121+
logInfo m!"[explodeWriteNest] Cannot explode the following any further: {e}"
122+
return (goal :: rest_goals)
123+
124+
partial def explodeStepExpr (hS : Expr) : TacticM Bool :=
125+
-- We expect hS to be of the following shape:
126+
-- <hyp>: <var:St> = (w ... (w ... <var:St>))
127+
withMainContext
128+
(do
129+
let S ← inferType hS
130+
let_expr Eq _ st_var nest ← S | return false
131+
-- Remove metadata, if present, from st_var and nest.
132+
let st_var := consumeMData st_var
133+
let nest := consumeMData nest
134+
-- logInfo m!"var: {st_var} nest: {nest}"
135+
if ! (st_var.isFVar && nest.isApp) then
136+
logInfo m!"[explodeStepExpr] Unexpected expression(s). We expect \
137+
the state variable on the LHS to be an FVar and the \
138+
term on the RHS to be a function application. Here is \
139+
what they actually are: \
140+
st_var: {st_var.ctorName}; nest: {nest.ctorName}."
141+
return false
142+
else
143+
let goals ← explodeWriteNest (← getMainGoal) st_var nest [] []
144+
replaceMainGoal goals
145+
return true)
146+
147+
def explodeStep (name : Name) : TacticM Unit :=
148+
withMainContext
149+
(do
150+
let h ← getFVarFromUserName name
151+
let success ← explodeStepExpr h
152+
if ! success then
153+
failure)
154+
155+
elab "explode_step" h:ident : tactic =>
156+
explodeStep (h.getId)
157+
158+
example (s0 s1 : ArmState)
159+
(h : s1 = w (StateField.GPR 31#5) 12#64 (w StateField.PC 0x2000#64 s0)) :
160+
r StateField.PC s1 = 0x2000#64 := by
161+
explode_step h
162+
assumption
163+
done
164+
165+
example (s0 s1 : ArmState) (x : BitVec 64)
166+
(h : s1 = w (StateField.GPR 31#5) x (w StateField.PC 0x2000#64 s0)) :
167+
r StateField.PC s1 = 0x2000#64 := by
168+
explode_step h
169+
assumption
170+
done
171+
172+
example (s0 s1 : ArmState)
173+
(h : s1 = w (StateField.GPR 31#5) 12#64 (if (1 = 1) then (w StateField.PC 0x2000#64 s0) else (w StateField.PC 0x2001#64 s0))) :
174+
r StateField.PC s1 = 0x2000#64 := by
175+
-- explode_step h
176+
simp at h
177+
explode_step h
178+
assumption
179+
done
180+
181+
-- explode_step adds hypotheses in the outside-in order for the RHS of `h`. It
182+
-- does not add a hypothesis for a field if it was already seen earlier. That is
183+
-- why we do not see two hypotheses for (StateField.GPR 31#5) below; we only see
184+
-- one hypothesis that corresponds to the most recent write.
185+
example (s0 s1 : ArmState)
186+
(h : s1 = w (StateField.GPR 31#5) 12#64
187+
(w StateField.PC 1#64
188+
(w (StateField.GPR 31#5) 13#64 s0))) :
189+
r StateField.PC s1 = 1#64 := by
190+
explode_step h
191+
assumption
192+
done

0 commit comments

Comments
 (0)