143 lines
5.3 KiB
Text
143 lines
5.3 KiB
Text
/-
|
|
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
|
|
Released under Apache 2.0 license as described in the file LICENSE.
|
|
Authors: Leonardo de Moura
|
|
-/
|
|
prelude
|
|
import init.logic init.binary init.combinator init.meta.interactive init.meta.decl_cmds
|
|
|
|
/- Make sure instances defined in this file have lower priority than the ones
|
|
defined for concrete structures -/
|
|
set_option default_priority 100
|
|
|
|
universe variable u
|
|
variables {A : Type u}
|
|
|
|
class semigroup (A : Type u) extends has_mul A :=
|
|
(mul_assoc : ∀ a b c : A, a * b * c = a * (b * c))
|
|
|
|
class comm_semigroup (A : Type u) extends semigroup A :=
|
|
(mul_comm : ∀ a b : A, a * b = b * a)
|
|
|
|
class left_cancel_semigroup (A : Type u) extends semigroup A :=
|
|
(mul_left_cancel : ∀ a b c : A, a * b = a * c → b = c)
|
|
|
|
class right_cancel_semigroup (A : Type u) extends semigroup A :=
|
|
(mul_right_cancel : ∀ a b c : A, a * b = c * b → a = c)
|
|
|
|
class monoid (A : Type u) extends semigroup A, has_one A :=
|
|
(one_mul : ∀ a : A, 1 * a = a) (mul_one : ∀ a : A, a * 1 = a)
|
|
|
|
class comm_monoid (A : Type u) extends monoid A, comm_semigroup A
|
|
|
|
class group (A : Type u) extends monoid A, has_inv A :=
|
|
(mul_left_inv : ∀ a : A, a⁻¹ * a = 1)
|
|
|
|
class comm_group (A : Type u) extends group A, comm_monoid A
|
|
|
|
@[simp] lemma mul_assoc [semigroup A] : ∀ a b c : A, a * b * c = a * (b * c) :=
|
|
semigroup.mul_assoc
|
|
|
|
@[simp] lemma mul_comm [comm_semigroup A] : ∀ a b : A, a * b = b * a :=
|
|
comm_semigroup.mul_comm
|
|
|
|
@[simp] lemma mul_left_comm [comm_semigroup A] : ∀ a b c : A, a * (b * c) = b * (a * c) :=
|
|
left_comm mul mul_comm mul_assoc
|
|
|
|
lemma mul_left_cancel [left_cancel_semigroup A] {a b c : A} : a * b = a * c → b = c :=
|
|
left_cancel_semigroup.mul_left_cancel a b c
|
|
|
|
lemma mul_right_cancel [right_cancel_semigroup A] {a b c : A} : a * b = c * b → a = c :=
|
|
right_cancel_semigroup.mul_right_cancel a b c
|
|
|
|
@[simp] lemma one_mul [monoid A] : ∀ a : A, 1 * a = a :=
|
|
monoid.one_mul
|
|
|
|
@[simp] lemma mul_one [monoid A] : ∀ a : A, a * 1 = a :=
|
|
monoid.mul_one
|
|
|
|
@[simp] lemma mul_left_inv [group A] : ∀ a : A, a⁻¹ * a = 1 :=
|
|
group.mul_left_inv
|
|
|
|
/- Additive "sister" structures.
|
|
Example, add_semigroup mirrors semigroup.
|
|
These structures exist just to help automation.
|
|
In an alternative design, we could have the binary operation as an
|
|
extra argument for semigroup, monoid, group, etc. However, the lemmas
|
|
would be hard to index since they would not contain any constant.
|
|
For example, mul_assoc would be
|
|
|
|
lemma mul_assoc {A : Type u} {op : A → A → A} [semigroup A op] :
|
|
∀ a b c : A, op (op a b) c = op a (op b c) :=
|
|
semigroup.mul_assoc
|
|
|
|
The simplifier cannot effectively use this lemma since the pattern for
|
|
the left-hand-side would be
|
|
|
|
?op (?op ?a ?b) ?c
|
|
|
|
Remark: we use a tactic for transporting theorems from the multiplicative fragment
|
|
to the additive one.
|
|
-/
|
|
|
|
@[class] def add_semigroup := semigroup
|
|
@[class] def add_monoid := monoid
|
|
@[class] def add_group := group
|
|
@[class] def add_comm_semigroup := comm_semigroup
|
|
@[class] def add_comm_monoid := comm_monoid
|
|
@[class] def add_comm_group := comm_group
|
|
|
|
instance add_semigroup.to_has_add {A : Type u} [s : add_semigroup A] : has_add A :=
|
|
⟨@semigroup.mul A s⟩
|
|
instance add_monoid.to_has_zero {A : Type u} [s : add_monoid A] : has_zero A :=
|
|
⟨@monoid.one A s⟩
|
|
instance add_group.to_has_neg {A : Type u} [s : add_group A] : has_neg A :=
|
|
⟨@group.inv A s⟩
|
|
|
|
meta def multiplicative_to_additive : name_map name :=
|
|
rb_map.of_list $
|
|
[/- map operations -/
|
|
(`mul, `add), (`one, `zero), (`inv, `neg),
|
|
/- map structures -/
|
|
(`semigroup, `add_semigroup),
|
|
(`monoid, `add_monoid),
|
|
(`group, `add_group),
|
|
(`comm_semigroup, `add_comm_semigroup),
|
|
(`comm_monoid, `add_comm_monoid),
|
|
(`comm_group, `add_comm_group),
|
|
/- map instances -/
|
|
(`semigroup.to_has_mul, `add_semigroup.to_has_add),
|
|
(`monoid.to_has_one, `add_monoid.to_has_zero),
|
|
(`group.to_has_inv, `add_group.to_has_neg),
|
|
(`comm_semigroup.to_semigroup, `add_comm_semigroup.to_add_semigroup),
|
|
(`monoid.to_semigroup, `add_monoid.to_add_semigroup),
|
|
(`comm_monoid.to_monoid, `add_comm_monoid.to_add_monoid),
|
|
(`comm_monoid.to_comm_semigroup, `add_comm_monoid.to_add_comm_semigroup),
|
|
(`group.to_monoid, `add_group.to_add_monoid),
|
|
(`comm_group.to_group, `add_comm_group.to_add_group),
|
|
(`comm_group.to_comm_monoid, `add_comm_group.to_add_comm_monoid)
|
|
]
|
|
|
|
open tactic
|
|
|
|
meta def transport_to_additive (src : name) (tgt : name) : command :=
|
|
copy_decl_updating_type multiplicative_to_additive src tgt
|
|
>> copy_attribute `reducible src tt tgt
|
|
>> copy_attribute `simp src tt tgt
|
|
>> copy_attribute `instance src tt tgt
|
|
|
|
/- Make sure all constants at multiplicative_to_additive are declared -/
|
|
meta def init_multiplicative_to_additive : command :=
|
|
multiplicative_to_additive^.fold skip (λ s t tac, do
|
|
env ← get_env,
|
|
if (env^.get t)^.to_bool = ff
|
|
then tac >> transport_to_additive s t
|
|
else tac)
|
|
|
|
run_command init_multiplicative_to_additive
|
|
run_command transport_to_additive `mul_assoc `add_assoc
|
|
run_command transport_to_additive `mul_comm `add_comm
|
|
run_command transport_to_additive `mul_left_comm `add_left_comm
|
|
run_command transport_to_additive `one_mul `zero_add
|
|
run_command transport_to_additive `mul_one `add_zero
|
|
run_command transport_to_additive `mul_left_inv `add_left_neg
|