feat: support Sort u in ac_refl.

This commit is contained in:
Daniel Fabian 2022-03-09 21:44:25 +00:00 committed by Leonardo de Moura
parent 8e0763f502
commit cf4e873974
4 changed files with 28 additions and 12 deletions

View file

@ -1112,16 +1112,16 @@ constant reduceNat (n : Nat) : Nat := n
axiom ofReduceBool (a b : Bool) (h : reduceBool a = b) : a = b
axiom ofReduceNat (a b : Nat) (h : reduceNat a = b) : a = b
class IsAssociative (op : ααα) where
class IsAssociative {α : Sort u} (op : ααα) where
assoc : (a b c : α) → op (op a b) c = op a (op b c)
class IsCommutative (op : ααα) where
class IsCommutative {α : Sort u} (op : ααα) where
comm : (a b : α) → op a b = op b a
class IsIdempotent (op : ααα) where
class IsIdempotent {α : Sort u} (op : ααα) where
idempotent : (x : α) → op x x = x
class IsNeutral (op : ααα) (neutral : α) where
class IsNeutral {α : Sort u} (op : ααα) (neutral : α) where
left_neutral : (a : α) → op neutral a = a
right_neutral : (a : α) → op a neutral = a

View file

@ -14,11 +14,11 @@ inductive Expr
| op (lhs rhs : Expr)
deriving Inhabited, Repr, BEq
structure Variable (op : ααα) where
structure Variable {α : Sort u} (op : ααα) : Type u where
value : α
neutral : Option $ IsNeutral op value
structure Context (α : Type u) where
structure Context (α : Sort u) where
op : ααα
assoc : IsAssociative op
comm : Option $ IsCommutative op
@ -26,12 +26,12 @@ structure Context (α : Type u) where
vars : List (Variable op)
arbitrary : α
class ContextInformation (α : Type u) where
class ContextInformation (α : Sort u) where
isNeutral : α → Nat → Bool
isComm : α → Bool
isIdem : α → Bool
class EvalInformation (α : Type u) (β : Type v) where
class EvalInformation (α : Sort u) (β : Sort v) where
arbitrary : α → β
evalOp : α → β → β → β
evalVar : α → Nat → β
@ -49,7 +49,7 @@ instance : EvalInformation (Context α) α where
evalOp ctx := ctx.op
evalVar ctx idx := ctx.var idx |>.value
def eval (β : Type u) [EvalInformation α β] (ctx : α) : (ex : Expr) → β
def eval (β : Sort u) [EvalInformation α β] (ctx : α) : (ex : Expr) → β
| Expr.var idx => EvalInformation.evalVar ctx idx
| Expr.op l r => EvalInformation.evalOp ctx (eval β ctx l) (eval β ctx r)
@ -57,7 +57,7 @@ def Expr.toList : Expr → List Nat
| Expr.var idx => [idx]
| Expr.op l r => l.toList.append r.toList
def evalList (β : Type u) [EvalInformation α β] (ctx : α) : List Nat → β
def evalList (β : Sort u) [EvalInformation α β] (ctx : α) : List Nat → β
| [] => EvalInformation.arbitrary ctx
| [x] => EvalInformation.evalVar ctx x
| x :: xs => EvalInformation.evalOp ctx (EvalInformation.evalVar ctx x) (evalList β ctx xs)

View file

@ -93,7 +93,7 @@ def buildNormProof (preContext : PreContext) (l r : Expr) : MetaM (Lean.Expr ×
let rhs ← convert acExprNormed
let α ← inferType vars[0]
let u ← getLevel α
let proof := mkAppN (mkConst ``Context.eq_of_norm [u.dec.get!]) #[α, context, lhs, rhs, ←mkEqRefl (mkConst ``Bool.true)]
let proof := mkAppN (mkConst ``Context.eq_of_norm [u]) #[α, context, lhs, rhs, ←mkEqRefl (mkConst ``Bool.true)]
return (proof, tgt)
where
mkContext (vars : Array Expr) : MetaM (Array Bool × Expr) := do

View file

@ -33,6 +33,22 @@ instance : IsCommutative (α := Nat) max := ⟨max_comm⟩
instance : IsIdempotent (α := Nat) max := ⟨max_idem⟩
instance : IsNeutral max 0 := ⟨Nat.zero_max, Nat.max_zero⟩
instance : IsAssociative And := ⟨λ p q r => propext ⟨λ ⟨⟨hp, hq⟩, hr⟩ => ⟨hp, hq, hr⟩, λ ⟨hp, hq, hr⟩ => ⟨⟨hp, hq⟩, hr⟩⟩⟩
instance : IsCommutative And := ⟨λ p q => propext ⟨λ ⟨hp, hq⟩ => ⟨hq, hp⟩, λ ⟨hq, hp⟩ => ⟨hp, hq⟩⟩⟩
instance : IsIdempotent And := ⟨λ p => propext ⟨λ ⟨hp, _⟩ => hp, λ hp => ⟨hp, hp⟩⟩⟩
instance : IsNeutral And True :=
⟨λ p => propext ⟨λ ⟨_, hp⟩ => hp, λ hp => ⟨True.intro, hp⟩⟩, λ p => propext ⟨λ ⟨hp, _⟩ => hp, λ hp => ⟨hp, True.intro⟩⟩⟩
theorem or_assoc (p q r : Prop) : ((p q) r) = (p q r) :=
propext ⟨λ hpqr => hpqr.elim (λ hpq => hpq.elim Or.inl $ λ hq => Or.inr $ Or.inl hq) $ λ hr => Or.inr $ Or.inr hr,
λ hpqr => hpqr.elim (λ hp => Or.inl $ Or.inl hp) $ λ hqr => hqr.elim (λ hq => Or.inl $ Or.inr hq) Or.inr⟩
instance : IsAssociative Or := ⟨or_assoc⟩
instance : IsCommutative Or := ⟨λ p q => propext ⟨λ hpq => hpq.elim Or.inr Or.inl, λ hqp => hqp.elim Or.inr Or.inl⟩⟩
instance : IsIdempotent Or := ⟨λ p => propext ⟨λ hp => hp.elim id id, Or.inl⟩⟩
instance : IsNeutral Or False :=
⟨λ p => propext ⟨λ hfp => hfp.elim False.elim id, Or.inr⟩, λ p => propext ⟨λ hpf => hpf.elim id False.elim, Or.inl⟩⟩
example (x y z : Nat) : x + y + 0 + z = z + (x + y) := by ac_refl
example (x y z : Nat) : (x + y) * (0 + z) = (x + y) * z:= by ac_refl
@ -64,5 +80,5 @@ theorem ex₃ (n : Nat) : (fun x => n + x) = (fun x => x + n) := by
#print ex₃
-- Repro: the Prop universe doesn't work
example (p q : Prop) : p p q ∧ True = q p := by
example (p q : Prop) : (p p q ∧ True) = (q p) := by
ac_refl