File: Mathlib/Tactic/Relation/Trans.lean

full_name: Mathlib.Tactic.initFn._@.Mathlib.Tactic.Relation.Trans._hyg.6
code: initialize registerTraceClass `Tactic.trans
goal: IO Unit

full_name: Mathlib.Tactic.transExt.config
code: /-- Discrimation tree settings for the `trans` extension. -/
def transExt.config : WhnfCoreConfig 
goal: Lean.Meta.WhnfCoreConfig

full_name: Mathlib.Tactic.transExt
code: /-- Environment extension storing transitivity lemmas -/
initialize transExt :
    SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ←
  registerSimpleScopedEnvExtension {
    addEntry := fun dt (n, ks) ↦ dt.insertCore ks n
    initial := {}
  }
goal: Lean.SimpleScopedEnvExtension (Lean.Name × Array Lean.Meta.DiscrTree.Key) (Lean.Meta.DiscrTree Lean.Name)

full_name: Mathlib.Tactic.initFn._@.Mathlib.Tactic.Relation.Trans._hyg.62
code: /-- Environment extension storing transitivity lemmas -/
initialize transExt :
    SimpleScopedEnvExtension (Name × Array DiscrTree.Key) (DiscrTree Name) ←
  registerSimpleScopedEnvExtension {
    addEntry := fun dt (n, ks) ↦ dt.insertCore ks n
    initial := {}
  }
goal: IO (Lean.SimpleScopedEnvExtension (Lean.Name × Array Lean.Meta.DiscrTree.Key) (Lean.Meta.DiscrTree Lean.Name))

full_name: Mathlib.Tactic.initFn._@.Mathlib.Tactic.Relation.Trans._hyg.147
code: initialize registerBuiltinAttribute {
  name := `trans
  descr := "transitive relation"
  add := fun decl _ kind ↦ MetaM.run' do
    let declTy := (← getConstInfo decl).type
    let (xs, _, targetTy) ← withReducible <| forallMetaTelescopeReducing declTy
    let fail := throwError
      "@[trans] attribute only applies to lemmas proving
      x ∼ y → y ∼ z → x ∼ z, got {indentExpr declTy} with target {indentExpr targetTy}"
    let .app (.app rel _) _ := targetTy | fail
    let some yzHyp := xs.back? | fail
    let some xyHyp := xs.pop.back? | fail
    let .app (.app _ _) _ ← inferType yzHyp | fail
    let .app (.app _ _) _ ← inferType xyHyp | fail
    let key ← withReducible <| DiscrTree.mkPath rel transExt.config
    transExt.add (decl, key) kind
}
goal: IO Unit

full_name: Trans.simple
code: /-- Composition using the `Trans` class in the homogeneous case. -/
def _root_.Trans.simple {α : Sort u} {r : α → α → Sort v} {a b c : α} [Trans r r r] :
    r a b → r b c → r a c 
goal: r a b → r b c → r a c

full_name: Trans.het
code: /-- Composition using the `Trans` class in the general case. -/
def _root_.Trans.het {α β γ : Sort*} {a : α} {b : β} {c : γ}
    {r : α → β → Sort u} {s : β → γ → Sort v} {t : outParam (α → γ → Sort w)} [Trans r s t] :
    r a b → s b c → t a c 
goal: r a b → s b c → t a c

full_name: Mathlib.Tactic.getExplicitFuncArg?
code: /-- solving `e ← mkAppM' f #[x]` -/
def getExplicitFuncArg? (e : Expr) : MetaM (Option <| Expr × Expr) 
goal: Lean.MetaM (Option (Lean.Expr × Lean.Expr))

full_name: Mathlib.Tactic.getExplicitRelArg?
code: /-- solving `tgt ← mkAppM' rel #[x, z]` given `tgt = f z` -/
def getExplicitRelArg? (tgt f z : Expr) : MetaM (Option <| Expr × Expr) 
goal: Lean.MetaM (Option (Lean.Expr × Lean.Expr))

full_name: Mathlib.Tactic.getExplicitRelArgCore
code: /-- refining `tgt ← mkAppM' rel #[x, z]` dropping more arguments if possible -/
def getExplicitRelArgCore (tgt rel x z : Expr) : MetaM (Expr × Expr) 
goal: Lean.MetaM (Lean.Expr × Lean.Expr)

full_name: Mathlib.Tactic.TransRelation.app
code: /-- Internal definition for `trans` tactic. Either a binary relation or a non-dependent
arrow. -/
inductive TransRelation
  | app (rel : Expr)
  | implies (name : Name) (bi : BinderInfo)
goal: Mathlib.Tactic.TransRelation

full_name: Mathlib.Tactic.TransRelation.implies
code: /-- Internal definition for `trans` tactic. Either a binary relation or a non-dependent
arrow. -/
inductive TransRelation
  | app (rel : Expr)
  | implies (name : Name) (bi : BinderInfo)
goal: Mathlib.Tactic.TransRelation

full_name: Mathlib.Tactic.TransRelation
code: /-- Internal definition for `trans` tactic. Either a binary relation or a non-dependent
arrow. -/
inductive TransRelation
  | app (rel : Expr)
  | implies (name : Name) (bi : BinderInfo)
goal: Type

full_name: Mathlib.Tactic.getRel
code: /-- Finds an explicit binary relation in the argument, if possible. -/
def getRel (tgt : Expr) : MetaM (Option (TransRelation × Expr × Expr)) 
goal: Lean.MetaM (Option (Mathlib.Tactic.TransRelation × Lean.Expr × Lean.Expr))

full_name: Mathlib.Tactic.tacticTrans___
code: /--
`trans` applies to a goal whose target has the form `t ~ u` where `~` is a transitive relation,
that is, a relation which has a transitivity lemma tagged with the attribute [trans].

* `trans s` replaces the goal with the two subgoals `t ~ s` and `s ~ u`.
* If `s` is omitted, then a metavariable is used instead.

Additionally, `trans` also applies to a goal whose target has the form `t → u`,
in which case it replaces the goal with `t → s` and `s → u`.
-/
elab "trans" t?:(ppSpace colGt term)? : tactic => withMainContext do
  let tgt ← getMainTarget''
  let .some (rel, x, z) ← getRel tgt |
    throwError (m!"transitivity lemmas only apply to binary relations and " ++
                m!"non-dependent arrows, not {indentExpr tgt}")
  match rel with
  | .implies name info =>
    -- only consider non-dependent arrows
    if z.hasLooseBVars then
      throwError "`trans` is not implemented for dependent arrows{indentExpr tgt}"
    -- parse the intermeditate term
    let middleType ← mkFreshExprMVar none
    let t'? ← t?.mapM (elabTermWithHoles · middleType (← getMainTag))
    let middle ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar middleType)
    liftMetaTactic fun goal => do
      -- create two new goals
      let g₁ ← mkFreshExprMVar (some <| .forallE name x middle info) .synthetic
      let g₂ ← mkFreshExprMVar (some <| .forallE name middle z info) .synthetic
      -- close the original goal with `fun x => g₂ (g₁ x)`
      goal.assign (.lam name x (.app g₂ (.app g₁ (.bvar 0))) .default)
      pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [middle.mvarId!]
    return
  | .app rel =>
    trace[Tactic.trans]"goal decomposed"
    trace[Tactic.trans]"rel: {indentExpr rel}"
    trace[Tactic.trans]"x: {indentExpr x}"
    trace[Tactic.trans]"z: {indentExpr z}"
    -- first trying the homogeneous case
    try
      let ty ← inferType x
      let t'? ← t?.mapM (elabTermWithHoles · ty (← getMainTag))
      let s ← saveState
      trace[Tactic.trans]"trying homogeneous case"
      let lemmas :=
        (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push ``Trans.simple
      for lem in lemmas do
        trace[Tactic.trans]"trying lemma {lem}"
        try
          liftMetaTactic fun g ↦ do
            let lemTy ← inferType (← mkConstWithLevelParams lem)
            let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ ↦ pure es.size
            let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar ty)
            let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic
            let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic
            g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂]))
            pure <| [g₁.mvarId!, g₂.mvarId!] ++
              if let some (_, gs') := t'? then gs' else [y.mvarId!]
          return
        catch _ => s.restore
      pure ()
    catch _ =>
    trace[Tactic.trans]"trying heterogeneous case"
    let t'? ← t?.mapM (elabTermWithHoles · none (← getMainTag))
    let s ← saveState
    for lem in (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push
        ``HEq.trans |>.push ``HEq.trans do
      try
        liftMetaTactic fun g ↦ do
          trace[Tactic.trans]"trying lemma {lem}"
          let lemTy ← inferType (← mkConstWithLevelParams lem)
          let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ ↦ pure es.size
          trace[Tactic.trans]"arity: {arity}"
          trace[Tactic.trans]"lemma-type: {lemTy}"
          let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar none)
          trace[Tactic.trans]"obtained y: {y}"
          trace[Tactic.trans]"rel: {indentExpr rel}"
          trace[Tactic.trans]"x:{indentExpr x}"
          trace[Tactic.trans]"z:  {indentExpr z}"
          let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic
          trace[Tactic.trans]"obtained g₂: {g₂}"
          let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic
          trace[Tactic.trans]"obtained g₁: {g₁}"
          g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂]))
          pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [y.mvarId!]
        return
      catch e =>
        trace[Tactic.trans]"failed: {e.toMessageData}"
        s.restore
    throwError m!"no applicable transitivity lemma found for {indentExpr tgt}"
goal: Lean.ParserDescr

full_name: Mathlib.Tactic._aux_Mathlib_Tactic_Relation_Trans___elabRules_Mathlib_Tactic_tacticTrans____1
code: /--
`trans` applies to a goal whose target has the form `t ~ u` where `~` is a transitive relation,
that is, a relation which has a transitivity lemma tagged with the attribute [trans].

* `trans s` replaces the goal with the two subgoals `t ~ s` and `s ~ u`.
* If `s` is omitted, then a metavariable is used instead.

Additionally, `trans` also applies to a goal whose target has the form `t → u`,
in which case it replaces the goal with `t → s` and `s → u`.
-/
elab "trans" t?:(ppSpace colGt term)? : tactic => withMainContext do
  let tgt ← getMainTarget''
  let .some (rel, x, z) ← getRel tgt |
    throwError (m!"transitivity lemmas only apply to binary relations and " ++
                m!"non-dependent arrows, not {indentExpr tgt}")
  match rel with
  | .implies name info =>
    -- only consider non-dependent arrows
    if z.hasLooseBVars then
      throwError "`trans` is not implemented for dependent arrows{indentExpr tgt}"
    -- parse the intermeditate term
    let middleType ← mkFreshExprMVar none
    let t'? ← t?.mapM (elabTermWithHoles · middleType (← getMainTag))
    let middle ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar middleType)
    liftMetaTactic fun goal => do
      -- create two new goals
      let g₁ ← mkFreshExprMVar (some <| .forallE name x middle info) .synthetic
      let g₂ ← mkFreshExprMVar (some <| .forallE name middle z info) .synthetic
      -- close the original goal with `fun x => g₂ (g₁ x)`
      goal.assign (.lam name x (.app g₂ (.app g₁ (.bvar 0))) .default)
      pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [middle.mvarId!]
    return
  | .app rel =>
    trace[Tactic.trans]"goal decomposed"
    trace[Tactic.trans]"rel: {indentExpr rel}"
    trace[Tactic.trans]"x: {indentExpr x}"
    trace[Tactic.trans]"z: {indentExpr z}"
    -- first trying the homogeneous case
    try
      let ty ← inferType x
      let t'? ← t?.mapM (elabTermWithHoles · ty (← getMainTag))
      let s ← saveState
      trace[Tactic.trans]"trying homogeneous case"
      let lemmas :=
        (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push ``Trans.simple
      for lem in lemmas do
        trace[Tactic.trans]"trying lemma {lem}"
        try
          liftMetaTactic fun g ↦ do
            let lemTy ← inferType (← mkConstWithLevelParams lem)
            let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ ↦ pure es.size
            let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar ty)
            let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic
            let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic
            g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂]))
            pure <| [g₁.mvarId!, g₂.mvarId!] ++
              if let some (_, gs') := t'? then gs' else [y.mvarId!]
          return
        catch _ => s.restore
      pure ()
    catch _ =>
    trace[Tactic.trans]"trying heterogeneous case"
    let t'? ← t?.mapM (elabTermWithHoles · none (← getMainTag))
    let s ← saveState
    for lem in (← (transExt.getState (← getEnv)).getUnify rel transExt.config).push
        ``HEq.trans |>.push ``HEq.trans do
      try
        liftMetaTactic fun g ↦ do
          trace[Tactic.trans]"trying lemma {lem}"
          let lemTy ← inferType (← mkConstWithLevelParams lem)
          let arity ← withReducible <| forallTelescopeReducing lemTy fun es _ ↦ pure es.size
          trace[Tactic.trans]"arity: {arity}"
          trace[Tactic.trans]"lemma-type: {lemTy}"
          let y ← (t'?.map (pure ·.1)).getD (mkFreshExprMVar none)
          trace[Tactic.trans]"obtained y: {y}"
          trace[Tactic.trans]"rel: {indentExpr rel}"
          trace[Tactic.trans]"x:{indentExpr x}"
          trace[Tactic.trans]"z:  {indentExpr z}"
          let g₂ ← mkFreshExprMVar (some <| ← mkAppM' rel #[y, z]) .synthetic
          trace[Tactic.trans]"obtained g₂: {g₂}"
          let g₁ ← mkFreshExprMVar (some <| ← mkAppM' rel #[x, y]) .synthetic
          trace[Tactic.trans]"obtained g₁: {g₁}"
          g.assign (← mkAppOptM lem (mkArray (arity - 2) none ++ #[some g₁, some g₂]))
          pure <| [g₁.mvarId!, g₂.mvarId!] ++ if let some (_, gs') := t'? then gs' else [y.mvarId!]
        return
      catch e =>
        trace[Tactic.trans]"failed: {e.toMessageData}"
        s.restore
    throwError m!"no applicable transitivity lemma found for {indentExpr tgt}"
goal: Lean.Elab.Tactic.Tactic

full_name: Mathlib.Tactic.tacticTransitivity___
code: syntax "transitivity" (ppSpace colGt term)? : tactic
goal: Lean.ParserDescr

full_name: Mathlib.Tactic._aux_Mathlib_Tactic_Relation_Trans___macroRules_Mathlib_Tactic_tacticTransitivity____1
code: macro_rules
  | `(tactic| transitivity) => `(tactic| trans)
  | `(tactic| transitivity $e) => `(tactic| trans $e)
goal: Lean.Macro