feat: add basic extract theorems for bv_decide (#7021)

This PR adds theorems for interactions of extractLsb with `&&&`, `^^^`,
`~~~` and `bif` to bv_decide's preprocessor.
This commit is contained in:
Henrik Böving 2025-02-10 14:48:20 +01:00 committed by GitHub
parent c307e8a04f
commit fa05bccd58
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
4 changed files with 44 additions and 7 deletions

View file

@ -196,13 +196,8 @@ def getEnumToBitVecLeFor (declName : Name) : MetaM Name := do
let recOn := mkApp2 (mkConst (mkRecOnName declName) [0]) motive x
let folder acc ctor := do
let statement := mkStatement (mkConst ctor)
let decidable ← synthInstance (mkApp (mkConst ``Decidable) statement)
let decideEqTrue :=
mkApp2
(mkConst ``Eq.refl [1])
(mkConst ``Bool)
(mkApp2 (mkConst ``decide) statement decidable)
return mkApp acc <| mkApp3 (mkConst ``of_decide_eq_true) statement decidable decideEqTrue
let proof ← mkDecideProof statement
return mkApp acc proof
let cases ← List.foldlM (init := recOn) folder ctors
mkLambdaFVars #[x] cases

View file

@ -218,5 +218,19 @@ builtin_simproc [bv_normalize] bv_allOnes_eq_and ((_ : BitVec _) == (_ : BitVec
rrhs
return .visit { expr := expr, proof? := some proof }
builtin_simproc [bv_normalize] bv_extractLsb'_not (BitVec.extractLsb' _ _ (~~~(_ : BitVec _))) :=
fun e => do
let_expr BitVec.extractLsb' initialWidth start len inner := e | return .continue
let some initialWidthVal ← getNatValue? initialWidth | return .continue
let some startVal ← getNatValue? start | return .continue
let some lenVal ← getNatValue? len | return .continue
if !(startVal + lenVal) < initialWidthVal then return .continue
let_expr Complement.complement _ _ inner := inner | return .continue
let newInner := mkApp4 (mkConst ``BitVec.extractLsb') initialWidth start len inner
let expr ← mkAppM ``Complement.complement #[newInner]
let lt ← mkDecideProof (← mkAppM ``LT.lt #[(← mkAppM ``HAdd.hAdd #[start, len]), initialWidth])
let proof := mkApp5 (mkConst ``BitVec.extractLsb'_not_of_lt) initialWidth inner start len lt
return .visit { expr := expr, proof? := some proof }
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View file

@ -339,5 +339,13 @@ theorem BitVec.udiv_ofNat_eq_of_lt (w : Nat) (x : BitVec w) (n : Nat) (k : Nat)
have : BitVec.ofNat w n = BitVec.twoPow w k := by simp [bv_toNat, hk]
rw [this, BitVec.udiv_twoPow_eq_of_lt (hk := by omega)]
attribute [bv_normalize] BitVec.extractLsb'_and
attribute [bv_normalize] BitVec.extractLsb'_xor
@[bv_normalize]
theorem BitVec.exctractLsb'_if {x y : BitVec w} (s l : Nat) :
BitVec.extractLsb' s l (bif c then x else y) = bif c then (BitVec.extractLsb' s l x) else (BitVec.extractLsb' s l y) := by
cases c <;> simp
end Normalize
end Std.Tactic.BVDecide

View file

@ -252,6 +252,26 @@ example (a b : BitVec 16) : (a &&& b == -1#16) = (a == -1#16 && b == -1#16) := b
example (a b : BitVec 16) : (-1#16 == a &&& b) = (a == -1#16 && b == -1#16) := by
bv_normalize
-- extractLsb'_and
example (a b : BitVec 16) :
BitVec.extractLsb' 1 12 (a &&& b) = BitVec.extractLsb' 1 12 a &&& BitVec.extractLsb' 1 12 b := by
bv_normalize
-- extractLsb'_xor
example (a b : BitVec 16) :
BitVec.extractLsb' 1 12 (a ^^^ b) = BitVec.extractLsb' 1 12 a ^^^ BitVec.extractLsb' 1 12 b := by
bv_normalize
-- extractLsb'_not_of_lt
example (a b : BitVec 16) :
BitVec.extractLsb' 1 12 (~~~(a &&& b)) = ~~~(BitVec.extractLsb' 1 12 a &&& BitVec.extractLsb' 1 12 b) := by
bv_normalize
-- extractLsb'_if
example (a b : BitVec 16) (c : Bool) :
BitVec.extractLsb' 1 12 (if c then a else b) = if c then BitVec.extractLsb' 1 12 a else BitVec.extractLsb' 1 12 b := by
bv_normalize
section
example (x y : BitVec 256) : x * y = y * x := by