Mercurial > hg > Members > ryokka > HoareLogic
changeset 4:64bd5c236002
add whileTestGears
author | ryokka |
---|---|
date | Fri, 14 Dec 2018 19:34:16 +0900 |
parents | 6be8ee856666 |
children | 17e4f3b58148 |
files | whileTestGears.agda whileTestPrim.agda |
diffstat | 2 files changed, 91 insertions(+), 2 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/whileTestGears.agda Fri Dec 14 19:34:16 2018 +0900 @@ -0,0 +1,90 @@ +module whileTestGears where + +open import Function +open import Data.Nat +open import Data.Bool hiding ( _≟_ ; _∧_) +open import Level renaming ( suc to succ ; zero to Zero ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import Relation.Binary.PropositionalEquality + + +record Env : Set where + field + varn : ℕ + vari : ℕ +open Env + +_-_ : ℕ -> ℕ -> ℕ +x - zero = x +zero - _ = zero +(suc x) - (suc y) = x - y + +record _∧_ {n : Level } (a : Set n) (b : Set n): Set n where + field + pi1 : a + pi2 : b + +lt : ℕ -> ℕ -> Bool +lt x y with (suc x ) ≤? y +lt x y | yes p = true +lt x y | no ¬p = false + +Equal : ℕ -> ℕ -> Bool +Equal x y with x ≟ y +Equal x y | yes p = true +Equal x y | no ¬p = false + +whileTest : {l : Level} {t : Set l} -> (Code : Env -> t) -> t +whileTest next = next (record {varn = 10 ; vari = 0} ) + +{-# TERMINATING #-} +whileLoop : {l : Level} {t : Set l} -> Env -> (Code : Env -> t) -> t +whileLoop env next with lt 0 (varn env) +whileLoop env next | false = next env +whileLoop env next | true = + whileLoop (record {varn = (varn env) - 1 ; vari = (vari env) + 1}) next + +test1 : Env +test1 = whileTest (λ env → whileLoop env (λ env1 → env1 )) + + +proof1 : whileTest (λ env → whileLoop env (λ e → (vari e) ≡ 10 )) +proof1 = refl + + +record EnvWithCond : Set (succ Zero) where + field + input : Env + condition : Set + proof : condition +open EnvWithCond + + + +-- stmt2Cond : {l : Level} → EnvWithCond {l} → +-- stmt2Cond env = (Equal (varn' env) 10) ∧ (Equal (vari' env) 0) + +whileTest' : {t : Set} -> (Code : (env : Env) -> ((vari env) ≡ 0) ∧ ((varn env) ≡ 10) -> t) -> t +whileTest' next = next env proof2 + where + env : Env + env = record {vari = 0 ; varn = 10} + proof2 : ((vari env) ≡ 0) ∧ ((varn env) ≡ 10) + proof2 = record {pi1 = refl ; pi2 = refl} + +{-# TERMINATING #-} +whileLoop' : {t : Set} -> (env : Env) -> ((vari env) + (vari env) ≡ 10) -> (Code : Env -> t) -> t +whileLoop' env proof next with lt 0 (varn env) +whileLoop' env proof next | false = next env +whileLoop' env proof next | true = whileLoop' env1 proof3 next + where + env1 = record {varn = (varn env) - 1 ; vari = (vari env) + 1} + proof3 : vari env1 + vari env1 ≡ 10 + proof3 = {!!} + +conversion1 : {t : Set} → (env : Env) -> ((vari env) ≡ 0) ∧ ((varn env) ≡ 10) + -> (Code : (env1 : Env) -> (vari env1 + vari env1 ≡ 10) -> t) -> t +conversion1 = {!!} + +-- proofGears : whileLoop' {!!} {!!} {!!} +-- proofGears = {!!}
--- a/whileTestPrim.agda Fri Dec 14 16:26:49 2018 +0900 +++ b/whileTestPrim.agda Fri Dec 14 19:34:16 2018 +0900 @@ -5,8 +5,7 @@ open import Data.Bool hiding ( _≟_ ) open import Level renaming ( suc to succ ; zero to Zero ) open import Relation.Nullary using (¬_; Dec; yes; no) -open import Relation.Binary.Core - +open import Relation.Binary.PropositionalEquality record Env : Set where