Compare commits

...

2 Commits

Author SHA1 Message Date
Leonardo de Moura
114664341e refactor: remove Cbv.mkAppNS alias, use Sym.Internal.mkAppNS directly
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-03 19:21:10 -07:00
Leonardo de Moura
dd6947548b feat: add mkAppNS, mkAppRevS, betaRevS, betaS, and related Sym functions
This PR adds a comprehensive public API for constructing maximally shared
expression applications and performing beta reduction in the `Sym` framework.
These functions were previously defined locally in the VC generator and cbv
tactic, and are needed by downstream `SymM`-based tools.

New functions in `Lean.Meta.Sym.Internal` (generic over `MonadShareCommon`):
- `mkAppS₆` through `mkAppS₁₁`
- `mkAppRangeS`, `mkAppNS`, `mkAppRevRangeS`, `mkAppRevS`

New public functions in `Lean.Meta.Sym` (`SymM`):
- `betaRevS`, `betaS`
- `mkForallFVarsS`

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-03 19:18:57 -07:00
5 changed files with 74 additions and 20 deletions

View File

@@ -97,4 +97,16 @@ public def mkLambdaFVarsS (xs : Array Expr) (e : Expr) : SymM Expr := do
let type abstractFVarsRange decl.type i xs
mkLambdaS decl.userName decl.binderInfo type b
/--
Similar to `mkForallFVars`, but uses the more efficient `abstractFVars` and `abstractFVarsRange`,
and makes the same assumption made by these functions.
-/
public def mkForallFVarsS (xs : Array Expr) (e : Expr) : SymM Expr := do
let b abstractFVars e xs
xs.size.foldRevM (init := b) fun i _ b => do
let x := xs[i]
let decl x.fvarId!.getDecl
let type abstractFVarsRange decl.type i xs
mkForallS decl.userName decl.binderInfo type b
end Lean.Meta.Sym

View File

@@ -189,4 +189,48 @@ def mkAppS₄ (f a₁ a₂ a₃ a₄ : Expr) : m Expr := do
def mkAppS₅ (f a₁ a₂ a₃ a₄ a₅ : Expr) : m Expr := do
mkAppS ( mkAppS₄ f a₁ a₂ a₃ a₄) a₅
def mkAppS₆ (f a₁ a₂ a₃ a₄ a₅ a₆ : Expr) : m Expr := do
mkAppS ( mkAppS₅ f a₁ a₂ a₃ a₄ a₅) a₆
def mkAppS₇ (f a₁ a₂ a₃ a₄ a₅ a₆ a₇ : Expr) : m Expr := do
mkAppS ( mkAppS₆ f a₁ a₂ a₃ a₄ a₅ a₆) a₇
def mkAppS₈ (f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ : Expr) : m Expr := do
mkAppS ( mkAppS₇ f a₁ a₂ a₃ a₄ a₅ a₆ a₇) a₈
def mkAppS₉ (f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ a₉ : Expr) : m Expr := do
mkAppS ( mkAppS₈ f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈) a₉
def mkAppS₁₀ (f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ a₉ a₁₀ : Expr) : m Expr := do
mkAppS ( mkAppS₉ f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ a₉) a₁₀
def mkAppS₁₁ (f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ a₉ a₁₀ a₁₁ : Expr) : m Expr := do
mkAppS ( mkAppS₁₀ f a₁ a₂ a₃ a₄ a₅ a₆ a₇ a₈ a₉ a₁₀) a₁₁
/-- `mkAppRangeS f i j #[a₀, ..., aᵢ, ..., aⱼ, ...]` ==> `f aᵢ ... aⱼ₋₁` with max sharing. -/
partial def mkAppRangeS (f : Expr) (beginIdx endIdx : Nat) (args : Array Expr) : m Expr :=
go endIdx f beginIdx
where
go (endIdx : Nat) (b : Expr) (i : Nat) : m Expr := do
if endIdx i then return b
else go endIdx ( mkAppS b args[i]!) (i + 1)
/-- `mkAppNS f #[a₀, ..., aₙ]` constructs `f a₀ ... aₙ` with max sharing. -/
def mkAppNS (f : Expr) (args : Array Expr) : m Expr :=
mkAppRangeS f 0 args.size args
/-- `mkAppRevRangeS f b e revArgs` ==> `mkAppRev f (revArgs.extract b e)` with max sharing. -/
partial def mkAppRevRangeS (f : Expr) (beginIdx endIdx : Nat) (revArgs : Array Expr) : m Expr :=
go revArgs beginIdx f endIdx
where
go (revArgs : Array Expr) (start : Nat) (b : Expr) (i : Nat) : m Expr := do
if i start then return b
else
let i := i - 1
go revArgs start ( mkAppS b revArgs[i]!) i
/-- Same as `mkAppS f args` but reversing `args`, with max sharing. -/
def mkAppRevS (f : Expr) (revArgs : Array Expr) : m Expr :=
mkAppRevRangeS f 0 revArgs.size revArgs
end Lean.Meta.Sym.Internal

View File

@@ -86,22 +86,8 @@ It assumes the input is maximally shared, and ensures the output is too.
public def instantiateS (e : Expr) (subst : Array Expr) : SymM Expr :=
liftBuilderM <| instantiateS' e subst
/-- `mkAppRevRangeS f b e args == mkAppRev f (revArgs.extract b e)` -/
def mkAppRevRangeS (f : Expr) (beginIdx endIdx : Nat) (revArgs : Array Expr) : AlphaShareBuilderM Expr :=
loop revArgs beginIdx f endIdx
where
loop (revArgs : Array Expr) (start : Nat) (b : Expr) (i : Nat) : AlphaShareBuilderM Expr := do
if i start then
return b
else
let i := i - 1
loop revArgs start ( mkAppS b revArgs[i]!) i
/--
Beta-reduces `f` applied to reversed arguments `revArgs`, ensuring maximally shared terms.
`betaRevS f #[a₃, a₂, a₁]` computes the beta-normal form of `f a₁ a₂ a₃`.
-/
partial def betaRevS (f : Expr) (revArgs : Array Expr) : AlphaShareBuilderM Expr :=
/-- Internal variant of `betaRevS` that runs in `AlphaShareBuilderM`. -/
private partial def betaRevS' (f : Expr) (revArgs : Array Expr) : AlphaShareBuilderM Expr :=
if revArgs.size == 0 then
return f
else
@@ -173,7 +159,7 @@ where
| .bvar bidx =>
let f' visitBVar f bidx offset
if modified || !isSameExpr f f' then
betaRevS f' argsRev
betaRevS' f' argsRev
else
return e
| _ => unreachable!
@@ -215,4 +201,18 @@ public def instantiateRevBetaS (e : Expr) (subst : Array Expr) : SymM Expr := do
if !e.hasLooseBVars || subst.isEmpty then return e
else liftBuilderM <| instantiateRevBetaS' e subst
/--
Beta-reduces `f` applied to reversed arguments `revArgs`, ensuring maximally shared terms.
`betaRevS f #[a₃, a₂, a₁]` computes the beta-normal form of `f a₁ a₂ a₃`.
-/
public def betaRevS (f : Expr) (revArgs : Array Expr) : SymM Expr :=
liftBuilderM <| betaRevS' f revArgs
/--
Apply the given arguments to `f`, beta-reducing if `f` is a lambda expression,
ensuring maximally shared terms. See `betaRevS` for details.
-/
public def betaS (f : Expr) (args : Array Expr) : SymM Expr :=
betaRevS f args.reverse
end Lean.Meta.Sym

View File

@@ -283,6 +283,7 @@ def handleProj : Simproc := fun e => do
let newProof mkEqOfHEq newProof (check := false)
return .step ( Lean.Expr.updateProjS! e e') newProof
open Sym.Internal in
/--
For an application whose head is neither a constant nor a lambda (e.g. a projection
like `p.1 x`), simplify the function head and lift the proof via `congrArg`.

View File

@@ -24,9 +24,6 @@ namespace Lean.Meta.Tactic.Cbv
open Lean.Meta.Sym.Simp
public def mkAppNS (f : Expr) (args : Array Expr) : Sym.SymM Expr := do
args.foldlM Sym.Internal.mkAppS f
abbrev isNatValue (e : Expr) : Bool := (Sym.getNatValue? e).isSome
abbrev isStringValue (e : Expr) : Bool := (Sym.getStringValue? e).isSome
abbrev isIntValue (e : Expr) : Bool := (Sym.getIntValue? e).isSome