lean4-htt/tests/bench/sym/simp_4.lean
Leonardo de Moura d92cdae8e9
feat: simpForall and simpArrow in Sym.simp (#11950)
This PR implements `simpForall` and `simpArrow` in `Sym.simp`.
2026-01-09 06:20:04 +00:00

117 lines
3.4 KiB
Text
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

import Lean
open Lean Meta
opaque f : Nat → Nat
namespace SimpBench
/-!
## `SymM` Simplifier benchmarks
-/
def getProofSize (r : Sym.Simp.Result) : MetaM Nat := do
match r with
| .rfl _ => return 0
| .step _ p _ => (ShareCommon.shareCommon' p).numObjs
def checkWithKernel (r : Sym.Simp.Result) : MetaM Float := do
match r with
| .rfl _ => return 0.0
| .step _ p _ =>
let p := ShareCommon.shareCommon' p
let startTime ← IO.monoNanosNow
Meta.checkWithKernel p
let endTime ← IO.monoNanosNow
return (endTime - startTime).toFloat / 1000000.0
def mkSimpMethods : MetaM Sym.Simp.Methods := do
let thms : Sym.Simp.Theorems := {}
let thms := thms.insert (← Sym.Simp.mkTheoremFromDecl ``Nat.zero_add)
let thms := thms.insert (← Sym.Simp.mkTheoremFromDecl ``Nat.add_zero)
return { post := thms.rewrite }
def simp (e : Expr) : MetaM (Sym.Simp.Result × Float) := Sym.SymM.run do
let e ← Grind.shareCommon e
let methods ← mkSimpMethods
let startTime ← IO.monoNanosNow
let r ← Sym.simp e methods { maxSteps := 100000000 }
let endTime ← IO.monoNanosNow
let timeMs := (endTime - startTime).toFloat / 1000000.0
-- logInfo e
-- match r with
-- | .rfl _ => logInfo "rfl"
-- | .step e' h _ =>
-- logInfo e'; logInfo h
return (r, timeMs)
def ppExample (e : Expr) (info := false) : MetaM Unit := do
IO.println "Example:"
IO.println (← ppExpr e)
IO.println "====>"
match (← simp e).1 with
| .rfl _ => IO.println "<no change>"
| .step e' h _ =>
IO.println (← ppExpr e')
IO.println "Proof:"
if info then
logInfo h
else
IO.println (← ppExpr h)
IO.println ""
def benchSimp (name : String) (e : Expr) (check := false) : MetaM Unit := do
let (r, timeMs) ← simp e
let proofSize ← getProofSize r
if check then
let kMs ← checkWithKernel r
IO.println s!"{name}: {timeMs}ms, kernel: {kMs}ms, proof_size={proofSize}"
else
IO.println s!"{name}: {timeMs}ms, proof_size={proofSize}"
def mkForallPrefix (n : Nat) (k : Array Expr → MetaM Expr) : MetaM Expr := do
let rec go (n : Nat) (xs : Array Expr) : MetaM Expr := do
match n with
| 0 => mkForallFVars xs (← k xs)
| n+1 =>
withLocalDeclD `x (mkConst ``Nat) fun x =>
go n (xs.push x)
go n #[]
def mkForallBench (n : Nat) : MetaM Expr :=
mkForallPrefix n fun xs => do
let rec go (n : Nat) (e : Expr) : MetaM Expr := do
match n with
| 0 => return e
| n+1 =>
let p₁ := mkNatEq xs[n]! (mkNatAdd (mkNatLit 0) xs[n]!)
let p₂ := mkNatEq (mkNatAdd (mkNatLit 0) xs[n]!) xs[n]!
let q := mkNatEq (mkNatLit 1) xs[n]!
if n % 2 == 0 then
go n (← mkArrow p₁ (← mkArrow q e))
else
go n (← mkArrow (← mkArrow p₁ p₂) e)
go n (mkConst ``True)
def benchForall (n : Nat) (check := false) : MetaM Unit := do
let e ← mkForallBench n
benchSimp s!"forall_{n}" e check
set_option maxRecDepth 100000
/-! ## Run all benchmarks -/
def runAllBenchmarks : MetaM Unit := do
IO.println "=== Simplifier Forall Telescope Stress Tests ==="
IO.println ""
benchForall 600 false
if true then return ()
IO.println ""
IO.println "--- Benchmark 1: Forall Telescope block ---"
ppExample (← mkForallBench 10)
for n in [10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 300, 400] do
benchForall n (n < 500)
#eval runAllBenchmarks
end SimpBench