changeset 83:cf5e6afbeb7c

fix
author ryokka
date Mon, 06 Jan 2020 16:02:31 +0900
parents 33a6fd61c3e6
children 77798ab0e660
files whileTestGears.agda
diffstat 1 files changed, 34 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/whileTestGears.agda	Thu Jan 02 20:22:24 2020 +0900
+++ b/whileTestGears.agda	Mon Jan 06 16:02:31 2020 +0900
@@ -164,7 +164,7 @@
 whileLoopPwP env s next exit | tri≈ ¬a b ¬c = exit env (lem (sym b) s)
   where
     lem : (varn env ≡ 0) → (varn env + vari env ≡ c10 env) → vari env ≡ c10 env
-    lem p1 p2 rewrite p1 = p2
+    lem refl refl = refl
 whileLoopPwP env s next exit | tri< a ¬b ¬c  = next (record env {varn = (varn env) - 1 ; vari = (vari env) + 1 }) (proof5 a)
   where
     1<0 : 1 ≤ zero → ⊥
@@ -187,10 +187,23 @@
          c10 env

 
+
+whileLoopPwP' : {l : Level} {t : Set l} → (n : ℕ) → (env : Envc ) → (n ≡ varn env) → whileTestStateP s2 env
+  → (next : (env : Envc ) → (pred n ≡ varn env) → whileTestStateP s2 env  → t)
+  → (exit : (env : Envc ) → whileTestStateP sf env  → t) → t
+whileLoopPwP' zero env refl refl next exit = exit env refl
+whileLoopPwP' (suc n) env refl refl next exit = next (record env {varn = pred (varn env) ; vari = suc (vari env) }) refl (+-suc n (vari env))
+
+
 {-# TERMINATING #-}
 loopPwP : {l : Level} {t : Set l} → (env : Envc ) → whileTestStateP s2 env → (exit : (env : Envc ) → whileTestStateP sf env → t) → t
 loopPwP env s exit = whileLoopPwP env s (λ env s → loopPwP env s exit ) exit
 
+
+loopPwP' : {l : Level} {t : Set l} → (n : ℕ) → (env : Envc ) → (n ≡ varn env) → whileTestStateP s2 env → (exit : (env : Envc ) → whileTestStateP sf env → t) → t
+loopPwP' zero env refl refl exit = exit env refl
+loopPwP' (suc n) env refl refl exit  = whileLoopPwP' (suc n) env refl refl (λ env x y → loopPwP' n env x y exit) exit
+
 --  all codtions are correctly connected and required condtion is proved in the continuation
 --      use required condition as t in (env → t) → t
 whileTestPCallwP : (c :  ℕ ) → Set
@@ -198,6 +211,26 @@
    conv : (env : Envc ) → (vari env ≡ 0) /\ (varn env ≡ c10 env) → varn env + vari env ≡ c10 env
    conv e record { pi1 = refl ; pi2 = refl } = +zero
 
+test : whileTestPCallwP 100
+test = refl
+
+-- pt : (c : ℕ) → whileTestPCallwP c
+-- pt c with <-cmp 0 c
+-- ... | tri≈ ¬a b ¬c = refl
+-- ... | tri< a ¬b ¬c = refl
+
+whileTestPCallwP' : (c :  ℕ ) → Set
+whileTestPCallwP' c = whileTestPwP {_} {_} c (λ env s → loopPwP' (varn env) env refl (conv env s) ( λ env s → vari env ≡ c )  ) where
+  conv : (env : Envc ) → (vari env ≡ 0) /\ (varn env ≡ c10 env) → varn env + vari env ≡ c10 env
+  conv e record { pi1 = refl ; pi2 = refl } = +zero
+
+
+{-- Nat だとできるけど 300 あたりから処理に時間がかかる --}
+test' : whileTestPCallwP' 100
+test' = refl
+
+
+
 --
 -- Using imply relation to make soundness explicit
 -- termination is shown by induction on varn