Browse Source

Start reworking the security model.

gas-move-test
Thomas Kerber 6 months ago
parent
commit
afb135392a
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
3 changed files with 181 additions and 74 deletions
  1. 12
    5
      Yggdrasil/Probability.agda
  2. 110
    44
      Yggdrasil/Security.agda
  3. 59
    25
      Yggdrasil/World.agda

+ 12
- 5
Yggdrasil/Probability.agda View File

@@ -13,10 +13,11 @@ open import Data.Nat.Properties using (≤-trans; ≤-refl)
13 13
 open import Data.List.Properties using (length-filter; length-map)
14 14
 open import Data.Product using (_×_; ∃; ∃-syntax; proj₁) renaming (_,_ to ⟨_,_⟩)
15 15
 open import Data.Rational using (ℚ) renaming (_≤?_ to _ℚ≤?_; _≤_ to _ℚ≤_)
16
+open import Function using (_∘_)
16 17
 open import Relation.Nullary using (Dec; yes; no; ¬_)
17 18
 open import Relation.Nullary.Decidable using (True; fromWitness)
18 19
 open import Relation.Binary.PropositionalEquality using (_≡_; refl; trans; cong)
19
-open import Level using (Level; Lift; lift) renaming (suc to lsuc)
20
+open import Level using (Level; Lift; lower; _⊔_) renaming (suc to lsuc; lift to llift)
20 21
 open import Yggdrasil.List using (_∈_; with-proof)
21 22
 import Yggdrasil.Rational as ℚ
22 23
 
@@ -46,12 +47,18 @@ length-all-fin zero = refl
46 47
 length-all-fin (suc n) = cong suc (trans (length-map suc (all-fin n)) (length-all-fin n))
47 48
 
48 49
 count : ∀ {ℓ n} {P : PrFin {ℓ} n → Set ℓ} → ((f : PrFin {ℓ} n) → Dec (P f)) → ℕ
49
-count {n = n} dec = length (filter dec (map lift (all-fin (suc (suc n)))))
50
+count {n = n} dec = length (filter dec (map llift (all-fin (suc (suc n)))))
50 51
 
51 52
 data Dist {ℓ : Level} : Set ℓ → Set (lsuc ℓ) where
52 53
   pure : ∀ {A : Set ℓ} → A → Dist A
53
-  sample : ∀ {n : ℕ} → Dist (PrFin n)
54
-  bind : ∀ {A B : Set ℓ} → Dist A → (A → Dist B) → Dist B
54
+  sample : ∀ {n : ℕ} → Dist (PrFin {ℓ} n)
55
+  _>>=_ : ∀ {A B : Set ℓ} → Dist A → (A → Dist B) → Dist B
56
+
57
+lift : {ℓ₁ ℓ₂ : Level} {A : Set ℓ₁} → Dist A → Dist (Lift ℓ₂ A)
58
+lift (pure x) = pure (llift x)
59
+lift {ℓ₁} {ℓ₂} (sample {n = n}) = sample {n = n} >>=
60
+  (pure ∘ llift ∘ llift ∘ lower)
61
+lift {ℓ₂ = ℓ} (D >>= f) = lift {ℓ₂ = ℓ} D >>= (lift ∘ f ∘ lower)
55 62
 
56 63
 ≡⇒≤ : {a b : ℕ} → a ≡ b → a ℕ≤ b
57 64
 ≡⇒≤ refl = ≤-refl
@@ -70,7 +77,7 @@ data Pr[_[_]]≡_ {ℓ : Level} : {A : Set ℓ} → (P : A → Set ℓ) → Dist
70 77
     Pr[ P₁ [ D ]]≡ p₁ → 
71 78
     ((x : A) → P₁ x → Pr[ P₂ [ f x ]]≡ p₂) →
72 79
     ((x : A) → ¬ (P₁ x) → Pr[ P₂ [ f x ]]≡ p₃) → 
73
-    Pr[ P₂ [ bind D f ]]≡ (case p₁ p₂ p₃)
80
+    Pr[ P₂ [ D >>= f ]]≡ (case p₁ p₂ p₃)
74 81
 
75 82
 record _≈[_]≈_ {ℓ : Level} {A : Set ℓ} (d₁ : Dist A) (ε : ℚ) (d₂ : Dist A) : Set (lsuc ℓ) where
76 83
   field

+ 110
- 44
Yggdrasil/Security.agda View File

@@ -5,63 +5,129 @@ open import Data.Product using (_×_; Σ; Σ-syntax; proj₁; proj₂; ∃; ∃-
5 5
 open import Data.Nat using (ℕ)
6 6
 open import Data.Maybe using (Maybe) renaming (map to mmap)
7 7
 open import Data.Unit using (⊤; tt)
8
+open import Function using (_∘_)
8 9
 open import Level using (Level; Lift; lift) renaming (suc to lsuc)
9 10
 open import Relation.Binary.PropositionalEquality using (_≡_; refl)
10 11
 open import Yggdrasil.List using (_∈_; here; there; with-proof; map≡-implies-∈≡)
11
-open import Yggdrasil.World using (WorldType; WorldState; World; Call; Strategy; Node; Action↑; weaken; call; call↓; _↑_; stnode; _∷_; []; exec)
12
+open import Yggdrasil.World using (WorldType; WorldState; World; Oracle; Call; Strategy; Node; Action; weaken; call; call↓; _↑_; stnode; _∷_; []; exec; _⊑_; Query; _∈↑_; abort; dist; _>>=_; call↯; query; path; _↑)
13
+open import Yggdrasil.Probability using (Dist; _>>=_; pure)
12 14
 open WorldType
13 15
 open Node
14 16
 
15 17
 data Guess {ℓ : Level} : Set ℓ where
16 18
   real? ideal? : Guess
17 19
 
18
-data Outcome : Set where
19
-  ↯ ✔ : Outcome
20
+data Action↯ {ℓ : Level} (Γᵢ Γᵣ : WorldType ℓ)
21
+    {hon-≡ : map weaken (hon Γᵢ) ≡ map weaken (hon Γᵣ)} : Set ℓ →
22
+    Set (lsuc ℓ) where
23
+  query : ∀ {Γ′ q} → q ∈ qry (node Γ′) → Γ′ ⊑ Γᵢ → (x : Query.A q) → Action↯ Γᵢ Γᵣ (Query.B q x)
24
+  abort : ∀ {A} → Action↯ Γᵢ Γᵣ A
25
+  dist  : ∀ {A} → Dist A → Action↯ Γᵢ Γᵣ A
26
+  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γᵣ → (x : Call.A f) →
27
+    Action↯ Γᵢ Γᵣ (Call.B f x)
28
+  _>>=_ : ∀ {A B} → Action↯ Γᵢ Γᵣ {hon-≡} A → (A → Action↯ Γᵢ Γᵣ {hon-≡} B) →
29
+    Action↯ Γᵢ Γᵣ B
20 30
 
21
-record RouterConfig {ℓ : Level} : Set (lsuc ℓ) where
31
+record Simulator {ℓ : Level} (Γᵢ Γᵣ : WorldType ℓ) : Set (lsuc ℓ) where
22 32
   field
23
-    real  : World ℓ
24
-    ideal : World ℓ
25
-    sim   : Σ[ σ ∈ Set ℓ ] (σ × (∀ {c} → σ → c ∈ adv (proj₁ ideal) →
26
-      σ × (Σ (Call ℓ (node (proj₁ real))) (_∈ adv (proj₁ real)))))
27
-    hon-≡ : map weaken (hon (proj₁ ideal)) ≡ map weaken (hon (proj₁ real))
33
+    hon-≡ : map weaken (hon Γᵢ) ≡ map weaken (hon Γᵣ)
34
+    state : Set ℓ
35
+    initial : state
36
+    call↯-map : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γᵢ →
37
+      (x : Call.A f) → Action↯ Γᵢ Γᵣ {hon-≡} (Call.B f x)
38
+    query-map : ∀ {q} → q ∈↑ Γᵣ → (x : Query.A q) → Action↯ Γᵢ Γᵣ {hon-≡} (Query.B q x)
28 39
 
29
-open RouterConfig
40
+open Simulator
30 41
 
31
-router-world-type : ∀ {ℓ} → RouterConfig {ℓ} → WorldType ℓ
32
-router-world-type {ℓ} rc = record
33
-  { node = router-node
34
-  ; adv = []
35
-  ; hon = map (λ{c → call (Call.A (proj₁ c)) (Call.B (proj₁ c)) (hon-map′ c)})
36
-    (with-proof (hon (proj₁ (ideal rc))))
37
-  }
38
-  where
39
-    router-node : Node ℓ
40
-    router-node = record
41
-      { state = Σ (Guess {ℓ}) (λ{ ideal? → Lift ℓ ⊤ ; real? → proj₁ (sim rc)})
42
-      ; chld  = proj₁ (ideal rc) ∷ proj₁ (real rc) ∷ []
43
-      ; qry   = []
44
-      } 
45
-    hon-map′ : (c : Σ (Call ℓ (node (proj₁ (ideal rc)))) (_∈ (hon (proj₁ (ideal rc))))) →
46
-      state router-node → (x : Call.A (proj₁ c)) →
47
-      (state router-node) × Action↑ router-node (Call.B (proj₁ c) x)
48
-    hon-map′ ⟨ call A B δ , ∈ideal ⟩ ⟨ ideal? , lift tt ⟩ x
49
-      = ⟨ ⟨ ideal? , lift tt ⟩ , call↓ ∈ideal x ↑ here ⟩
50
-    hon-map′ ⟨ call A B δ , ∈ideal ⟩ ⟨ real? , σ ⟩ x with map≡-implies-∈≡ (hon-≡ rc) ∈ideal
51
-    ... | ⟨ _ , ⟨ ∈real , refl ⟩ ⟩ = ⟨ ⟨ real? , σ ⟩ , call↓ ∈real x ↑ there here ⟩
42
+Actionᵢ⇒Actionᵣ : ∀ {ℓ : Level} {Γᵢ Γᵣ : WorldType ℓ} {A : Set ℓ} →
43
+  Simulator Γᵢ Γᵣ → Oracle Γᵢ → Action Γᵢ A → Action Γᵣ A
44
+Action↯⇒Action : ∀ {ℓ : Level} {Γᵢ Γᵣ : WorldType ℓ} {A : Set ℓ} →
45
+  (S : Simulator Γᵢ Γᵣ) → Oracle Γᵢ → Action↯ Γᵢ Γᵣ {hon-≡ S} A → Action Γᵣ A
52 46
 
53
-router-world-state : ∀ {ℓ} → (rc : RouterConfig {ℓ}) → Guess {ℓ} →
54
-  WorldState (router-world-type rc)
55
-router-world-state rc real? = stnode ⟨ real? , proj₁ (proj₂ (sim rc)) ⟩
56
-  (proj₂ (ideal rc) ∷ proj₂ (real rc) ∷ [])
57
-router-world-state rc ideal? = stnode ⟨ ideal? , lift tt ⟩
58
-  (proj₂ (ideal rc) ∷ proj₂ (real rc) ∷ [])
47
+Actionᵢ⇒Actionᵣ S O ((call↓ ∈Γᵢ x) ↑) with map≡-implies-∈≡ (hon-≡ S) ∈Γᵢ
48
+... | ⟨ _ , ⟨ ∈Γᵣ , refl ⟩ ⟩ = call↓ ∈Γᵣ x ↑
49
+Actionᵢ⇒Actionᵣ _ _ abort = abort
50
+Actionᵢ⇒Actionᵣ _ _ (dist D) = dist D
51
+Actionᵢ⇒Actionᵣ S O (call↯ ∈Γ Γ⊑ x) = Action↯⇒Action S O (call↯-map S ∈Γ Γ⊑ x)
52
+Actionᵢ⇒Actionᵣ S O (α >>= β) = (Actionᵢ⇒Actionᵣ S O α) >>=
53
+  (Actionᵢ⇒Actionᵣ S O ∘ β)
59 54
 
60
-router-strategy : ∀ {ℓ A} → (rc : RouterConfig {ℓ}) →
61
-  Strategy (proj₁ (ideal rc)) A → Strategy (router-world-type rc) A
62
-router-strategy = ?
55
+-- FIXME: The termination checker (understandably) doesn't like this. Can we
56
+-- delay the recursion to runtime?
57
+Action↯⇒Action S O (query ∈Γ Γ⊑ x) = {!Actionᵢ⇒Actionᵣ S O (O (path Γ⊑ ∈Γ) x)!}
58
+Action↯⇒Action _ _ abort = abort
59
+Action↯⇒Action _ _ (dist D) = dist D
60
+Action↯⇒Action _ _ (call↯ ∈Γ Γ⊑ x) = call↯ ∈Γ Γ⊑ x
61
+Action↯⇒Action S O (α >>= β) = (Action↯⇒Action S O α) >>=
62
+  (Action↯⇒Action S O ∘ β)
63 63
 
64
-yggdrasil-game : ∀ {ℓ} → (rc : RouterConfig {ℓ}) →
65
-  Strategy (proj₁ (ideal rc)) Guess → Guess {ℓ} → ℕ → Maybe (Guess {ℓ})
66
-yggdrasil-game rc str world gas = mmap proj₁ (exec (router-strategy rc str)
67
-  (router-world-state rc world) gas)
64
+
65
+record Challenge {ℓ : Level} : Set (lsuc ℓ) where
66
+  field
67
+    Γᵣ : WorldType ℓ
68
+    Γᵢ : WorldType ℓ
69
+    Σᵣ : WorldState Γᵣ
70
+    Σᵢ : WorldState Γᵢ
71
+    sim : Simulator Γᵢ Γᵣ
72
+    --sim   : Σ[ σ ∈ Set ℓ ] (σ × (∀ {c} → σ → c ∈ adv (proj₁ ideal) →
73
+    --  σ × (Σ (Call ℓ (node (proj₁ real))) (_∈ adv (proj₁ real)))))
74
+ -- strategy : 
75
+
76
+--exec-ideal : {ℓ : Level} → (c : Challenge {ℓ}) → (s : Strategy (proj₁ (ideal c)))
77
+
78
+--private
79
+--  relevel : {ℓ₁ ℓ₂ : Level} → Guess {ℓ₁} → Guess {ℓ₂}
80
+--  relevel real? = real?
81
+--  relevel ideal? = ideal?
82
+--
83
+--data Outcome : Set where
84
+--  ↯ ✔ : Outcome
85
+--
86
+--record RouterConfig {ℓ : Level} : Set (lsuc ℓ) where
87
+--  field
88
+--    real  : World ℓ
89
+--    ideal : World ℓ
90
+--    sim   : Σ[ σ ∈ Set ℓ ] (σ × (∀ {c} → σ → c ∈ adv (proj₁ ideal) →
91
+--      σ × (Σ (Call ℓ (node (proj₁ real))) (_∈ adv (proj₁ real)))))
92
+--    hon-≡ : map weaken (hon (proj₁ ideal)) ≡ map weaken (hon (proj₁ real))
93
+--
94
+--open RouterConfig
95
+--
96
+--router-world-type : ∀ {ℓ} → RouterConfig {ℓ} → WorldType ℓ
97
+--router-world-type {ℓ} rc = record
98
+--  { node = router-node
99
+--  ; adv = []
100
+--  ; hon = map (λ{c → call (Call.A (proj₁ c)) (Call.B (proj₁ c)) (hon-map′ c)})
101
+--    (with-proof (hon (proj₁ (ideal rc))))
102
+--  }
103
+--  where
104
+--    router-node : Node ℓ
105
+--    router-node = record
106
+--      { state = Σ (Guess {ℓ}) (λ{ ideal? → Lift ℓ ⊤ ; real? → proj₁ (sim rc)})
107
+--      ; chld  = proj₁ (ideal rc) ∷ proj₁ (real rc) ∷ []
108
+--      ; qry   = []
109
+--      } 
110
+--    hon-map′ : (c : Σ (Call ℓ (node (proj₁ (ideal rc)))) (_∈ (hon (proj₁ (ideal rc))))) →
111
+--      state router-node → (x : Call.A (proj₁ c)) →
112
+--      (state router-node) × Action↑ router-node (Call.B (proj₁ c) x)
113
+--    hon-map′ ⟨ call A B δ , ∈ideal ⟩ ⟨ ideal? , lift tt ⟩ x
114
+--      = ⟨ ⟨ ideal? , lift tt ⟩ , call↓ ∈ideal x ↑ here ⟩
115
+--    hon-map′ ⟨ call A B δ , ∈ideal ⟩ ⟨ real? , σ ⟩ x with map≡-implies-∈≡ (hon-≡ rc) ∈ideal
116
+--    ... | ⟨ _ , ⟨ ∈real , refl ⟩ ⟩ = ⟨ ⟨ real? , σ ⟩ , call↓ ∈real x ↑ there here ⟩
117
+--
118
+--router-world-state : ∀ {ℓ} → (rc : RouterConfig {ℓ}) → Guess {ℓ} →
119
+--  WorldState (router-world-type rc)
120
+--router-world-state rc real? = stnode ⟨ real? , proj₁ (proj₂ (sim rc)) ⟩
121
+--  (proj₂ (ideal rc) ∷ proj₂ (real rc) ∷ [])
122
+--router-world-state rc ideal? = stnode ⟨ ideal? , lift tt ⟩
123
+--  (proj₂ (ideal rc) ∷ proj₂ (real rc) ∷ [])
124
+
125
+--router-strategy : ∀ {ℓ A} → (rc : RouterConfig {ℓ}) →
126
+--  Strategy (proj₁ (ideal rc)) A → Strategy (router-world-type rc) A
127
+--router-strategy = ?
128
+--
129
+--yggdrasil-game : ∀ {ℓ} → (rc : RouterConfig {ℓ}) →
130
+--  Strategy (proj₁ (ideal rc)) Guess → Guess {ℓ} → ℕ → Dist (Maybe (Guess {lsuc ℓ}))
131
+--yggdrasil-game rc str world gas =
132
+--  (exec (router-strategy rc str) (router-world-state rc world) gas) >>=
133
+--  (pure ∘ mmap (relevel ∘ proj₁))

+ 59
- 25
Yggdrasil/World.agda View File

@@ -8,7 +8,8 @@ open import Data.Nat using (ℕ; zero; suc)
8 8
 open import Data.Product using (_×_; Σ; ∃; ∃-syntax) renaming (_,_ to ⟨_,_⟩)
9 9
 open import Data.Sum using (_⊎_; inj₁; inj₂)
10 10
 open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
11
-open import Level using (Level) renaming (suc to lsuc)
11
+open import Level using (Level) renaming (suc to lsuc; lift to llift)
12
+open import Yggdrasil.Probability using (Dist; pure; _>>=_; lift)
12 13
 open import Yggdrasil.List using (_∈_; here; there)
13 14
 
14 15
 record Query (ℓ : Level) : Set (lsuc ℓ) where
@@ -18,11 +19,10 @@ record Query (ℓ : Level) : Set (lsuc ℓ) where
18 19
 
19 20
 record Node (ℓ : Level) : Set (lsuc ℓ)
20 21
 record WorldType (ℓ : Level) : Set (lsuc ℓ)
21
-data Action↯ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
22
+--data Action↯ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
22 23
 data Action↑ {ℓ : Level} (N : Node ℓ) : Set ℓ → Set (lsuc ℓ)
23 24
 data Action↓ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
24
-Action : {ℓ : Level} → WorldType ℓ → Set ℓ → Set (lsuc ℓ)
25
-Action Γ A = Action↯ Γ A ⊎ Action↓ Γ A
25
+data Action {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
26 26
 
27 27
 data WorldState {ℓ : Level} (Γ : WorldType ℓ) : Set (lsuc ℓ)
28 28
 data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (lsuc ℓ)
@@ -67,16 +67,28 @@ data _⊑_ {ℓ : Level} : (Γ₁ Γ₂ : WorldType ℓ) → Set (lsuc ℓ) wher
67 67
 ⊑-right : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₂ ⊑ Γ₃ → Γ₁ ∈ chld (node Γ₂) → Γ₁ ⊑ Γ₃
68 68
 ⊑-right Γ⊑ ∈Γ = ⊑-trans (there ∈Γ here) Γ⊑
69 69
 
70
-data Action↯ {ℓ} Γ where
70
+data Action {ℓ} Γ where
71
+  _↑ : ∀ {A} → Action↓ {ℓ} Γ A → Action {ℓ} Γ A
72
+  abort : ∀ {A} → Action Γ A
73
+  dist  : ∀ {A} → Dist A → Action Γ A
71 74
   call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ → (x : Call.A f) →
72
-    Action↯ Γ (Call.B f x)
75
+    Action Γ (Call.B f x)
76
+  _>>=_ : ∀ {A B} → Action Γ A → (A → Action Γ B) → Action Γ B
77
+
78
+--A = Action↯ Γ A ⊎ Action↓ Γ A
79
+--data Action↯ {ℓ} Γ where
80
+--  abort : ∀ {A} → Action↯ Γ A
81
+--  dist  : ∀ {A} → Dist A → Action↯ Γ A
82
+--  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ → (x : Call.A f) →
83
+--    Action↯ Γ (Call.B f x)
84
+--  _>>=_ : ∀ {A B} → Action↯ Γ A → (A → Action↯ Γ B) → Action↯ Γ B
73 85
 
74 86
 data Action↓ {ℓ} Γ where
75 87
   call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action↓ Γ (Call.B f x)
76 88
 
77 89
 data Action↑ {ℓ} N where
78 90
   abort : ∀ {A} → Action↑ N A
79
-  pure  : ∀ {A} → A → Action↑ N A
91
+  dist  : ∀ {A} → Dist A → Action↑ N A
80 92
   query : ∀ {q} → q ∈ qry N → (x : Query.A q) → Action↑ N (Query.B q x)
81 93
   _↑_   : ∀ {Γ A} → Action↓ Γ A → Γ ∈ chld N → Action↑ N A
82 94
   _>>=_ : ∀ {A B} → Action↑ N A → (A → Action↑ N B) → Action↑ N B
@@ -122,38 +134,59 @@ set (there Γ′∈ ⊑Γ) (stnode Σ Σs) Σ′ = stnode Σ (set′ Γ′∈ 
122 134
     set′ (there Γ∈) ⊑Γ (Σ ∷ Σs) Σ′ = Σ ∷ set′ Γ∈ ⊑Γ Σs Σ′
123 135
 
124 136
 exec : ∀ {ℓ Γ A} → Strategy {ℓ} Γ A → WorldState {ℓ} Γ → ℕ →
125
-  Maybe (A × WorldState {ℓ} Γ)
126
-exec↯ : ∀ {ℓ Γ A} → Oracle Γ → Action↯ Γ A → WorldState {ℓ} Γ → ℕ →
127
-  Maybe (A × WorldState {ℓ} Γ)
137
+  Dist (Maybe (A × WorldState {ℓ} Γ))
138
+exec′ : ∀ {ℓ Γ A} → Oracle Γ → Action Γ A → WorldState {ℓ} Γ → ℕ →
139
+  Dist (Maybe (A × WorldState {ℓ} Γ))
140
+--exec↯ : ∀ {ℓ Γ A} → Oracle Γ → Action↯ Γ A → WorldState {ℓ} Γ → ℕ →
141
+--  Dist (Maybe (A × WorldState {ℓ} Γ))
128 142
 exec↓ : ∀ {ℓ Γ₁ Γ₂ A} → Oracle Γ₁ → Action↓ Γ₂ A → WorldState {ℓ} Γ₁ →
129
-  Γ₂ ⊑ Γ₁ → ℕ → Maybe (A × WorldState {ℓ} Γ₁)
143
+  Γ₂ ⊑ Γ₁ → ℕ → Dist (Maybe (A × WorldState {ℓ} Γ₁))
130 144
 exec↑ : ∀ {ℓ Γ₁ Γ₂ N A} → Oracle Γ₁ → Action↑ N A → WorldState {ℓ} Γ₁ →
131
-  Γ₂ ⊑ Γ₁ → N ≡ node Γ₂ → ℕ → Maybe (A × WorldState {ℓ} Γ₁)
145
+  Γ₂ ⊑ Γ₁ → N ≡ node Γ₂ → ℕ → Dist (Maybe (A × WorldState {ℓ} Γ₁))
132 146
 
133
-exec (strat (inj₁ α) O) Σ g = exec↯ O α Σ g
134
-exec (strat (inj₂ α) O) Σ g = exec↓ O α Σ here g
147
+-- NOTE: Gas is only used for termination here, it is NOT a computational model.
148
+exec (strat α O) Σ g = exec′ O α Σ g
135 149
 
136
-exec↯ _ _ _ zero = nothing
137
-exec↯ O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = let
150
+exec′ _ _ _ zero = pure nothing
151
+exec′ O (α ↑) Σ g = exec↓ O α Σ here g
152
+exec′ _ abort _ _ = pure nothing
153
+exec′ O (dist D) Σ (suc g) = lift D >>= λ{ (llift x) → pure (just ⟨ x , Σ ⟩ ) }
154
+exec′ O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = let
138 155
     σ = get ⊑Γ Σ
139 156
     ⟨ σ′ , α ⟩ = Call.δ f σ x
140 157
     Σ′ = set ⊑Γ Σ σ′
141 158
   in exec↑ O α Σ′ ⊑Γ refl g
142
-
143
-exec↓ _ _ _ _ zero = nothing
159
+-- exec′ O (α ↯) Σ g = exec↯ O α Σ g
160
+exec′ O (α >>= β) Σ (suc g) = (exec′ O α Σ (suc g)) >>= λ{
161
+  (just ⟨ x , Σ′ ⟩) → exec′ O (β x) Σ′ g;
162
+  nothing           → pure nothing }
163
+
164
+-- exec↯ _ _ _ zero = pure nothing
165
+-- exec↯ _ abort _ _ = pure nothing
166
+-- exec↯ O (dist D) Σ (suc g) = lift D >>= λ{ (llift x) → pure (just ⟨ x , Σ ⟩ ) }
167
+-- exec↯ O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = let
168
+--     σ = get ⊑Γ Σ
169
+--     ⟨ σ′ , α ⟩ = Call.δ f σ x
170
+--     Σ′ = set ⊑Γ Σ σ′
171
+--   in exec↑ O α Σ′ ⊑Γ refl g
172
+-- exec↯ O (α >>= β) Σ (suc g) = (exec↯ O α Σ (suc g)) >>= λ{
173
+--   (just ⟨ x , Σ′ ⟩) → exec↯ O (β x) Σ′ g;
174
+--   nothing           → pure nothing }
175
+
176
+exec↓ _ _ _ _ zero = pure nothing
144 177
 exec↓ O (call↓ {f = f} f∈ x) Σ ⊑Γ (suc g) = let
145 178
     σ = get ⊑Γ Σ
146 179
     ⟨ σ′ , α ⟩ = Call.δ f σ x
147 180
     Σ′ = set ⊑Γ Σ σ′
148 181
   in exec↑ O α Σ′ ⊑Γ refl g
149 182
 
150
-exec↑ _ _ _ _ _ zero = nothing
151
-exec↑ O abort Σ ⊑Γ N≡ (suc g) = nothing
152
-exec↑ O (pure x) Σ ⊑Γ N≡ (suc g) = just ⟨ x , Σ ⟩
183
+exec↑ _ _ _ _ _ zero = pure nothing
184
+exec↑ O abort Σ ⊑Γ N≡ (suc g) = pure nothing
185
+exec↑ O (dist D) Σ ⊑Γ N≡ (suc g) = lift D >>=
186
+  λ{ (llift x) → pure (just ⟨ x , Σ ⟩) }
153 187
 exec↑ O (query {q = q} q∈ x) Σ ⊑Γ refl (suc g) =
154
-  exec (strat (O (path ⊑Γ q∈) x) O) Σ g
188
+  exec′ O (O (path ⊑Γ q∈) x) Σ g
155 189
 exec↑ O (α ↑ Γ′∈) Σ ⊑Γ refl (suc g) = exec↓ O α Σ (⊑-right ⊑Γ Γ′∈) g
156
-exec↑ O (α >>= β) Σ ⊑Γ N≡ (suc g) with exec↑ O α Σ ⊑Γ N≡ (suc g)
157
-... | just ⟨ x , Σ′ ⟩ = exec↑ O (β x) Σ′ ⊑Γ N≡ g
158
-... | nothing         = nothing
190
+exec↑ O (α >>= β) Σ ⊑Γ N≡ (suc g) = (exec↑ O α Σ ⊑Γ N≡ (suc g)) >>= λ{
191
+  (just ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ N≡ g;
192
+  nothing           → pure nothing }

Loading…
Cancel
Save