Intermediate commit: add while loops and start trying to formalize them.
This commit is contained in:
		
							parent
							
								
									5d56a7ce2d
								
							
						
					
					
						commit
						844c99336a
					
				
							
								
								
									
										246
									
								
								Language.agda
									
									
									
									
									
								
							
							
						
						
									
										246
									
								
								Language.agda
									
									
									
									
									
								
							@ -1,8 +1,9 @@
 | 
			
		||||
module Language where
 | 
			
		||||
 | 
			
		||||
open import Data.Nat using (ℕ; suc; pred)
 | 
			
		||||
open import Data.Integer using (ℤ; +_) renaming (_+_ to _+ᶻ_; _-_ to _-ᶻ_)
 | 
			
		||||
open import Data.String using (String) renaming (_≟_ to _≟ˢ_)
 | 
			
		||||
open import Data.Product using (Σ; _,_; proj₁; proj₂)
 | 
			
		||||
open import Data.Product using (_×_; Σ; _,_; proj₁; proj₂)
 | 
			
		||||
open import Data.Vec using (Vec; foldr; lookup; _∷_)
 | 
			
		||||
open import Data.List using ([]; _∷_; List) renaming (foldr to foldrˡ; map to mapˡ)
 | 
			
		||||
open import Data.List.Membership.Propositional as MemProp using () renaming (_∈_ to _∈ˡ_)
 | 
			
		||||
@ -23,8 +24,60 @@ data Expr : Set where
 | 
			
		||||
    `_ : String → Expr
 | 
			
		||||
    #_ : ℕ → Expr
 | 
			
		||||
 | 
			
		||||
data BasicStmt : Set where
 | 
			
		||||
    _←_ : String → Expr → BasicStmt
 | 
			
		||||
    noop : BasicStmt
 | 
			
		||||
 | 
			
		||||
data Stmt : Set where
 | 
			
		||||
    _←_ : String → Expr → Stmt
 | 
			
		||||
    ⟨_⟩ : BasicStmt → Stmt
 | 
			
		||||
    _then_ : Stmt → Stmt → Stmt
 | 
			
		||||
    if_then_else_ : Expr → Stmt → Stmt → Stmt
 | 
			
		||||
    while_repeat_ : Expr → Stmt → Stmt
 | 
			
		||||
 | 
			
		||||
module Semantics where
 | 
			
		||||
    data Value : Set where
 | 
			
		||||
        ↑ᶻ : ℤ → Value
 | 
			
		||||
 | 
			
		||||
    Env : Set
 | 
			
		||||
    Env = List (String × Value)
 | 
			
		||||
 | 
			
		||||
    data _∈_ : (String × Value) → Env → Set where
 | 
			
		||||
        here : ∀ (s : String) (v : Value) (ρ : Env) → (s , v) ∈ ((s , v) ∷ ρ)
 | 
			
		||||
        there : ∀ (s s' : String) (v v' : Value) (ρ : Env) → ¬ (s ≡ s') → (s , v) ∈ ρ → (s , v) ∈ ((s' , v') ∷ ρ)
 | 
			
		||||
 | 
			
		||||
    data _,_⇒ᵉ_ : Env → Expr → Value → Set where
 | 
			
		||||
        ⇒ᵉ-ℕ : ∀ (ρ : Env) (n : ℕ) → ρ , (# n) ⇒ᵉ (↑ᶻ (+ n))
 | 
			
		||||
        ⇒ᵉ-Var : ∀ (ρ : Env) (x : String) (v : Value) → (x , v) ∈ ρ → ρ , (` x) ⇒ᵉ v
 | 
			
		||||
        ⇒ᵉ-+ : ∀ (ρ : Env) (e₁ e₂ : Expr) (z₁ z₂ : ℤ) →
 | 
			
		||||
               ρ , e₁ ⇒ᵉ (↑ᶻ z₁) → ρ , e₂ ⇒ᵉ (↑ᶻ z₂) →
 | 
			
		||||
               ρ , (e₁ + e₂) ⇒ᵉ (↑ᶻ (z₁ +ᶻ z₂))
 | 
			
		||||
        ⇒ᵉ-- : ∀ (ρ : Env) (e₁ e₂ : Expr) (z₁ z₂ : ℤ) →
 | 
			
		||||
               ρ , e₁ ⇒ᵉ (↑ᶻ z₁) → ρ , e₂ ⇒ᵉ (↑ᶻ z₂) →
 | 
			
		||||
               ρ , (e₁ - e₂) ⇒ᵉ (↑ᶻ (z₁ -ᶻ z₂))
 | 
			
		||||
 | 
			
		||||
    data _,_⇒ᵇ_ : Env → BasicStmt → Env → Set where
 | 
			
		||||
        ⇒ᵇ-noop : ∀ (ρ : Env) → ρ , noop ⇒ᵇ ρ
 | 
			
		||||
        ⇒ᵇ-← : ∀ (ρ : Env) (x : String) (e : Expr) (v : Value) →
 | 
			
		||||
               ρ , e ⇒ᵉ v → ρ , (x ← e) ⇒ᵇ ((x , v) ∷ ρ)
 | 
			
		||||
 | 
			
		||||
    data _,_⇒ˢ_ : Env → Stmt → Env → Set where
 | 
			
		||||
        ⇒ˢ-⟨⟩ : ∀ (ρ₁ ρ₂ : Env) (bs : BasicStmt) →
 | 
			
		||||
                ρ₁ , bs ⇒ᵇ ρ₂ → ρ₁ , ⟨ bs ⟩ ⇒ˢ ρ₂
 | 
			
		||||
        ⇒ˢ-then : ∀ (ρ₁ ρ₂ ρ₃ : Env) (s₁ s₂ : Stmt) →
 | 
			
		||||
                  ρ₁ , s₁ ⇒ˢ ρ₂ → ρ₂ , s₂ ⇒ˢ ρ₃ →
 | 
			
		||||
                  ρ₁ , (s₁ then s₂) ⇒ˢ ρ₃
 | 
			
		||||
        ⇒ˢ-if-true : ∀ (ρ₁ ρ₂ : Env) (e : Expr) (z : ℤ) (s₁ s₂ : Stmt) →
 | 
			
		||||
            ρ₁ , e ⇒ᵉ (↑ᶻ z) → ¬ z ≡ (+ 0) → ρ₁ , s₁ ⇒ˢ ρ₂ →
 | 
			
		||||
            ρ₁ , (if e then s₁ else s₂) ⇒ˢ ρ₂
 | 
			
		||||
        ⇒ˢ-if-false : ∀ (ρ₁ ρ₂ : Env) (e : Expr) (s₁ s₂ : Stmt) →
 | 
			
		||||
            ρ₁ , e ⇒ᵉ (↑ᶻ (+ 0)) → ρ₁ , s₂ ⇒ˢ ρ₂ →
 | 
			
		||||
            ρ₁ , (if e then s₁ else s₂) ⇒ˢ ρ₂
 | 
			
		||||
        ⇒ˢ-while-true : ∀ (ρ₁ ρ₂ ρ₃ : Env) (e : Expr) (z : ℤ) (s : Stmt) →
 | 
			
		||||
            ρ₁ , e ⇒ᵉ (↑ᶻ z) → ¬ z ≡ (+ 0) → ρ₁ , s ⇒ˢ ρ₂ → ρ₂ , (while e repeat s) ⇒ˢ ρ₃ →
 | 
			
		||||
            ρ₁ , (while e repeat s) ⇒ˢ ρ₃
 | 
			
		||||
        ⇒ˢ-while-false : ∀ (ρ : Env) (e : Expr) (s : Stmt) →
 | 
			
		||||
            ρ , e ⇒ᵉ (↑ᶻ (+ 0)) →
 | 
			
		||||
            ρ , (while e repeat s) ⇒ˢ ρ
 | 
			
		||||
 | 
			
		||||
open import Lattice.MapSet _≟ˢ_
 | 
			
		||||
    renaming
 | 
			
		||||
@ -47,9 +100,9 @@ data _∈ᵉ_ : String → Expr → Set where
 | 
			
		||||
    in⁻₂ : ∀ {e₁ e₂ : Expr} {k : String} → k ∈ᵉ e₂ → k ∈ᵉ (e₁ - e₂)
 | 
			
		||||
    here : ∀ {k : String} → k ∈ᵉ (` k)
 | 
			
		||||
 | 
			
		||||
data _∈ᵗ_ : String → Stmt → Set where
 | 
			
		||||
    in←₁ : ∀ {k : String} {e : Expr} → k ∈ᵗ (k ← e)
 | 
			
		||||
    in←₂ : ∀ {k k' : String} {e : Expr} → k ∈ᵉ e → k ∈ᵗ (k' ← e)
 | 
			
		||||
data _∈ᵇ_ : String → BasicStmt → Set where
 | 
			
		||||
    in←₁ : ∀ {k : String} {e : Expr} → k ∈ᵇ (k ← e)
 | 
			
		||||
    in←₂ : ∀ {k k' : String} {e : Expr} → k ∈ᵉ e → k ∈ᵇ (k' ← e)
 | 
			
		||||
 | 
			
		||||
private
 | 
			
		||||
    Expr-vars : Expr → StringSet
 | 
			
		||||
@ -58,84 +111,91 @@ private
 | 
			
		||||
    Expr-vars (` s) = singletonˢ s
 | 
			
		||||
    Expr-vars (# _) = emptyˢ
 | 
			
		||||
 | 
			
		||||
    ∈-Expr-vars⇒∈ : ∀ {k : String} (e : Expr) → k ∈ˢ (Expr-vars e) → k ∈ᵉ e
 | 
			
		||||
    ∈-Expr-vars⇒∈ {k} (e₁ + e₂) k∈vs
 | 
			
		||||
        with Expr-Provenance k ((`ˢ (Expr-vars e₁)) ∪ (`ˢ (Expr-vars e₂))) k∈vs
 | 
			
		||||
    ...   | in₁ (single k,tt∈vs₁) _ = (in⁺₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    ...   | in₂ _ (single k,tt∈vs₂) = (in⁺₂ (∈-Expr-vars⇒∈ e₂ (forget k,tt∈vs₂)))
 | 
			
		||||
    ...   | bothᵘ (single k,tt∈vs₁) _ = (in⁺₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    ∈-Expr-vars⇒∈ {k} (e₁ - e₂) k∈vs
 | 
			
		||||
        with Expr-Provenance k ((`ˢ (Expr-vars e₁)) ∪ (`ˢ (Expr-vars e₂))) k∈vs
 | 
			
		||||
    ...   | in₁ (single k,tt∈vs₁) _ = (in⁻₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    ...   | in₂ _ (single k,tt∈vs₂) = (in⁻₂ (∈-Expr-vars⇒∈ e₂ (forget k,tt∈vs₂)))
 | 
			
		||||
    ...   | bothᵘ (single k,tt∈vs₁) _ = (in⁻₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    ∈-Expr-vars⇒∈ {k} (` k) (RelAny.here refl) = here
 | 
			
		||||
    -- ∈-Expr-vars⇒∈ : ∀ {k : String} (e : Expr) → k ∈ˢ (Expr-vars e) → k ∈ᵉ e
 | 
			
		||||
    -- ∈-Expr-vars⇒∈ {k} (e₁ + e₂) k∈vs
 | 
			
		||||
    --     with Expr-Provenance k ((`ˢ (Expr-vars e₁)) ∪ (`ˢ (Expr-vars e₂))) k∈vs
 | 
			
		||||
    -- ...   | in₁ (single k,tt∈vs₁) _ = (in⁺₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    -- ...   | in₂ _ (single k,tt∈vs₂) = (in⁺₂ (∈-Expr-vars⇒∈ e₂ (forget k,tt∈vs₂)))
 | 
			
		||||
    -- ...   | bothᵘ (single k,tt∈vs₁) _ = (in⁺₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    -- ∈-Expr-vars⇒∈ {k} (e₁ - e₂) k∈vs
 | 
			
		||||
    --     with Expr-Provenance k ((`ˢ (Expr-vars e₁)) ∪ (`ˢ (Expr-vars e₂))) k∈vs
 | 
			
		||||
    -- ...   | in₁ (single k,tt∈vs₁) _ = (in⁻₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    -- ...   | in₂ _ (single k,tt∈vs₂) = (in⁻₂ (∈-Expr-vars⇒∈ e₂ (forget k,tt∈vs₂)))
 | 
			
		||||
    -- ...   | bothᵘ (single k,tt∈vs₁) _ = (in⁻₁ (∈-Expr-vars⇒∈ e₁ (forget k,tt∈vs₁)))
 | 
			
		||||
    -- ∈-Expr-vars⇒∈ {k} (` k) (RelAny.here refl) = here
 | 
			
		||||
 | 
			
		||||
    ∈⇒∈-Expr-vars : ∀ {k : String} {e : Expr} → k ∈ᵉ e → k ∈ˢ (Expr-vars e)
 | 
			
		||||
    ∈⇒∈-Expr-vars {k} {e₁ + e₂} (in⁺₁ k∈e₁) =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₁ {m₁ = Expr-vars e₁}
 | 
			
		||||
                         {m₂ = Expr-vars e₂}
 | 
			
		||||
                         (∈⇒∈-Expr-vars k∈e₁)
 | 
			
		||||
    ∈⇒∈-Expr-vars {k} {e₁ + e₂} (in⁺₂ k∈e₂) =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₂ {m₁ = Expr-vars e₁}
 | 
			
		||||
                         {m₂ = Expr-vars e₂}
 | 
			
		||||
                         (∈⇒∈-Expr-vars k∈e₂)
 | 
			
		||||
    ∈⇒∈-Expr-vars {k} {e₁ - e₂} (in⁻₁ k∈e₁) =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₁ {m₁ = Expr-vars e₁}
 | 
			
		||||
                         {m₂ = Expr-vars e₂}
 | 
			
		||||
                         (∈⇒∈-Expr-vars k∈e₁)
 | 
			
		||||
    ∈⇒∈-Expr-vars {k} {e₁ - e₂} (in⁻₂ k∈e₂) =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₂ {m₁ = Expr-vars e₁}
 | 
			
		||||
                         {m₂ = Expr-vars e₂}
 | 
			
		||||
                         (∈⇒∈-Expr-vars k∈e₂)
 | 
			
		||||
    ∈⇒∈-Expr-vars here = RelAny.here refl
 | 
			
		||||
    -- ∈⇒∈-Expr-vars : ∀ {k : String} {e : Expr} → k ∈ᵉ e → k ∈ˢ (Expr-vars e)
 | 
			
		||||
    -- ∈⇒∈-Expr-vars {k} {e₁ + e₂} (in⁺₁ k∈e₁) =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₁ {m₁ = Expr-vars e₁}
 | 
			
		||||
    --                      {m₂ = Expr-vars e₂}
 | 
			
		||||
    --                      (∈⇒∈-Expr-vars k∈e₁)
 | 
			
		||||
    -- ∈⇒∈-Expr-vars {k} {e₁ + e₂} (in⁺₂ k∈e₂) =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₂ {m₁ = Expr-vars e₁}
 | 
			
		||||
    --                      {m₂ = Expr-vars e₂}
 | 
			
		||||
    --                      (∈⇒∈-Expr-vars k∈e₂)
 | 
			
		||||
    -- ∈⇒∈-Expr-vars {k} {e₁ - e₂} (in⁻₁ k∈e₁) =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₁ {m₁ = Expr-vars e₁}
 | 
			
		||||
    --                      {m₂ = Expr-vars e₂}
 | 
			
		||||
    --                      (∈⇒∈-Expr-vars k∈e₁)
 | 
			
		||||
    -- ∈⇒∈-Expr-vars {k} {e₁ - e₂} (in⁻₂ k∈e₂) =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₂ {m₁ = Expr-vars e₁}
 | 
			
		||||
    --                      {m₂ = Expr-vars e₂}
 | 
			
		||||
    --                      (∈⇒∈-Expr-vars k∈e₂)
 | 
			
		||||
    -- ∈⇒∈-Expr-vars here = RelAny.here refl
 | 
			
		||||
 | 
			
		||||
    BasicStmt-vars : BasicStmt → StringSet
 | 
			
		||||
    BasicStmt-vars (x ← e) = (singletonˢ x) ⊔ˢ (Expr-vars e)
 | 
			
		||||
    BasicStmt-vars noop = emptyˢ
 | 
			
		||||
 | 
			
		||||
    Stmt-vars : Stmt → StringSet
 | 
			
		||||
    Stmt-vars (x ← e) = (singletonˢ x) ⊔ˢ (Expr-vars e)
 | 
			
		||||
    Stmt-vars ⟨ bs ⟩ = BasicStmt-vars bs
 | 
			
		||||
    Stmt-vars (s₁ then s₂) = (Stmt-vars s₁) ⊔ˢ (Stmt-vars s₂)
 | 
			
		||||
    Stmt-vars (if e then s₁ else s₂) = ((Expr-vars e) ⊔ˢ (Stmt-vars s₁)) ⊔ˢ (Stmt-vars s₂)
 | 
			
		||||
    Stmt-vars (while e repeat s) = (Expr-vars e) ⊔ˢ (Stmt-vars s)
 | 
			
		||||
 | 
			
		||||
    ∈-Stmt-vars⇒∈ : ∀ {k : String} (s : Stmt) → k ∈ˢ (Stmt-vars s) → k ∈ᵗ s
 | 
			
		||||
    ∈-Stmt-vars⇒∈ {k} (k' ← e) k∈vs
 | 
			
		||||
        with Expr-Provenance k ((`ˢ (singletonˢ k')) ∪ (`ˢ (Expr-vars e))) k∈vs
 | 
			
		||||
    ...   | in₁ (single (RelAny.here refl)) _ = in←₁
 | 
			
		||||
    ...   | in₂ _ (single k,tt∈vs') = in←₂ (∈-Expr-vars⇒∈ e (forget k,tt∈vs'))
 | 
			
		||||
    ...   | bothᵘ (single (RelAny.here refl)) _ = in←₁
 | 
			
		||||
    -- ∈-Stmt-vars⇒∈ : ∀ {k : String} (s : Stmt) → k ∈ˢ (Stmt-vars s) → k ∈ᵇ s
 | 
			
		||||
    -- ∈-Stmt-vars⇒∈ {k} (k' ← e) k∈vs
 | 
			
		||||
    --     with Expr-Provenance k ((`ˢ (singletonˢ k')) ∪ (`ˢ (Expr-vars e))) k∈vs
 | 
			
		||||
    -- ...   | in₁ (single (RelAny.here refl)) _ = in←₁
 | 
			
		||||
    -- ...   | in₂ _ (single k,tt∈vs') = in←₂ (∈-Expr-vars⇒∈ e (forget k,tt∈vs'))
 | 
			
		||||
    -- ...   | bothᵘ (single (RelAny.here refl)) _ = in←₁
 | 
			
		||||
 | 
			
		||||
    ∈⇒∈-Stmt-vars : ∀ {k : String} {s : Stmt} → k ∈ᵗ s → k ∈ˢ (Stmt-vars s)
 | 
			
		||||
    ∈⇒∈-Stmt-vars {k} {k ← e} in←₁ =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₁ {m₁ = singletonˢ k}
 | 
			
		||||
                         {m₂ = Expr-vars e}
 | 
			
		||||
                         (RelAny.here refl)
 | 
			
		||||
    ∈⇒∈-Stmt-vars {k} {k' ← e} (in←₂ k∈e) =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₂ {m₁ = singletonˢ k'}
 | 
			
		||||
                         {m₂ = Expr-vars e}
 | 
			
		||||
                         (∈⇒∈-Expr-vars k∈e)
 | 
			
		||||
    -- ∈⇒∈-Stmt-vars : ∀ {k : String} {s : Stmt} → k ∈ᵇ s → k ∈ˢ (Stmt-vars s)
 | 
			
		||||
    -- ∈⇒∈-Stmt-vars {k} {k ← e} in←₁ =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₁ {m₁ = singletonˢ k}
 | 
			
		||||
    --                      {m₂ = Expr-vars e}
 | 
			
		||||
    --                      (RelAny.here refl)
 | 
			
		||||
    -- ∈⇒∈-Stmt-vars {k} {k' ← e} (in←₂ k∈e) =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₂ {m₁ = singletonˢ k'}
 | 
			
		||||
    --                      {m₂ = Expr-vars e}
 | 
			
		||||
    --                      (∈⇒∈-Expr-vars k∈e)
 | 
			
		||||
 | 
			
		||||
    Stmts-vars : ∀ {n : ℕ} → Vec Stmt n → StringSet
 | 
			
		||||
    Stmts-vars = foldr (λ n → StringSet)
 | 
			
		||||
                       (λ {k} stmt acc → (Stmt-vars stmt) ⊔ˢ acc) emptyˢ
 | 
			
		||||
 | 
			
		||||
    ∈-Stmts-vars⇒∈ : ∀ {n : ℕ} {k : String} (ss : Vec Stmt n) →
 | 
			
		||||
                     k ∈ˢ (Stmts-vars ss) → Σ (Fin n) (λ f → k ∈ᵗ lookup ss f)
 | 
			
		||||
    ∈-Stmts-vars⇒∈ {suc n'} {k} (s ∷ ss') k∈vss
 | 
			
		||||
        with Expr-Provenance k ((`ˢ (Stmt-vars s)) ∪ (`ˢ (Stmts-vars ss'))) k∈vss
 | 
			
		||||
    ...   | in₁ (single k,tt∈vs) _ = (zero , ∈-Stmt-vars⇒∈ s (forget k,tt∈vs))
 | 
			
		||||
    ...   | in₂ _ (single k,tt∈vss') =
 | 
			
		||||
            let
 | 
			
		||||
                (f' , k∈s') = ∈-Stmts-vars⇒∈ ss' (forget k,tt∈vss')
 | 
			
		||||
            in
 | 
			
		||||
                (suc f' , k∈s')
 | 
			
		||||
    ...   | bothᵘ (single k,tt∈vs) _ = (zero , ∈-Stmt-vars⇒∈ s (forget k,tt∈vs))
 | 
			
		||||
    -- ∈-Stmts-vars⇒∈ : ∀ {n : ℕ} {k : String} (ss : Vec Stmt n) →
 | 
			
		||||
    --                  k ∈ˢ (Stmts-vars ss) → Σ (Fin n) (λ f → k ∈ᵇ lookup ss f)
 | 
			
		||||
    -- ∈-Stmts-vars⇒∈ {suc n'} {k} (s ∷ ss') k∈vss
 | 
			
		||||
    --     with Expr-Provenance k ((`ˢ (Stmt-vars s)) ∪ (`ˢ (Stmts-vars ss'))) k∈vss
 | 
			
		||||
    -- ...   | in₁ (single k,tt∈vs) _ = (zero , ∈-Stmt-vars⇒∈ s (forget k,tt∈vs))
 | 
			
		||||
    -- ...   | in₂ _ (single k,tt∈vss') =
 | 
			
		||||
    --         let
 | 
			
		||||
    --             (f' , k∈s') = ∈-Stmts-vars⇒∈ ss' (forget k,tt∈vss')
 | 
			
		||||
    --         in
 | 
			
		||||
    --             (suc f' , k∈s')
 | 
			
		||||
    -- ...   | bothᵘ (single k,tt∈vs) _ = (zero , ∈-Stmt-vars⇒∈ s (forget k,tt∈vs))
 | 
			
		||||
 | 
			
		||||
    ∈⇒∈-Stmts-vars : ∀ {n : ℕ} {k : String} {ss : Vec Stmt n} {f : Fin n} →
 | 
			
		||||
                     k ∈ᵗ lookup ss f → k ∈ˢ (Stmts-vars ss)
 | 
			
		||||
    ∈⇒∈-Stmts-vars {suc n} {k} {s ∷ ss'} {zero} k∈s =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₁ {m₁ = Stmt-vars s}
 | 
			
		||||
                         {m₂ = Stmts-vars ss'}
 | 
			
		||||
                         (∈⇒∈-Stmt-vars k∈s)
 | 
			
		||||
    ∈⇒∈-Stmts-vars {suc n} {k} {s ∷ ss'} {suc f'} k∈ss' =
 | 
			
		||||
        ⊔ˢ-preserves-∈k₂ {m₁ = Stmt-vars s}
 | 
			
		||||
                         {m₂ = Stmts-vars ss'}
 | 
			
		||||
                         (∈⇒∈-Stmts-vars {n} {k} {ss'} {f'} k∈ss')
 | 
			
		||||
    -- ∈⇒∈-Stmts-vars : ∀ {n : ℕ} {k : String} {ss : Vec Stmt n} {f : Fin n} →
 | 
			
		||||
    --                  k ∈ᵇ lookup ss f → k ∈ˢ (Stmts-vars ss)
 | 
			
		||||
    -- ∈⇒∈-Stmts-vars {suc n} {k} {s ∷ ss'} {zero} k∈s =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₁ {m₁ = Stmt-vars s}
 | 
			
		||||
    --                      {m₂ = Stmts-vars ss'}
 | 
			
		||||
    --                      (∈⇒∈-Stmt-vars k∈s)
 | 
			
		||||
    -- ∈⇒∈-Stmts-vars {suc n} {k} {s ∷ ss'} {suc f'} k∈ss' =
 | 
			
		||||
    --     ⊔ˢ-preserves-∈k₂ {m₁ = Stmt-vars s}
 | 
			
		||||
    --                      {m₂ = Stmts-vars ss'}
 | 
			
		||||
    --                      (∈⇒∈-Stmts-vars {n} {k} {ss'} {f'} k∈ss')
 | 
			
		||||
 | 
			
		||||
    -- Creating a new number from a natural number can never create one
 | 
			
		||||
    -- equal to one you get from weakening the bounds on another number.
 | 
			
		||||
@ -160,6 +220,44 @@ private
 | 
			
		||||
    indices-complete (suc n') zero = RelAny.here refl
 | 
			
		||||
    indices-complete (suc n') (suc f') = RelAny.there (x∈xs⇒fx∈fxs suc (indices-complete n' f'))
 | 
			
		||||
 | 
			
		||||
    -- Sketch, 'build control flow graph'
 | 
			
		||||
 | 
			
		||||
    -- -- Create new block, mark it as the current insertion point.
 | 
			
		||||
    -- emptyBlock : m Id
 | 
			
		||||
 | 
			
		||||
    -- currentBlock : m Id
 | 
			
		||||
 | 
			
		||||
    -- -- Create a new block, and insert the statement into it. Shold restore insertion pont.
 | 
			
		||||
    -- createBlock : Stmt → m (Id × Id)
 | 
			
		||||
 | 
			
		||||
    -- -- Note that the given ID is a successor / predecessor of the given
 | 
			
		||||
    -- -- insertion point.
 | 
			
		||||
    -- noteSuccessor : Id → m ()
 | 
			
		||||
    -- notePredecessor : Id → m ()
 | 
			
		||||
    -- noteEdge : Id → Id → m ()
 | 
			
		||||
 | 
			
		||||
    -- -- Insert the given statment into the current insertion point.
 | 
			
		||||
    -- buildCfg : Stmt → m Cfg
 | 
			
		||||
    -- buildCfg { bs₁ } = push bs₁
 | 
			
		||||
    -- buildCfg (s₁ ; s₂ ) = buildCfg s₁ >> buildCfg s₂
 | 
			
		||||
    -- buildCfg (if _ then s₁ else s₂) = do
 | 
			
		||||
    --     (b₁ , b₁') ← createBlock s₁
 | 
			
		||||
    --     noteSuccessor b₁
 | 
			
		||||
 | 
			
		||||
    --     (b₂ , b₂') ← createBlock s₂
 | 
			
		||||
    --     noteSuccessor b₂
 | 
			
		||||
 | 
			
		||||
    --     b ← emptyBlock
 | 
			
		||||
    --     notePredecessor b₁'
 | 
			
		||||
    --     notePredecessor b₂'
 | 
			
		||||
    -- buildCfg (while e repeat s) = do
 | 
			
		||||
    --     (b₁, b₁') ← createBlock s
 | 
			
		||||
    --     noteSuccessor b₁
 | 
			
		||||
    --     noteEdge b₁' b₁
 | 
			
		||||
 | 
			
		||||
    --     b ← emptyBlock
 | 
			
		||||
    --     notePredecessor b₁'
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
-- For now, just represent the program and CFG as one type, without branching.
 | 
			
		||||
record Program : Set where
 | 
			
		||||
@ -192,8 +290,8 @@ record Program : Set where
 | 
			
		||||
    code : State → Stmt
 | 
			
		||||
    code = lookup stmts
 | 
			
		||||
 | 
			
		||||
    vars-complete : ∀ {k : String} (s : State) → k ∈ᵗ (code s) → k ∈ˡ vars
 | 
			
		||||
    vars-complete {k} s = ∈⇒∈-Stmts-vars {length} {k} {stmts} {s}
 | 
			
		||||
    -- vars-complete : ∀ {k : String} (s : State) → k ∈ᵇ (code s) → k ∈ˡ vars
 | 
			
		||||
    -- vars-complete {k} s = ∈⇒∈-Stmts-vars {length} {k} {stmts} {s}
 | 
			
		||||
 | 
			
		||||
    _≟_ : IsDecidable (_≡_ {_} {State})
 | 
			
		||||
    _≟_ = _≟ᶠ_
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user