Browse Source

Start working on ISM ideas.

master
Thomas Kerber 6 months ago
parent
commit
4ca10bba09
Signed by: Thomas Kerber <t.kerber@ed.ac.uk> GPG Key ID: 8489B911F9ED617B
1 changed files with 346 additions and 196 deletions
  1. 346
    196
      Yggdrasil/World.agda

+ 346
- 196
Yggdrasil/World.agda View File

@@ -1,209 +1,355 @@
1 1
 module Yggdrasil.World where
2 2
 
3
-open import Data.Bool using (Bool; true; false)
4
-open import Data.Empty using (⊥-elim)
3
+open import Data.Bool using (Bool; T)
5 4
 open import Data.List using (List; _∷_; []; map)
6
-open import Data.Maybe using (Maybe; nothing; just) renaming (map to mmap)
7
-open import Data.Nat using (ℕ; zero; suc)
8
-open import Data.Product using (_×_; ∃; ∃-syntax; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
9
-open import Data.Sum using (_⊎_; inj₁; inj₂)
10
-open import Function using (_∘_)
11
-open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
12
-open import Level using (Level; Lift) renaming (suc to lsuc; lift to llift)
13
-open import Yggdrasil.Probability using (Dist; pure; _>>=′_; lift)
14
-open import Yggdrasil.List using (_∈_; here; there)
15
-
5
+open import Data.List.Any using (here; there)
6
+open import Data.List.Membership.Propositional using (_∈_)
7
+open import Data.Maybe using (Maybe; just; nothing) renaming (map to mmap)
8
+open import Data.Nat using (ℕ; suc)
9
+open import Data.Product as Π using (_×_; ∃; ∃-syntax; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
10
+open import Data.String using (String)
11
+import Data.String.Unsafe as S
12
+open import Function using (id)
13
+open import Level using (Level; _⊔_; Lift) renaming (suc to lsuc; zero to lzero)
14
+open import Relation.Binary.PropositionalEquality using (_≡_; refl)
15
+open import Relation.Nullary using (Dec; yes; no)
16
+
17
+-- Auto-lifted variant of ⊤.
16 18
 data ⊤ {ℓ : Level} : Set ℓ where
17 19
   tt : ⊤
18 20
 
19
-data ⊥ {ℓ : Level} : Set ℓ where
20
-
21
-T : ∀ {ℓ} → Bool → Set ℓ
22
-T true = ⊤
23
-T false = ⊥
24
-
25
-record Query (ℓ : Level) : Set (lsuc ℓ) where
26
-  constructor mkquery
27
-  field
28
-    A : Set ℓ
29
-    B : A → Set ℓ
30
-
31
-mknquery : {ℓ : Level} → Set ℓ → Set ℓ → Query ℓ
32
-mknquery A B = mkquery A (λ _ → B)
33
-
34
-record Node (ℓ : Level) : Set (lsuc ℓ)
35
-record WorldType (ℓ : Level) : Set (lsuc ℓ)
36
-data Action↑ {ℓ : Level} (N : Node ℓ) : Set ℓ → Set (lsuc ℓ)
37
-data Action⊤ {ℓ : Level} (S : Set ℓ) (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
38
-
39
-data WorldState {ℓ : Level} (Γ : WorldType ℓ) : Set (lsuc ℓ)
40
-data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (lsuc ℓ)
41
-
42
-record Node ℓ where
43
-  inductive
44
-  constructor mknode
45
-  field
46
-    state : Set ℓ
47
-    chld  : List (WorldType ℓ)
48
-    qry   : List (Query ℓ)
49
-
50
-open Node
51
-
52
-
53
-record Call (ℓ : Level) (N : Node ℓ) : Set (lsuc ℓ) where
21
+Table : ∀ {ℓ} → Set ℓ → Set ℓ
22
+Table A = List (String × A)
23
+
24
+lookup : ∀ {ℓ A} → Table {ℓ} A → String → Maybe A
25
+lookup [] _ = nothing
26
+lookup (⟨ s₁ , x ⟩ ∷ xs) s₂ with s₁ S.≟ s₂
27
+... | yes _ = just x
28
+... | no _  = lookup xs s₂
29
+
30
+module Weak where
31
+  record WeakState {ℓ : Level} : Set (lsuc ℓ)
32
+
33
+  record WeakTransition {ℓ : Level} : Set (lsuc ℓ) where
34
+    inductive
35
+    field
36
+      A : Set ℓ
37
+      B : A → Set ℓ
38
+      Σ : A → WeakState {ℓ}
39
+
40
+  record WeakState {ℓ} where
41
+    inductive
42
+    field
43
+      δ↑ : Table (WeakTransition {ℓ})
44
+      δ↓ : Table (WeakTransition {ℓ})
45
+
46
+open Weak using (WeakState; WeakTransition)
47
+
48
+record State {ℓ : Level} (Σʷ : WeakState {ℓ}) : Set (lsuc ℓ)
49
+data Action {ℓ : Level} : {Σʷ₁ Σʷ₂ : WeakState {ℓ}} → (Σ₁ : Π.Σ (Set ℓ) id) →
50
+    (Σ₂ : State Σʷ₂) → Set ℓ → Set (lsuc ℓ)
51
+
52
+Transition↑ : {ℓ : Level} {Σʷ : WeakState {ℓ}} → (Σ₁ : Π.Σ (Set ℓ) id) →
53
+  WeakTransition {ℓ} → Set (lsuc ℓ)
54
+Transition↑ {Σʷ = Σʷ} Σ₁ T = (x : A T) → Π.Σ (State (Σ T x))
55
+    (λ Σ₂ → Action {Σʷ₁ = Σʷ} Σ₁ Σ₂ (B T x))
56
+  where open WeakTransition using (A; B; Σ)
57
+
58
+Transition↓ : {ℓ : Level} → WeakTransition {ℓ} → Set (lsuc ℓ)
59
+Transition↓ T = (x : A T) → State (Σ T x)
60
+  where open WeakTransition using (A; Σ)
61
+
62
+data Transitions↑ {ℓ : Level} (Σ : Π.Σ (Set ℓ) id) :
63
+    Table (WeakTransition {ℓ}) → Set (lsuc ℓ) where
64
+  [] : Transitions↑ Σ []
65
+  _∷_ : ∀ {Σʷ T Ts name} → Transition↑ {Σʷ = Σʷ} Σ T → Transitions↑ Σ Ts →
66
+    Transitions↑ Σ (⟨ name , T ⟩ ∷ Ts)
67
+
68
+data Transitions↓ {ℓ : Level} :
69
+    Table (WeakTransition {ℓ}) → Set (lsuc ℓ) where
70
+  [] : Transitions↓ []
71
+  _∷_ : ∀ {T Ts name} → Transition↓ T → Transitions↓ Ts →
72
+    Transitions↓ (⟨ name , T ⟩ ∷ Ts)
73
+
74
+record State {ℓ} Σʷ where
54 75
   inductive
55
-  constructor call
56 76
   field
57
-    A : Set ℓ
58
-    B : A → Set ℓ
59
-    δ : (x : A) → Action↑ N (B x)
60
-
61
-ncall : {ℓ : Level} {N : Node ℓ} → (A B : Set ℓ) → (A → Action↑ N B) → Call ℓ N
62
-ncall A B δ = call A (λ _ → B) δ
63
-
64
-weaken : ∀ {ℓ N} → Call ℓ N → Query ℓ
65
-weaken c = record { A = Call.A c; B = Call.B c }
66
-
67
-record WorldType ℓ where
68
-  inductive
69
-  constructor tynode
70
-  field
71
-    node : Node ℓ
72
-    adv  : List (Call ℓ node)
73
-    hon  : List (Call ℓ node)
74
-
75
-open WorldType
76
-
77
-data _⊑_ {ℓ : Level} : (Γ₁ Γ₂ : WorldType ℓ) → Set (lsuc ℓ) where
78
-  here : ∀ {Γ} → Γ ⊑ Γ
79
-  there : ∀ {Γ₁ Γ₂ Γ₃} → Γ₂ ∈ chld (node Γ₃) → Γ₁ ⊑ Γ₂ → Γ₁ ⊑ Γ₃
80
-
81
-⊑-trans : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₁ ⊑ Γ₂ → Γ₂ ⊑ Γ₃ → Γ₁ ⊑ Γ₃
82
-⊑-trans ⊑Γ here = ⊑Γ
83
-⊑-trans ⊑Γ (there Γ′∈ ⊑Γ′) = there Γ′∈ (⊑-trans ⊑Γ ⊑Γ′)
84
-
85
-⊑-right : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₂ ⊑ Γ₃ → Γ₁ ∈ chld (node Γ₂) → Γ₁ ⊑ Γ₃
86
-⊑-right Γ⊑ ∈Γ = ⊑-trans (there ∈Γ here) Γ⊑
87
-
88
-data Action⊤ {ℓ} S Γ where
89
-  read  : Action⊤ S Γ S
90
-  write : S → Action⊤ S Γ ⊤
91
-  call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action⊤ S Γ (Call.B f x)
92
-  abort : ∀ {A} → Action⊤ S Γ A
93
-  dist  : ∀ {A} → Dist A → Action⊤ S Γ A
94
-  call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ →
95
-    (x : Call.A f) → Action⊤ S Γ (Call.B f x)
96
-  _>>=_ : ∀ {A B} → Action⊤ S Γ A → (A → Action⊤ S Γ B) → Action⊤ S Γ B
97
-
98
-data Action↑ {ℓ} N where
99
-  read  : Action↑ N (state N)
100
-  write : state N → Action↑ N ⊤
101
-  call↓ : ∀ {Γ f} → f ∈ (hon Γ) → Γ ∈ chld N → (x : Call.A f) →
102
-    Action↑ N (Call.B f x)
103
-  abort : ∀ {A} → Action↑ N A
104
-  dist  : ∀ {A} → Dist A → Action↑ N A
105
-  query : ∀ {q} → q ∈ qry N → (x : Query.A q) → Action↑ N (Query.B q x)
106
-  _>>=_ : ∀ {A B} → Action↑ N A → (A → Action↑ N B) → Action↑ N B
107
-
108
-return : ∀ {ℓ N A} → A → Action↑ {ℓ} N A
109
-return x = dist (pure x)
110
-
111
-infixl 1 _>>=_ _>>_
112
-
113
-_>>_ : ∀ {ℓ N A B} → Action↑ {ℓ} N A → Action↑ {ℓ} N B → Action↑ {ℓ} N B
114
-α >> β = α >>= (λ _ → β)
115
-
116
-data WorldStates {ℓ} where
117
-  [] : WorldStates []
118
-  _∷_ : ∀ {Γ Γs} → WorldState Γ → WorldStates Γs → WorldStates (Γ ∷ Γs)
119
-
120
-data WorldState {ℓ} Γ where
121
-  stnode : state (node Γ) → WorldStates (chld (node Γ)) → WorldState Γ
122
-
123
-record World (ℓ : Level) : Set (lsuc ℓ) where
124
-  field
125
-    Γ : WorldType ℓ
126
-    Σ : WorldState Γ
127
-
128
-data _∈↑_ {ℓ : Level} (q : Query ℓ) (Γ : WorldType ℓ) : Set (lsuc ℓ) where
129
-  path : ∀ {Γ′} → Γ′ ⊑ Γ → q ∈ qry (node Γ′) → q ∈↑ Γ
130
-
131
-Oracle : ∀ {ℓ} → Set ℓ → WorldType ℓ → Set (lsuc ℓ)
132
-Oracle S Γ = ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action⊤ S Γ (Query.B q x)
133
-
134
-record Strategy {ℓ : Level} (Γ : WorldType ℓ) (A : Set ℓ) {S : Set ℓ} : Set (lsuc ℓ) where
135
-  constructor strat
77
+    Σ : Set ℓ
78
+    σ : Σ
79
+    δ↑ : Transitions↑ ⟨ Σ , σ ⟩ (WeakState.δ↑ Σʷ)
80
+    δ↓ : Transitions↓ (WeakState.δ↓ Σʷ)
81
+
82
+⌊_⌋ : ∀ {ℓ Σʷ} → (Σ : State {ℓ} Σʷ) → Π.Σ (Set ℓ) id
83
+⌊ Σ ⌋ = ⟨ State.Σ Σ , State.σ Σ ⟩
84
+
85
+lookup↓ : ∀ {ℓ xs δ} → δ ∈ xs → (Ts : Transitions↓ {ℓ} xs) → Transition↓ (proj₂ δ)
86
+lookup↓ (here refl) (x ∷ _) = x
87
+lookup↓ (there ∈xs) (_ ∷ xs) = lookup↓ ∈xs xs
88
+
89
+∈↓ʷ⇒∈↓ : ∀ {ℓ Σʷ δ} {Σ : State Σʷ} → δ ∈ (WeakState.δ↓ Σʷ) →
90
+  Transition↓ {ℓ} (proj₂ δ)
91
+∈↓ʷ⇒∈↓ {Σ = Σ} δ∈ = lookup↓ δ∈ (State.δ↓ Σ)
92
+--
93
+--open Weak
94
+--
95
+
96
+data Action {ℓ} where
97
+  get    : ∀ {Σʷ Σ} → Action {ℓ} {Σʷ} {Σʷ} ⌊ Σ ⌋ Σ (State.Σ Σ)
98
+  set    : ∀ {Σʷ₁ Σʷ₂ Σ₁ Σ₂} → State.Σ Σ₂ → Action {ℓ} {Σʷ₁} {Σʷ₂} Σ₁ Σ₂ ⊤
99
+  call   : ∀ {Σʷ δ} {Σ : State Σʷ} → (δ∈ : δ ∈ WeakState.δ↓ Σʷ) →
100
+    (x : WeakTransition.A (proj₂ δ)) →
101
+    Action {ℓ} {Σʷ} {WeakTransition.Σ (proj₂ δ) x} ⌊ Σ ⌋
102
+      (∈↓ʷ⇒∈↓ {Σ = Σ} δ∈ x)
103
+      (WeakTransition.B (proj₂ δ) x)
104
+  return : ∀ {Σʷ Σ A} → Action {ℓ} {Σʷ} {Σʷ} ⌊ Σ ⌋ Σ A
105
+  _>>=_  : ∀ {Σʷ₁ Σʷ₂ Σʷ₃ Σ₁ Σ₂ Σ₃ A B} →
106
+    Action {ℓ} {Σʷ₁} {Σʷ₂} (⌊_⌋ {Σʷ = Σʷ₁} Σ₁) Σ₂ A →
107
+    (A → Action {ℓ} {Σʷ₂} {Σʷ₃} ⌊ Σ₂ ⌋ Σ₃ B) →
108
+    Action {ℓ} {Σʷ₁} {Σʷ₃} ⌊ Σ₁ ⌋ Σ₃ B
109
+
110
+record ParallelComposable {ℓ₁ ℓ₂ : Level} (A : Set ℓ₁) {P : A → A → Set ℓ₂} :
111
+    Set (ℓ₁ ⊔ ℓ₂) where
136 112
   field
137
-    state : S
138
-    init : Action⊤ S Γ A
139
-    oracle : Oracle S Γ
140
-
141
-
142
-
143
-get : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁)
144
-get here (stnode Σ _) = Σ
145
-get (there Γ′∈ ⊑Γ) (stnode _ Σs) = get ⊑Γ (lookup Γ′∈ Σs)
146
-  where
147
-    lookup : ∀ {Γ Γs} → Γ ∈ Γs → WorldStates Γs → WorldState Γ
148
-    lookup here (Σ ∷ _) = Σ
149
-    lookup (there Γ′∈) (_ ∷ Σs) = lookup Γ′∈ Σs
150
-
151
-set : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁) →
152
-  WorldState {ℓ} Γ₂
153
-set here (stnode Σ Σs) Σ′ = stnode Σ′ Σs
154
-set (there Γ′∈ ⊑Γ) (stnode Σ Σs) Σ′ = stnode Σ (set′ Γ′∈ ⊑Γ Σs Σ′)
155
-  where
156
-    set′ : ∀ {Γ₁ Γ₂ Γs} → Γ₂ ∈ Γs → Γ₁ ⊑ Γ₂ → WorldStates Γs →
157
-      state (node Γ₁) → WorldStates Γs
158
-    set′ here ⊑Γ (Σ ∷ Σs) Σ′ = set ⊑Γ Σ Σ′ ∷ Σs
159
-    set′ (there Γ∈) ⊑Γ (Σ ∷ Σs) Σ′ = Σ ∷ set′ Γ∈ ⊑Γ Σs Σ′
160
-
161
-data Result {ℓ : Level} (A : Set ℓ) : Set ℓ where
162
-  abort      : Result A
163
-  out-of-gas : Result A
164
-  result     : A → Result A
165
-
166
-rmap : ∀ {ℓ A B} → (A → B) → Result {ℓ} A → Result {ℓ} B
167
-rmap _ abort = abort
168
-rmap _ out-of-gas = out-of-gas
169
-rmap f (result x) = result (f x)
170
-
171
-exec : ∀ {ℓ S Γ A} → Strategy {ℓ} Γ A {S} → WorldState {ℓ} Γ → ℕ →
172
-  Dist (Result (Lift (lsuc ℓ) A))
173
-exec⊤ : ∀ {ℓ S Γ A} → Oracle S Γ → Action⊤ S Γ A → S × WorldState {ℓ} Γ → ℕ →
174
-  Dist (Result (A × (S × WorldState {ℓ} Γ)))
175
-exec↑ : ∀ {ℓ S Γ₁ Γ₂ A} → Oracle S Γ₁ → Action↑ (node Γ₂) A →
176
-  (S × WorldState {ℓ} Γ₁) → Γ₂ ⊑ Γ₁ → ℕ → Dist (Result (A × (S × WorldState {ℓ} Γ₁)))
177
-
178
-exec (strat S α O) Σ g = (exec⊤ O α ⟨ S , Σ ⟩ g) >>=′ (pure ∘ rmap (llift ∘ proj₁))
179
-
180
-exec⊤ O read                    Σ g       = pure (result ⟨ proj₁ Σ , Σ ⟩)
181
-exec⊤ O (write σ)               Σ g       = pure (result ⟨ tt , ⟨ σ , proj₂ Σ ⟩ ⟩)
182
-exec⊤ O (call↓ {f = f} ∈Γ x)    Σ g       = exec↑ O (Call.δ f x) Σ here g
183
-exec⊤ O abort                   Σ g       = pure abort
184
-exec⊤ O (dist D)                Σ g       = lift D >>=′ λ{
185
-  (llift x) → pure (result ⟨ x , Σ ⟩ ) }
186
-exec⊤ O (call↯ {f = f} f∈ ⊑Γ x) Σ g       = exec↑ O (Call.δ f x) Σ ⊑Γ g
187
-exec⊤ O (α >>= β)               Σ g       = (exec⊤ O α Σ g) >>=′ λ{
188
-  (result ⟨ x , Σ′ ⟩) → exec⊤ O (β x) Σ′ g ;
189
-  abort               → pure abort         ;
190
-  out-of-gas          → pure out-of-gas    }
191
-
192
-exec↑ O read                    Σ ⊑Γ g       = pure (result
193
-  ⟨ get ⊑Γ (proj₂ Σ) , Σ ⟩)
194
-exec↑ O (write σ)               Σ ⊑Γ g       = pure (result
195
-  ⟨ tt , ⟨ proj₁ Σ , set ⊑Γ (proj₂ Σ) σ ⟩ ⟩)
196
-exec↑ O abort                   Σ ⊑Γ g       = pure abort
197
-exec↑ O (dist D)                Σ ⊑Γ g       = lift D >>=′
198
-  λ{ (llift x) → pure (result ⟨ x , Σ ⟩) }
199
-exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ zero    = pure out-of-gas
200
-exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ (suc g) = exec⊤ O (O (path ⊑Γ q∈) x) Σ g
201
-exec↑ O (call↓ {f = f} ∈Γ Γ∈ x) Σ ⊑Γ g       = exec↑ O (Call.δ f x) Σ (⊑-right ⊑Γ Γ∈) g
202
-exec↑ O (α >>= β)               Σ ⊑Γ g       = (exec↑ O α Σ ⊑Γ g) >>=′ λ{
203
-  (result ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ g ;
204
-  abort               → pure abort            ;
205
-  out-of-gas          → pure out-of-gas       }
113
+    _||_ : A → A → A
114
+    _∘_  : (x : A) → (y : A) → {_ : P x y} → A
115
+
116
+data InterfaceMatches {ℓ : Level} : ℕ → (Σʷ₁ Σʷ₂ : WeakState {ℓ}) → Set (lsuc ℓ) where
117
+  unreachable : ∀ {Σʷ₁ Σʷ₂} → InterfaceMatches 0 Σʷ₁ Σʷ₂
118
+  match : ∀ {n Σʷ₁ Σʷ₂ δ₁} →
119
+    -- For each interface in the outgoing to Σʷ₁
120
+    δ₁ ∈ WeakState.δ↓ Σʷ₁ →
121
+    Π.Σ (String × WeakTransition {ℓ}) (λ δ₂ →
122
+      -- A corresponding interface exists in the incoming of Σʷ₂
123
+      (δ₂ ∈ WeakState.δ↑ Σʷ₂) ×
124
+      -- With the same name
125
+      (proj₁ δ₁ ≡ proj₁ δ₂) ×
126
+      -- The same input type
127
+      Π.Σ (WeakTransition.A (proj₂ δ₁) ≡ WeakTransition.A (proj₂ δ₂)) (λ{
128
+        refl → (x : WeakTransition.A (proj₂ δ₁)) →
129
+          -- The same output type
130
+          WeakTransition.B (proj₂ δ₁) x ≡ WeakTransition.B (proj₂ δ₂) x ×
131
+          -- And preserving the fact that interfaces keep matching.
132
+          InterfaceMatches n (WeakTransition.Σ (proj₂ δ₁) x)
133
+            (WeakTransition.Σ (proj₂ δ₂) x)
134
+    })) →
135
+    InterfaceMatches (suc n) Σʷ₁ Σʷ₂
136
+
137
+instance
138
+  WeakStateParallelComposable : ∀ {ℓ : Level} → ParallelComposable {lsuc ℓ} (WeakState {ℓ}) {λ Σʷ₁ Σʷ₂ → ∀ n → InterfaceMatches n Σʷ₁ Σʷ₂}
139
+  WeakStateParallelComposable = record
140
+    { _||_ = ?
141
+    ; _∘_  = λ Σʷ₁ Σʷ₂ → record
142
+      { δ↑ = ?
143
+      ; δ↓ = ?
144
+      }
145
+    }
146
+--  ActionParallelComposable : ∀ {ℓ : Level} {Σʷ : WeakState {ℓ}} → (Σ : State Σʷ) → (A : Set ℓ) → ParallelComposable {ℓ} {P = InterfaceMatches
147
+--ParallelComposable 
148
+
149
+-- open import Data.Bool using (Bool; true; false)
150
+-- open import Data.Empty using (⊥-elim)
151
+-- open import Data.List using (List; _∷_; []; map)
152
+-- open import Data.Maybe using (Maybe; nothing; just) renaming (map to mmap)
153
+-- open import Data.Nat using (ℕ; zero; suc)
154
+-- open import Data.Product using (_×_; ∃; ∃-syntax; proj₁; proj₂) renaming (_,_ to ⟨_,_⟩)
155
+-- open import Data.Sum using (_⊎_; inj₁; inj₂)
156
+-- open import Function using (_∘_)
157
+-- open import Relation.Binary.PropositionalEquality using (_≡_; _≢_; refl)
158
+-- open import Level using (Level; Lift) renaming (suc to lsuc; lift to llift)
159
+-- open import Yggdrasil.Probability using (Dist; pure; _>>=′_; lift)
160
+-- open import Yggdrasil.List using (_∈_; here; there)
161
+-- 
162
+-- data ⊤ {ℓ : Level} : Set ℓ where
163
+--   tt : ⊤
164
+-- 
165
+-- data ⊥ {ℓ : Level} : Set ℓ where
166
+-- 
167
+-- T : ∀ {ℓ} → Bool → Set ℓ
168
+-- T true = ⊤
169
+-- T false = ⊥
170
+-- 
171
+-- record Query (ℓ : Level) : Set (lsuc ℓ) where
172
+--   constructor mkquery
173
+--   field
174
+--     A : Set ℓ
175
+--     B : A → Set ℓ
176
+-- 
177
+-- mknquery : {ℓ : Level} → Set ℓ → Set ℓ → Query ℓ
178
+-- mknquery A B = mkquery A (λ _ → B)
179
+-- 
180
+-- record Node (ℓ : Level) : Set (lsuc ℓ)
181
+-- record WorldType (ℓ : Level) : Set (lsuc ℓ)
182
+-- data Action↑ {ℓ : Level} (N : Node ℓ) : Set ℓ → Set (lsuc ℓ)
183
+-- data Action⊤ {ℓ : Level} (S : Set ℓ) (Γ : WorldType ℓ) : Set ℓ → Set (lsuc ℓ)
184
+-- 
185
+-- data WorldState {ℓ : Level} (Γ : WorldType ℓ) : Set (lsuc ℓ)
186
+-- data WorldStates {ℓ : Level} : List (WorldType ℓ) → Set (lsuc ℓ)
187
+-- 
188
+-- record Node ℓ where
189
+--   inductive
190
+--   constructor mknode
191
+--   field
192
+--     state : Set ℓ
193
+--     chld  : List (WorldType ℓ)
194
+--     qry   : List (Query ℓ)
195
+-- 
196
+-- open Node
197
+-- 
198
+-- 
199
+-- record Call (ℓ : Level) (N : Node ℓ) : Set (lsuc ℓ) where
200
+--   inductive
201
+--   constructor call
202
+--   field
203
+--     A : Set ℓ
204
+--     B : A → Set ℓ
205
+--     δ : (x : A) → Action↑ N (B x)
206
+-- 
207
+-- -- A non-dependently typed instance of call.
208
+-- ncall : {ℓ : Level} {N : Node ℓ} → (A B : Set ℓ) → (A → Action↑ N B) → Call ℓ N
209
+-- ncall A B δ = call A (λ _ → B) δ
210
+-- 
211
+-- weaken : ∀ {ℓ N} → Call ℓ N → Query ℓ
212
+-- weaken c = record { A = Call.A c; B = Call.B c }
213
+-- 
214
+-- record WorldType ℓ where
215
+--   inductive
216
+--   constructor tynode
217
+--   field
218
+--     node : Node ℓ
219
+--     adv  : List (Call ℓ node)
220
+--     hon  : List (Call ℓ node)
221
+-- 
222
+-- open WorldType
223
+-- 
224
+-- data _⊑_ {ℓ : Level} : (Γ₁ Γ₂ : WorldType ℓ) → Set (lsuc ℓ) where
225
+--   here : ∀ {Γ} → Γ ⊑ Γ
226
+--   there : ∀ {Γ₁ Γ₂ Γ₃} → Γ₂ ∈ chld (node Γ₃) → Γ₁ ⊑ Γ₂ → Γ₁ ⊑ Γ₃
227
+-- 
228
+-- ⊑-trans : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₁ ⊑ Γ₂ → Γ₂ ⊑ Γ₃ → Γ₁ ⊑ Γ₃
229
+-- ⊑-trans ⊑Γ here = ⊑Γ
230
+-- ⊑-trans ⊑Γ (there Γ′∈ ⊑Γ′) = there Γ′∈ (⊑-trans ⊑Γ ⊑Γ′)
231
+-- 
232
+-- ⊑-right : ∀ {ℓ} {Γ₁ Γ₂ Γ₃ : WorldType ℓ} → Γ₂ ⊑ Γ₃ → Γ₁ ∈ chld (node Γ₂) → Γ₁ ⊑ Γ₃
233
+-- ⊑-right Γ⊑ ∈Γ = ⊑-trans (there ∈Γ here) Γ⊑
234
+-- 
235
+-- data Action⊤ {ℓ} S Γ where
236
+--   read  : Action⊤ S Γ S
237
+--   write : S → Action⊤ S Γ ⊤
238
+--   call↓ : ∀ {f} → f ∈ (hon Γ) → (x : Call.A f) → Action⊤ S Γ (Call.B f x)
239
+--   abort : ∀ {A} → Action⊤ S Γ A
240
+--   dist  : ∀ {A} → Dist A → Action⊤ S Γ A
241
+--   call↯ : ∀ {Γ′} {f : Call ℓ (node Γ′)} → f ∈ (adv Γ′) → Γ′ ⊑ Γ →
242
+--     (x : Call.A f) → Action⊤ S Γ (Call.B f x)
243
+--   _>>=_ : ∀ {A B} → Action⊤ S Γ A → (A → Action⊤ S Γ B) → Action⊤ S Γ B
244
+-- 
245
+-- data Action↑ {ℓ} N where
246
+--   read  : Action↑ N (state N)
247
+--   write : state N → Action↑ N ⊤
248
+--   call↓ : ∀ {Γ f} → f ∈ (hon Γ) → Γ ∈ chld N → (x : Call.A f) →
249
+--     Action↑ N (Call.B f x)
250
+--   abort : ∀ {A} → Action↑ N A
251
+--   dist  : ∀ {A} → Dist A → Action↑ N A
252
+--   query : ∀ {q} → q ∈ qry N → (x : Query.A q) → Action↑ N (Query.B q x)
253
+--   _>>=_ : ∀ {A B} → Action↑ N A → (A → Action↑ N B) → Action↑ N B
254
+-- 
255
+-- -- TODO: build full monad instances of all actions, and Dist -- once I figure
256
+-- -- out how that works in agda.
257
+-- return : ∀ {ℓ N A} → A → Action↑ {ℓ} N A
258
+-- return x = dist (pure x)
259
+-- 
260
+-- infixl 1 _>>=_ _>>_
261
+-- 
262
+-- _>>_ : ∀ {ℓ N A B} → Action↑ {ℓ} N A → Action↑ {ℓ} N B → Action↑ {ℓ} N B
263
+-- α >> β = α >>= (λ _ → β)
264
+-- 
265
+-- data WorldStates {ℓ} where
266
+--   [] : WorldStates []
267
+--   _∷_ : ∀ {Γ Γs} → WorldState Γ → WorldStates Γs → WorldStates (Γ ∷ Γs)
268
+-- 
269
+-- data WorldState {ℓ} Γ where
270
+--   stnode : state (node Γ) → WorldStates (chld (node Γ)) → WorldState Γ
271
+-- 
272
+-- record World (ℓ : Level) : Set (lsuc ℓ) where
273
+--   field
274
+--     Γ : WorldType ℓ
275
+--     Σ : WorldState Γ
276
+-- 
277
+-- data _∈↑_ {ℓ : Level} (q : Query ℓ) (Γ : WorldType ℓ) : Set (lsuc ℓ) where
278
+--   path : ∀ {Γ′} → Γ′ ⊑ Γ → q ∈ qry (node Γ′) → q ∈↑ Γ
279
+-- 
280
+-- Oracle : ∀ {ℓ} → Set ℓ → WorldType ℓ → Set (lsuc ℓ)
281
+-- Oracle S Γ = ∀ {q} → q ∈↑ Γ → (x : Query.A q) → Action⊤ S Γ (Query.B q x)
282
+-- 
283
+-- record Strategy {ℓ : Level} (Γ : WorldType ℓ) (A : Set ℓ) {S : Set ℓ} : Set (lsuc ℓ) where
284
+--   constructor strat
285
+--   field
286
+--     state : S
287
+--     init : Action⊤ S Γ A
288
+--     oracle : Oracle S Γ
289
+-- 
290
+-- 
291
+-- 
292
+-- get : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁)
293
+-- get here (stnode Σ _) = Σ
294
+-- get (there Γ′∈ ⊑Γ) (stnode _ Σs) = get ⊑Γ (lookup Γ′∈ Σs)
295
+--   where
296
+--     lookup : ∀ {Γ Γs} → Γ ∈ Γs → WorldStates Γs → WorldState Γ
297
+--     lookup here (Σ ∷ _) = Σ
298
+--     lookup (there Γ′∈) (_ ∷ Σs) = lookup Γ′∈ Σs
299
+-- 
300
+-- set : ∀ {ℓ Γ₁ Γ₂} → Γ₁ ⊑ Γ₂ → WorldState {ℓ} Γ₂ → state (node Γ₁) →
301
+--   WorldState {ℓ} Γ₂
302
+-- set here (stnode Σ Σs) Σ′ = stnode Σ′ Σs
303
+-- set (there Γ′∈ ⊑Γ) (stnode Σ Σs) Σ′ = stnode Σ (set′ Γ′∈ ⊑Γ Σs Σ′)
304
+--   where
305
+--     set′ : ∀ {Γ₁ Γ₂ Γs} → Γ₂ ∈ Γs → Γ₁ ⊑ Γ₂ → WorldStates Γs →
306
+--       state (node Γ₁) → WorldStates Γs
307
+--     set′ here ⊑Γ (Σ ∷ Σs) Σ′ = set ⊑Γ Σ Σ′ ∷ Σs
308
+--     set′ (there Γ∈) ⊑Γ (Σ ∷ Σs) Σ′ = Σ ∷ set′ Γ∈ ⊑Γ Σs Σ′
309
+-- 
310
+-- data Result {ℓ : Level} (A : Set ℓ) : Set ℓ where
311
+--   abort      : Result A
312
+--   out-of-gas : Result A
313
+--   result     : A → Result A
314
+-- 
315
+-- rmap : ∀ {ℓ A B} → (A → B) → Result {ℓ} A → Result {ℓ} B
316
+-- rmap _ abort = abort
317
+-- rmap _ out-of-gas = out-of-gas
318
+-- rmap f (result x) = result (f x)
319
+-- 
320
+-- exec : ∀ {ℓ S Γ A} → Strategy {ℓ} Γ A {S} → WorldState {ℓ} Γ → ℕ →
321
+--   Dist (Result (Lift (lsuc ℓ) A))
322
+-- exec⊤ : ∀ {ℓ S Γ A} → Oracle S Γ → Action⊤ S Γ A → S × WorldState {ℓ} Γ → ℕ →
323
+--   Dist (Result (A × (S × WorldState {ℓ} Γ)))
324
+-- exec↑ : ∀ {ℓ S Γ₁ Γ₂ A} → Oracle S Γ₁ → Action↑ (node Γ₂) A →
325
+--   (S × WorldState {ℓ} Γ₁) → Γ₂ ⊑ Γ₁ → ℕ → Dist (Result (A × (S × WorldState {ℓ} Γ₁)))
326
+-- 
327
+-- -- NOTE: Gas is only used for termination here, it is NOT a computational model.
328
+-- exec (strat S α O) Σ g = (exec⊤ O α ⟨ S , Σ ⟩ g) >>=′ (pure ∘ rmap (llift ∘ proj₁))
329
+-- 
330
+-- exec⊤ O read                    Σ g       = pure (result ⟨ proj₁ Σ , Σ ⟩)
331
+-- exec⊤ O (write σ)               Σ g       = pure (result ⟨ tt , ⟨ σ , proj₂ Σ ⟩ ⟩)
332
+-- exec⊤ O (call↓ {f = f} ∈Γ x)    Σ g       = exec↑ O (Call.δ f x) Σ here g
333
+-- exec⊤ O abort                   Σ g       = pure abort
334
+-- exec⊤ O (dist D)                Σ g       = lift D >>=′ λ{
335
+--   (llift x) → pure (result ⟨ x , Σ ⟩ ) }
336
+-- exec⊤ O (call↯ {f = f} f∈ ⊑Γ x) Σ g       = exec↑ O (Call.δ f x) Σ ⊑Γ g
337
+-- exec⊤ O (α >>= β)               Σ g       = (exec⊤ O α Σ g) >>=′ λ{
338
+--   (result ⟨ x , Σ′ ⟩) → exec⊤ O (β x) Σ′ g ;
339
+--   abort               → pure abort         ;
340
+--   out-of-gas          → pure out-of-gas    }
341
+-- 
342
+-- exec↑ O read                    Σ ⊑Γ g       = pure (result
343
+--   ⟨ get ⊑Γ (proj₂ Σ) , Σ ⟩)
344
+-- exec↑ O (write σ)               Σ ⊑Γ g       = pure (result
345
+--   ⟨ tt , ⟨ proj₁ Σ , set ⊑Γ (proj₂ Σ) σ ⟩ ⟩)
346
+-- exec↑ O abort                   Σ ⊑Γ g       = pure abort
347
+-- exec↑ O (dist D)                Σ ⊑Γ g       = lift D >>=′
348
+--   λ{ (llift x) → pure (result ⟨ x , Σ ⟩) }
349
+-- exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ zero    = pure out-of-gas
350
+-- exec↑ O (query {q = q} q∈ x)    Σ ⊑Γ (suc g) = exec⊤ O (O (path ⊑Γ q∈) x) Σ g
351
+-- exec↑ O (call↓ {f = f} ∈Γ Γ∈ x) Σ ⊑Γ g       = exec↑ O (Call.δ f x) Σ (⊑-right ⊑Γ Γ∈) g
352
+-- exec↑ O (α >>= β)               Σ ⊑Γ g       = (exec↑ O α Σ ⊑Γ g) >>=′ λ{
353
+--   (result ⟨ x , Σ′ ⟩) → exec↑ O (β x) Σ′ ⊑Γ g ;
354
+--   abort               → pure abort            ;
355
+--   out-of-gas          → pure out-of-gas       }

Loading…
Cancel
Save