view hoare.agda @ 2:250c1d4e683b default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 14 Feb 2021 00:09:23 +0900
parents 69dc3096fa72
children
line wrap: on
line source

open import Level renaming ( suc to Suc ; zero to Zero )
module hoare where

open import Data.Nat
open import Data.Nat.Properties
-- open import Data.Bool hiding (_≤?_ ; _≤_)
-- open import Data.Product renaming ( _×_ to _/\_ )
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary using (¬_; Dec; yes; no)
open import logic

record Env : Set (Suc Zero) where
   field
        varn : ℕ
        vari : ℕ
open Env

Statement : Set (Suc Zero)
Statement = {t : Set} → Env → (Env → t ) → t

Cond : Set (Suc Zero)
Cond = Env → Set

whileTest :  {t : Set (Suc Zero) }  → (c10 : ℕ) → (Env → t) → t
whileTest c10 next = next ( record {varn = c10 ; vari = 0 } )

lt :  ℕ → ℕ → Bool
lt zero zero = false
lt (suc _) zero = false
lt zero (suc _) = true
lt (suc x) (suc y) = lt x y

open import nat 
-- _-_ : ℕ → ℕ → ℕ
-- zero - zero = zero
-- zero - suc y = zero
-- suc x - zero = suc x
-- suc x - suc y = x - y

{-# TERMINATING #-}
whileLoop : {t : Set (Suc Zero)} → Env → (Env → t) → t
whileLoop env next with lt 0 (varn env)
whileLoop env next | false = next env
whileLoop env next | true =
   whileLoop (record env {varn = (varn env) - 1 ; vari = (vari env) + 1}) next

test1 : Env
test1 = whileTest 10 (λ env → whileLoop env (λ env1 → env1 ))

assert1 : whileTest 10 (λ env → whileLoop env (λ e → (vari e) ≡ 10 ))
assert1 = refl

-- proof1 : (n : ℕ ) → whileTest n (λ env → whileLoop env (λ e → (vari e) ≡ n ))
-- proof1 = {!!}

{-# TERMINATING #-}
whileLoop' : {l : Level} {t : Set l} → (env : Env ) → {c10 :  ℕ } → ((varn env) + (vari env) ≡ c10) → (Code : Env  → t) → t
whileLoop' env proof next with  ( suc zero  ≤? (varn  env) )
whileLoop' env proof next       | no p = next env
whileLoop' env {c10} proof next | yes p = whileLoop' record env {varn = (varn  env) - 1 ; vari = (vari env) + 1} (proof3 proof p ) next
    where
          env1 = record env {varn = (varn  env) - 1 ; vari = (vari env) + 1}
          proof3 : varn env + vari env ≡ c10 → (suc zero  ≤ (varn  env))  → varn env1 + vari env1 ≡ c10
          proof3 n+i=c 0<n = begin
              varn env1 + vari env1 ≡⟨⟩
              (varn env - 1) + (vari env + 1) ≡⟨ cong (λ k → (varn env - 1 ) + k ) (+-comm _ 1 ) ⟩
              (varn env - 1) + (1 + vari env ) ≡⟨ sym (+-assoc _ 1 _) ⟩ -- 1 ≤ varn env
              ((varn env - 1) + 1 )+ vari env  ≡⟨ cong (λ k → k + vari env) (minus+n {_} {1} (s≤s p)) ⟩
              varn env + vari env ≡⟨ proof ⟩
              c10
            ∎ where open ≡-Reasoning  

open _∧_

-- Condition to Invariant
conversion1 : {l : Level} {t : Set l } → (env : Env ) → {c10 :  ℕ } → ((vari env) ≡ 0) ∧ ((varn env) ≡ c10)
               → (Code : (env1 : Env ) → (varn env1 + vari env1 ≡ c10) → t) → t
conversion1 env {c10} p1 next = next env proof4
   where
      proof4 : varn env + vari env ≡ c10
      proof4 = let open ≡-Reasoning  in
          begin
            varn env + vari env
          ≡⟨ cong ( λ n → n + vari env ) (proj2 p1) ⟩
            c10 + vari env
          ≡⟨ cong ( λ n → c10 + n ) (proj1 p1) ⟩
            c10 + 0
          ≡⟨ +-comm _ 0 ⟩
            c10


whileTest' : {l : Level} {t : Set l}  →  {c10 :  ℕ } → (Code : (env : Env )  → ((vari env) ≡ 0) ∧ ((varn env) ≡ c10) → t) → t
whileTest' {_} {_}  {c10} next = next env proof2
  where
    env : Env
    env = record {vari = 0 ; varn = c10 }
    proof2 : ((vari env) ≡ 0) ∧ ((varn env) ≡ c10) -- PostCondition
    proof2 = record { proj1 = refl ; proj2 =  refl }

-- all proofs are connected
proofGears : {c10 :  ℕ } → Set
proofGears {c10} = whileTest' {_} {_} {c10} (λ n p1 →  conversion1 n p1 (λ n1 p2 → whileLoop' n1 p2 (λ n2 →  ( vari n2 ≡ c10 ))))

-- proof2 : {c10 :  ℕ } → proofGears  {c10}
-- proof2 {c10} = {!!}

data _implies_ {l m : Level}  (A : Set l ) (B : Set m)  : Set (l Level.⊔  m) where
    proof : ( A → B ) → A implies B

--    ind1 : {Inv : ℕ → Set l} → A →  (∀(i : ℕ) → Inv i) → B  → A implies B

-- step : {l m n : Level} {t : Set l} {A : Set l } {B : Set m} {C : Set n} (F : A → (B → t) → t ) →  
-- step = ?

data WhileTestState (c10 : ℕ) (env : Env)  : Set where
  S1 : (vari env ≡ 0) ∧ (varn env ≡ c10 ) → WhileTestState c10 env
  S2 : varn env + vari env ≡ c10 → WhileTestState c10 env
  Sf : vari env ≡ c10 → WhileTestState c10 env

proofGears1 : {c10 : ℕ } →
    whileTest' {_} {_} {c10} (λ n p1 →
    conversion1 n p1 (λ n1 p2 →
    whileLoop' n1 p2 (λ n2 →  vari n2 ≡ c10 )))
proofGears1 {c10} = {!!} where
     lemma2 : whileTest' {Level.suc Level.zero} {_} {c10} (λ n p1 → (vari n ≡ 0) ∧ (varn n ≡ c10 ))
     lemma2 = record { proj1 = refl ; proj2 =  refl }
     lemma4 : {n : Env} → (p2 : ((varn n) + (vari n) ≡ c10)) → whileLoop' n p2 (λ n2 →  vari n2 ≡ c10)
     lemma4 {record { varn = zero ; vari = i }} p2 = p2
     lemma4 {record { varn = suc n ; vari = i }} p2 with lemma4 {record { varn = n - 0; vari = i + 1 }} {!!} 
     ... | t = {!!}