import tactic.linarith
import lib.interactive_expr

meta def rel_symb : expr → tactic (expr × expr × string)
| `(%%x < %%y) := pure (x, y, " < ")
| `(%%x ≤ %%y) := pure (x, y, " ≤ ")
| `(%%x > %%y) := pure (x, y, " > ")
| `(%%x ≥ %%y) := pure (x, y, " ≥ ")
| `(%%x ∈ %%y) := pure (x, y, " ∈ ")
| e := do pe ← tactic.pp e, tactic.fail $ "Not a relation: " ++ pe.to_string

section
open expr

/-- Une version de `expr.rename_var` qui renomme même les variables libres. -/
meta def expr.rename (old new : name) : expr → expr
| (pi n bi t b) := (pi (if n = old then new else n) bi (expr.rename t) (expr.rename b))
| (lam n bi t b) := (lam (if n = old then new else n) bi (expr.rename t) (expr.rename b))
| (app t b) := (app (expr.rename t) (expr.rename b))
| (local_const n nn bi t) := (local_const (if n = old then new else n) (if nn = old then new else nn) bi $ expr.rename t)
| e := e

end

/-- Mini language d'expression où les quantificateurs bornés et les connecteurs ∧, ∨ et ↔ sont des citoyens à part entière. -/
meta inductive my_expr
| forall_rel (var_name : name) (typ : expr) (rel : string) (rel_rhs : expr) (propo : my_expr) : my_expr
| forall_simple (var_name : name) (typ : expr) (propo : my_expr) : my_expr
| exist_rel (var_name : name) (typ : expr) (rel : string) (rel_rhs : expr) (propo : my_expr) : my_expr
| exist_simple (var_name : name) (typ : expr) (propo : my_expr) : my_expr
| conjunction (propo propo' : my_expr) : my_expr
| disjunction (propo propo' : my_expr) : my_expr
| impl (le re : expr) (lhs : my_expr) (rhs : my_expr) : my_expr
| ssi (le re : expr) (lhs rhs : my_expr) : my_expr
| egal (le re : expr) : my_expr
| ineq (le : expr) (symb : string) (re : expr) : my_expr
| prop (e : expr) : my_expr
| data (e : expr) : my_expr

namespace my_expr

meta def tofmt : my_expr →  tactic format
| (forall_rel var_name typ rel rel_rhs propo) := do
    rhs ← tactic.pp rel_rhs,
    p ← tofmt propo,
    pure $ "∀ " ++ var_name.to_string ++ rel ++ rhs.to_string ++ ", " ++ p
| (forall_simple var_name typ propo) := do
    p ← tofmt propo,
    pure $ "∀ " ++ var_name.to_string ++ ", " ++ p
| (exist_rel var_name typ rel rel_rhs propo) := do
    rhs ← tactic.pp rel_rhs,
    p ← tofmt propo,
    pure $ "∃ " ++ var_name.to_string ++ rel ++ rhs.to_string ++ ", " ++ p
| (exist_simple var_name typ propo) := do
    p ← tofmt propo,
    pure $ "∃ " ++ var_name.to_string ++ ", " ++ p
| (conjunction propo propo') := do
    p ← tofmt propo,
    p' ← tofmt propo',
    pure $ p ++ " ∧ " ++ p'
| (disjunction propo propo') := do
    p ← tofmt propo,
    p' ← tofmt propo',
    pure $ p ++ " ∨ " ++ p'
| (impl le re lhs rhs) := do
  l ← tofmt lhs,
  r ← tofmt rhs,
  pure $ l ++ " → " ++ r
| (ssi le re lhs rhs) := do
  l ← tofmt lhs,
  r ← tofmt rhs,
  pure $ l ++ " ↔ " ++ r
| (egal le re) := do
  l ← tactic.pp le,
  r ← tactic.pp re,
  pure $ l ++ " = " ++ r
| (ineq le symb re) := do
  l ← tactic.pp le,
  r ← tactic.pp re,
  pure $ l ++ symb ++ r
| (prop e) := tactic.pp e
| (data e) := tactic.pp e

meta instance : has_to_tactic_format my_expr :=
⟨my_expr.tofmt⟩

/-- Définitions à tenter de déplier quand on ne reconnait ni un ∀ ni un ∃. -/
def unfold_defs : list name := [`borne_sup, `continue_en, `croissante, `decroissante,
  `est_borne_inf, `est_borne_sup, `extraction, `impair, `impaire, `injective,
  `limite_infinie_suite, `limite_infini_suite, `limite_moins_infini_suite,
  `limite_suite, `majorant, `majoree, `minorant, `minoree, `pair, `paire, `pgcd,
  `segment, `suite_cauchy, `suite_croissante, `suite_decroissante, `surjective,
  `valeur_adherence]

meta def parse : expr → tactic my_expr
| e@(expr.pi n bi t b) := do
    var ← tactic.mk_local' n bi t,
    match (expr.instantiate_var b var) with
    | e'@(expr.pi n' bi' t' b') :=
      do { (x, y, symbole) ← rel_symb t',
           --tactic.trace (rel_symb t'),
           when (x.local_pp_name ≠ n) $ tactic.fail "",
/-            tactic.trace "e : ", tactic.trace e,
           tactic.trace "e' : ", tactic.trace e',
           tactic.trace "n : ", tactic.trace n,
           tactic.trace "n' :", tactic.trace n',
           tactic.trace "t' :", tactic.trace t',
           tactic.trace y,
 -/           var' ← tactic.mk_local' n' bi' t',
           my_expr.forall_rel n t symbole y <$> parse (expr.instantiate_var b' var') } <|>
      do { typ ← parse t,
           body ← parse e',
           if e.is_arrow then
              pure (impl t e' typ body)
           else
             pure $ my_expr.forall_simple n t body }
    | e' := do
           typ ← parse t,
           body ← parse e',
            if e.is_arrow then
              pure (impl t e' typ body)
            else
              forall_simple n t <$> parse (expr.instantiate_var b var)
    end
|`(@Exists %%α %%p) :=
  do {
    `(@Exists %%α' %%p') ← pure p.binding_body,
    var ← tactic.mk_local' p.binding_name p.binding_info p.binding_domain,
    (x, y, symbole) ← rel_symb α'.binding_body,
    exist_rel p.binding_name α symbole y <$> parse (expr.instantiate_var p' var).binding_body } <|>
  do {
    var ← tactic.mk_local' p.binding_name p.binding_info p.binding_domain,
    exist_simple p.binding_name α <$> parse (expr.instantiate_var p.binding_body var)
    }
|`(and %%e %%e') := do
    p ← parse e,
    p' ← parse e',
    pure $ conjunction p p'
|`(or %%e %%e') := do
    p ← parse e,
    p' ← parse e',
    pure $ disjunction p p'
|`(iff %%e %%e') := do
    p ← parse e,
    p' ← parse e',
    pure $ ssi e e' p p'
|`(eq %%e %%e') := pure $ egal e e'
| `(%%x < %%y) := pure $ ineq x " < " y
| `(%%x ≤ %%y) := pure $ ineq x " ≤ " y
| `(%%x > %%y) := pure $ ineq x " > " y
| `(%%x ≥ %%y) := pure $ ineq x " ≥ " y
| e := do { e' ← tactic.delta unfold_defs e,
            tactic.trace  "Remarque : La commande",
            tactic.trace  " On déplie nom,",
            tactic.trace  "ou",
            tactic.trace  " On déplie nom dans hyp,",
            tactic.trace  "permet de déplier la définition nom dans le but ou dans une hypothèse hyp.",
            tactic.trace  "",
            parse e' } <|>
       do { t ← tactic.infer_type e, pure $ if t = `(Prop) then prop e else data e } <|> pure (prop e)

meta def rename (old new : name) : my_expr → my_expr
| (forall_rel n typ rel rel_rhs propo) := forall_rel (if n = old then new else n) typ rel rel_rhs $ rename propo
| (forall_simple n typ propo) := forall_simple (if n = old then new else n) typ $ rename propo
| (exist_rel n typ rel rel_rhs propo) := exist_rel (if n = old then new else n) typ rel rel_rhs $ rename propo
| (exist_simple n typ propo) := exist_simple (if n = old then new else n) typ $ rename propo
| (conjunction propo propo') := conjunction (rename propo) (rename propo')
| (disjunction propo propo') := disjunction (rename propo) (rename propo')
| (impl le re lhs rhs) := impl (le.rename_var old new) (re.rename_var old new) (rename lhs) (rename rhs)
| (ssi le re lhs rhs) := ssi (le.rename_var old new) (re.rename_var old new) (rename lhs) (rename rhs)
| (egal le re) := egal (le.rename_var old new) (re.rename_var old new)
| (ineq le rel re) := ineq (le.rename_var old new) rel (re.rename_var old new)
| (prop e) := prop (e.rename old new)
| (data e) := data (e.rename old new)

/- meta def P : expr := expr.local_const `P `P binder_info.default `(ℕ → Prop)
meta def n : expr := expr.local_const `n `n binder_info.default `(ℕ)
meta def m : expr := expr.app P n

run_cmd tactic.pp (expr.rename `n `k m) >>= tactic.trace

run_cmd tactic.pp ((my_expr.prop m).rename `n `k) >>= tactic.trace
 -/

end my_expr

namespace tactic.interactive
setup_tactic_parser
open tactic my_expr

meta def test (h : parse ident) : tactic unit :=
do t ← get_local h >>= infer_type,
   trace t,
   parse t >>= trace

end tactic.interactive

/- section tests
example (Q R : ℕ → Prop) (P : ℕ → ℕ → Prop)
  (h₁ : R 1 → Q 2)
  (h₂ : ∀ k ≥ 2, ∃ n ≥ 3, ∀ l, l - n = 0 → P l k)
  (h₃ : ∃ n ≥ 5, Q n)
  (h₄ : ∀ k ≥ 2, ∃ n ≥ 3, P n k)
  (h₅ : ∃ n, Q n)
  (h₆ : ∀ k, ∃ n, P n k)
  (h₇ : ∀ k ≥ 2, ∃ n, P n k)
  (h₈ : (∀ k : ℕ, Q k) → (∀ l , R l))
  (h₉ : (∀ k : ℕ, Q k) ↔ (∀ l , R l))
  (h₁₀ : ∀ k, 1 ≤ k → Q k)
  (h₁₁ : ∀ k, ∀ l, k ≤ l → P k l) : true :=
begin
  test h₁,
  test h₂,
  test h₃,
  test h₄,
  test h₅,
  test h₆,
  test h₇,
  test h₈,
  test h₉,
  test h₁₀,
  test h₁₁,
  trivial
end

end tests -/

meta def symb_to_hyp : string → expr → string
| " ≥ " `(0) := "_pos"
| " ≥ " _ := "_sup"
| " > " `(0) := "_pos"
| " > " _ := "_sup"
| " ≤ " `(0) := "_neg"
| " ≤ " _ := "_inf"
| " < " `(0) := "_neg"
| " < " _ := "_inf"
| " ∈ " _ := "_dans"
| _ _ := ""

meta def describe : string → string
| "ℝ" := "un nombre réel"
| "ℕ" := "un nombre entier naturel"
| "ℤ" := "un nombre entier relatif"
| t := "une expression de type " ++ t

meta def describe_pl : string → string
| "ℝ" := "des nombres réels"
| "ℕ" := "des nombres entiers naturels"
| "ℤ" := "des nombres entiers relatifs"
| t := "des expressions de type " ++ t

def libre (s: string) : string := "Le nom " ++ s ++ " peut être choisi librement parmi les noms disponibles."

def libres (ls : list string) : string :=
"Les noms " ++ string.intercalate ", " ls ++ " peuvent être choisis librement parmi les noms disponibles."

meta def applique_a : list format → string
| [] := ""
| [x] := " appliqué à " ++ x.to_string
| s@(x::t) := " appliqué à " ++ s.to_string

section
open tactic my_expr

meta def tactic.aide : option name → tactic unit
| (some h) := do
  let sh := h.to_string,
  eh ← get_local h <|> fail ("Il n'y a pas d'hypothèse appellée " ++ sh),
  hyp ← infer_type eh,
  but ← to_string <$> (target >>= pp),
  msg ← lock_tactic_state $ do {
    r ← tactic.apply_core eh {}, -- On essaie d'appliquer `h`
    l ← r.mmap (λ p : name × expr, tactic.instantiate_mvars p.2),  -- on instancie les méta-variables qui peuvent l'être
    l' ← (l.filter (λ v : expr, not v.is_mvar)).mmap pp, -- on regarde ce qui a réussit à être unifié à la ligne du dessus
    do { ptgt ← to_string <$> (target >>= pp), -- Cette ligne va échouer s'il ne reste plus de but après `apply`
         pure $ "  Par " ++ sh ++ applique_a l' ++ " il suffit de montrer que " ++ ptgt ++
         ",\n\nSi vous disposez déjà d'une démonstration H de " ++ ptgt ++
         " alors on peut utiliser :\n  On conclut par " ++ sh ++ applique_a (l' ++ ["H"]) ++ "," } <|>
    do { pure $ "  On conclut par " ++ sh ++ applique_a l' ++ "," }
    } <|> pure "",
  m ← parse hyp,
  match m with
  | (forall_rel var_name typ rel rel_rhs propo) := do
      py ← pp rel_rhs,
      t ← pp typ,

      let n := var_name.to_string,
      let n₀ := n ++ "₀",
      let nn₀ := mk_simple_name n₀,
      p ← to_string <$> pp (propo.rename var_name nn₀),
      match propo with
      | (exist_rel var_name' typ' rel' rel_rhs' propo') := do
        let n' := var_name'.to_string,
        py' ← to_string <$> pp rel_rhs',
        p' ← to_string <$> pp (propo'.rename var_name nn₀),
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ n ++ rel ++ py.to_string ++ ", ∃ " ++ n' ++ rel' ++ py' ++ ", ... »",
        trace "On peut l'utiliser avec :",
        trace ("  Par " ++ sh ++ " appliqué à [" ++ n₀ ++ ", h" ++ n₀ ++ "] on obtient " ++ n' ++ " tel que (" ++
          n' ++ symb_to_hyp rel' rel_rhs' ++ " : " ++ n' ++ rel' ++ py' ++ ") (h" ++ n' ++ ": " ++ p' ++ "),"),
        trace ("où " ++ n₀ ++ " est " ++ describe t.to_string ++
               " et h" ++ n₀ ++ " est une démonstration du fait que " ++ n₀ ++ rel ++ py.to_string),
        trace $ libres [n' ++ symb_to_hyp rel' rel_rhs', "h" ++ n']
      | (exist_simple var_name' typ' propo') := do
        let n' := var_name'.to_string,
        p' ← to_string <$> pp (propo'.rename var_name nn₀),
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ n ++ rel ++ py.to_string ++ ", ∃ " ++ n'  ++ ", ... »",
        trace "On peut l'utiliser avec :",
        trace ("  Par " ++ sh ++ " appliqué à [" ++ n₀ ++ ", h" ++ n₀ ++"] on obtient " ++ n' ++ " tel que (h" ++ n' ++ ": " ++ p' ++ "),"),
        trace ("où " ++ n₀ ++ " est " ++ describe t.to_string ++
               " et h" ++ n₀ ++ " est une démonstration du fait que " ++ n₀ ++ rel ++ py.to_string),
        trace $ libres [n', "h" ++ n']
      | _ := do
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ var_name.to_string ++ rel ++ py.to_string ++ ", »",
        trace "On peut l'utiliser avec :",
        trace ("  Par " ++ sh ++ " appliqué à " ++ n₀ ++ " on obtient (h : " ++ p ++ "),"),
        trace $ "où " ++ n₀ ++ " est " ++ describe t.to_string,
        trace $ libre "h"
      end
  | (forall_simple var_name typ propo) := do
      t ← pp typ,
      let n := var_name.to_string,
      let n₀ := n ++ "₀",
      let nn₀ := mk_simple_name n₀,
      p ← to_string <$> pp (propo.rename (mk_simple_name n) nn₀),
      match propo with
      | (exist_rel var_name' typ' rel' rel_rhs' propo') := do
        let n' := var_name'.to_string,
        py' ← to_string <$> pp rel_rhs',
        p' ← to_string <$> pp (propo'.rename var_name nn₀),
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ n ++ "," ++ "∃ " ++ n' ++ rel' ++ py' ++ ", ... »",
        trace "On peut l'utiliser avec :",
        trace ("  Par " ++ sh ++ " appliqué à " ++ n₀ ++ " on obtient " ++ n' ++ " tel que (" ++
          n' ++ symb_to_hyp rel' rel_rhs' ++ " : " ++ n' ++ rel' ++ py' ++ ") (h" ++ n' ++ ": " ++ p' ++ "),"),
        trace $ "où " ++ n₀ ++ " est " ++ describe t.to_string,
        trace $ libres [n', n' ++ symb_to_hyp rel' rel_rhs', "h" ++ n']
      | (exist_simple var_name' typ' propo') := do
        let n' := var_name'.to_string,
        p' ← to_string <$> pp (propo'.rename var_name nn₀),
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ n ++ ", ∃ " ++ n'  ++ ", ... »",
        trace "On peut l'utiliser avec :",
        trace ("  Par " ++ sh ++ " appliqué à " ++ n₀ ++" on obtient " ++ n' ++ " tel que (h" ++ n' ++ ": " ++ p' ++ "),"),
        trace $ "où " ++ n₀ ++ " est " ++ describe t.to_string,
        trace $ libres [n', "h" ++ n']
      | (forall_rel var_name' typ' rel' rel_rhs' propo') := do
        let n' := var_name'.to_string,
        py' ← to_string <$> pp rel_rhs',
        p' ← to_string <$> pp (propo'.rename var_name nn₀),
        let rel := n ++ rel' ++ n',
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ n ++ " " ++ n' ++", " ++ rel ++ " → ... ",
        trace "On peut l'utiliser avec :",
        trace ("  Par " ++ sh ++ " appliqué à ["++n++", "++n'++", H] on obtient (h : " ++ p' ++ "),"),
        trace $ "où " ++ n ++ " et " ++ n' ++ " sont " ++ describe_pl t.to_string ++ " et H est une démonstration de " ++ rel,
        trace $ libre "h"
      | _ := do
        trace $ "L'hypothèse " ++ sh ++ " commence par « ∀ " ++ n ++ ", »",
        trace "On peut l'utiliser avec :",
        trace $ "  Par " ++ sh ++ " appliqué à " ++ n₀ ++ " on obtient (h : " ++ p ++ "),",
        trace $ "où " ++ n₀ ++ " est " ++ describe t.to_string,
        trace $ libre "h",
        trace $ "\nSi cette hypothèse ne servira plus dans sa forme générale, on peut aussi spécialiser " ++ sh ++ " par",
        trace $ "  On applique " ++ sh ++ " à " ++ n₀ ++ ",",
        when (msg ≠ "") (do
          trace $ "\nComme le but est " ++ but ++ ", on peut utiliser :",
          trace $ msg)
      end
  | (exist_rel var_name typ rel rel_rhs propo) := do
      let n := var_name.to_string,
      y ← to_string <$> pp rel_rhs,
      p ← to_string <$> pp propo,
      trace $ "L'hypothèse " ++ sh ++ " est de la forme « ∃ " ++ var_name.to_string ++ rel ++ y ++ ", ... »",
      trace "On peut l'utiliser avec :",
      trace ("  Par " ++ sh ++ " on obtient " ++ n ++  " tel que (" ++
          n ++ symb_to_hyp rel rel_rhs ++ " : " ++ n ++ rel ++ y ++ ") (h" ++ n ++ ": " ++ p ++ "),"),
      trace $ libres [n, n ++ symb_to_hyp rel rel_rhs, "h" ++ n]
  | (exist_simple var_name typ propo) := do
      let n := var_name.to_string,
      p ← to_string <$> pp propo,
      trace $ "L'hypothèse " ++ sh ++ " est de la forme « ∃ " ++ var_name.to_string ++ ", ... »",
      trace "On peut l'utiliser avec :",
      trace ("  Par " ++ sh ++ " on obtient " ++ n ++  " tel que (h" ++ n ++ ": " ++ p ++ "),"),
      trace $ libres [n, "h" ++ n]
  | (conjunction propo propo') := do
    p ← to_string <$> pp propo,
    p' ← to_string <$> pp propo',
    trace $ "L'hypothèse " ++ sh ++ " est de la forme « ... et ... »",
    trace "On peut l'utiliser avec :",
    trace $ "  Par " ++ sh ++ " on obtient (h₁ : " ++ p ++ ") (h₂ : " ++ p' ++ "),",
    trace $ libres ["h₁", "h₂"]
  | (disjunction propo propo') := do
    p ← to_string <$> pp propo,
    p' ← to_string <$> pp propo',
    trace $ "L'hypothèse " ++ sh ++ " est de la forme « ... ou ... »",
    trace "On peut l'utiliser avec :",
    trace $ "  On discute en utilisant " ++ sh ++ ","
  | (impl le re lhs rhs) := do
      l ← to_string <$> pp lhs,
      r ← to_string <$> pp rhs,
      trace $ "L'hypothèse " ++ sh ++ " est une implication",
      goal ← target,
      do {
        unify re goal,
        trace "La conclusion de cette implication est le but courant",
        trace "On peut donc utiliser cette hypothèse avec :",
        trace $ "  Par " ++ sh ++ " il suffit de montrer : " ++ r,
        trace $ "\nSi vous disposez déjà d'une preuve H de " ++ l ++ " alors on peut utiliser :",
        trace $ "  On conclut par " ++ sh ++ " appliqué à H,"} <|>
      do {
        trace $ "La prémisse de cette implication est " ++ l,
        trace $ "Si vous avez une démonstration H de " ++ l,
        trace "vous pouvez donc utiliser cette hypothèse avec :",
        trace $ "  Par " ++ sh ++ " appliqué à H on obtient H' : " ++ r ++ ",",
        trace $ libre "H'"  }
  | (ssi le re lhs rhs) := do
      l ← to_string <$> pp lhs,
      r ← to_string <$> pp rhs,
      trace $ "L'hypothèse " ++ sh ++ " est une équivalence",
      trace $ "On peut s'en servir pour remplacer le membre de gauche (c'est à dire " ++ l ++
              ") par le membre de droite  (c'est à dire " ++ r ++ ") dans le but par :",
      trace $ "  On réécrit via " ++ sh ++ ",",
      trace $ "On peut s'en servir pour remplacer le membre de droite dans par le membre de gauche dans le but par :",
      trace $ "  On réécrit via ←" ++ sh ++ ",",
      trace $ "On peut aussi effectuer de tels remplacements dans une hypothèse " ++ sh ++ "' par",
      trace $ "  On réécrit via " ++ sh ++ " dans "++ sh ++ "',",
      trace $ "ou",
      trace $ "  On réécrit via ←" ++ sh ++ " dans "++ sh ++ "',"
  | (egal le re) := do
      l ← to_string <$> pp le,
      r ← to_string <$> pp re,
      trace $ "L'hypothèse " ++ sh ++ " est une égalité",
      ex : bool ← lock_tactic_state $ (exact eh >> pure tt) <|> pure ff,
      if ex then
          trace $ "Cette égalité est exactement ce qu'il faut démontrer\n" ++
                  "On peut l'utiliser avec :\n" ++
                  "  On conclut par " ++ sh ++ ","
      else
        do {lin : bool ← lock_tactic_state $ (linarith ff tt [to_pexpr eh] >> pure tt) <|> pure ff,
        if lin then
          trace $ "Le but courant en découle immédiatement\n" ++
                  "On peut l'utiliser avec :\n" ++
                  "  On conclut par " ++ sh ++ ","
        else
          do
          trace $ "On peut s'en servir pour remplacer le membre de gauche (c'est à dire " ++ l ++
                  ") par le membre de droite  (c'est à dire " ++ r ++ ") dans le but par :",
          trace $ "  On réécrit via " ++ sh ++ ",",
          trace $ "On peut s'en servir pour remplacer le membre de droite dans par le membre de gauche dans le but par :",
          trace $ "  On réécrit via ← " ++ sh ++ ",",
          trace $ "On peut aussi effectuer de tels remplacements dans une hypothèse " ++ sh ++ "' par",
          trace $ "  On réécrit via " ++ sh ++ " dans "++ sh ++ "',",
          trace $ "ou",
          trace $ "  On réécrit via ← " ++ sh ++ " dans "++ sh ++ "',\n",
          trace $ "On peut aussi s'en servir comme étape dans un calcul, ou bien combinée linéairement à d'autres par :\n" ++
                  "  On combine [" ++ sh ++ ", ...]," }
  | (ineq le rel re) := do
      l ← to_string <$> pp le,
      r ← to_string <$> pp re,
      trace $ "L'hypothèse " ++ sh ++ " est une inégalité",
      ex : bool ← lock_tactic_state $ (exact eh >> pure tt) <|> pure ff,
      if ex then
          trace $ "Cette inégalité est exactement ce qu'il faut démontrer\n" ++
                  "On peut l'utiliser avec :\n" ++
                  "  On conclut par " ++ sh ++ ","
      else
        do {lin : bool ← lock_tactic_state $ (linarith ff tt [to_pexpr eh] >> pure tt) <|> pure ff,
        if lin then
          trace $ "Le but courant en découle immédiatement\n" ++
                  "On peut l'utiliser avec :\n" ++
                  "  On conclut par " ++ sh  ++ ","
        else
          trace $ "On peut s'en servir comme étape dans un calcul, ou bien combinée linéairement à d'autres par :\n" ++
                  "  On combine [" ++ sh ++ ", ...],"
            }
  | (prop `(false)) := do
      trace $ "Cette hypothèse est une contradiction.\n" ++
              "On peut en déduire tout ce qu'on veut par :\n" ++
              "  Montrons une contradiction,\n  On conclut par " ++ sh ++ ","
  | (prop e) := do
      trace "Je n'ai rien à déclarer à propos de cette hypothèse."
  | (data e) := do
      t ← to_string <$> pp e,
      trace $ "L'objet " ++ sh ++ match t with
      | "ℝ" := " est un nombre réel fixé."
      | "ℕ" := " est un nombre entier naturel fixé."
      | "ℤ" := " est un nombre entier relatif fixé."
      | s := " : " ++ s ++ " est fixé."
      end
  end

| none := do
  goal ← target,
  g ← parse goal,
  match g with
  | (forall_rel var_name typ rel rel_rhs propo) := do
      py ← pp rel_rhs,
      let commun := var_name.to_string ++ rel ++ py.to_string ++ ",",
      trace $ "Le but commence par « ∀ " ++ commun ++ " »",
      trace "Une démonstration directe commence donc par :",
      trace $ "  Soit " ++ commun ++ ","
  | (forall_simple var_name typ propo) := do
      let n := var_name.to_string,
      t ← to_string <$> pp typ,
      trace $ "Le but commence par « ∀ " ++ var_name.to_string ++ " : " ++ t ++ ", »",
      trace "Une démonstration directe commence donc par :",
      trace $ "  Soit " ++ var_name.to_string ++ " : " ++ t ++ ","
  | (exist_rel var_name typ rel rel_rhs propo) := do
      let n := var_name.to_string,
      let n₀ := n ++ "₀",
      let nn₀ := mk_simple_name n₀,
      tgt ← to_string <$> pp (propo.rename (mk_simple_name n) nn₀),
      t ← to_string <$> pp typ,
      trace $ "Le but est de la forme « ∃ " ++ n ++ ", ... »",
      trace "Une démonstration directe commence donc par :",
      trace $ "  Montrons que " ++ n₀ ++ " convient : " ++ tgt ++ ",",
      trace $ "en remplaçant " ++ n₀ ++ " par " ++ describe t
  | (exist_simple var_name typ propo) := do
      let n := var_name.to_string,
      let n₀ := n ++ "₀",
      let nn₀ := mk_simple_name n₀,
      tgt ← to_string <$> pp (propo.rename (mk_simple_name n) nn₀),
      t ← to_string <$> pp typ,
      trace $ "Le but est de la forme « ∃ " ++ n ++ ", ... »",
      trace "Une démonstration directe commence donc par :",
      trace $ "  Montrons que " ++ n₀ ++ " convient : " ++ tgt ++ ",",
      trace $ "en remplaçant " ++ n₀ ++ " par " ++ describe t
  | (conjunction propo propo') := do
    p ← to_string <$> pp propo,
    p' ← to_string <$> pp propo',
    trace $ "Le but est de la forme « ... et ... »",
    trace "Une démonstration directe commence donc par :",
    trace $ "  Montrons que " ++ p ++ ",",
    trace $ "Une fois cette première démonstration achevée, il restera à montrer que " ++ p'
  | (disjunction propo propo') := do
    p ← to_string <$> pp propo,
    p' ← to_string <$> pp propo',
    trace $ "Le but est de la forme « ... ou ... »",
    trace "Une démonstration directe commence donc par annoncer quelle alternative va être démontrée :",
    trace $ "  Montrons que " ++ p ++ ",",
    trace $ "ou bien :",
    trace $ "  Montrons que " ++ p' ++ ","
  | (impl le re lhs rhs) := do
      l ← pp lhs,
      trace $ "Le but est une implication « " ++ l.to_string ++ " → ... »",
      trace "Une démonstration directe commence donc par :",
      trace $ "  Supposons hyp : " ++ l.to_string ++ ", ",
      trace "où hyp est un nom disponible au choix."
  | (ssi le re lhs rhs) := do
      l ← to_string <$> pp lhs,
      r ← to_string <$> pp rhs,
      trace "Le but est une équivalence. On peut annoncer la démonstration de l'implication de la gauche vers la droite par :",
      trace $ " Montrons que " ++ l ++ " → " ++ r ++ ",",
      trace $ "Une fois cette première démonstration achevée, il restera à montrer que " ++ r ++ " → " ++ l
  | (egal le re) := do
      l ← to_string <$> pp le,
      r ← to_string <$> pp re,
      trace $ "Le but est une égalité\n" ++
              "On peut la démontrer par réécriture avec la commande `On réécrit via`\n" ++
              "ou bien commencer un calcul par\n" ++
              "  calc " ++ l ++ " = sorry : by { sorry }\n" ++
              "  ... = " ++ r ++ " : by { sorry },\n" ++
              "On peut bien sûr utiliser plus de lignes intermédiaires.\n" ++
              "Attention à ne pas mettre de virgule à la fin des lignes intermédiaires.\n\n" ++
              "On peut aussi tenter des combinaisons linéaires d'hypothèses hyp₁ hyp₂... avec\n" ++
              "  On combine [hyp₁, hyp₂],"
  | (ineq le rel re) := do
      l ← to_string <$> pp le,
      r ← to_string <$> pp re,
      trace $ "Le but est une inégalité\n" ++
              "On peut commencer un calcul par\n" ++
              "  calc " ++ l ++ rel ++ "sorry : by { sorry }\n" ++
              "  ... = " ++ r ++ " : by { sorry },\n" ++
              "On peut bien sûr utiliser plus de lignes intermédiaires.\n" ++
              "La dernière ligne du calcul n'est pas forcément une égalité, cela peut être une inégalité.\n" ++
              "De même la première ligne peut être une égalité. Au total les symboles de relations\n" ++
              "doivent s'enchaîner pour donner " ++ rel ++ "\n" ++
              "Attention à ne pas mettre de virgule à la fin des lignes intermédiaires.\n\n" ++
              "On peut aussi tenter des combinaisons linéaires d'hypothèses hyp₁ hyp₂... avec\n" ++
              "  On combine [hyp₁, hyp₂],"
  | (prop `(false)) := do
      trace $ "Le but est de montrer une contradiction.\n" ++
              "On peut par exemple appliquer une hypothèse qui est une négation" ++
              "c'est à dire, par définition, de la forme P → false."
  | (prop e) := do
      trace "Pas d'idée"
  | (data e) := do
      trace "Pas d'idée"
  end
end

namespace tactic.interactive
setup_tactic_parser
open tactic

meta def aide (i : parse ident?) : tactic unit :=
focus1 (tactic.aide i)

end tactic.interactive

example (P Q : ℕ → Prop) (h : ∀ n, P n → Q n) (h' : P 2) : Q 2 :=
begin
  aide h,
  exact h 2 h'
end

example (P : ℕ → Prop) (h : ∀ n, P n) : P 2 :=
begin
  aide h,
  exact h 2
end

example (P Q : ℕ → Prop) (h : P 1 → Q 2) (h' : P 1) : Q 2 :=
begin
  aide h,
  exact h h'
end

example (P Q : ℕ → Prop) (h : P 1 → Q 2) : true :=
begin
  aide h,
  trivial
end

example (P Q : ℕ → Prop) (h : P 1 ∧ Q 2) : true :=
begin
  aide h,
  trivial
end

example (P Q : ℕ → Prop) (h : (∀ n ≥ 2, P n) ↔  ∀ l, Q l) : true :=
begin
  aide h,
  trivial
end

example : true ∧ 1 = 1 :=
begin
  aide,
  exact ⟨trivial, rfl⟩
end

example (P Q : ℕ → Prop) (h : P 1 ∨ Q 2) : true :=
begin
  aide h,
  trivial
end

example : true ∨ false :=
begin
  aide,
  left,
  trivial
end

example (P : Prop) (h : P) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → ℕ → Prop) (k l n : ℕ) (h : l - n = 0 → P l k) : true :=
begin
  aide h,
  aide k,
  trivial
end

example (P : ℕ → ℕ → Prop) (h : ∀ k ≥ 2, ∃ n ≥ 3, ∀ l, l - n = 0 → P l k) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → Prop) (h : ∃ n ≥ 5, P n) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → ℕ → Prop) (h : ∀ k ≥ 2, ∃ n ≥ 3, P n k) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → Prop) (h : ∃ n : ℕ, P n) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → ℕ → Prop) (h : ∀ k, ∃ n : ℕ, P n k) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → ℕ → Prop) (h : ∀ k ≥ 2, ∃ n : ℕ, P n k) : true :=
begin
  aide h,
  trivial
end

example (P : ℕ → Prop): ∃ n : ℕ, P n → true :=
begin
  aide,
  use 0,
  tauto
end

example (P Q : Prop) (h : Q) : P → Q :=
begin
  aide,
  exact λ _, h,
end

example : ∀ n ≥ 0, true :=
begin
  aide,
  intros,
  trivial
end

example : ∀ n : ℕ, 0 ≤ n :=
begin
  aide,
  exact nat.zero_le
end


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.adjunction.fully_faithful
import category_theory.functor.reflects_isomorphisms
import category_theory.epi_mono

/-!
# Reflective functors

Basic properties of reflective functors, especially those relating to their essential image.

Note properties of reflective functors relating to limits and colimits are included in
`category_theory.monad.limits`.
-/

universes v₁ v₂ v₃ u₁ u₂ u₃

noncomputable theory

namespace category_theory

open category adjunction

variables {C : Type u₁} {D : Type u₂} {E : Type u₃}
variables [category.{v₁} C] [category.{v₂} D] [category.{v₃} E]

/--
A functor is *reflective*, or *a reflective inclusion*, if it is fully faithful and right adjoint.
-/
class reflective (R : D ⥤ C) extends is_right_adjoint R, full R, faithful R.

variables {i : D ⥤ C}

/--
For a reflective functor `i` (with left adjoint `L`), with unit `η`, we have `η_iL = iL η`.
-/
-- TODO: This holds more generally for idempotent adjunctions, not just reflective adjunctions.
lemma unit_obj_eq_map_unit [reflective i] (X : C) :
  (of_right_adjoint i).unit.app (i.obj ((left_adjoint i).obj X))
    = i.map ((left_adjoint i).map ((of_right_adjoint i).unit.app X)) :=
begin
 rw [←cancel_mono (i.map ((of_right_adjoint i).counit.app ((left_adjoint i).obj X))),
     ←i.map_comp],
 simp,
end

/--
When restricted to objects in `D` given by `i : D ⥤ C`, the unit is an isomorphism. In other words,
`η_iX` is an isomorphism for any `X` in `D`.
More generally this applies to objects essentially in the reflective subcategory, see
`functor.ess_image.unit_iso`.
-/
instance is_iso_unit_obj [reflective i] {B : D} :
  is_iso ((of_right_adjoint i).unit.app (i.obj B)) :=
begin
  have : (of_right_adjoint i).unit.app (i.obj B) =
            inv (i.map ((of_right_adjoint i).counit.app B)),
  { rw ← comp_hom_eq_id,
    apply (of_right_adjoint i).right_triangle_components },
  rw this,
  exact is_iso.inv_is_iso,
end

/--
If `A` is essentially in the image of a reflective functor `i`, then `η_A` is an isomorphism.
This gives that the "witness" for `A` being in the essential image can instead be given as the
reflection of `A`, with the isomorphism as `η_A`.

(For any `B` in the reflective subcategory, we automatically have that `ε_B` is an iso.)
-/
lemma functor.ess_image.unit_is_iso [reflective i] {A : C} (h : A ∈ i.ess_image) :
  is_iso ((of_right_adjoint i).unit.app A) :=
begin
  suffices : (of_right_adjoint i).unit.app A =
                h.get_iso.inv ≫ (of_right_adjoint i).unit.app (i.obj h.witness) ≫
                  (left_adjoint i ⋙ i).map h.get_iso.hom,
  { rw this,
    apply_instance },
  rw ← nat_trans.naturality,
  simp,
end

/-- If `η_A` is an isomorphism, then `A` is in the essential image of `i`. -/
lemma mem_ess_image_of_unit_is_iso [is_right_adjoint i] (A : C)
  [is_iso ((of_right_adjoint i).unit.app A)] : A ∈ i.ess_image :=
⟨(left_adjoint i).obj A, ⟨(as_iso ((of_right_adjoint i).unit.app A)).symm⟩⟩

/-- If `η_A` is a split monomorphism, then `A` is in the reflective subcategory. -/
lemma mem_ess_image_of_unit_split_mono [reflective i] {A : C}
  [split_mono ((of_right_adjoint i).unit.app A)] : A ∈ i.ess_image :=
begin
  let η : 𝟭 C ⟶ left_adjoint i ⋙ i := (of_right_adjoint i).unit,
  haveI : is_iso (η.app (i.obj ((left_adjoint i).obj A))) := (i.obj_mem_ess_image _).unit_is_iso,
  have : epi (η.app A),
  { apply epi_of_epi (retraction (η.app A)) _,
    rw (show retraction _ ≫ η.app A = _, from η.naturality (retraction (η.app A))),
    apply epi_comp (η.app (i.obj ((left_adjoint i).obj A))) },
  resetI,
  haveI := is_iso_of_epi_of_split_mono (η.app A),
  exact mem_ess_image_of_unit_is_iso A,
end

/-- Composition of reflective functors. -/
instance reflective.comp (F : C ⥤ D) (G : D ⥤ E) [Fr : reflective F] [Gr : reflective G] :
  reflective (F ⋙ G) := { to_faithful := faithful.comp F G, }

/-- (Implementation) Auxiliary definition for `unit_comp_partial_bijective`. -/
def unit_comp_partial_bijective_aux [reflective i] (A : C) (B : D) :
  (A ⟶ i.obj B) ≃ (i.obj ((left_adjoint i).obj A) ⟶ i.obj B) :=
((adjunction.of_right_adjoint i).hom_equiv _ _).symm.trans (equiv_of_fully_faithful i)

/-- The description of the inverse of the bijection `unit_comp_partial_bijective_aux`. -/
lemma unit_comp_partial_bijective_aux_symm_apply [reflective i] {A : C} {B : D}
  (f : i.obj ((left_adjoint i).obj A) ⟶ i.obj B) :
  (unit_comp_partial_bijective_aux _ _).symm f = (of_right_adjoint i).unit.app A ≫ f :=
by simp [unit_comp_partial_bijective_aux]

/--
If `i` has a reflector `L`, then the function `(i.obj (L.obj A) ⟶ B) → (A ⟶ B)` given by
precomposing with `η.app A` is a bijection provided `B` is in the essential image of `i`.
That is, the function `λ (f : i.obj (L.obj A) ⟶ B), η.app A ≫ f` is bijective, as long as `B` is in
the essential image of `i`.
This definition gives an equivalence: the key property that the inverse can be described
nicely is shown in `unit_comp_partial_bijective_symm_apply`.

This establishes there is a natural bijection `(A ⟶ B) ≃ (i.obj (L.obj A) ⟶ B)`. In other words,
from the point of view of objects in `D`, `A` and `i.obj (L.obj A)` look the same: specifically
that `η.app A` is an isomorphism.
-/
def unit_comp_partial_bijective [reflective i] (A : C) {B : C} (hB : B ∈ i.ess_image) :
  (A ⟶ B) ≃ (i.obj ((left_adjoint i).obj A) ⟶ B) :=
calc (A ⟶ B) ≃ (A ⟶ i.obj hB.witness) : iso.hom_congr (iso.refl _) hB.get_iso.symm
     ...     ≃ (i.obj _ ⟶ i.obj hB.witness) : unit_comp_partial_bijective_aux _ _
     ...     ≃ (i.obj ((left_adjoint i).obj A) ⟶ B) : iso.hom_congr (iso.refl _) hB.get_iso

@[simp]
lemma unit_comp_partial_bijective_symm_apply [reflective i] (A : C) {B : C}
  (hB : B ∈ i.ess_image) (f) :
  (unit_comp_partial_bijective A hB).symm f = (of_right_adjoint i).unit.app A ≫ f :=
by simp [unit_comp_partial_bijective, unit_comp_partial_bijective_aux_symm_apply]

lemma unit_comp_partial_bijective_symm_natural [reflective i] (A : C) {B B' : C} (h : B ⟶ B')
  (hB : B ∈ i.ess_image) (hB' : B' ∈ i.ess_image) (f : i.obj ((left_adjoint i).obj A) ⟶ B) :
  (unit_comp_partial_bijective A hB').symm (f ≫ h) =
    (unit_comp_partial_bijective A hB).symm f ≫ h :=
by simp

lemma unit_comp_partial_bijective_natural [reflective i] (A : C) {B B' : C} (h : B ⟶ B')
  (hB : B ∈ i.ess_image) (hB' : B' ∈ i.ess_image) (f : A ⟶ B) :
  (unit_comp_partial_bijective A hB') (f ≫ h) = unit_comp_partial_bijective A hB f ≫ h :=
by rw [←equiv.eq_symm_apply, unit_comp_partial_bijective_symm_natural A h, equiv.symm_apply_apply]

/-- If `i : D ⥤ C` is reflective, the inverse functor of `i ≌ F.ess_image` can be explicitly
defined by the reflector. -/
@[simps]
def equiv_ess_image_of_reflective [reflective i] : D ≌ i.ess_image :=
{ functor := i.to_ess_image,
  inverse := i.ess_image_inclusion ⋙ (left_adjoint i : _),
  unit_iso := nat_iso.of_components (λ X, (as_iso $ (of_right_adjoint i).counit.app X).symm)
    (by { intros X Y f, dsimp, simp only [is_iso.eq_inv_comp, is_iso.comp_inv_eq, category.assoc],
      exact ((of_right_adjoint i).counit.naturality _).symm }),
  counit_iso := nat_iso.of_components
    (λ X, by { refine (iso.symm $ as_iso _), exact (of_right_adjoint i).unit.app X,
      apply_with (is_iso_of_reflects_iso _ i.ess_image_inclusion) { instances := ff },
      exact functor.ess_image.unit_is_iso X.prop })
    (by { intros X Y f, dsimp, simp only [is_iso.eq_inv_comp, is_iso.comp_inv_eq, category.assoc],
      exact ((of_right_adjoint i).unit.naturality f).symm }) }

end category_theory


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser

! This file was ported from Lean 3 source module group_theory.group_action.prod
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Group.Prod
import Mathbin.GroupTheory.GroupAction.Defs

/-!
# Prod instances for additive and multiplicative actions

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines instances for binary product of additive and multiplicative actions and provides
scalar multiplication as a homomorphism from `α × β` to `β`.

## Main declarations

* `smul_mul_hom`/`smul_monoid_hom`: Scalar multiplication bundled as a multiplicative/monoid
  homomorphism.

## See also

* `group_theory.group_action.option`
* `group_theory.group_action.pi`
* `group_theory.group_action.sigma`
* `group_theory.group_action.sum`
-/

variable {M N P E α β : Type _}

namespace Prod

section

variable [SMul M α] [SMul M β] [SMul N α] [SMul N β] (a : M) (x : α × β)

@[to_additive Prod.hasVadd]
instance : SMul M (α × β) :=
  ⟨fun a p => (a • p.1, a • p.2)⟩

/- warning: prod.smul_fst -> Prod.smul_fst is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : SMul.{u1, u2} M α] [_inst_2 : SMul.{u1, u3} M β] (a : M) (x : Prod.{u2, u3} α β), Eq.{succ u2} α (Prod.fst.{u2, u3} α β (SMul.smul.{u1, max u2 u3} M (Prod.{u2, u3} α β) (Prod.smul.{u1, u2, u3} M α β _inst_1 _inst_2) a x)) (SMul.smul.{u1, u2} M α _inst_1 a (Prod.fst.{u2, u3} α β x))
but is expected to have type
  forall {M : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_1 : SMul.{u1, u3} M α] [_inst_2 : SMul.{u1, u2} M β] (a : M) (x : Prod.{u3, u2} α β), Eq.{succ u3} α (Prod.fst.{u3, u2} α β (HSMul.hSMul.{u1, max u3 u2, max u3 u2} M (Prod.{u3, u2} α β) (Prod.{u3, u2} α β) (instHSMul.{u1, max u3 u2} M (Prod.{u3, u2} α β) (Prod.smul.{u1, u3, u2} M α β _inst_1 _inst_2)) a x)) (HSMul.hSMul.{u1, u3, u3} M α α (instHSMul.{u1, u3} M α _inst_1) a (Prod.fst.{u3, u2} α β x))
Case conversion may be inaccurate. Consider using '#align prod.smul_fst Prod.smul_fstₓ'. -/
@[simp, to_additive]
theorem smul_fst : (a • x).1 = a • x.1 :=
  rfl
#align prod.smul_fst Prod.smul_fst
#align prod.vadd_fst Prod.vadd_fst

#print Prod.smul_snd /-
@[simp, to_additive]
theorem smul_snd : (a • x).2 = a • x.2 :=
  rfl
#align prod.smul_snd Prod.smul_snd
#align prod.vadd_snd Prod.vadd_snd
-/

/- warning: prod.smul_mk -> Prod.smul_mk is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : SMul.{u1, u2} M α] [_inst_2 : SMul.{u1, u3} M β] (a : M) (b : α) (c : β), Eq.{succ (max u2 u3)} (Prod.{u2, u3} α β) (SMul.smul.{u1, max u2 u3} M (Prod.{u2, u3} α β) (Prod.smul.{u1, u2, u3} M α β _inst_1 _inst_2) a (Prod.mk.{u2, u3} α β b c)) (Prod.mk.{u2, u3} α β (SMul.smul.{u1, u2} M α _inst_1 a b) (SMul.smul.{u1, u3} M β _inst_2 a c))
but is expected to have type
  forall {M : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_1 : SMul.{u1, u3} M α] [_inst_2 : SMul.{u1, u2} M β] (a : M) (b : α) (c : β), Eq.{max (succ u3) (succ u2)} (Prod.{u3, u2} α β) (HSMul.hSMul.{u1, max u2 u3, max u3 u2} M (Prod.{u3, u2} α β) (Prod.{u3, u2} α β) (instHSMul.{u1, max u3 u2} M (Prod.{u3, u2} α β) (Prod.smul.{u1, u3, u2} M α β _inst_1 _inst_2)) a (Prod.mk.{u3, u2} α β b c)) (Prod.mk.{u3, u2} α β (HSMul.hSMul.{u1, u3, u3} M α α (instHSMul.{u1, u3} M α _inst_1) a b) (HSMul.hSMul.{u1, u2, u2} M β β (instHSMul.{u1, u2} M β _inst_2) a c))
Case conversion may be inaccurate. Consider using '#align prod.smul_mk Prod.smul_mkₓ'. -/
@[simp, to_additive]
theorem smul_mk (a : M) (b : α) (c : β) : a • (b, c) = (a • b, a • c) :=
  rfl
#align prod.smul_mk Prod.smul_mk
#align prod.vadd_mk Prod.vadd_mk

/- warning: prod.smul_def -> Prod.smul_def is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : SMul.{u1, u2} M α] [_inst_2 : SMul.{u1, u3} M β] (a : M) (x : Prod.{u2, u3} α β), Eq.{succ (max u2 u3)} (Prod.{u2, u3} α β) (SMul.smul.{u1, max u2 u3} M (Prod.{u2, u3} α β) (Prod.smul.{u1, u2, u3} M α β _inst_1 _inst_2) a x) (Prod.mk.{u2, u3} α β (SMul.smul.{u1, u2} M α _inst_1 a (Prod.fst.{u2, u3} α β x)) (SMul.smul.{u1, u3} M β _inst_2 a (Prod.snd.{u2, u3} α β x)))
but is expected to have type
  forall {M : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_1 : SMul.{u1, u3} M α] [_inst_2 : SMul.{u1, u2} M β] (a : M) (x : Prod.{u3, u2} α β), Eq.{max (succ u3) (succ u2)} (Prod.{u3, u2} α β) (HSMul.hSMul.{u1, max u3 u2, max u3 u2} M (Prod.{u3, u2} α β) (Prod.{u3, u2} α β) (instHSMul.{u1, max u3 u2} M (Prod.{u3, u2} α β) (Prod.smul.{u1, u3, u2} M α β _inst_1 _inst_2)) a x) (Prod.mk.{u3, u2} α β (HSMul.hSMul.{u1, u3, u3} M α α (instHSMul.{u1, u3} M α _inst_1) a (Prod.fst.{u3, u2} α β x)) (HSMul.hSMul.{u1, u2, u2} M β β (instHSMul.{u1, u2} M β _inst_2) a (Prod.snd.{u3, u2} α β x)))
Case conversion may be inaccurate. Consider using '#align prod.smul_def Prod.smul_defₓ'. -/
@[to_additive]
theorem smul_def (a : M) (x : α × β) : a • x = (a • x.1, a • x.2) :=
  rfl
#align prod.smul_def Prod.smul_def
#align prod.vadd_def Prod.vadd_def

/- warning: prod.smul_swap -> Prod.smul_swap is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_1 : SMul.{u1, u2} M α] [_inst_2 : SMul.{u1, u3} M β] (a : M) (x : Prod.{u2, u3} α β), Eq.{max (succ u3) (succ u2)} (Prod.{u3, u2} β α) (Prod.swap.{u2, u3} α β (SMul.smul.{u1, max u2 u3} M (Prod.{u2, u3} α β) (Prod.smul.{u1, u2, u3} M α β _inst_1 _inst_2) a x)) (SMul.smul.{u1, max u3 u2} M (Prod.{u3, u2} β α) (Prod.smul.{u1, u3, u2} M β α _inst_2 _inst_1) a (Prod.swap.{u2, u3} α β x))
but is expected to have type
  forall {M : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_1 : SMul.{u1, u3} M α] [_inst_2 : SMul.{u1, u2} M β] (a : M) (x : Prod.{u3, u2} α β), Eq.{max (succ u3) (succ u2)} (Prod.{u2, u3} β α) (Prod.swap.{u3, u2} α β (HSMul.hSMul.{u1, max u3 u2, max u3 u2} M (Prod.{u3, u2} α β) (Prod.{u3, u2} α β) (instHSMul.{u1, max u3 u2} M (Prod.{u3, u2} α β) (Prod.smul.{u1, u3, u2} M α β _inst_1 _inst_2)) a x)) (HSMul.hSMul.{u1, max u3 u2, max u3 u2} M (Prod.{u2, u3} β α) (Prod.{u2, u3} β α) (instHSMul.{u1, max u3 u2} M (Prod.{u2, u3} β α) (Prod.smul.{u1, u2, u3} M β α _inst_2 _inst_1)) a (Prod.swap.{u3, u2} α β x))
Case conversion may be inaccurate. Consider using '#align prod.smul_swap Prod.smul_swapₓ'. -/
@[simp, to_additive]
theorem smul_swap : (a • x).symm = a • x.symm :=
  rfl
#align prod.smul_swap Prod.smul_swap
#align prod.vadd_swap Prod.vadd_swap

/- warning: prod.smul_zero_mk -> Prod.smul_zero_mk is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {β : Type.{u2}} [_inst_2 : SMul.{u1, u2} M β] {α : Type.{u3}} [_inst_5 : Monoid.{u1} M] [_inst_6 : AddMonoid.{u3} α] [_inst_7 : DistribMulAction.{u1, u3} M α _inst_5 _inst_6] (a : M) (c : β), Eq.{succ (max u3 u2)} (Prod.{u3, u2} α β) (SMul.smul.{u1, max u3 u2} M (Prod.{u3, u2} α β) (Prod.smul.{u1, u3, u2} M α β (SMulZeroClass.toHasSmul.{u1, u3} M α (AddZeroClass.toHasZero.{u3} α (AddMonoid.toAddZeroClass.{u3} α _inst_6)) (DistribSMul.toSmulZeroClass.{u1, u3} M α (AddMonoid.toAddZeroClass.{u3} α _inst_6) (DistribMulAction.toDistribSMul.{u1, u3} M α _inst_5 _inst_6 _inst_7))) _inst_2) a (Prod.mk.{u3, u2} α β (OfNat.ofNat.{u3} α 0 (OfNat.mk.{u3} α 0 (Zero.zero.{u3} α (AddZeroClass.toHasZero.{u3} α (AddMonoid.toAddZeroClass.{u3} α _inst_6))))) c)) (Prod.mk.{u3, u2} α β (OfNat.ofNat.{u3} α 0 (OfNat.mk.{u3} α 0 (Zero.zero.{u3} α (AddZeroClass.toHasZero.{u3} α (AddMonoid.toAddZeroClass.{u3} α _inst_6))))) (SMul.smul.{u1, u2} M β _inst_2 a c))
but is expected to have type
  forall {M : Type.{u2}} {β : Type.{u1}} [_inst_2 : SMul.{u2, u1} M β] {α : Type.{u3}} [_inst_5 : Monoid.{u2} M] [_inst_6 : AddMonoid.{u3} α] [_inst_7 : DistribMulAction.{u2, u3} M α _inst_5 _inst_6] (a : M) (c : β), Eq.{max (succ u1) (succ u3)} (Prod.{u3, u1} α β) (HSMul.hSMul.{u2, max u1 u3, max u1 u3} M (Prod.{u3, u1} α β) (Prod.{u3, u1} α β) (instHSMul.{u2, max u1 u3} M (Prod.{u3, u1} α β) (Prod.smul.{u2, u3, u1} M α β (SMulZeroClass.toSMul.{u2, u3} M α (AddMonoid.toZero.{u3} α _inst_6) (DistribSMul.toSMulZeroClass.{u2, u3} M α (AddMonoid.toAddZeroClass.{u3} α _inst_6) (DistribMulAction.toDistribSMul.{u2, u3} M α _inst_5 _inst_6 _inst_7))) _inst_2)) a (Prod.mk.{u3, u1} α β (OfNat.ofNat.{u3} α 0 (Zero.toOfNat0.{u3} α (AddMonoid.toZero.{u3} α _inst_6))) c)) (Prod.mk.{u3, u1} α β (OfNat.ofNat.{u3} α 0 (Zero.toOfNat0.{u3} α (AddMonoid.toZero.{u3} α _inst_6))) (HSMul.hSMul.{u2, u1, u1} M β β (instHSMul.{u2, u1} M β _inst_2) a c))
Case conversion may be inaccurate. Consider using '#align prod.smul_zero_mk Prod.smul_zero_mkₓ'. -/
theorem smul_zero_mk {α : Type _} [Monoid M] [AddMonoid α] [DistribMulAction M α] (a : M) (c : β) :
    a • ((0 : α), c) = (0, a • c) := by rw [Prod.smul_mk, smul_zero]
#align prod.smul_zero_mk Prod.smul_zero_mk

/- warning: prod.smul_mk_zero -> Prod.smul_mk_zero is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {α : Type.{u2}} [_inst_1 : SMul.{u1, u2} M α] {β : Type.{u3}} [_inst_5 : Monoid.{u1} M] [_inst_6 : AddMonoid.{u3} β] [_inst_7 : DistribMulAction.{u1, u3} M β _inst_5 _inst_6] (a : M) (b : α), Eq.{succ (max u2 u3)} (Prod.{u2, u3} α β) (SMul.smul.{u1, max u2 u3} M (Prod.{u2, u3} α β) (Prod.smul.{u1, u2, u3} M α β _inst_1 (SMulZeroClass.toHasSmul.{u1, u3} M β (AddZeroClass.toHasZero.{u3} β (AddMonoid.toAddZeroClass.{u3} β _inst_6)) (DistribSMul.toSmulZeroClass.{u1, u3} M β (AddMonoid.toAddZeroClass.{u3} β _inst_6) (DistribMulAction.toDistribSMul.{u1, u3} M β _inst_5 _inst_6 _inst_7)))) a (Prod.mk.{u2, u3} α β b (OfNat.ofNat.{u3} β 0 (OfNat.mk.{u3} β 0 (Zero.zero.{u3} β (AddZeroClass.toHasZero.{u3} β (AddMonoid.toAddZeroClass.{u3} β _inst_6))))))) (Prod.mk.{u2, u3} α β (SMul.smul.{u1, u2} M α _inst_1 a b) (OfNat.ofNat.{u3} β 0 (OfNat.mk.{u3} β 0 (Zero.zero.{u3} β (AddZeroClass.toHasZero.{u3} β (AddMonoid.toAddZeroClass.{u3} β _inst_6))))))
but is expected to have type
  forall {M : Type.{u2}} {α : Type.{u1}} [_inst_1 : SMul.{u2, u1} M α] {β : Type.{u3}} [_inst_5 : Monoid.{u2} M] [_inst_6 : AddMonoid.{u3} β] [_inst_7 : DistribMulAction.{u2, u3} M β _inst_5 _inst_6] (a : M) (b : α), Eq.{max (succ u1) (succ u3)} (Prod.{u1, u3} α β) (HSMul.hSMul.{u2, max u3 u1, max u1 u3} M (Prod.{u1, u3} α β) (Prod.{u1, u3} α β) (instHSMul.{u2, max u1 u3} M (Prod.{u1, u3} α β) (Prod.smul.{u2, u1, u3} M α β _inst_1 (SMulZeroClass.toSMul.{u2, u3} M β (AddMonoid.toZero.{u3} β _inst_6) (DistribSMul.toSMulZeroClass.{u2, u3} M β (AddMonoid.toAddZeroClass.{u3} β _inst_6) (DistribMulAction.toDistribSMul.{u2, u3} M β _inst_5 _inst_6 _inst_7))))) a (Prod.mk.{u1, u3} α β b (OfNat.ofNat.{u3} β 0 (Zero.toOfNat0.{u3} β (AddMonoid.toZero.{u3} β _inst_6))))) (Prod.mk.{u1, u3} α β (HSMul.hSMul.{u2, u1, u1} M α α (instHSMul.{u2, u1} M α _inst_1) a b) (OfNat.ofNat.{u3} β 0 (Zero.toOfNat0.{u3} β (AddMonoid.toZero.{u3} β _inst_6))))
Case conversion may be inaccurate. Consider using '#align prod.smul_mk_zero Prod.smul_mk_zeroₓ'. -/
theorem smul_mk_zero {β : Type _} [Monoid M] [AddMonoid β] [DistribMulAction M β] (a : M) (b : α) :
    a • (b, (0 : β)) = (a • b, 0) := by rw [Prod.smul_mk, smul_zero]
#align prod.smul_mk_zero Prod.smul_mk_zero

variable [Pow α E] [Pow β E]

#print Prod.pow /-
@[to_additive SMul]
instance pow : Pow (α × β) E where pow p c := (p.1 ^ c, p.2 ^ c)
#align prod.has_pow Prod.pow
#align prod.has_smul Prod.smul
-/

/- warning: prod.pow_fst -> Prod.pow_fst is a dubious translation:
lean 3 declaration is
  forall {E : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_5 : Pow.{u2, u1} α E] [_inst_6 : Pow.{u3, u1} β E] (p : Prod.{u2, u3} α β) (c : E), Eq.{succ u2} α (Prod.fst.{u2, u3} α β (HPow.hPow.{max u2 u3, u1, max u2 u3} (Prod.{u2, u3} α β) E (Prod.{u2, u3} α β) (instHPow.{max u2 u3, u1} (Prod.{u2, u3} α β) E (Prod.pow.{u1, u2, u3} E α β _inst_5 _inst_6)) p c)) (HPow.hPow.{u2, u1, u2} α E α (instHPow.{u2, u1} α E _inst_5) (Prod.fst.{u2, u3} α β p) c)
but is expected to have type
  forall {E : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_5 : Pow.{u3, u1} α E] [_inst_6 : Pow.{u2, u1} β E] (p : Prod.{u3, u2} α β) (c : E), Eq.{succ u3} α (Prod.fst.{u3, u2} α β (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u3, u2} α β) E (Prod.{u3, u2} α β) (instHPow.{max u3 u2, u1} (Prod.{u3, u2} α β) E (Prod.pow.{u1, u3, u2} E α β _inst_5 _inst_6)) p c)) (HPow.hPow.{u3, u1, u3} α E α (instHPow.{u3, u1} α E _inst_5) (Prod.fst.{u3, u2} α β p) c)
Case conversion may be inaccurate. Consider using '#align prod.pow_fst Prod.pow_fstₓ'. -/
@[simp, to_additive smul_fst, to_additive_reorder 6]
theorem pow_fst (p : α × β) (c : E) : (p ^ c).fst = p.fst ^ c :=
  rfl
#align prod.pow_fst Prod.pow_fst
#align prod.smul_fst Prod.smul_fst

/- warning: prod.pow_snd -> Prod.pow_snd is a dubious translation:
lean 3 declaration is
  forall {E : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_5 : Pow.{u2, u1} α E] [_inst_6 : Pow.{u3, u1} β E] (p : Prod.{u2, u3} α β) (c : E), Eq.{succ u3} β (Prod.snd.{u2, u3} α β (HPow.hPow.{max u2 u3, u1, max u2 u3} (Prod.{u2, u3} α β) E (Prod.{u2, u3} α β) (instHPow.{max u2 u3, u1} (Prod.{u2, u3} α β) E (Prod.pow.{u1, u2, u3} E α β _inst_5 _inst_6)) p c)) (HPow.hPow.{u3, u1, u3} β E β (instHPow.{u3, u1} β E _inst_6) (Prod.snd.{u2, u3} α β p) c)
but is expected to have type
  forall {E : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_5 : Pow.{u3, u1} α E] [_inst_6 : Pow.{u2, u1} β E] (p : Prod.{u3, u2} α β) (c : E), Eq.{succ u2} β (Prod.snd.{u3, u2} α β (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u3, u2} α β) E (Prod.{u3, u2} α β) (instHPow.{max u3 u2, u1} (Prod.{u3, u2} α β) E (Prod.pow.{u1, u3, u2} E α β _inst_5 _inst_6)) p c)) (HPow.hPow.{u2, u1, u2} β E β (instHPow.{u2, u1} β E _inst_6) (Prod.snd.{u3, u2} α β p) c)
Case conversion may be inaccurate. Consider using '#align prod.pow_snd Prod.pow_sndₓ'. -/
@[simp, to_additive smul_snd, to_additive_reorder 6]
theorem pow_snd (p : α × β) (c : E) : (p ^ c).snd = p.snd ^ c :=
  rfl
#align prod.pow_snd Prod.pow_snd
#align prod.smul_snd Prod.smul_snd

/- warning: prod.pow_mk -> Prod.pow_mk is a dubious translation:
lean 3 declaration is
  forall {E : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_5 : Pow.{u2, u1} α E] [_inst_6 : Pow.{u3, u1} β E] (c : E) (a : α) (b : β), Eq.{succ (max u2 u3)} (Prod.{u2, u3} α β) (HPow.hPow.{max u2 u3, u1, max u2 u3} (Prod.{u2, u3} α β) E (Prod.{u2, u3} α β) (instHPow.{max u2 u3, u1} (Prod.{u2, u3} α β) E (Prod.pow.{u1, u2, u3} E α β _inst_5 _inst_6)) (Prod.mk.{u2, u3} α β a b) c) (Prod.mk.{u2, u3} α β (HPow.hPow.{u2, u1, u2} α E α (instHPow.{u2, u1} α E _inst_5) a c) (HPow.hPow.{u3, u1, u3} β E β (instHPow.{u3, u1} β E _inst_6) b c))
but is expected to have type
  forall {E : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_5 : Pow.{u3, u1} α E] [_inst_6 : Pow.{u2, u1} β E] (c : E) (a : α) (b : β), Eq.{max (succ u3) (succ u2)} (Prod.{u3, u2} α β) (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u3, u2} α β) E (Prod.{u3, u2} α β) (instHPow.{max u3 u2, u1} (Prod.{u3, u2} α β) E (Prod.pow.{u1, u3, u2} E α β _inst_5 _inst_6)) (Prod.mk.{u3, u2} α β a b) c) (Prod.mk.{u3, u2} α β (HPow.hPow.{u3, u1, u3} α E α (instHPow.{u3, u1} α E _inst_5) a c) (HPow.hPow.{u2, u1, u2} β E β (instHPow.{u2, u1} β E _inst_6) b c))
Case conversion may be inaccurate. Consider using '#align prod.pow_mk Prod.pow_mkₓ'. -/
/- Note that the `c` arguments to this lemmas cannot be in the more natural right-most positions due
to limitations in `to_additive` and `to_additive_reorder`, which will silently fail to reorder more
than two adjacent arguments -/
@[simp, to_additive smul_mk, to_additive_reorder 6]
theorem pow_mk (c : E) (a : α) (b : β) : Prod.mk a b ^ c = Prod.mk (a ^ c) (b ^ c) :=
  rfl
#align prod.pow_mk Prod.pow_mk
#align prod.smul_mk Prod.smul_mk

/- warning: prod.pow_def -> Prod.pow_def is a dubious translation:
lean 3 declaration is
  forall {E : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_5 : Pow.{u2, u1} α E] [_inst_6 : Pow.{u3, u1} β E] (p : Prod.{u2, u3} α β) (c : E), Eq.{succ (max u2 u3)} (Prod.{u2, u3} α β) (HPow.hPow.{max u2 u3, u1, max u2 u3} (Prod.{u2, u3} α β) E (Prod.{u2, u3} α β) (instHPow.{max u2 u3, u1} (Prod.{u2, u3} α β) E (Prod.pow.{u1, u2, u3} E α β _inst_5 _inst_6)) p c) (Prod.mk.{u2, u3} α β (HPow.hPow.{u2, u1, u2} α E α (instHPow.{u2, u1} α E _inst_5) (Prod.fst.{u2, u3} α β p) c) (HPow.hPow.{u3, u1, u3} β E β (instHPow.{u3, u1} β E _inst_6) (Prod.snd.{u2, u3} α β p) c))
but is expected to have type
  forall {E : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_5 : Pow.{u3, u1} α E] [_inst_6 : Pow.{u2, u1} β E] (p : Prod.{u3, u2} α β) (c : E), Eq.{max (succ u3) (succ u2)} (Prod.{u3, u2} α β) (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u3, u2} α β) E (Prod.{u3, u2} α β) (instHPow.{max u3 u2, u1} (Prod.{u3, u2} α β) E (Prod.pow.{u1, u3, u2} E α β _inst_5 _inst_6)) p c) (Prod.mk.{u3, u2} α β (HPow.hPow.{u3, u1, u3} α E α (instHPow.{u3, u1} α E _inst_5) (Prod.fst.{u3, u2} α β p) c) (HPow.hPow.{u2, u1, u2} β E β (instHPow.{u2, u1} β E _inst_6) (Prod.snd.{u3, u2} α β p) c))
Case conversion may be inaccurate. Consider using '#align prod.pow_def Prod.pow_defₓ'. -/
@[to_additive smul_def, to_additive_reorder 6]
theorem pow_def (p : α × β) (c : E) : p ^ c = (p.1 ^ c, p.2 ^ c) :=
  rfl
#align prod.pow_def Prod.pow_def
#align prod.smul_def Prod.smul_def

/- warning: prod.pow_swap -> Prod.pow_swap is a dubious translation:
lean 3 declaration is
  forall {E : Type.{u1}} {α : Type.{u2}} {β : Type.{u3}} [_inst_5 : Pow.{u2, u1} α E] [_inst_6 : Pow.{u3, u1} β E] (p : Prod.{u2, u3} α β) (c : E), Eq.{max (succ u3) (succ u2)} (Prod.{u3, u2} β α) (Prod.swap.{u2, u3} α β (HPow.hPow.{max u2 u3, u1, max u2 u3} (Prod.{u2, u3} α β) E (Prod.{u2, u3} α β) (instHPow.{max u2 u3, u1} (Prod.{u2, u3} α β) E (Prod.pow.{u1, u2, u3} E α β _inst_5 _inst_6)) p c)) (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u3, u2} β α) E (Prod.{u3, u2} β α) (instHPow.{max u3 u2, u1} (Prod.{u3, u2} β α) E (Prod.pow.{u1, u3, u2} E β α _inst_6 _inst_5)) (Prod.swap.{u2, u3} α β p) c)
but is expected to have type
  forall {E : Type.{u1}} {α : Type.{u3}} {β : Type.{u2}} [_inst_5 : Pow.{u3, u1} α E] [_inst_6 : Pow.{u2, u1} β E] (p : Prod.{u3, u2} α β) (c : E), Eq.{max (succ u3) (succ u2)} (Prod.{u2, u3} β α) (Prod.swap.{u3, u2} α β (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u3, u2} α β) E (Prod.{u3, u2} α β) (instHPow.{max u3 u2, u1} (Prod.{u3, u2} α β) E (Prod.pow.{u1, u3, u2} E α β _inst_5 _inst_6)) p c)) (HPow.hPow.{max u3 u2, u1, max u3 u2} (Prod.{u2, u3} β α) E (Prod.{u2, u3} β α) (instHPow.{max u3 u2, u1} (Prod.{u2, u3} β α) E (Prod.pow.{u1, u2, u3} E β α _inst_6 _inst_5)) (Prod.swap.{u3, u2} α β p) c)
Case conversion may be inaccurate. Consider using '#align prod.pow_swap Prod.pow_swapₓ'. -/
@[simp, to_additive smul_swap, to_additive_reorder 6]
theorem pow_swap (p : α × β) (c : E) : (p ^ c).symm = p.symm ^ c :=
  rfl
#align prod.pow_swap Prod.pow_swap
#align prod.smul_swap Prod.smul_swap

@[to_additive]
instance [SMul M N] [IsScalarTower M N α] [IsScalarTower M N β] : IsScalarTower M N (α × β) :=
  ⟨fun x y z => mk.inj_iff.mpr ⟨smul_assoc _ _ _, smul_assoc _ _ _⟩⟩

@[to_additive]
instance [SMulCommClass M N α] [SMulCommClass M N β] : SMulCommClass M N (α × β)
    where smul_comm r s x := mk.inj_iff.mpr ⟨smul_comm _ _ _, smul_comm _ _ _⟩

@[to_additive]
instance [SMul Mᵐᵒᵖ α] [SMul Mᵐᵒᵖ β] [IsCentralScalar M α] [IsCentralScalar M β] :
    IsCentralScalar M (α × β) :=
  ⟨fun r m => Prod.ext (op_smul_eq_smul _ _) (op_smul_eq_smul _ _)⟩

#print Prod.faithfulSMulLeft /-
@[to_additive]
instance faithfulSMulLeft [FaithfulSMul M α] [Nonempty β] : FaithfulSMul M (α × β) :=
  ⟨fun x y h =>
    let ⟨b⟩ := ‹Nonempty β›
    eq_of_smul_eq_smul fun a : α => by injection h (a, b)⟩
#align prod.has_faithful_smul_left Prod.faithfulSMulLeft
#align prod.has_faithful_vadd_left Prod.faithfulVAddLeft
-/

#print Prod.faithfulSMulRight /-
@[to_additive]
instance faithfulSMulRight [Nonempty α] [FaithfulSMul M β] : FaithfulSMul M (α × β) :=
  ⟨fun x y h =>
    let ⟨a⟩ := ‹Nonempty α›
    eq_of_smul_eq_smul fun b : β => by injection h (a, b)⟩
#align prod.has_faithful_smul_right Prod.faithfulSMulRight
#align prod.has_faithful_vadd_right Prod.faithfulVAddRight
-/

end

#print Prod.smulCommClassBoth /-
@[to_additive]
instance smulCommClassBoth [Mul N] [Mul P] [SMul M N] [SMul M P] [SMulCommClass M N N]
    [SMulCommClass M P P] : SMulCommClass M (N × P) (N × P) :=
  ⟨fun c x y => by simp [smul_def, mul_def, mul_smul_comm]⟩
#align prod.smul_comm_class_both Prod.smulCommClassBoth
#align prod.vadd_comm_class_both Prod.vaddCommClassBoth
-/

#print Prod.isScalarTowerBoth /-
instance isScalarTowerBoth [Mul N] [Mul P] [SMul M N] [SMul M P] [IsScalarTower M N N]
    [IsScalarTower M P P] : IsScalarTower M (N × P) (N × P) :=
  ⟨fun c x y => by simp [smul_def, mul_def, smul_mul_assoc]⟩
#align prod.is_scalar_tower_both Prod.isScalarTowerBoth
-/

@[to_additive]
instance {m : Monoid M} [MulAction M α] [MulAction M β] : MulAction M (α × β)
    where
  mul_smul a₁ a₂ p := mk.inj_iff.mpr ⟨mul_smul _ _ _, mul_smul _ _ _⟩
  one_smul := fun ⟨b, c⟩ => mk.inj_iff.mpr ⟨one_smul _ _, one_smul _ _⟩

instance {R M N : Type _} [Zero M] [Zero N] [SMulZeroClass R M] [SMulZeroClass R N] :
    SMulZeroClass R (M × N) where smul_zero a := mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩

instance {R M N : Type _} [AddZeroClass M] [AddZeroClass N] [DistribSMul R M] [DistribSMul R N] :
    DistribSMul R (M × N) where smul_add a p₁ p₂ := mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩

instance {R M N : Type _} {r : Monoid R} [AddMonoid M] [AddMonoid N] [DistribMulAction R M]
    [DistribMulAction R N] : DistribMulAction R (M × N) :=
  { Prod.distribSmul with }

instance {R M N : Type _} {r : Monoid R} [Monoid M] [Monoid N] [MulDistribMulAction R M]
    [MulDistribMulAction R N] : MulDistribMulAction R (M × N)
    where
  smul_mul a p₁ p₂ := mk.inj_iff.mpr ⟨smul_mul' _ _ _, smul_mul' _ _ _⟩
  smul_one a := mk.inj_iff.mpr ⟨smul_one _, smul_one _⟩

end Prod

/-! ### Scalar multiplication as a homomorphism -/

section BundledSmul

/- warning: smul_mul_hom -> smulMulHom is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Monoid.{u1} α] [_inst_2 : Mul.{u2} β] [_inst_3 : MulAction.{u1, u2} α β _inst_1] [_inst_4 : IsScalarTower.{u1, u2, u2} α β β (MulAction.toHasSmul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β _inst_2) (MulAction.toHasSmul.{u1, u2} α β _inst_1 _inst_3)] [_inst_5 : SMulCommClass.{u1, u2, u2} α β β (MulAction.toHasSmul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β _inst_2)], MulHom.{max u1 u2, u2} (Prod.{u1, u2} α β) β (Prod.hasMul.{u1, u2} α β (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) _inst_2) _inst_2
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Monoid.{u1} α] [_inst_2 : Mul.{u2} β] [_inst_3 : MulAction.{u1, u2} α β _inst_1] [_inst_4 : IsScalarTower.{u1, u2, u2} α β β (MulAction.toSMul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β _inst_2) (MulAction.toSMul.{u1, u2} α β _inst_1 _inst_3)] [_inst_5 : SMulCommClass.{u1, u2, u2} α β β (MulAction.toSMul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β _inst_2)], MulHom.{max u2 u1, u2} (Prod.{u1, u2} α β) β (Prod.instMulProd.{u1, u2} α β (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)) _inst_2) _inst_2
Case conversion may be inaccurate. Consider using '#align smul_mul_hom smulMulHomₓ'. -/
/-- Scalar multiplication as a multiplicative homomorphism. -/
@[simps]
def smulMulHom [Monoid α] [Mul β] [MulAction α β] [IsScalarTower α β β] [SMulCommClass α β β] :
    α × β →ₙ* β where
  toFun a := a.1 • a.2
  map_mul' a b := (smul_mul_smul _ _ _ _).symm
#align smul_mul_hom smulMulHom

/- warning: smul_monoid_hom -> smulMonoidHom is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Monoid.{u1} α] [_inst_2 : MulOneClass.{u2} β] [_inst_3 : MulAction.{u1, u2} α β _inst_1] [_inst_4 : IsScalarTower.{u1, u2, u2} α β β (MulAction.toHasSmul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β (MulOneClass.toHasMul.{u2} β _inst_2)) (MulAction.toHasSmul.{u1, u2} α β _inst_1 _inst_3)] [_inst_5 : SMulCommClass.{u1, u2, u2} α β β (MulAction.toHasSmul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β (MulOneClass.toHasMul.{u2} β _inst_2))], MonoidHom.{max u1 u2, u2} (Prod.{u1, u2} α β) β (Prod.mulOneClass.{u1, u2} α β (Monoid.toMulOneClass.{u1} α _inst_1) _inst_2) _inst_2
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Monoid.{u1} α] [_inst_2 : MulOneClass.{u2} β] [_inst_3 : MulAction.{u1, u2} α β _inst_1] [_inst_4 : IsScalarTower.{u1, u2, u2} α β β (MulAction.toSMul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β (MulOneClass.toMul.{u2} β _inst_2)) (MulAction.toSMul.{u1, u2} α β _inst_1 _inst_3)] [_inst_5 : SMulCommClass.{u1, u2, u2} α β β (MulAction.toSMul.{u1, u2} α β _inst_1 _inst_3) (Mul.toSMul.{u2} β (MulOneClass.toMul.{u2} β _inst_2))], MonoidHom.{max u2 u1, u2} (Prod.{u1, u2} α β) β (Prod.instMulOneClassProd.{u1, u2} α β (Monoid.toMulOneClass.{u1} α _inst_1) _inst_2) _inst_2
Case conversion may be inaccurate. Consider using '#align smul_monoid_hom smulMonoidHomₓ'. -/
/-- Scalar multiplication as a monoid homomorphism. -/
@[simps]
def smulMonoidHom [Monoid α] [MulOneClass β] [MulAction α β] [IsScalarTower α β β]
    [SMulCommClass α β β] : α × β →* β :=
  { smulMulHom with map_one' := one_smul _ _ }
#align smul_monoid_hom smulMonoidHom

end BundledSmul


import tactic
import .topology
import .gluing
import .fiber_product

section fiber_space

variables {E E' B : Type} (π' : E' → B) (φ : E → E')

def res_base (U : set B) :
  φ ⁻¹' (π' ⁻¹' U) → π' ⁻¹' U :=
  subtype.map φ (by simp)

@[simp]
lemma res_base_def (U : set B)
  (a : E) (ha : a ∈ φ ⁻¹' (π' ⁻¹' U)) :
  res_base _ _ U ⟨a, ha⟩ = ⟨φ a, ha⟩ := rfl

lemma from_sub_res_image_of_to_sub
  (U : set B) (V : set E) :
  from_sub _ ((res_base π' φ U) '' (to_sub _ V)) =
    (π' ⁻¹' U) ∩ (φ '' V) :=
begin
  ext e', simp, split,
  rintro ⟨e'', he'', ⟨e, he⟩, he12⟩, rw he12 at *,
  exact ⟨he'', ⟨e, he.1, he.2.2⟩⟩,
  rintro ⟨he', e, he1, he2⟩, use e', split, exact he', use e,
  simp [he2], exact ⟨he1, he'⟩,
end

lemma from_sub_res_preimage_of_to_sub
  (U : set B) (V : set E') :
  from_sub _ ((res_base π' φ U) ⁻¹' (to_sub _ V)) =
    φ ⁻¹' ((π' ⁻¹' U) ∩ V) :=
begin
  unfold from_sub, unfold to_sub, unfold res_base,
  ext e, simp, split,
  rintro ⟨x, hx⟩, rw ← hx.2.2, exact ⟨hx.1, hx.2.1⟩,
  intro h, use e, simp, exact h,
end

lemma res_base_inj_of_inj
  (hφ_inj : function.injective φ) (U : set B) :
  function.injective (res_base π' φ U) :=
begin
  apply subtype.map_injective, exact hφ_inj,
end

lemma res_base_surj_of_surj
  (hφ_surj : function.surjective φ) (U : set B) :
  function.surjective (res_base π' φ U) :=
begin
  rintro ⟨x, hx⟩, obtain ⟨y, hy⟩ := hφ_surj x,
  use y, simp, rwa hy,
  simp, exact hy,
end

lemma res_base_bij_of_bij
  (hφ_bij : function.bijective φ) (U : set B) :
  function.bijective (res_base π' φ U) :=
begin
  split,
    apply res_base_inj_of_inj _ _ hφ_bij.1,
    apply res_base_surj_of_surj _ _ hφ_bij.2,
end

variables {I : Type} (U : cover I B)

lemma fiber_map_inj_iff_cover_inj :
  function.injective φ ↔
  ∀ i, function.injective (res_base π' φ (U i)) :=
begin
  split,
    intros hφ_inj i, apply res_base_inj_of_inj, exact hφ_inj,
  intros hφ_inj_cover e1 e2 he,
  obtain ⟨i, hi⟩ := U.hx (π' (φ e1)),
  specialize @hφ_inj_cover i ⟨e1, hi⟩ ⟨e2, by rwa he at hi⟩,
  simp at hφ_inj_cover, exact hφ_inj_cover he,
end

lemma fiber_map_surj_iff_cover_surj :
  function.surjective φ ↔
  ∀ i, function.surjective (res_base π' φ (U i)) :=
begin
  split,
    intros hφ_surj i, apply res_base_surj_of_surj, exact hφ_surj,
  intro hφ_surj_cover, intro e',
  obtain ⟨i, hi⟩ := U.hx (π' e'),
  obtain ⟨⟨a, ha⟩, ha'⟩ := hφ_surj_cover i ⟨e', hi⟩,
  use a, simp at ha', exact ha',
end

lemma fiber_map_bij_iff_cover_bij :
  function.bijective φ ↔
  ∀ i, function.bijective (res_base π' φ (U i)) :=
begin
  unfold function.bijective,
  rw forall_and_distrib,
  rw ← fiber_map_inj_iff_cover_inj,
  rw ← fiber_map_surj_iff_cover_surj,
end

section fiber_bundle

open topology

variables [topology B] [topology E] [topology E']
  {J : Type} (V : open_cover J B)

lemma res_base_cts_of_cts
  (hπ'_cts : cts π') (hφ_cts : cts φ) (U ∈ opens B) :
  cts (res_base π' φ U) :=
  subtype_map_cts hφ_cts

lemma fiber_map_cts_iff_cover_cts
  (hπ_cts : cts (π' ∘ φ)) (hπ'_cts : cts π') :
  cts φ ↔
  ∀ j, cts (res_base π' φ (V j)) :=
begin
  split,
    intros hφ_cts j,
    apply res_base_cts_of_cts _ _ hπ'_cts hφ_cts _ (V.hopen j),
  intros hφ_cts_cover,
  rw cts_iff_ptwise_cts, intros e W hW heW, simp,
  obtain ⟨j, hj⟩ := V.hx (π' (φ e)),
  use φ ⁻¹' (π' ⁻¹' (V j) ∩ W),
  split, -- proof of openness
    specialize hφ_cts_cover j (to_sub _ W),
    rw to_sub_open_iff at hφ_cts_cover,
    specialize hφ_cts_cover ⟨W, hW, rfl⟩,
    rw from_sub_open_iff at hφ_cts_cover,
    rwa ← from_sub_res_preimage_of_to_sub,
    rw ←set.preimage_comp,
    apply hπ_cts, exact V.hopen j,
  split, simp, simp, exact ⟨hj, heW⟩,
end

lemma res_base_open_map_of_open_map
  (hπ_cts : cts (π' ∘ φ)) (hπ'_cts : cts π')
  (hφ_open : open_map φ)
  (U ∈ opens B) :
  open_map (res_base π' φ U) :=
begin
  apply subtype_map_open, exact hφ_open,
  change ((π' ∘ φ) ⁻¹' U ∈ opens E), apply hπ_cts, exact ‹U ∈ opens B›,
end

lemma fiber_map_open_map_iff_res_open_map
  (hπ_cts : cts (π' ∘ φ)) (hπ'_cts : cts π') :
  open_map φ ↔
  ∀ j, open_map (res_base π' φ (V j)) :=
begin
  split,
    intros hφ_open j,
    apply res_base_open_map_of_open_map _ _ hπ_cts hπ'_cts hφ_open _ (V.hopen j),
  intros hφ_open_map W hW,
  rw subset_open_iff_open_cover (pullback_open_cover π' hπ'_cts V),
  intro j, change π' ⁻¹' (V j) ∩ φ '' W ∈ opens E',
  specialize hφ_open_map j (to_sub _ W),
  rw to_sub_open_iff at hφ_open_map,
  specialize hφ_open_map ⟨W, hW, rfl⟩,
  rw from_sub_open_iff at hφ_open_map,
  rwa ← from_sub_res_image_of_to_sub,
  apply hπ'_cts, exact V.hopen j,
end

lemma res_base_homeo_of_homeo
  (hπ_cts : cts (π' ∘ φ)) (hπ'_cts : cts π')
  (hφ_homeo : homeo φ)
  (U ∈ opens B) :
  homeo (res_base π' φ U) :=
begin
  rw homeo_iff at *,
  split,
    exact res_base_cts_of_cts _ _ hπ'_cts hφ_homeo.1 U ‹U ∈ opens B›,
  split,
    exact res_base_bij_of_bij _ _ hφ_homeo.2.1 U,
    exact res_base_open_map_of_open_map _ _ hπ_cts hπ'_cts hφ_homeo.2.2 U ‹U ∈ opens B›,
end

lemma fiber_map_homeo_iff_res_homeo
  (hπ_cts : cts (π' ∘ φ)) (hπ'_cts : cts π') :
  homeo φ ↔
  ∀ j, homeo (res_base π' φ (V j)) :=
begin
  split, intros hφ_homeo j,
    exact res_base_homeo_of_homeo _ _ hπ_cts hπ'_cts hφ_homeo (V j) (V.hopen j),
  intro hφ_homeo,
  rw [homeo_iff,
      fiber_map_cts_iff_cover_cts _ _ V hπ_cts hπ'_cts,
      fiber_map_bij_iff_cover_bij _ _ V.to_cover,
      fiber_map_open_map_iff_res_open_map _ _ V hπ_cts hπ'_cts,
      ← forall_and_distrib, ← forall_and_distrib],
  intro j, specialize hφ_homeo j, rwa homeo_iff at hφ_homeo,
end

end fiber_bundle
end fiber_space