175661b6c3
This PR reorganizes the monad hierarchy for symbolic computation in Lean. ## Motivation We want a clean layering where: 1. A foundational monad (`SymM`) provides maximally shared terms and structural/syntactic `isDefEq` 2. `GrindM` builds on this foundation, adding E-graphs, congruence closure, and decision procedures 3. Symbolic execution / VCGen uses `GrindM` directly without introducing a third monad ## Changes The core symbolic computation layer still lives in `Lean.Meta.Sym`. This monad (`SymM`) provides: - Maximally shared terms with pointer-based equality - Structural/syntactic `isDefEq` and matching (no reduction, predictable cost) - Monotonic local contexts (no `revert` or `clear`), enabling O(1) metavariable validation - Efficient `intro`, `apply`, and `simp` implementations The name "Sym" reflects that this is infrastructure for symbolic computation: symbolic simulation, verification condition generation, and decision procedures. ### Updated hierarchy ``` Lean.Meta.Sym -- SymM: shared terms, syntactic isDefEq, intro, apply, simp Lean.Meta.Grind -- GrindM: E-graphs, congruence closure (extends SymM) ``` Symbolic execution is a usage pattern of `GrindM` operating on `Grind.Goal`, not a separate monad. This keeps the API surface minimal: users learn two monads, and VCGen is "how you use `GrindM`" (for users that want to use `grind`) rather than a third abstraction to understand.
83 lines
2.7 KiB
Text
83 lines
2.7 KiB
Text
import Lean.Meta.Tactic
|
||
import Lean.Meta.Sym
|
||
|
||
open Lean Meta Sym
|
||
def profileM {α : Type} (k : MetaM α) (msg : String := "experiment") : MetaM α :=
|
||
profileitM Exception msg ({ : Options }.setBool `profiler true |>.setNat `profiler.threshold 0) k
|
||
|
||
def genTerm (n : Nat) : Expr := Id.run do
|
||
let mut e := mkConst ``True
|
||
let nat := mkConst ``Nat
|
||
for _ in 0...n do
|
||
let eq := mkApp3 (mkConst ``Eq [1]) nat (mkBVar 0) (mkNatAdd (mkBVar 2) (mkBVar 1))
|
||
e := mkApp2 (mkConst ``And) eq e
|
||
e := mkApp2 (mkConst ``Exists [1]) nat (mkLambda `y .default nat e)
|
||
e := mkForall `x .default nat e
|
||
e := mkLet `z nat (mkNatAdd (mkBVar 1) (mkBVar 0)) e
|
||
let eq := mkApp3 (mkConst ``Eq [1]) nat (mkBVar 0) (mkNatAdd (mkBVar 2) (mkBVar 1))
|
||
e := mkApp2 (mkConst ``And) eq e
|
||
e := mkApp2 (mkConst ``Exists [1]) nat (mkLambda `y .default nat e)
|
||
e := mkForall `x .default nat e
|
||
e := mkLet `z nat (mkNatLit 0) e
|
||
return e
|
||
|
||
set_option maxRecDepth 10000000
|
||
|
||
def tryIntros? (goals : List MVarId) : SymM (Option (List MVarId)) := do
|
||
try
|
||
let goal :: goals := goals | return none
|
||
let (_, goal') ← intros goal
|
||
return some (goal' :: goals)
|
||
catch _ =>
|
||
return none
|
||
|
||
def tryApply? (rule : BackwardRule) (goals : List MVarId) : SymM (Option (List MVarId)) := do
|
||
let goal :: goals := goals | return none
|
||
try
|
||
let goals' ← rule.apply goal
|
||
return some (goals' ++ goals)
|
||
catch _ =>
|
||
return none
|
||
|
||
def tryApplyAny? (rules : List BackwardRule) (goals : List MVarId) : SymM (Option (List MVarId)) := do
|
||
match rules with
|
||
| [] => return none
|
||
| rule :: rules =>
|
||
if let some goals' ← tryApply? rule goals then
|
||
return some goals'
|
||
else
|
||
tryApplyAny? rules goals
|
||
|
||
def solve (n : Nat) (type : Expr) : MetaM Unit := profileM (msg := s!"size {n}") <| SymM.run do
|
||
let mvarId := (← mkFreshExprMVar type).mvarId!
|
||
let rules ← [``Exists.intro, ``And.intro, ``Eq.refl, ``True.intro].mapM fun declName => mkBackwardRuleFromDecl declName
|
||
let goal ← preprocessMVar mvarId
|
||
discard <| go 10000000 rules [goal]
|
||
return ()
|
||
where
|
||
go (fuel : Nat) (rules : List BackwardRule) (goals : List MVarId) : SymM Bool := do
|
||
let fuel + 1 := fuel | throwError "out of fuel"
|
||
let goal :: goals' := goals | return true
|
||
if (← goal.isAssigned) then
|
||
go fuel rules goals'
|
||
else
|
||
if let some goals' ← tryIntros? goals then
|
||
go fuel rules goals'
|
||
else if let some goals' ← tryApplyAny? rules goals then
|
||
go fuel rules goals'
|
||
else
|
||
throwError "Stuck at {goal}"
|
||
|
||
def test (n : Nat) : MetaM Unit := do
|
||
let e := genTerm n
|
||
solve n e
|
||
|
||
-- We are solving problems of the following form
|
||
#eval logInfo (genTerm 2)
|
||
|
||
#eval test 1000
|
||
#eval test 2000
|
||
#eval test 3000
|
||
#eval test 4000
|
||
#eval test 5000
|
||
#eval test 6000
|