Mercurial > hg > Members > Moririn
view ModelChecking.agda @ 708:4761b08c4bd6
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 19 Apr 2022 19:39:29 +0900 |
parents | e30dcd03c07f |
children | 6a805c8c1e53 |
line wrap: on
line source
module ModelChecking where open import Level renaming (zero to Z ; suc to succ) open import Data.Nat hiding (compare) open import Data.Nat.Properties as NatProp open import Data.Maybe -- open import Data.Maybe.Properties open import Data.Empty open import Data.List open import Data.Product open import Function as F hiding (const) open import Relation.Binary open import Relation.Binary.PropositionalEquality open import Relation.Nullary open import logic open import Data.Unit hiding ( _≟_ ; _≤?_ ; _≤_) open import Relation.Binary.Definitions record AtomicNat : Set where field value : ℕ set : {n : Level } {t : Set n} → AtomicNat → (value : ℕ) → ( AtomicNat → t ) → t set a v next = next record { value = v } record Phils : Set where field pid : ℕ left right : AtomicNat putdown_rfork : {n : Level} {t : Set n} → Phils → ( Phils → t ) → t putdown_rfork p next = set (Phils.right p) 0 ( λ f → next record p { right = f } ) putdown_lfork : {n : Level} {t : Set n} → Phils → ( Phils → t ) → t putdown_lfork p next = set (Phils.left p) 0 ( λ f → next record p { left = f } ) thinking : {n : Level} {t : Set n} → Phils → ( Phils → t ) → t thinking p next = next p pickup_rfork : {n : Level} {t : Set n} → Phils → ( Phils → t ) → t pickup_rfork p next = set (Phils.right p) (Phils.pid p) ( λ f → next record p { right = f } ) pickup_lfork : {n : Level} {t : Set n} → Phils → ( Phils → t ) → t pickup_lfork p next = set (Phils.left p) (Phils.pid p) ( λ f → next record p { left = f } ) eating : {n : Level} {t : Set n} → Phils → ( Phils → t ) → t eating p next = next p data Code : Set where C_set : Code C_putdown_rfork : Code C_putdown_lfork : Code C_thinking : Code C_pickup_rfork : Code C_pickup_lfork : Code C_eating : Code record Process : Set where field phil : Phils next_code : Code putdown_rfork_stub : {n : Level} {t : Set n} → Process → ( Process → t) → t putdown_rfork_stub p next = putdown_rfork ( Process.phil p ) ( λ ph → next record p { phil = ph ; next_code = C_putdown_lfork } ) putdown_lfork_stub : {n : Level} {t : Set n} → Process → ( Process → t) → t putdown_lfork_stub p next = putdown_lfork ( Process.phil p ) ( λ ph → next record p { phil = ph ; next_code = C_putdown_lfork } ) code_table : {n : Level} {t : Set n} → Code → Process → ( Process → t) → t code_table C_set = {!!} code_table C_putdown_rfork = putdown_rfork_stub code_table C_putdown_lfork = putdown_lfork_stub code_table C_thinking = {!!} code_table C_pickup_rfork = {!!} code_table C_pickup_lfork = {!!} code_table C_eating = {!!} open Process step : {n : Level} {t : Set n} → List Process → (List Process → t) → t step {n} {t} [] next0 = next0 [] step {n} {t} (p ∷ ps) next0 = code_table (next_code p) p ( λ np → next0 (ps ++ ( np ∷ [] ) )) test : List Process test = step ( record { phil = record { pid = 1 ; left = record { value = 1 } ; right = record { value = 1 } } ; next_code = C_putdown_rfork } ∷ [] ) ( λ ps → ps ) test1 : List Process test1 = step ( record { phil = record { pid = 1 ; left = record { value = 1 } ; right = record { value = 1 } } ; next_code = C_putdown_rfork } ∷ [] ) $ λ ps → step ps $ λ ps → ps -- loop exexution -- concurrnt execution -- state db ( binary tree of processes ) -- depth first ececution -- verify temporal logic poroerries