Browse Source

Mostly finish execution.

gas-move-test
Thomas Kerber 6 months ago
parent
commit
4cd48c4b9e
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
2 changed files with 123 additions and 41 deletions
  1. 2
    2
      Yggdrasil/List.agda
  2. 121
    39
      Yggdrasil/World.agda

+ 2
- 2
Yggdrasil/List.agda View File

@@ -4,6 +4,6 @@ open import Data.List using (List; _∷_)
4 4
 open import Level using (Level)
5 5
 
6 6
 data _∈_ {ℓ : Level} {A : Set ℓ} : A → List A → Set ℓ where
7
-  --here : {x : A} {xs : List A} → (x ∷ xs) ∈ x 
8
-  --there : {x y : A} {xs : List A} → xs ∈ y → (x ∷ xs) ∈ y
7
+  here : {x : A} {xs : List A} → x ∈ (x ∷ xs)
8
+  there : {x y : A} {xs : List A} → y ∈ xs → y ∈ (x ∷ xs)
9 9
 

+ 121
- 39
Yggdrasil/World.agda View File

@@ -2,77 +2,159 @@ module Yggdrasil.World where
2 2
 
3 3
 open import Data.Bool using (Bool)
4 4
 open import Data.List using (List; _∷_; []; map)
5
-open import Data.Maybe using (Maybe)
6
-open import Data.Product using (_×_)
7
-open import Data.Sum using (_⊎_)
8
-open import Level using (Level; suc)
9
-open import Yggdrasil.List using (_∈_)
10
-
11
-record Query (ℓ : Level) : Set (suc ℓ) where
5
+open import Data.Maybe using (Maybe; nothing; just)
6
+open import Data.Nat using (ℕ; zero; suc)
7
+open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
8
+open import Data.Sum using (_⊎_; inj₁; inj₂)
9
+open import Relation.Binary.PropositionalEquality using (_≡_; refl)
10
+open import Level using (Level) renaming (suc to lsuc)
11
+open import Yggdrasil.List using (_∈_; here; there)
12
+
13
+record Query (ℓ : Level) : Set (lsuc ℓ) where
12 14
   field
13 15
     A : Set ℓ
14 16
     B : A → Set ℓ
15 17
 
16
-record WorldType (ℓ : Level) : Set (suc ℓ)
17
-data Action↯ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (suc ℓ)
18
-data Action↑ {ℓ : Level} (Γs : List (WorldType ℓ)) (Qs : List (Query ℓ)) : Set ℓ → Set (suc ℓ)
19
-data Action↓ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (suc ℓ)
20
-Action : {ℓ : Level} → WorldType ℓ → Set ℓ → Set (suc ℓ)
18
+record Node (ℓ : Level) : Set (lsuc ℓ)
19
+record WorldType (ℓ : Level) : Set (lsuc ℓ)
20
+data Action↯ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
21
+data Action↑ {ℓ : Level} (N : Node ℓ) : Set ℓ → Set (lsuc ℓ)
22
+data Action↓ {ℓ : Level} (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
23
+Action : {ℓ : Level} → WorldType ℓ → Set ℓ → Set (lsuc ℓ)
21 24
 Action Γ A = Action↯ Γ A ⊎ Action↓ Γ A
22 25
 
23
-data WorldState {ℓ : Level} (Γ : WorldType ℓ) : Set (suc ℓ)
24
-data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (suc ℓ)
26
+data WorldState {ℓ : Level} (Γ : WorldType ℓ) : Set (lsuc ℓ)
27
+data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (lsuc ℓ)
25 28
 
29
+record Node ℓ where
30
+  inductive
31
+  field
32
+    state : Set ℓ
33
+    chld  : List (WorldType ℓ)
34
+    qry   : List (Query ℓ)
26 35
 
27
-record Call (ℓ : Level) (Σ : Set ℓ) (Γs : List (WorldType ℓ))
28
-    (Qs : List (Query ℓ)) : Set (suc ℓ) where
36
+open Node
37
+
38
+record Call (ℓ : Level) (N : Node ℓ) : Set (lsuc ℓ) where
29 39
   inductive
30 40
   field
31 41
     A : Set ℓ
32 42
     B : A → Set ℓ
33
-    δ : Σ → (x : A) → Σ × Action↑ Γs Qs (B x)
43
+    δ : (state N) → (x : A) → (state N) × Action↑ N (B x)
34 44
 
35 45
 record WorldType ℓ where
36 46
   inductive
37 47
   field
38
-    root : Set ℓ
39
-    chld : List (WorldType ℓ)
40
-    qry  : List (Query ℓ)
41
-    adv  : List (Call ℓ root chld qry)
42
-    hon  : List (Call ℓ root chld qry)
48
+    node : Node ℓ
49
+    adv  : List (Call ℓ node)
50
+    hon  : List (Call ℓ node)
43 51
 
44 52
 open WorldType
45 53
 
54
+data _⊑_ {ℓ : Level} : (Γ₁ Γ₂ : WorldType ℓ) → Set (lsuc ℓ) where
55
+  here : ∀ {Γ} → Γ ⊑ Γ
56
+  there : ∀ {Γ₁ Γ₂ Γ₃} → Γ₂ ∈ chld (node Γ₃) → Γ₁ ⊑ Γ₂ → Γ₁ ⊑ Γ₃
57
+
58
+-- ⊑-extract-right : ∀ {Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → Γ₁ ≢ Γ₂ → ∃[ Γ₃ ] 
59
+
60
+⊑-right : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₂ ⊑ Γ₃ → Γ₁ ∈ chld (node Γ₂) → Γ₁ ⊑ Γ₃
61
+⊑-right here ∈Γ = there ∈Γ here
62
+⊑-right (there Γ′∈ ⊑Γ′) ∈Γ = ?
63
+
46 64
 data Action↯ {ℓ} Γ where
47
-  call↯ : ∀ {f} → f ∈ (adv Γ) → (x : Call.A f) → Action↯ Γ (Call.B f x)
48
-  lift↯ : ∀ {Γ′ A} → Action↯ Γ′ A → Γ′ ∈ (chld Γ) → Action↯ Γ A
65
+  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ) → Γ′ ⊑ Γ → (x : Call.A f) →
66
+    Action↯ Γ (Call.B f x)
49 67
 
50 68
 data Action↓ {ℓ} Γ where
51 69
   call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action↓ Γ (Call.B f x)
52 70
 
53
-data Action↑ {ℓ} Γs Qs where
54
-  abort : ∀ {A} → Action↑ Γs Qs A
55
-  pure  : ∀ {A} → A → Action↑ Γs Qs A
56
-  query : ∀ {q} → q ∈ Qs → (x : Query.A q) → Action↑ Γs Qs (Query.B q x)
57
-  _↑    : ∀ {Γ A} → Action↓ Γ A → Γ ∈ Γs → Action↑ Γs Qs A
58
-  _>>=_ : ∀ {A B} → Action↑ Γs Qs A → (A → Action↑ Γs Qs B) → Action↑ Γs Qs B
71
+data Action↑ {ℓ} N where
72
+  abort : ∀ {A} → Action↑ N A
73
+  pure  : ∀ {A} → A → Action↑ N A
74
+  query : ∀ {q} → q ∈ qry N → (x : Query.A q) → Action↑ N (Query.B q x)
75
+  _↑_   : ∀ {Γ A} → Action↓ Γ A → Γ ∈ chld N → Action↑ N A
76
+  _>>=_ : ∀ {A B} → Action↑ N A → (A → Action↑ N B) → Action↑ N B
59 77
 
60 78
 data WorldStates {ℓ} where
61 79
   [] : WorldStates []
62 80
   _∷_ : ∀ {Γ Γs} → WorldState Γ → WorldStates Γs → WorldStates (Γ ∷ Γs)
63 81
 
64 82
 data WorldState {ℓ} Γ where
65
-  node : root Γ → WorldStates (chld Γ) → WorldState Γ
83
+  stnode : state (node Γ) → WorldStates (chld (node Γ)) → WorldState Γ
66 84
 
67
-data _∈↑_ {ℓ : Level} (q : Query ℓ) (Γ : WorldType ℓ) : Set (suc ℓ) where
68
-  here : q ∈ qry Γ → q ∈↑ Γ
69
-  there : ∀ {Γ′} → q ∈↑ Γ′ → Γ′ ∈ chld Γ → q ∈↑ Γ
85
+data _∈↑_ {ℓ : Level} (q : Query ℓ) (Γ : WorldType ℓ) : Set (lsuc ℓ) where
86
+  path : ∀ {Γ′} → Γ′ ⊑ Γ → q ∈ qry (node Γ′) → q ∈↑ Γ
70 87
 
71
-record Strategy {ℓ : Level} (Γ : WorldType ℓ) (A : Set ℓ) : Set (suc ℓ) where
88
+Oracle : ∀ {ℓ} → WorldType ℓ → Set (lsuc ℓ)
89
+Oracle Γ = ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action Γ (Query.B q x)
90
+
91
+record Strategy {ℓ : Level} (Γ : WorldType ℓ) (A : Set ℓ) : Set (lsuc ℓ) where
72 92
   constructor strat
73 93
   field
74 94
     init : Action Γ A
75
-    oracle : ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action Γ (Query.B q x)
76
-
77
-exec : ∀ {ℓ Γ A} → Strategy {ℓ} Γ A → WorldState {ℓ} Γ → Maybe A
78
-exec = ?
95
+    oracle : Oracle Γ
96
+
97
+get : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁)
98
+get here (stnode Σ _) = Σ
99
+get (there Γ′∈ ⊑Γ) (stnode _ Σs) = get ⊑Γ (lookup Γ′∈ Σs)
100
+  where
101
+    lookup : ∀ {Γ Γs} → Γ ∈ Γs → WorldStates Γs → WorldState Γ
102
+    lookup here (Σ ∷ _) = Σ
103
+    lookup (there Γ′∈) (_ ∷ Σs) = lookup Γ′∈ Σs
104
+
105
+set : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁) →
106
+  WorldState {ℓ} Γ₂
107
+set here (stnode Σ Σs) Σ′ = stnode Σ′ Σs
108
+set (there Γ′∈ ⊑Γ) (stnode Σ Σs) Σ′ = stnode Σ (set′ Γ′∈ ⊑Γ Σs Σ′)
109
+  where
110
+    set′ : ∀ {Γ₁ Γ₂ Γs} → Γ₂ ∈ Γs → Γ₁ ⊑ Γ₂ → WorldStates Γs →
111
+      state (node Γ₁) → WorldStates Γs
112
+    set′ here ⊑Γ (Σ ∷ Σs) Σ′ = set ⊑Γ Σ Σ′ ∷ Σs
113
+    set′ (there Γ∈) ⊑Γ (Σ ∷ Σs) Σ′ = Σ ∷ set′ Γ∈ ⊑Γ Σs Σ′
114
+
115
+exec : ∀ {ℓ Γ A} → Strategy {ℓ} Γ A → WorldState {ℓ} Γ → ℕ →
116
+  Maybe (A × WorldState {ℓ} Γ)
117
+exec↯ : ∀ {ℓ Γ A} → Oracle Γ → Action↯ Γ A → WorldState {ℓ} Γ → ℕ →
118
+  Maybe (A × WorldState {ℓ} Γ)
119
+exec↓ : ∀ {ℓ Γ₁ Γ₂ A} → Oracle Γ₁ → Action↓ Γ₂ A → WorldState {ℓ} Γ₁ →
120
+  Γ₂ ⊑ Γ₁ → ℕ → Maybe (A × WorldState {ℓ} Γ₁)
121
+exec↑ : ∀ {ℓ Γ₁ Γ₂ N A} → Oracle Γ₁ → Action↑ N A → WorldState {ℓ} Γ₁ →
122
+  Γ₂ ⊑ Γ₁ → N ≡ node Γ₂ → ℕ → Maybe (A × WorldState {ℓ} Γ₁)
123
+
124
+
125
+--    root : Set ℓ
126
+--    chld : List (WorldType ℓ)
127
+--    qry  : List (Query ℓ)
128
+--    adv  : List (Call ℓ root chld qry)
129
+--    hon  : List (Call ℓ root chld qry)
130
+
131
+exec (strat (inj₁ α) O) Σ g = exec↯ O α Σ g
132
+exec (strat (inj₂ α) O) Σ g = exec↓ O α Σ here g
133
+
134
+exec↯ _ _ _ zero = nothing
135
+exec↯ O (call↯ {f = f} f∈ ⊑Γ x) Σ (suc g) = let
136
+    σ = get ⊑Γ Σ
137
+    ⟨ σ′ , α ⟩ = Call.δ f σ x
138
+    Σ′ = set ⊑Γ Σ σ′
139
+  in exec↑ O α Σ′ ⊑Γ refl g
140
+
141
+exec↓ _ _ _ _ zero = nothing
142
+exec↓ O (call↓ {f = f} f∈ x) Σ ⊑Γ (suc g) = let
143
+    σ = get ⊑Γ Σ
144
+    ⟨ σ′ , α ⟩ = Call.δ f σ x
145
+    Σ′ = set ⊑Γ Σ σ′
146
+  in exec↑ O α Σ′ ⊑Γ refl g
147
+
148
+--Oracle Γ = ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action Γ (Query.B q x)
149
+--path : ∀ {Γ′} → Γ′ ⊑ Γ → q ∈ qry (node Γ′) → q ∈↑ Γ
150
+
151
+-- NOTE: Gas is only used for termination here, it is NOT a computational model.
152
+exec↑ _ _ _ _ _ zero = nothing
153
+exec↑ O abort Σ ⊑Γ N≡ (suc g) = nothing
154
+exec↑ O (pure x) Σ ⊑Γ N≡ (suc g) = just ⟨ x , Σ ⟩
155
+exec↑ O (query {q = q} q∈ x) Σ ⊑Γ refl (suc g) =
156
+  exec (strat (O (path ⊑Γ q∈) x) O) Σ g
157
+exec↑ O (α ↑ Γ′∈) Σ ⊑Γ refl (suc g) = exec↓ O α Σ (⊑-right ⊑Γ Γ′∈) g
158
+exec↑ O (α >>= β) Σ ⊑Γ N≡ (suc g) with exec↑ O α Σ ⊑Γ N≡ (suc g)
159
+... | just ⟨ x , Σ′ ⟩ = exec↑ O (β x) Σ′ ⊑Γ N≡ g
160
+... | nothing         = nothing

Loading…
Cancel
Save