-
Notifications
You must be signed in to change notification settings - Fork 1
/
Scopecheck.agda
76 lines (68 loc) · 2.9 KB
/
Scopecheck.agda
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
module STLC.Scopecheck (Type : Set) where
open import STLC.Syntax Type as S hiding (Expr; module Expr)
open import STLC.Bound Type
open import Data.Nat hiding (_≟_)
open import Data.Fin
open import Data.Vec using ([]; _∷_; lookup; reverse)
open import Data.String
open import Relation.Nullary.Decidable
appˡ : ∀ {n} {Γ : Binder n} {E E′ F F′} → Γ ⊢ (E · F) ↝ (E′ · F′) → Γ ⊢ E ↝ E′
appˡ (δ · _) = δ
appʳ : ∀ {n} {Γ : Binder n} {E E′ F F′} → Γ ⊢ (E · F) ↝ (E′ · F′) → Γ ⊢ F ↝ F′
appʳ (_ · δ) = δ
open import Relation.Nullary
open import Relation.Binary
open import Relation.Binary.PropositionalEquality
open import Data.Product
open import Data.Sum
open import STLC.Utils
name-dec : ∀ {n} {Γ : Binder n} {x y : Name} {E : Expr (suc n)} →
(y ∷ Γ) ⊢ var x ↝ E →
x ≡ y ⊎ (∃[ E′ ] Γ ⊢ var x ↝ E′)
name-dec var-zero = inj₁ refl
name-dec (var-suc p) = inj₂ (_ , p)
find-name : ∀ {n} → (Γ : Binder n) → (x : Name) → Dec (∃[ E′ ] Γ ⊢ var x ↝ E′)
find-name [] x = no lem
where
lem : ∄[ E′ ] [] ⊢ var x ↝ E′
lem (_ , ())
find-name (y ∷ Γ) x with x ≟ y
find-name (y ∷ Γ) .y | yes refl = yes (var zero , var-zero)
find-name (y ∷ Γ) x | no x≢y with find-name Γ x
find-name (y ∷ Γ) x | no x≢y | yes (var k , δ) = yes (var (suc k) , var-suc {p = fromWitnessFalse x≢y} δ)
find-name (y ∷ Γ) x | no x≢y | yes (lam _ _ , ())
find-name (y ∷ Γ) x | no x≢y | yes (_ · _ , ())
find-name (y ∷ Γ) x | no x≢y | no ¬p = no lem
where
lem : ∄[ E′ ] (y ∷ Γ) ⊢ var x ↝ E′
lem (E′ , δ) with name-dec δ
lem (E′ , δ) | inj₁ x≡y = x≢y x≡y
lem (E′ , δ) | inj₂ p = ¬p p
check : ∀ {n} → (Γ : Binder n) → (E : S.Expr) → Dec (∃[ E′ ] Γ ⊢ E ↝ E′)
check Γ (var x) = find-name Γ x
check Γ (lam (x ∶ τ) E) with check (x ∷ Γ) E
check Γ (lam (x ∶ τ) E) | yes (E′ , δ) = yes (lam _ E′ , lam δ)
check Γ (lam (x ∶ τ) E) | no ¬p = no lem
where
lem : ∄[ E′ ] Γ ⊢ lam (x ∶ τ) E ↝ E′
lem (var _ , ())
lem (_ · _ , ())
lem (lam .τ E′ , lam δ) = ¬p (E′ , δ)
check Γ (E · F) with check Γ E
check Γ (E · F) | yes (E′ , δ₁) with check Γ F
check Γ (E · F) | yes (E′ , δ₁) | yes (F′ , δ₂) = yes (E′ · F′ , δ₁ · δ₂)
check Γ (E · F) | yes (E′ , δ₁) | no ¬p = no lem
where
lem : ∄[ E′ ] Γ ⊢ E · F ↝ E′
lem (var _ , ())
lem (lam _ _ , ())
lem (E₁ · E₂ , δ) = ¬p (E₂ , appʳ δ)
check Γ (E · F) | no ¬p = no lem
where
lem : ∄[ E′ ] Γ ⊢ (E · F) ↝ E′
lem (var _ , ())
lem (lam _ _ , ())
lem (E₁ · E₂ , δ) = ¬p (E₁ , appˡ δ)
-- Go from a representation that uses Names to one that uses de Bruijn indices
scope : (E : S.Expr) → {p : True (check [] E)} → Expr 0
scope E {p} = proj₁ (toWitness p)