Skip to content

Commit 7367808

Browse files
lukaszczlukaszcz
committed
args approx
1 parent ca18db5 commit 7367808

File tree

2 files changed

+81
-56
lines changed

2 files changed

+81
-56
lines changed

‎Juvix/Core/Main/Semantics/Equiv.lean

Lines changed: 66 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ import Juvix.Core.Main.Semantics.Eval
33
import Juvix.Core.Main.Semantics.Eval.Indexed
44
import Juvix.Utils
55
import Mathlib.Tactic.Linarith
6+
import Mathlib.Data.List.Forall2
67
import Aesop
78

89
namespace Juvix.Core.Main
@@ -13,9 +14,7 @@ def Value.Approx.Indexed (n : Nat) (v₁ v₂ : Value) : Prop :=
1314
(∃ ctr_name args_rev args_rev',
1415
v₁ = Value.constr_app ctr_name args_rev ∧
1516
v₂ = Value.constr_app ctr_name args_rev' ∧
16-
args_rev.length = args_rev'.length ∧
17-
(∀ k < n, ∀ p ∈ List.zip args_rev args_rev',
18-
Value.Approx.Indexed k (Prod.fst p) (Prod.snd p))) ∨
17+
(∀ k < n, List.Forall₂ (Value.Approx.Indexed k) args_rev args_rev')) ∨
1918
(∃ env₁ body₁ env₂ body₂,
2019
v₁ = Value.closure env₁ body₁ ∧
2120
v₂ = Value.closure env₂ body₂ ∧
@@ -29,11 +28,24 @@ def Value.Approx.Indexed (n : Nat) (v₁ v₂ : Value) : Prop :=
2928

3029
notation:40 v:40 " ≲(" n:40 ") " v':40 => Value.Approx.Indexed n v v'
3130

31+
notation:40 args₁:40 " ≲ₐ(" n:40 ") " args₂:40 => List.Forall₂ (Value.Approx.Indexed n) args₁ args₂
32+
3233
def Value.Approx (v v' : Value) : Prop :=
3334
∀ n, v ≲(n) v'
3435

3536
notation:40 v:40 " ≲ " v':40 => Value.Approx v v'
3637

38+
notation:40 args₁:40 " ≲ₐ " args₂:40 => List.Forall₂ Value.Approx args₁ args₂
39+
40+
def Object.Value.Approx.Indexed (n : Nat) : Object → Object → Prop
41+
| Object.value v₁, Object.value v₂ => v₁ ≲(n) v₂
42+
| _, _ => False
43+
44+
def Env.Approx.Indexed (n : Nat) : (env₁ env₂ : Env) → Prop :=
45+
List.Forall₂ (Object.Value.Approx.Indexed n)
46+
47+
notation:40 env₁:40 " ≲ₑ(" n:40 ") " env₂:40 => Env.Approx.Indexed n env₁ env₂
48+
3749
def Expr.Approx (env₁ env₂ : Env) (e₁ e₂ : Expr) : Prop :=
3850
(∀ v₁, env₁ ⊢ e₁ ↦ v₁ → ∃ v₂, env₂ ⊢ e₂ ↦ v₂ ∧ v₁ ≲ v₂)
3951

@@ -56,10 +68,9 @@ lemma Value.Approx.Indexed.const {n c} : Value.const c ≲(n) Value.const c := b
5668

5769
@[aesop unsafe apply]
5870
lemma Value.Approx.Indexed.constr_app {n ctr_name args_rev args_rev'} :
59-
args_rev.length = args_rev'.length →
60-
(∀ k < n, ∀ p ∈ List.zip args_rev args_rev', p.1 ≲(k) p.2) →
71+
(∀ k < n, args_rev ≲ₐ(k) args_rev') →
6172
Value.constr_app ctr_name args_rev ≲(n) Value.constr_app ctr_name args_rev' := by
62-
intro hlen h
73+
intro h
6374
unfold Value.Approx.Indexed
6475
simp only [reduceCtorEq, and_self, exists_const, constr_app.injEq, Prod.forall, exists_and_left,
6576
false_and, or_false, false_or]
@@ -90,8 +101,7 @@ inductive Value.Approx.Indexed.Inversion (n : Nat) : Value → Value → Prop wh
90101
| unit : Value.Approx.Indexed.Inversion n Value.unit Value.unit
91102
| const {c} : Value.Approx.Indexed.Inversion n (Value.const c) (Value.const c)
92103
| constr_app {ctr_name args_rev args_rev'} :
93-
args_rev.length = args_rev'.length →
94-
(∀ k < n, ∀ p ∈ List.zip args_rev args_rev', p.1 ≲(k) p.2) →
104+
(∀ k < n, args_rev ≲ₐ(k) args_rev') →
95105
Value.Approx.Indexed.Inversion n (Value.constr_app ctr_name args_rev) (Value.constr_app ctr_name args_rev')
96106
| closure {env₁ body₁ env₂ body₂} :
97107
(∀ n₁ n₂, n₁ + n₂ < n →
@@ -111,14 +121,14 @@ lemma Value.Approx.Indexed.invert {n v v'} :
111121
rcases h with
112122
⟨h₁, h₂⟩ |
113123
⟨c, h₁, h₂⟩ |
114-
⟨ctr_name, args_rev, args_rev', h₁, h₂, hlen, hargs⟩ |
124+
⟨ctr_name, args_rev, args_rev', h₁, h₂, hargs⟩ |
115125
⟨env₁, body₁, env₂, body₂, h₁, h₂, h⟩
116126
· subst h₁ h₂
117127
exact Value.Approx.Indexed.Inversion.unit
118128
· subst h₁ h₂
119129
exact Value.Approx.Indexed.Inversion.const
120130
· subst h₁ h₂
121-
exact Value.Approx.Indexed.Inversion.constr_app hlen hargs
131+
exact Value.Approx.Indexed.Inversion.constr_app hargs
122132
· subst h₁ h₂
123133
exact Value.Approx.Indexed.Inversion.closure h
124134

@@ -138,9 +148,8 @@ lemma Value.Approx.Indexed.anti_monotone {n n' v₁ v₂} (h : v₁ ≲(n) v₂)
138148
exact Value.Approx.Indexed.unit
139149
case const =>
140150
exact Value.Approx.Indexed.const
141-
case constr_app ctr_name args_rev args_rev' hlen hargs =>
151+
case constr_app ctr_name args_rev args_rev' hargs =>
142152
apply Value.Approx.Indexed.constr_app
143-
· assumption
144153
· intros
145154
have : k = 0 := by linarith
146155
subst k
@@ -158,12 +167,11 @@ lemma Value.Approx.Indexed.anti_monotone {n n' v₁ v₂} (h : v₁ ≲(n) v₂)
158167
exact Value.Approx.Indexed.unit
159168
case const =>
160169
exact Value.Approx.Indexed.const
161-
case constr_app ctr_name args_rev args_rev' hlen hargs =>
170+
case constr_app ctr_name args_rev args_rev' hargs =>
162171
apply Value.Approx.Indexed.constr_app
163-
· assumption
164-
· intros k' hk' p hp
165-
have h : k' ≤ n := by linarith
166-
aesop
172+
· intros k' hk'
173+
have : k' < n + 1 := by linarith
174+
simp_all only
167175
case closure env₁ body₁ env₂ body₂ ch =>
168176
apply Value.Approx.Indexed.closure
169177
· intro n₁ n₂ hn a₁ a₂ v₁ happrox heval
@@ -189,7 +197,6 @@ lemma Value.Approx.Indexed.refl {n} v : v ≲(n) v := by
189197
exact Value.Approx.Indexed.const
190198
case constr_app ctr_name args_rev =>
191199
apply Value.Approx.Indexed.constr_app
192-
· rfl
193200
· intros
194201
have : k = 0 := by linarith
195202
subst k
@@ -209,12 +216,11 @@ lemma Value.Approx.Indexed.refl {n} v : v ≲(n) v := by
209216
exact Value.Approx.Indexed.const
210217
case constr_app ctr_name args_rev =>
211218
apply Value.Approx.Indexed.constr_app
212-
· rfl
213-
· intros k' hk' p hp
214-
have h : p.fst = p.snd := Utils.zip_refl_eq args_rev p hp
215-
rw [h]
219+
· intros k' hk'
216220
have : k' ≤ n := by linarith
217-
aesop
221+
rw [List.forall₂_same]
222+
intros
223+
simp_all only
218224
case closure env body =>
219225
apply Value.Approx.Indexed.closure
220226
· intros k' hk' va₁ va₂ v₁ happrox heval
@@ -239,10 +245,10 @@ lemma Value.Approx.Indexed.trans {n v₁ v₂ v₃} : v₁ ≲(n) v₂ → v₂
239245
invert h₂
240246
case const =>
241247
exact Value.Approx.Indexed.const
242-
case constr_app ctr_name args_rev₁ args_rev₁' hlen₁ ch₁ =>
248+
case constr_app ctr_name args_rev₁ args_rev₁' ch₁ =>
243249
cases h₂.invert
244-
case constr_app args_rev₂ hlen₂ ch₂ =>
245-
apply Value.Approx.Indexed.constr_app <;> aesop
250+
case constr_app args_rev₂ ch₂ =>
251+
apply Value.Approx.Indexed.constr_app; aesop
246252
case closure env₁ body₁ env₁' body₁' ch₁ =>
247253
cases h₂.invert
248254
case closure env₂ body₂ ch₂ =>
@@ -262,15 +268,18 @@ lemma Value.Approx.Indexed.trans {n v₁ v₂ v₃} : v₁ ≲(n) v₂ → v₂
262268
invert h₂
263269
case const =>
264270
exact Value.Approx.Indexed.const
265-
case constr_app ctr_name args_rev args_rev' hlen₁ ch₁ =>
271+
case constr_app ctr_name args_rev args_rev' ch₁ =>
266272
invert h₂
267-
case constr_app args_rev'' hlen₂ ch₂ =>
273+
case constr_app args_rev'' ch₂ =>
268274
apply Value.Approx.Indexed.constr_app
269-
· aesop
270-
· intro k' hk' p hp
271-
obtain ⟨p₁, hp₁, p₂, hp₂, h₁, h₂, h₃⟩ := Utils.zip_ex_mid3 args_rev args_rev' args_rev'' p hlen₁ hlen₂ hp
272-
have : k' ≤ n := by linarith
273-
aesop
275+
· intro k' hk'
276+
have hk' : k' ≤ n := by linarith
277+
apply Utils.forall₂_trans
278+
· unfold Transitive
279+
intro v₁ v₂ v₃
280+
exact ih k' hk'
281+
· aesop
282+
· aesop
274283
case closure env₁ body₁ env₂ body₂ ch₁ =>
275284
invert h₂
276285
case closure env₃ body₃ ch₂ =>
@@ -362,10 +371,12 @@ lemma Value.Approx.const_right {v c} : Value.const c ≲ v ↔ v = Value.const c
362371

363372
@[aesop unsafe apply]
364373
lemma Value.Approx.constr_app {ctr_name args_rev args_rev'} :
365-
args_rev.length = args_rev'.length →
366-
(∀ p ∈ List.zip args_rev args_rev', Prod.fst p ≲ Prod.snd p) →
374+
args_rev ≲ₐ args_rev' →
367375
Value.constr_app ctr_name args_rev ≲ Value.constr_app ctr_name args_rev' := by
368-
intro hlen h n
376+
intro h n
377+
apply Value.Approx.Indexed.constr_app
378+
intro k hk
379+
rw [List.forall₂_iff_zip] at *
369380
aesop
370381

371382
lemma Value.Approx.closure {env₁ body₁ env₂ body₂} :
@@ -379,37 +390,38 @@ lemma Value.Approx.closure {env₁ body₁ env₂ body₂} :
379390
@[aesop safe destruct]
380391
lemma Value.Approx.constr_app_inv {ctr_name args_rev args_rev'} :
381392
Value.constr_app ctr_name args_rev ≲ Value.constr_app ctr_name args_rev' →
382-
(∀ p ∈ List.zip args_rev args_rev', Prod.fst p ≲ Prod.snd p) ∧
383-
args_rev.length = args_rev'.length := by
393+
args_rev ≲ₐ args_rev' := by
394+
rw [List.forall₂_iff_zip]
384395
intro h
385396
constructor
386397
case left =>
387-
intros p hp n
388-
invert (h (n + 1))
389-
aesop
398+
invert (h 1)
399+
case constr_app hargs =>
400+
specialize (hargs 0 _)
401+
· linarith
402+
· exact List.Forall₂.length_eq hargs
390403
case right =>
391-
invert (h 0)
392-
aesop
404+
intros v₁ v₂ hv n
405+
invert (h (n + 1))
406+
case constr_app hargs =>
407+
specialize (hargs n _)
408+
· linarith
409+
· rw [List.forall₂_iff_zip] at hargs
410+
aesop
393411

394412
lemma Value.Approx.constr_app_inv_length {ctr_name args_rev args_rev'} :
395413
Value.constr_app ctr_name args_rev ≲ Value.constr_app ctr_name args_rev' →
396414
args_rev.length = args_rev'.length := by
397415
intro h
398-
exact (Value.Approx.constr_app_inv h).right
399-
400-
lemma Value.Approx.constr_app_inv_args {ctr_name args_rev args_rev'} :
401-
Value.constr_app ctr_name args_rev ≲ Value.constr_app ctr_name args_rev' →
402-
∀ p ∈ List.zip args_rev args_rev', Prod.fst p ≲ Prod.snd p := by
403-
intro h
404-
exact (Value.Approx.constr_app_inv h).left
416+
have := Value.Approx.constr_app_inv h
417+
exact List.Forall₂.length_eq this
405418

406419
@[aesop unsafe 90% destruct]
407420
lemma Value.Approx.constr_app_inv_left {ctr_name args_rev' v} :
408421
v ≲ Value.constr_app ctr_name args_rev' →
409422
∃ args_rev,
410423
v = Value.constr_app ctr_name args_rev ∧
411-
args_rev.length = args_rev'.length ∧
412-
∀ p ∈ List.zip args_rev args_rev', Prod.fst p ≲ Prod.snd p := by
424+
args_rev ≲ₐ args_rev' := by
413425
intro h
414426
invert (h 0)
415427
aesop
@@ -419,8 +431,7 @@ lemma Value.Approx.constr_app_inv_right {ctr_name args_rev v} :
419431
Value.constr_app ctr_name args_rev ≲ v →
420432
∃ args_rev',
421433
v = Value.constr_app ctr_name args_rev' ∧
422-
args_rev.length = args_rev'.length ∧
423-
∀ p ∈ List.zip args_rev args_rev', Prod.fst p ≲ Prod.snd p := by
434+
args_rev ≲ₐ args_rev' := by
424435
intro h
425436
invert (h 0)
426437
aesop
@@ -475,8 +486,7 @@ inductive Value.Approx.Inversion : Value -> Value -> Prop where
475486
| unit : Value.Approx.Inversion Value.unit Value.unit
476487
| const {c} : Value.Approx.Inversion (Value.const c) (Value.const c)
477488
| constr_app {ctr_name args_rev args_rev'} :
478-
args_rev.length = args_rev'.length →
479-
(∀ p ∈ List.zip args_rev args_rev', p.1 ≲ p.2) →
489+
args_rev ≲ₐ args_rev' →
480490
Value.Approx.Inversion (Value.constr_app ctr_name args_rev) (Value.constr_app ctr_name args_rev')
481491
| closure {env₁ body₁ env₂ body₂} :
482492
(∀ a₁ a₂, a₁ ≲ a₂ → body₁ ≲⟨a₁ ∷ env₁, a₂ ∷ env₂⟩ body₂) →

‎Juvix/Utils.lean

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11

2+
import Mathlib.Order.Defs.Unbundled
23
import Aesop
34

45
namespace Juvix.Utils
@@ -68,4 +69,18 @@ theorem zip_ex_mid3 {α} (l₁ l₂ l₃ : List α) (p : α × α)
6869
obtain ⟨p₁, hp₁, p₂, hp₂, h₁, h₂⟩ := ih ys zs hl₁ hl₂ ht
6970
exact ⟨p₁, List.mem_cons_of_mem _ hp₁, p₂, List.mem_cons_of_mem _ hp₂, h₁, h₂⟩
7071

72+
theorem forall₂_trans {α} {P : α → α → Prop} (h : Transitive P) : Transitive (List.Forall₂ P) := by
73+
intro l₁ l₂ l₃ h₁ h₂
74+
induction h₁ generalizing l₃
75+
case nil =>
76+
cases h₂
77+
case nil =>
78+
constructor
79+
case cons x y xs ys h₁ h₂ ih =>
80+
cases h₂
81+
case cons y' ys' h₂' h₃ =>
82+
constructor
83+
exact h h₁ h₂'
84+
exact ih h₃
85+
7186
end Juvix.Utils

0 commit comments

Comments
 (0)