Mercurial > hg > Papers > 2022 > soto-sigos
diff Paper/src/agda/hoare-test.agda.replaced @ 0:14a0e409d574
ADD fast commit
author | soto <soto@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 24 Apr 2022 23:13:44 +0900 |
parents | |
children | 9ec2d2ac1309 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Paper/src/agda/hoare-test.agda.replaced Sun Apr 24 23:13:44 2022 +0900 @@ -0,0 +1,103 @@ +module hoare-test where + +open import Data.Nat hiding (_!$\sqcup$!_) +open import Level renaming ( suc to succ ; zero to Zero ) + +open import Relation.Binary +open import Relation.Binary.PropositionalEquality + +open import Relation.Nullary hiding (proof) + +open import Data.Nat.Properties as NatProp -- <-cmp + +record Env : Set where + field + var-init-x : !$\mathbb{N}$! + var-init-y : !$\mathbb{N}$! + var-x : !$\mathbb{N}$! + var-y : !$\mathbb{N}$! +open Env + +plus-com : {l : Level} {t : Set l} !$\rightarrow$! Env !$\rightarrow$! (next : Env !$\rightarrow$! t) !$\rightarrow$! (exit : Env !$\rightarrow$! t) !$\rightarrow$! t +plus-com env next exit with var-y env +... | zero = exit record env{var-x = var-x env ; var-y = zero} +... | suc y = next record env{var-x = suc (var-x env) ; var-y = y} + +plus-init : {l : Level} {t : Set l} !$\rightarrow$! ( x y : !$\mathbb{N}$! ) !$\rightarrow$! (next : Env !$\rightarrow$! t) !$\rightarrow$! t +plus-init x y next = next (record { var-init-x = x ; var-init-y = y ; var-x = x ; var-y = y }) + +{-!$\#$! TERMINATING !$\#$!-} +plus-p : {l : Level} {t : Set l} !$\rightarrow$! (env : Env) !$\rightarrow$! (exit : Env !$\rightarrow$! t) !$\rightarrow$! t +plus-p env exit = plus-com env ( !$\lambda$! env !$\rightarrow$! plus-p env exit ) exit + +plus : !$\mathbb{N}$! !$\rightarrow$! !$\mathbb{N}$! !$\rightarrow$! Env +plus x y = plus-init x y (!$\lambda$! env !$\rightarrow$! plus-p env (!$\lambda$! env !$\rightarrow$! env)) +--(record { varx = x ; vary = y }) (!$\lambda$! env !$\rightarrow$! env) + +-- ここまでplusの定義 + +-- mdg (meta code gear) +data mdg-state : Set where + s-init : mdg-state + s-doing : mdg-state + s-fin : mdg-state + +record _!$\wedge$!_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n !$\sqcup$! m) where + field + proj1 : A + proj2 : B + +-- mcg (meta code gear) +plus-mdg : mdg-state !$\rightarrow$! Env !$\rightarrow$! Set +plus-mdg s-init env = (var-x env !$\equiv$! var-init-x env) !$\wedge$! (var-y env !$\equiv$! var-init-y env) +plus-mdg s-doing env = (var-init-x env !$\equiv$! var-init-x env) !$\wedge$! (var-init-y env !$\equiv$! var-init-y env) -- よくないmdg +plus-mdg s-fin env = (var-init-x env !$\equiv$! var-init-x env) !$\wedge$! (var-init-y env !$\equiv$! var-init-y env) -- よくないmdg + +-- 実行のwrapperを作って、そこでmcgが適切に選ばれて接続をしたい。多分できる気がする。 +plus-init-mcg : {l : Level} {t : Set l} !$\rightarrow$! (x y : !$\mathbb{N}$!) !$\rightarrow$! ((env : Env ) !$\rightarrow$! plus-mdg s-init env !$\rightarrow$! t) !$\rightarrow$! t +plus-init-mcg x y next = next ( plus-init x y ( !$\lambda$! env !$\rightarrow$! env ) ) record { proj1 = refl ; proj2 = refl } where + +plus-com-mcg : {l : Level} {t : Set l} !$\rightarrow$! (env : Env ) !$\rightarrow$! (next : (env : Env ) !$\rightarrow$! plus-mdg s-doing env !$\rightarrow$! t) !$\rightarrow$! (exit : (env : Env ) !$\rightarrow$! plus-mdg s-fin env !$\rightarrow$! t) !$\rightarrow$! t +plus-com-mcg env-in next exit with (var-y env-in) +... | suc y = next ( plus-com env-in ( !$\lambda$! env !$\rightarrow$! env ) ( !$\lambda$! env !$\rightarrow$! env ) ) (record { proj1 = refl ; proj2 = refl }) where +... | zero = exit env-in (record { proj1 = refl ; proj2 = refl }) + +--plus-com-mcg +{-!$\#$! TERMINATING !$\#$!-} +plus-p-mcg : {l : Level} {t : Set l} !$\rightarrow$! (env : Env) !$\rightarrow$! (exit : (env : Env ) !$\rightarrow$! plus-mdg s-fin env !$\rightarrow$! t) !$\rightarrow$! t +plus-p-mcg env exit = plus-com-mcg env (!$\lambda$! env s !$\rightarrow$! plus-p-mcg env exit ) exit + +plus-mcg : (x y : !$\mathbb{N}$!) !$\rightarrow$! Env +plus-mcg x y = plus-init-mcg x y (!$\lambda$! env s !$\rightarrow$! plus-p-mcg env (!$\lambda$! env s !$\rightarrow$! env)) + +test1 = plus-mcg 3 4 + +{- +next env ? where + env : Env + env = plus-com env-in {!!} {!!} +-} +--plus-mdg s-init (plus-p record env{var-x = var-init-x env ; var-y = var-init-y env} (!$\lambda$! env !$\rightarrow$! env)) + + + +{- +whileTestPwP : {l : Level} {t : Set l} !$\rightarrow$! (c10 : !$\mathbb{N}$!) !$\rightarrow$! ((env : Envc ) !$\rightarrow$! whileTestStateP s1 env !$\rightarrow$! t) !$\rightarrow$! t +whileTestPwP c10 next = next env record { pi1 = refl ; pi2 = refl } where + env : Envc + env = whileTestP c10 ( !$\lambda$! env !$\rightarrow$! env ) +-} + +data hoare-cond : Set where + p : hoare-cond + q : hoare-cond + + +{- +continuation-hoare-triple : {l : Level} {t : Set l} !$\rightarrow$! hoare-cond !$\rightarrow$! (next : Env !$\rightarrow$! t) Set +continuation-hoare-triple p next = continuation-hoare-triple q +continuation-hoare-triple q next = continuation-hoare-triple p +-} + + +