feat: Congruence tactics
This commit is contained in:
parent
2f951c8fef
commit
cc74d41b15
|
@ -1,3 +1,4 @@
|
||||||
|
|
||||||
|
import Pantograph.Tactic.Congruence
|
||||||
import Pantograph.Tactic.MotivatedApply
|
import Pantograph.Tactic.MotivatedApply
|
||||||
import Pantograph.Tactic.NoConfuse
|
import Pantograph.Tactic.NoConfuse
|
||||||
|
|
|
@ -0,0 +1,78 @@
|
||||||
|
import Lean
|
||||||
|
|
||||||
|
open Lean
|
||||||
|
|
||||||
|
namespace Pantograph.Tactic
|
||||||
|
|
||||||
|
def congruenceArg: Elab.Tactic.TacticM Unit := do
|
||||||
|
let goal ← Elab.Tactic.getMainGoal
|
||||||
|
let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
|
||||||
|
-- Create the descendant goals
|
||||||
|
|
||||||
|
let nextGoals ← goal.withContext do
|
||||||
|
let u ← Meta.mkFreshLevelMVar
|
||||||
|
let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
|
||||||
|
let f ← Meta.mkFreshExprMVar (.some <| .forallE .anonymous alpha beta .default)
|
||||||
|
.synthetic (userName := goal.name ++ `f)
|
||||||
|
let a₁ ← Meta.mkFreshExprMVar (.some alpha)
|
||||||
|
.synthetic (userName := goal.name ++ `a₁)
|
||||||
|
let a₂ ← Meta.mkFreshExprMVar (.some alpha)
|
||||||
|
.synthetic (userName := goal.name ++ `a₂)
|
||||||
|
let h ← Meta.mkEq a₁ a₂
|
||||||
|
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f a₁) (.app f a₂)) (← goal.getType)
|
||||||
|
let conduit ← Meta.mkFreshExprMVar conduitType
|
||||||
|
.synthetic (userName := goal.name ++ `conduit)
|
||||||
|
goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrArg f h)
|
||||||
|
return [alpha, a₁, a₂, f, h, conduit]
|
||||||
|
Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
|
||||||
|
|
||||||
|
def congruenceFun: Elab.Tactic.TacticM Unit := do
|
||||||
|
let goal ← Elab.Tactic.getMainGoal
|
||||||
|
let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
|
||||||
|
-- Create the descendant goals
|
||||||
|
|
||||||
|
let nextGoals ← goal.withContext do
|
||||||
|
let u ← Meta.mkFreshLevelMVar
|
||||||
|
let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
|
||||||
|
let fType := .forallE .anonymous alpha beta .default
|
||||||
|
let f₁ ← Meta.mkFreshExprMVar (.some fType)
|
||||||
|
.synthetic (userName := goal.name ++ `f₁)
|
||||||
|
let f₂ ← Meta.mkFreshExprMVar (.some fType)
|
||||||
|
.synthetic (userName := goal.name ++ `f₂)
|
||||||
|
let a ← Meta.mkFreshExprMVar (.some alpha)
|
||||||
|
.synthetic (userName := goal.name ++ `a)
|
||||||
|
let h ← Meta.mkEq f₁ f₂
|
||||||
|
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a) (.app f₂ a)) (← goal.getType)
|
||||||
|
let conduit ← Meta.mkFreshExprMVar conduitType
|
||||||
|
.synthetic (userName := goal.name ++ `conduit)
|
||||||
|
goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongrFun h a)
|
||||||
|
return [alpha, f₁, f₂, h, a, conduit]
|
||||||
|
Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
|
||||||
|
|
||||||
|
def congruence: Elab.Tactic.TacticM Unit := do
|
||||||
|
let goal ← Elab.Tactic.getMainGoal
|
||||||
|
let .some (beta, _, _) := (← goal.getType).eq? | throwError "Goal is not an Eq"
|
||||||
|
-- Create the descendant goals
|
||||||
|
|
||||||
|
let nextGoals ← goal.withContext do
|
||||||
|
let u ← Meta.mkFreshLevelMVar
|
||||||
|
let alpha ← Meta.mkFreshExprMVar (.some $ mkSort u) .natural .anonymous
|
||||||
|
let fType := .forallE .anonymous alpha beta .default
|
||||||
|
let f₁ ← Meta.mkFreshExprMVar (.some fType)
|
||||||
|
.synthetic (userName := goal.name ++ `f₁)
|
||||||
|
let f₂ ← Meta.mkFreshExprMVar (.some fType)
|
||||||
|
.synthetic (userName := goal.name ++ `f₂)
|
||||||
|
let a₁ ← Meta.mkFreshExprMVar (.some alpha)
|
||||||
|
.synthetic (userName := goal.name ++ `a₁)
|
||||||
|
let a₂ ← Meta.mkFreshExprMVar (.some alpha)
|
||||||
|
.synthetic (userName := goal.name ++ `a₂)
|
||||||
|
let h₁ ← Meta.mkEq f₁ f₂
|
||||||
|
let h₂ ← Meta.mkEq a₁ a₂
|
||||||
|
let conduitType ← Meta.mkEq (← Meta.mkEq (.app f₁ a₁) (.app f₂ a₂)) (← goal.getType)
|
||||||
|
let conduit ← Meta.mkFreshExprMVar conduitType
|
||||||
|
.synthetic (userName := goal.name ++ `conduit)
|
||||||
|
goal.assign $ ← Meta.mkEqMP conduit (← Meta.mkCongr h₁ h₂)
|
||||||
|
return [alpha, f₁, f₂, a₁, a₂, h₁, h₂, conduit]
|
||||||
|
Elab.Tactic.setGoals <| nextGoals.map (·.mvarId!)
|
||||||
|
|
||||||
|
end Pantograph.Tactic
|
Loading…
Reference in New Issue