├── .gitignore ├── C4B.agda └── WebAssembly.agda /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai 2 | .agda-lib -------------------------------------------------------------------------------- /C4B.agda: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | 3 | module C4B where 4 | 5 | -------------------------------------------------------------------------------- 6 | 7 | import Data.Bool as 𝟚 renaming (Bool to t) 8 | import Data.Empty as 𝟘 renaming (⊥ to t) 9 | import Data.Unit as 𝟙 renaming (⊤ to t) 10 | import Data.Bool as 𝟚 renaming (Bool to t) 11 | import Data.Maybe as Maybe renaming (Maybe to t) 12 | import Data.Product as × renaming (proj₁ to fst; proj₂ to snd) 13 | import Data.Sum as + renaming (inj₁ to injᴸ; inj₂ to injᴿ) 14 | import Data.Nat as ℕ renaming (ℕ to t) 15 | import Data.Integer as ℤ renaming (ℤ to t) 16 | import Data.Rational as ℚ renaming (ℚ to t) 17 | import Data.Float as 𝔽 renaming (Float to t) 18 | import Data.Fin as Fin renaming (Fin to t) 19 | import Data.Vec as Vec renaming (Vec to t; [] to []ⱽ; _∷_ to _∷ⱽ_) 20 | import Data.String as String renaming (String to t) 21 | import Level as 𝕃 renaming (Level to t) 22 | import Function 23 | 24 | module List where 25 | open import Data.List 26 | renaming (List to t; 27 | [] to []ᴸ; _∷_ to _∷ᴸ_; _++_ to _++ᴸ_) 28 | public 29 | 30 | lookup : ∀ {a} {A : Set a} (xs : t A) → Fin.t (length xs) → A 31 | lookup []ᴸ () 32 | lookup (x ∷ᴸ xs) Fin.zero = x 33 | lookup (x ∷ᴸ xs) (Fin.suc i) = lookup xs i 34 | 35 | 36 | module Rel₀ where 37 | open import Relation.Nullary public 38 | 39 | module Rel₂ where 40 | open import Relation.Binary public 41 | open import Relation.Binary.PropositionalEquality public 42 | 43 | open 𝟚 using (if_then_else_) 44 | open × using (∃; _×_; _,_; fst; snd) 45 | open + using (_⊎_; injᴸ; injᴿ) 46 | open List using ([]ᴸ; _∷ᴸ_; _++ᴸ_) 47 | open Vec using ([]ⱽ; _∷ⱽ_) 48 | open 𝕃 using (_⊔_) 49 | open Function using (case_return_of_; case_of_) 50 | open Rel₀ using (¬_) 51 | open Rel₂ using (_≡_; _≢_; refl; Rel) 52 | 53 | -------------------------------------------------------------------------------- 54 | 55 | {-# FOREIGN GHC import Prelude (undefined, error) #-} 56 | postulate unsafeUndefined : {t : Set} → t 57 | {-# COMPILE GHC unsafeUndefined = undefined #-} 58 | postulate unsafeError : {t : Set} → String.t → t 59 | {-# COMPILE GHC unsafeError = error #-} 60 | 61 | -------------------------------------------------------------------------------- 62 | 63 | congFin : ∀ {X : Set} {a b : ℕ.t} 64 | → a ≡ b 65 | → (Fin.t a → X) 66 | → Fin.t b 67 | → X 68 | congFin p f n rewrite Rel₂.cong Fin.t p = f n 69 | 70 | -------------------------------------------------------------------------------- 71 | 72 | module OperationalSemantics 73 | (V : Set) 74 | (E : Set) 75 | (_is_ : V → V → 𝟚.t) 76 | (ret : V) 77 | where 78 | 79 | data FunCall : Set where 80 | _⟪_⟫ : V → List.t V → FunCall 81 | 82 | data Syntax : Set where 83 | assertˢ : E → Syntax 84 | skipˢ : Syntax 85 | breakˢ : Syntax 86 | returnˢ : V → Syntax 87 | _←ˢ_ : V → E → Syntax 88 | _≔ˢ_ : V → FunCall → Syntax 89 | loopˢ : Syntax → Syntax 90 | ifˢ_thenˢ_elseˢ_fiˢ : E → Syntax → Syntax → Syntax 91 | _∷ˢ_ : Syntax → Syntax → Syntax 92 | tickˢ : ℚ.t → Syntax 93 | 94 | infix 15 _≔ˢ_ 95 | infix 16 _⟪_⟫ 96 | 97 | data Continuation : Set where 98 | stopᴷ : Continuation 99 | seqᴷ : Syntax → Continuation → Continuation 100 | loopᴷ : Syntax → Continuation → Continuation 101 | callᴷ : (r : V) 102 | → (θ : V → Maybe.t ℤ.t) 103 | → Continuation 104 | → Continuation 105 | 106 | Value : Set 107 | Value = ℤ.t 108 | 109 | record ProgramState : Set where 110 | constructor ⟨_#_⟩ 111 | field 112 | localsᶠ : (V → Maybe.t Value) 113 | globalsᶠ : (V → Maybe.t Value) 114 | 115 | lookup : ProgramState → V → Maybe.t Value 116 | lookup ps n with localsᶠ n | globalsᶠ n 117 | ... | Maybe.just v | _ = Maybe.just v 118 | ... | Maybe.nothing | Maybe.just v = Maybe.just v 119 | ... | Maybe.nothing | Maybe.nothing = Maybe.nothing 120 | 121 | record Eval : Set where 122 | constructor eval⟨_!_!_!_⟩ 123 | field 124 | σ : ProgramState 125 | S : Syntax 126 | K : Continuation 127 | c : ℚ.t 128 | 129 | update_with:_↦_ : ProgramState → V → Value → ProgramState 130 | update σ with: x ↦ v = _ 131 | 132 | is-true : ℤ.t → Set 133 | is-true n = n ≢ (ℤ.+_ 0) 134 | 135 | is-false : ℤ.t → Set 136 | is-false n = n ≡ (ℤ.+_ 0) 137 | 138 | negateℤ : ℤ.t → ℤ.t 139 | negateℤ = ℤ.-_ 140 | 141 | negateℚ : ℚ.t → ℚ.t 142 | negateℚ n = record { numerator = negateℤ (ℚ.t.numerator n) 143 | ; denominator-1 = ℚ.t.denominator-1 n 144 | ; isCoprime = unsafeUndefined 145 | } 146 | 147 | addℚ : ℚ.t → ℚ.t → ℚ.t 148 | addℚ a b = let ℕ→ℤ = ℤ.+_ 149 | denominatorA = ℕ.suc (ℚ.t.denominator-1 a) 150 | denominatorB = ℕ.suc (ℚ.t.denominator-1 b) 151 | in ℚ._÷_ (ℤ._+_ (ℤ._*_ (ℚ.t.numerator a) (ℕ→ℤ denominatorB)) 152 | (ℤ._*_ (ℚ.t.numerator b) (ℕ→ℤ denominatorA))) 153 | (ℕ._*_ denominatorA denominatorB) 154 | {unsafeUndefined} 155 | {unsafeUndefined} 156 | 157 | minusℚ : ℚ.t → ℚ.t → ℚ.t 158 | minusℚ a b = addℚ a (negateℚ b) 159 | 160 | _∈ⱽ_ : V 161 | → (xs : List.t V) 162 | → Maybe.t (Fin.t (List.length xs)) 163 | _∈ⱽ_ = λ n xs → helper n (List.zip (List.allFin (List.length xs)) xs) 164 | where 165 | helper : {n : ℕ.t} 166 | → V 167 | → List.t (Fin.t n × V) 168 | → Maybe.t (Fin.t n) 169 | helper _ []ᴸ = Maybe.nothing 170 | helper n ((k , v) ∷ᴸ xs) = if (n is v) 171 | then Maybe.just k 172 | else helper n xs 173 | 174 | 175 | data _↝_ {Σ : V → Maybe.t (List.t V × Syntax)} 176 | {⟦_⟧ : E → ProgramState → Value} 177 | : Eval → Eval → Set where 178 | S:Assert : ∀ {σ} {e} {K} {c} 179 | → {_ : is-true (⟦ e ⟧ σ)} 180 | → eval⟨ σ ! assertˢ e ! K ! c ⟩ 181 | ↝ eval⟨ σ ! skipˢ ! K ! c ⟩ 182 | S:BrkSeq : ∀ {σ} {S} {K} {c} 183 | → eval⟨ σ ! breakˢ ! seqᴷ S K ! c ⟩ 184 | ↝ eval⟨ σ ! breakˢ ! K ! c ⟩ 185 | S:BrkLoop : ∀ {σ} {S} {K} {c} 186 | → eval⟨ σ ! breakˢ ! loopᴷ S K ! c ⟩ 187 | ↝ eval⟨ σ ! skipˢ ! K ! c ⟩ 188 | S:RetSeq : ∀ {σ} {x} {S} {K} {c} 189 | → eval⟨ σ ! returnˢ x ! seqᴷ S K ! c ⟩ 190 | ↝ eval⟨ σ ! returnˢ x ! K ! c ⟩ 191 | S:RetLoop : ∀ {σ} {x} {S} {K} {c} 192 | → eval⟨ σ ! returnˢ x ! loopᴷ S K ! c ⟩ 193 | ↝ eval⟨ σ ! returnˢ x ! K ! c ⟩ 194 | S:RetCall : ∀ {θ₁} {θ₂} {γ} {x} {v} {r} {K} {c} 195 | → {_ : Maybe.just v ≡ θ₁ x} 196 | → let σ₁ = ⟨ θ₁ # γ ⟩ 197 | σ₂ = update ⟨ θ₂ # γ ⟩ with: r ↦ v 198 | in ( eval⟨ σ₁ ! returnˢ x ! callᴷ r θ₂ K ! c ⟩ 199 | ↝ eval⟨ σ₂ ! skipˢ ! K ! c ⟩ ) 200 | S:Update : ∀ {σ} {x} {e} {v} {K} {c} 201 | → {_ : v ≡ ⟦ e ⟧ σ } 202 | → eval⟨ σ ! x ←ˢ e ! K ! c ⟩ 203 | ↝ eval⟨ (update σ with: x ↦ v) ! skipˢ ! K ! c ⟩ 204 | S:Call : ∀ {θ₁} {γ} {r} {as} {f} {ps} {body} {K} {c} 205 | → {_ : Maybe.just (ps , body) ≡ Σ f} 206 | → {p : (List.length as) ≡ (List.length ps)} 207 | → let θ₂ n = case (n ∈ⱽ ps) of 208 | λ { (Maybe.just k) → θ₁ (congFin p 209 | (List.lookup as) k) 210 | ; Maybe.nothing → θ₁ n 211 | } 212 | in ( eval⟨ ⟨ θ₁ # γ ⟩ ! (r ≔ˢ f ⟪ as ⟫) ! K ! c ⟩ 213 | ↝ eval⟨ ⟨ θ₂ # γ ⟩ ! body ! callᴷ r θ₁ K ! c ⟩ ) 214 | S:Loop : ∀ {σ} {S} {K} {c} 215 | → eval⟨ σ ! loopˢ S ! K ! c ⟩ 216 | ↝ eval⟨ σ ! S ! loopᴷ S K ! c ⟩ 217 | S:SkipLoop : ∀ {σ} {S} {K} {c} 218 | → eval⟨ σ ! skipˢ ! loopᴷ S K ! c ⟩ 219 | ↝ eval⟨ σ ! loopˢ S ! K ! c ⟩ 220 | S:IfTrue : ∀ {σ} {e} {S₁} {S₂} {K} {c} 221 | → {_ : is-true (⟦ e ⟧ σ)} 222 | → eval⟨ σ ! ifˢ e thenˢ S₁ elseˢ S₂ fiˢ ! K ! c ⟩ 223 | ↝ eval⟨ σ ! S₁ ! K ! c ⟩ 224 | S:IfFalse : ∀ {σ} {e} {S₁} {S₂} {K} {c} 225 | → {_ : is-false (⟦ e ⟧ σ)} 226 | → eval⟨ σ ! ifˢ e thenˢ S₁ elseˢ S₂ fiˢ ! K ! c ⟩ 227 | ↝ eval⟨ σ ! S₂ ! K ! c ⟩ 228 | S:Seq : ∀ {σ} {S₁} {S₂} {K} {c} 229 | → eval⟨ σ ! S₁ ∷ˢ S₂ ! K ! c ⟩ 230 | ↝ eval⟨ σ ! S₁ ! seqᴷ S₂ K ! c ⟩ 231 | S:SkipSeq : ∀ {σ} {S} {K} {c} 232 | → eval⟨ σ ! skipˢ ! seqᴷ S K ! c ⟩ 233 | ↝ eval⟨ σ ! S ! K ! c ⟩ 234 | S:Tick : ∀ {σ} {n} {K} {c} 235 | → eval⟨ σ ! tickˢ n ! K ! c ⟩ 236 | ↝ eval⟨ σ ! skipˢ ! K ! minusℚ c n ⟩ 237 | 238 | data PValue : Set where 239 | varᴾ : V → PValue 240 | exprᴾ : E → PValue 241 | 242 | data Predicate : Set where 243 | trueᴾ : Predicate 244 | falseᴾ : Predicate 245 | ¬ᴾ_ : Predicate → Predicate 246 | _∧ᴾ_ : Predicate → Predicate → Predicate 247 | _∨ᴾ_ : Predicate → Predicate → Predicate 248 | _⇒ᴾ_ : Predicate → Predicate → Predicate 249 | _<ᴾ_ : PValue → PValue → Predicate 250 | _=ᴾ_ : PValue → PValue → Predicate 251 | is-trueᴾ : PValue → Predicate 252 | 253 | is-falseᴾ : PValue → Predicate 254 | is-falseᴾ v = ¬ᴾ (is-trueᴾ v) 255 | 256 | _>ᴾ_ : PValue → PValue → Predicate 257 | a >ᴾ b = b <ᴾ a 258 | 259 | _≤ᴾ_ : PValue → PValue → Predicate 260 | a ≤ᴾ b = (a <ᴾ b) ∨ᴾ (a =ᴾ b) 261 | 262 | _≥ᴾ_ : PValue → PValue → Predicate 263 | a ≥ᴾ b = (a >ᴾ b) ∨ᴾ (a =ᴾ b) 264 | 265 | substᴾ_↦_within_ : V → PValue → Predicate → Predicate 266 | substᴾ_↦_within_ = {!!} 267 | 268 | QType : Set 269 | QType = List.t ℚ.t 270 | 271 | QContext : Set 272 | QContext = Predicate × QType 273 | 274 | data QState : Set where 275 | ⟨_,_⟩ : (B : QContext) 276 | → (R : QContext) 277 | → QState 278 | 279 | quantAdd : QType → ℚ.t → QType 280 | quantAdd []ᴸ _ = []ᴸ 281 | quantAdd (x ∷ᴸ xs) n = addℚ x n ∷ᴸ xs 282 | 283 | quantSub : QType → ℚ.t → QType 284 | quantSub xs n = quantAdd xs (negateℚ n) 285 | 286 | quantFirst : (ℚ.t → Set) → QType → Set 287 | quantFirst f []ᴸ = 𝟙.t 288 | quantFirst f (x ∷ᴸ xs) = f x 289 | 290 | _≤ℚ_ : ℚ.t → ℚ.t → Set 291 | _≤ℚ_ = ℚ._≤_ 292 | 293 | _<ℚ_ : ℚ.t → ℚ.t → Set 294 | a <ℚ b = (a ≢ b) × (a ≤ℚ b) 295 | 296 | 0ℚ : ℚ.t 297 | 0ℚ = record { numerator = ℤ.+_ 0 298 | ; denominator-1 = 0 299 | ; isCoprime = unsafeUndefined 300 | } 301 | 302 | data QHoare : Set where 303 | [⦃_⦄⟨_⟩⦃_⦄] : QContext → Syntax → QContext → QHoare 304 | 305 | data _⊢_ : QState → QHoare → Set where 306 | Q:Skip : ∀ {B R} {Γ} {Q} 307 | → ⟨ B , R ⟩ 308 | ⊢ [⦃ Γ , Q ⦄⟨ skipˢ ⟩⦃ Γ , Q ⦄] 309 | Q:Break : ∀ {R} {Γᴮ} {Qᴮ} {Γ'} {Q'} 310 | → ⟨ (Γᴮ , Qᴮ) , R ⟩ 311 | ⊢ [⦃ Γᴮ , Qᴮ ⦄⟨ breakˢ ⟩⦃ Γ' , Q' ⦄] 312 | Q:Tick : ∀ {B R} {Γ} {Q} {n} 313 | → ((n <ℚ 0ℚ) → quantFirst (λ q₀ → 0ℚ ≤ℚ q₀) Q) 314 | → ⟨ B , R ⟩ 315 | ⊢ [⦃ Γ , Q ⦄⟨ tickˢ n ⟩⦃ Γ , quantSub Q n ⦄] 316 | Q:Return : ∀ {B} {Γᴿ} {Qᴿ} {Γ Γ'} {Q Q'} {x} 317 | → Γ ≡ substᴾ ret ↦ (varᴾ x) within Γᴿ 318 | -- → Q ≡ subst ret for x within Qᴿ 319 | -- -- perhaps these should be collected constraints 320 | → ⟨ B , (Γᴿ , Qᴿ) ⟩ 321 | ⊢ [⦃ Γ , Q ⦄⟨ returnˢ x ⟩⦃ Γ' , Q' ⦄] 322 | -- Q:Update : _ 323 | -- Q:Loop : _ 324 | -- Q:Inc : _ 325 | -- Q:Dec : _ 326 | Q:If : ∀ {B R} {e} {S₁ S₂} {Γ Γ'} {Q Q'} 327 | → ⟨ B , R ⟩ 328 | ⊢ [⦃ (Γ ∧ᴾ (is-trueᴾ (exprᴾ e))) , Q ⦄⟨ S₁ ⟩⦃ Γ' , Q' ⦄] 329 | → ⟨ B , R ⟩ 330 | ⊢ [⦃ (Γ ∧ᴾ (is-falseᴾ (exprᴾ e))) , Q ⦄⟨ S₂ ⟩⦃ Γ' , Q' ⦄] 331 | → ⟨ B , R ⟩ 332 | ⊢ [⦃ Γ , Q ⦄⟨ ifˢ e thenˢ S₁ elseˢ S₂ fiˢ ⟩⦃ Γ' , Q' ⦄] 333 | Q:Seq : ∀ {B R} {X Y Z} {S₁ S₂} 334 | → ⟨ B , R ⟩ ⊢ [⦃ X ⦄⟨ S₁ ⟩⦃ Y ⦄] 335 | → ⟨ B , R ⟩ ⊢ [⦃ Y ⦄⟨ S₂ ⟩⦃ Z ⦄] 336 | → ⟨ B , R ⟩ ⊢ [⦃ X ⦄⟨ S₁ ∷ˢ S₂ ⟩⦃ Z ⦄] 337 | -- Q:Call : _ 338 | Q:Assert : ∀ {B R} {Γ} {Q} {e} 339 | → let Γ' = Γ ∧ᴾ (is-trueᴾ (exprᴾ e)) 340 | in ⟨ B , R ⟩ ⊢ [⦃ Γ , Q ⦄⟨ assertˢ e ⟩⦃ Γ' , Q ⦄] 341 | -- Q:Extend : _ 342 | -- Q:Weak : _ 343 | -- Q:Relax : _ 344 | -- foo : ⟨ (_ , _) , (_ , _) ⟩ ⊢ [⦃ _ , _ ⦄⟨ _ ⟩⦃ _ , _ ⦄] 345 | 346 | -------------------------------------------------------------------------------- 347 | -------------------------------------------------------------------------------- /WebAssembly.agda: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | 3 | module WebAssembly where 4 | 5 | -------------------------------------------------------------------------------- 6 | 7 | import Data.Empty as 𝟘 renaming (⊥ to t) 8 | import Data.Unit as 𝟙 renaming (⊤ to t) 9 | import Data.Bool as 𝟚 renaming (Bool to t) 10 | import Data.Maybe as Maybe renaming (Maybe to t) 11 | import Data.Product as × renaming (proj₁ to fst; proj₂ to snd) 12 | import Data.Sum as + renaming (inj₁ to injᴸ; inj₂ to injᴿ) 13 | import Data.Nat as ℕ renaming (ℕ to t) 14 | import Data.Integer as ℤ renaming (ℤ to t) 15 | import Data.Float as 𝔽 renaming (Float to t) 16 | import Data.Fin as Fin renaming (Fin to t) 17 | import Data.Vec as Vec renaming (Vec to t; [] to []ⱽ; _∷_ to _∷ⱽ_) 18 | import Data.List as List renaming (List to t; 19 | [] to []ᴸ; _∷_ to _∷ᴸ_; _++_ to _++ᴸ_) 20 | import Data.String as String renaming (String to t) 21 | import Level as 𝕃 renaming (Level to t) 22 | 23 | open × using (Σ; ∃; _×_; _,_; fst; snd) 24 | open + using (_⊎_; injᴸ; injᴿ) 25 | open List using ([]ᴸ; _∷ᴸ_; _++ᴸ_) 26 | open Vec using ([]ⱽ; _∷ⱽ_) 27 | open 𝕃 using (_⊔_) 28 | 29 | module Rel₀ where 30 | open import Relation.Nullary public 31 | 32 | module Rel₂ where 33 | open import Relation.Binary public 34 | open import Relation.Binary.PropositionalEquality public 35 | 36 | open Rel₀ using (¬_) 37 | open Rel₂ using (_≡_; _≢_; refl; Rel) 38 | 39 | -------------------------------------------------------------------------------- 40 | 41 | {-# FOREIGN GHC import Prelude (undefined, error) #-} 42 | postulate unsafeUndefined : {t : Set} → t 43 | {-# COMPILE GHC unsafeUndefined = undefined #-} 44 | postulate unsafeError : {t : Set} → String.t → t 45 | {-# COMPILE GHC unsafeError = error #-} 46 | 47 | -------------------------------------------------------------------------------- 48 | 49 | Name : Set 50 | Name = String.t 51 | 52 | -------------------------------------------------------------------------------- 53 | 54 | module QT where 55 | data QuantityType : Set where 56 | bitsTypeᶜ : QuantityType 57 | bytesTypeᶜ : QuantityType 58 | pagesTypeᶜ : QuantityType 59 | 60 | t : Set 61 | t = QuantityType 62 | 63 | data _<_ : Rel QuantityType 𝕃.zero where 64 | bits_ _≤_ _≥_ : Rel QuantityType 𝕃.zero 69 | 70 | _≠_ lhs rhs = ¬ (lhs ≡ rhs) 71 | 72 | _>_ lhs rhs = rhs < lhs 73 | 74 | _≤_ lhs rhs = (lhs ≡ rhs) ⊎ (lhs < rhs) 75 | 76 | _≥_ lhs rhs = rhs ≤ lhs 77 | 78 | instance 79 | <-bits-bytes : bitsTypeᶜ < bytesTypeᶜ 80 | <-bits-bytes = bits