d1174e10e6
Previously, the tactic state shown at `decreasing_by` would leak lots of details about the translation, and mention `invImage`, `PSigma` etc. This is not nice. So this introduces `clean_wf`, which is like `simp_wf` but using `simp`'s `only` mode, and runs this unconditionally. This should clean up the goal to a reasonable extent. Previously `simp_wf` was an unrestricted `simp […]` call, but we probably don’t want arbitrary simplification to happen at this point, so this now became `simp only` call. For backwards compatibility, `decreasing_with` begins with `try simp`. The `simp_wf` tactic is still available to not break too much existing code; it’s docstring suggests to no longer use it. With `set_option cleanDecreasingByGoal false` one can disable the use of `clean_wf`. I hope this is only needed for debugging and understanding. Migration advise: If your `decreasing_by` proof begins with `simp_wf`, either remove that (if the proof still goes through), or replace with `simp`. I am a bit anxious about running even `simp only` unconditionally here, as it may do more than some user might want, e.g. because of options like `zetaDelta := true`. We'll see if we need to reign in this tactic some more. I wonder if in corner cases the `simp_wf` tactic might be able to close the goal, and if that is a problem. If so, we may have to promote simp’s internal `mayCloseGoal` parameter to a simp configuration option and use that here. fixes #4928
69 lines
3.2 KiB
Text
69 lines
3.2 KiB
Text
def HList (αs : List (Type u)) : Type u := αs.foldr Prod.{u, u} PUnit
|
||
|
||
@[match_pattern] def HList.nil : HList [] := ⟨⟩
|
||
@[match_pattern] def HList.cons (a : α) (as : HList αs): HList (α :: αs) := (a, as)
|
||
|
||
def HList.set : {αs : _} → HList αs → (i : Fin αs.length) → αs.get i → HList αs
|
||
| _ :: _, cons a as, ⟨0, h⟩, b => cons b as
|
||
| _ :: _, cons a as, ⟨Nat.succ n, h⟩, b => cons a (set as ⟨n, Nat.le_of_succ_le_succ h⟩ b)
|
||
| [], nil, _, _ => nil
|
||
|
||
instance : EmptyCollection (HList ∅) where
|
||
emptyCollection := HList.nil
|
||
|
||
notation:30 Γ " ⊢ " α => HList Γ → α
|
||
|
||
-- simplify well-founded recursion proofs by ignoring context sizes
|
||
local instance : SizeOf (List α) := ⟨fun _ => 0⟩ in
|
||
|
||
-- m: base monad
|
||
-- ω: `return` type, `m ω` is the type of the entire `do` block
|
||
-- Γ: `do`-local immutable context
|
||
-- Δ: `do`-local mutable context
|
||
-- b: `break` allowed
|
||
-- c: `continue` allowed
|
||
-- α: local result type, `m α` is the type of the statement
|
||
inductive Stmt (m : Type u → Type _) (ω : Type u) : (Γ Δ : List (Type u)) → (b c : Bool) → (α : Type u) → Type _ where
|
||
| expr (e : Γ ⊢ Δ ⊢ m α) : Stmt m ω Γ Δ b c α
|
||
| bind (s₁ : Stmt m ω Γ Δ b c α) (s₂ : Stmt m ω (α :: Γ) Δ b c β) : Stmt m ω Γ Δ b c β
|
||
| letmut (e : Γ ⊢ Δ ⊢ α) (s : Stmt m ω Γ (α :: Δ) b c β) : Stmt m ω Γ Δ b c β
|
||
| ass (x : Fin Δ.length) (e : Γ ⊢ Δ ⊢ Δ.get x) : Stmt m ω Γ Δ b c PUnit
|
||
| ite (e : Γ ⊢ Δ ⊢ Bool) (s₁ s₂ : Stmt m ω Γ Δ b c α) : Stmt m ω Γ Δ b c α
|
||
| ret (e : Γ ⊢ Δ ⊢ ω) : Stmt m ω Γ Δ b c α
|
||
--| sfor [ForM m γ α] (e : Σ Γ → γ) (body : α → Stmt m ω Γ Δ true PUnit) : Stmt m ω Γ Δ b c PUnit
|
||
| sfor (e : Γ ⊢ Δ ⊢ List α) (body : Stmt m ω (α :: Γ) Δ true true PUnit) : Stmt m ω Γ Δ b c PUnit
|
||
| sbreak : Stmt m ω Γ Δ true c α
|
||
| scont : Stmt m ω Γ Δ b true α
|
||
|
||
-- normal and abnormal result values
|
||
inductive Res (ω α : Type _) : (b c : Bool) → Type _ where
|
||
| val (a : α) : Res ω α b c
|
||
| ret (o : ω) : Res ω α b c
|
||
| rbreak : Res ω α true c
|
||
| rcont : Res ω α b true
|
||
|
||
instance : Coe α (Res ω α b c) := ⟨Res.val⟩
|
||
instance : Coe (Id α) (Res ω α b c) := ⟨Res.val⟩
|
||
|
||
def Ctx.extendBot (x : α) : {Γ : _} → HList Γ → HList (Γ ++ [α])
|
||
| [], _ => HList.cons x HList.nil
|
||
| _ :: _, HList.cons a as => HList.cons a (extendBot x as)
|
||
|
||
def Ctx.extend (x : α) : HList Γ → HList (α :: Γ) :=
|
||
fun σ => HList.cons x σ
|
||
|
||
def Ctx.drop : HList (α :: Γ) → HList Γ
|
||
| HList.cons a as => as
|
||
|
||
@[simp]
|
||
def Stmt.mapCtx (f : HList Γ' → HList Γ) : Stmt m ω Γ Δ b c β → Stmt m ω Γ' Δ b c β
|
||
| expr e => expr (e ∘ f)
|
||
| bind s₁ s₂ => bind (s₁.mapCtx f) (s₂.mapCtx (fun | HList.cons a as => HList.cons a (f as)))
|
||
| letmut e s => letmut (e ∘ f) (s.mapCtx f)
|
||
| ass x e => ass x (e ∘ f)
|
||
| ite e s₁ s₂ => ite (e ∘ f) (s₁.mapCtx f) (s₂.mapCtx f)
|
||
| ret e => ret (e ∘ f)
|
||
| sfor e body => sfor (e ∘ f) (body.mapCtx (fun | HList.cons a as => HList.cons a (f as)))
|
||
| sbreak => sbreak
|
||
| scont => scont
|
||
termination_by s => sizeOf s
|