Skip to content

Commit bba35e4

Browse files
authored
perf: add performance comparison tests for SymM vs MetaM (#11838)
This PR adds performance comparison tests between the new `SymM` monad and the standard `MetaM` for `intros`/`apply` operations. The tests solve problems of the form: ```lean let z := 0; ∀ x, ∃ y, x = z + y ∧ let z := z + x; ∀ x, ∃ y, x = z + y ∧ ... ∧ True ``` using repeated `intros` and `apply` with `Exists.intro`, `And.intro`, `Eq.refl`, and `True.intro`. **Results show 10-20x speedup:** | Size | MetaM | SymM | Speedup | |------|-------|------|---------| | 1000 | 226ms | 21ms | 10.8x | | 2000 | 582ms | 44ms | 13.2x | | 3000 | 1.08s | 72ms | 15.0x | | 4000 | 1.72s | 101ms | 17.0x | | 5000 | 2.49s | 125ms | 19.9x | | 6000 | 3.45s | 157ms | 22.0x |
1 parent 17581a2 commit bba35e4

File tree

2 files changed

+161
-0
lines changed

2 files changed

+161
-0
lines changed
Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
import Lean.Meta.Tactic
2+
3+
open Lean Meta
4+
def profileM {α : Type} (k : MetaM α) (msg : String := "experiment") : MetaM α :=
5+
profileitM Exception msg ({ : Options }.setBool `profiler true |>.setNat `profiler.threshold 0) k
6+
7+
def genTerm (n : Nat) : Expr := Id.run do
8+
let mut e := mkConst ``True
9+
let nat := mkConst ``Nat
10+
for _ in 0...n do
11+
let eq := mkApp3 (mkConst ``Eq [1]) nat (mkBVar 0) (mkNatAdd (mkBVar 2) (mkBVar 1))
12+
e := mkApp2 (mkConst ``And) eq e
13+
e := mkApp2 (mkConst ``Exists [1]) nat (mkLambda `y .default nat e)
14+
e := mkForall `x .default nat e
15+
e := mkLet `z nat (mkNatAdd (mkBVar 1) (mkBVar 0)) e
16+
let eq := mkApp3 (mkConst ``Eq [1]) nat (mkBVar 0) (mkNatAdd (mkBVar 2) (mkBVar 1))
17+
e := mkApp2 (mkConst ``And) eq e
18+
e := mkApp2 (mkConst ``Exists [1]) nat (mkLambda `y .default nat e)
19+
e := mkForall `x .default nat e
20+
e := mkLet `z nat (mkNatLit 0) e
21+
return e
22+
23+
set_option maxRecDepth 10000000
24+
25+
def tryIntros? (goals : List MVarId) : MetaM (Option (List MVarId)) := do
26+
let goal :: goals := goals | return none
27+
let (fvars, goal') ← goal.intros
28+
if fvars.isEmpty then return none
29+
return some (goal' :: goals)
30+
31+
def tryApply? (declName : Name) (goals : List MVarId) : MetaM (Option (List MVarId)) := do
32+
let goal :: goals := goals | return none
33+
try
34+
let goals' ← goal.applyConst declName
35+
return some (goals' ++ goals)
36+
catch _ =>
37+
return none
38+
39+
def tryApplyAny? (declNames : List Name) (goals : List MVarId) : MetaM (Option (List MVarId)) := do
40+
match declNames with
41+
| [] => return none
42+
| declName :: declNames =>
43+
if let some goals' ← tryApply? declName goals then
44+
return some goals'
45+
else
46+
tryApplyAny? declNames goals
47+
48+
def solve (n : Nat) (type : Expr) : MetaM Unit := profileM (msg := s!"size {n}") do
49+
let mvarId := (← mkFreshExprMVar type).mvarId!
50+
discard <| go 10000000 [mvarId]
51+
return ()
52+
where
53+
go (fuel : Nat) (goals : List MVarId) : MetaM Bool := do
54+
let fuel + 1 := fuel | throwError "out of fuel"
55+
let goal :: goals' := goals | return true
56+
if (← goal.isAssigned) then
57+
go fuel goals'
58+
else
59+
if let some goals' ← tryIntros? goals then
60+
go fuel goals'
61+
else if let some goals' ← tryApplyAny? [``Exists.intro, ``And.intro, ``Eq.refl, ``True.intro] goals then
62+
go fuel goals'
63+
else
64+
throwError "Stuck at {goal}"
65+
66+
def test (n : Nat) : MetaM Unit := do
67+
let e := genTerm n
68+
solve n e
69+
70+
-- We are solving problems of the following form
71+
#eval logInfo (genTerm 2)
72+
73+
#eval test 1000
74+
#eval test 2000
75+
#eval test 3000
76+
#eval test 4000
77+
#eval test 5000
78+
#eval test 6000

tests/lean/sym/perf_sym_apply.lean

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
import Lean.Meta.Tactic
2+
import Lean.Meta.Sym
3+
4+
open Lean Meta Sym
5+
def profileM {α : Type} (k : MetaM α) (msg : String := "experiment") : MetaM α :=
6+
profileitM Exception msg ({ : Options }.setBool `profiler true |>.setNat `profiler.threshold 0) k
7+
8+
def genTerm (n : Nat) : Expr := Id.run do
9+
let mut e := mkConst ``True
10+
let nat := mkConst ``Nat
11+
for _ in 0...n do
12+
let eq := mkApp3 (mkConst ``Eq [1]) nat (mkBVar 0) (mkNatAdd (mkBVar 2) (mkBVar 1))
13+
e := mkApp2 (mkConst ``And) eq e
14+
e := mkApp2 (mkConst ``Exists [1]) nat (mkLambda `y .default nat e)
15+
e := mkForall `x .default nat e
16+
e := mkLet `z nat (mkNatAdd (mkBVar 1) (mkBVar 0)) e
17+
let eq := mkApp3 (mkConst ``Eq [1]) nat (mkBVar 0) (mkNatAdd (mkBVar 2) (mkBVar 1))
18+
e := mkApp2 (mkConst ``And) eq e
19+
e := mkApp2 (mkConst ``Exists [1]) nat (mkLambda `y .default nat e)
20+
e := mkForall `x .default nat e
21+
e := mkLet `z nat (mkNatLit 0) e
22+
return e
23+
24+
set_option maxRecDepth 10000000
25+
26+
def tryIntros? (goals : List Goal) : SymM (Option (List Goal)) := do
27+
try
28+
let goal :: goals := goals | return none
29+
let (_, goal') ← intros goal
30+
return some (goal' :: goals)
31+
catch _ =>
32+
return none
33+
34+
def tryApply? (rule : BackwardRule) (goals : List Goal) : SymM (Option (List Goal)) := do
35+
let goal :: goals := goals | return none
36+
try
37+
let goals' ← rule.apply goal
38+
return some (goals' ++ goals)
39+
catch _ =>
40+
return none
41+
42+
def tryApplyAny? (rules : List BackwardRule) (goals : List Goal) : SymM (Option (List Goal)) := do
43+
match rules with
44+
| [] => return none
45+
| rule :: rules =>
46+
if let some goals' ← tryApply? rule goals then
47+
return some goals'
48+
else
49+
tryApplyAny? rules goals
50+
51+
def solve (n : Nat) (type : Expr) : MetaM Unit := profileM (msg := s!"size {n}") <| SymM.run' do
52+
let mvarId := (← mkFreshExprMVar type).mvarId!
53+
let rules ← [``Exists.intro, ``And.intro, ``Eq.refl, ``True.intro].mapM fun declName => mkBackwardRuleFromDecl declName
54+
let goal ← mkGoal mvarId
55+
discard <| go 10000000 rules [goal]
56+
return ()
57+
where
58+
go (fuel : Nat) (rules : List BackwardRule) (goals : List Goal) : SymM Bool := do
59+
let fuel + 1 := fuel | throwError "out of fuel"
60+
let goal :: goals' := goals | return true
61+
if (← goal.mvarId.isAssigned) then
62+
go fuel rules goals'
63+
else
64+
if let some goals' ← tryIntros? goals then
65+
go fuel rules goals'
66+
else if let some goals' ← tryApplyAny? rules goals then
67+
go fuel rules goals'
68+
else
69+
throwError "Stuck at {goal.mvarId}"
70+
71+
def test (n : Nat) : MetaM Unit := do
72+
let e := genTerm n
73+
solve n e
74+
75+
-- We are solving problems of the following form
76+
#eval logInfo (genTerm 2)
77+
78+
#eval test 1000
79+
#eval test 2000
80+
#eval test 3000
81+
#eval test 4000
82+
#eval test 5000
83+
#eval test 6000

0 commit comments

Comments
 (0)