Mercurial > hg > Papers > 2020 > soto-midterm

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/dummy.tex	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,61 @@
+
+%%% jdummy.def
+%
+\DeclareRelationFont{JY1}{mc}{it}{}{OT1}{cmr}{it}{}
+\DeclareRelationFont{JT1}{mc}{it}{}{OT1}{cmr}{it}{}
+\DeclareFontShape{JY1}{mc}{m}{it}{<5> <6> <7> <8> <9> <10> sgen*min
+    <10.95><12><14.4><17.28><20.74><24.88> min10
+    <-> min10}{}
+\DeclareFontShape{JT1}{mc}{m}{it}{<5> <6> <7> <8> <9> <10> sgen*tmin
+    <10.95><12><14.4><17.28><20.74><24.88> tmin10
+    <-> tmin10}{}
+\DeclareRelationFont{JY1}{mc}{sl}{}{OT1}{cmr}{sl}{}
+\DeclareRelationFont{JT1}{mc}{sl}{}{OT1}{cmr}{sl}{}
+\DeclareFontShape{JY1}{mc}{m}{sl}{<5> <6> <7> <8> <9> <10> sgen*min
+    <10.95><12><14.4><17.28><20.74><24.88> min10
+    <-> min10}{}
+\DeclareFontShape{JT1}{mc}{m}{sl}{<5> <6> <7> <8> <9> <10> sgen*tmin
+    <10.95><12><14.4><17.28><20.74><24.88> tmin10
+    <-> tmin10}{}
+\DeclareRelationFont{JY1}{mc}{sc}{}{OT1}{cmr}{sc}{}
+\DeclareRelationFont{JT1}{mc}{sc}{}{OT1}{cmr}{sc}{}
+\DeclareFontShape{JY1}{mc}{m}{sc}{<5> <6> <7> <8> <9> <10> sgen*min
+    <10.95><12><14.4><17.28><20.74><24.88> min10
+    <-> min10}{}
+\DeclareFontShape{JT1}{mc}{m}{sc}{<5> <6> <7> <8> <9> <10> sgen*tmin
+    <10.95><12><14.4><17.28><20.74><24.88> tmin10
+    <-> tmin10}{}
+\DeclareRelationFont{JY1}{gt}{it}{}{OT1}{cmbx}{it}{}
+\DeclareRelationFont{JT1}{gt}{it}{}{OT1}{cmbx}{it}{}
+\DeclareFontShape{JY1}{mc}{bx}{it}{<5> <6> <7> <8> <9> <10> sgen*goth
+    <10.95><12><14.4><17.28><20.74><24.88> goth10
+    <-> goth10}{}
+\DeclareFontShape{JT1}{mc}{bx}{it}{<5> <6> <7> <8> <9> <10> sgen*tgoth
+    <10.95><12><14.4><17.28><20.74><24.88> tgoth10
+    <-> tgoth10}{}
+\DeclareRelationFont{JY1}{gt}{sl}{}{OT1}{cmbx}{sl}{}
+\DeclareRelationFont{JT1}{gt}{sl}{}{OT1}{cmbx}{sl}{}
+\DeclareFontShape{JY1}{mc}{bx}{sl}{<5> <6> <7> <8> <9> <10> sgen*goth
+    <10.95><12><14.4><17.28><20.74><24.88> goth10
+    <-> goth10}{}
+\DeclareFontShape{JT1}{mc}{bx}{sl}{<5> <6> <7> <8> <9> <10> sgen*tgoth
+    <10.95><12><14.4><17.28><20.74><24.88> tgoth10
+    <-> tgoth10}{}
+\DeclareRelationFont{JY1}{gt}{sc}{}{OT1}{cmbx}{sc}{}
+\DeclareRelationFont{JT1}{gt}{sc}{}{OT1}{cmbx}{sc}{}
+\DeclareFontShape{JY1}{mc}{bx}{sc}{<5> <6> <7> <8> <9> <10> sgen*goth
+    <10.95><12><14.4><17.28><20.74><24.88> goth10
+    <-> goth10}{}
+\DeclareFontShape{JT1}{mc}{bx}{sc}{<5> <6> <7> <8> <9> <10> sgen*tgoth
+    <10.95><12><14.4><17.28><20.74><24.88> tgoth10
+    <-> tgoth10}{}
+\DeclareRelationFont{JY1}{gt}{it}{}{OT1}{cmr}{it}{}
+\DeclareRelationFont{JT1}{gt}{it}{}{OT1}{cmr}{it}{}
+\DeclareFontShape{JY1}{gt}{m}{it}{<5> <6> <7> <8> <9> <10> sgen*goth
+    <10.95><12><14.4><17.28><20.74><24.88> goth10
+    <-> goth10}{}
+\DeclareFontShape{JT1}{gt}{m}{it}{<5> <6> <7> <8> <9> <10> sgen*tgoth
+    <10.95><12><14.4><17.28><20.74><24.88> tgoth10
+    <-> tgoth10}{}
+\endinput
+%%%% end of jdummy.def
Binary file mid_thesis.pdf has changed
--- a/mid_thesis.tex	Tue Aug 25 15:06:24 2020 +0900
+++ b/mid_thesis.tex	Tue Sep 08 18:38:08 2020 +0900
@@ -1,7 +1,9 @@
-\documentclass[twocolumn,twoside,9.5pt]{jarticle}
-\usepackage[dvips]{graphicx}
+\documentclass[a4j,9.5pt]{jarticle}
+% \usepackage[dvips]{graphicx}
 \usepackage{picins}
 \usepackage{fancyhdr}
+\usepackage[]{multicol}
+\usepackage{listings,jlisting}
 %\pagestyle{fancy}
 \lhead{\parpic{\includegraphics[height=1zw,keepaspectratio,bb=0 0 251 246]{pic/emblem-bitmap.pdf}}琉球大学主催 工学部工学科知能情報コース 中間発表予稿}
 \rhead{}
@@ -17,25 +19,138 @@
 \setlength{\footskip}{0mm}
 \pagestyle{empty}

+
+\usepackage{ascmac}
+\usepackage[dvipdfmx]{graphicx}
+\usepackage{amssymb}
+\usepackage{type1cm}
+\usepackage[usenames]{color}
+\usepackage{ulem}
+
+\renewcommand{\abstractname}{要 旨}
+\lstset{
+  frame=single,
+  keepspaces=true,
+  stringstyle={\ttfamily},
+  commentstyle={\ttfamily},
+  identifierstyle={\ttfamily},
+  keywordstyle={\ttfamily},
+  basicstyle={\small\ttfamily},
+  breaklines=true,
+  xleftmargin=0zw,
+  xrightmargin=0zw,
+  framerule=.3pt,
+  columns=[l]{fullflexible},
+  numbers=none,
+  stepnumber=1,
+  numberstyle={\scriptsize},
+  numbersep=2em,
+  language={},
+  tabsize=4,
+  lineskip=-0.1zw,
+  escapechar={@},
+}
+
 \begin{document}
-\title{題名}
-\author{学籍番号 氏名 {}{} 指導教員 : 指導教員名}
+\title{Continuation based C での Hoare Logic を用いた赤黒木の検証 \\ Validation of red-black tree implemented in Continuation based C using Hoare Logic}
+\author{学籍番号 175706H 氏名 上地 悠斗 \\ 指導教員 : 河野 真治}
 \date{}
 \maketitle
-\thispagestyle{fancy}
+\thispagestyle{fancy}

-\section{section1}
+% 要旨
+\input{./tex/abstract/abstract.tex}
+
+\begin{multicols}{2}
+\input{./tex/intro/intro.tex}

-\section{section2}
+\section{Continuation based C}
+	前述した通り CbC とはC言語からループ制御構造とサブルーチンコールを取り除き、
+	継続を導入したC言語の下位言語である。継続呼び出しは引数付き goto 文で表現される。
+	また、CodeGear を処理の単位、DataGear をデータの単位として記述するプログラミング言語である。
+	CbC のプログラミングでは DataGear を CodeGear で変更し、その変更を次の CodeGear に渡して処理を行う。

-\section{section3}
+\subsection{Code Gear / Data Gear}
+	CbCでは、検証しやすいプログラムの単位として DataGear と CodeGear という単位を用いるプログラミングスタイルを提案している。
+
+	CodeGear はプログラムの処理そのものであり、一般的なプログラム言語における関数と同じ役割である。
+	DataGear は CodeGear で扱うデータの単位であり、処理に必要なデータである。
+	CodeGear の入力となる DataGear を Input DataGear と呼び、出力は Output DataGear と呼ぶ。
+
+	CodeGear 間の移動は継続を用いて行われる。
+	継続は関数呼び出しとは異なり、呼び出した後に元のコードに戻らず、次の CodeGear へ継続を行う。
+	これは、関数型プログラミングでは末尾関数呼び出しを行うことに相当する。


-\section{section4}
+\subsection{Meta Code Gear / Meta Data Gear}
+	プログラムの記述する際は、ノーマルレベルの計算の他に、メモリ管理、スレッド管理、
+	資源管理等を記述しなければならない処理が存在する。
+	これらの計算はノーマルレベルの計算と区別してメタ計算と呼ぶ。
+
+	メタ計算は OS の機能を通して処理することが多く、信頼性の高い記述が求められる。
+	そのため、 CbC ではメタ計算を分離するために Meta CodeGear、 Meta DataGear を定義している。
+
+	Meta CodeGear は CbC 上でのメタ計算で、通常の CodeGear を実行する際に必要なメタ計算を分離するための単位である。
+	CodeGear を実行する前後やDataGear の大枠として Meta Gear が存在している。
+
+	例として CodeGear が DataGear から値を取得する際に使われる、 stub CodeGear について説明する。
+
+	CbC では CodeGear を実行する際、ノーマルレベルの計算からは見えないが
+	必要な DataGear を Context と呼ばれる Meta DataGear を通して取得することになる。
+	これはユーザーが直接データを扱える状態では信頼性が高いとは言えないと考えるからである。
+	そのために、 Meta CodeGear として Context から必要な DataGear を取り出し、
+	CodeGear に接続する stub CodeGear という Meta CodeGear を定義している。
+
+	Meta DataGear は CbC 上のメタ計算で扱われる DataGear である。例えば stub
+	CodeGear では Context と呼ばれる接続可能な CodeGear、DataGear のリストや、DataGear
+	のメモリ空間等を持った Meta DataGear を扱っている。
+
+
+\section{Hoare Logic}
+	Hoare Logic とは C.A.R Hoare、 R.W Floyd が考案したプログラムの検証の手法である。
+	これは、「プログラムの事前条件(P)が成立しているとき、コマンド(C)実行して停止すると事後条件(Q)が成り立つ」
+	というもので、CbCの実行を継続するという性質に非常に相性が良い。
+	Hoare Logic を表記すると以下のようになる。
+	$$ \{P\}\ C\ \{Q\} $$
+	この3つ組は Hoare Triple と呼ばれる。
+
+	Hoare Triple の事後条件を受け取り異なる条件を返す別の Hoare Triple を繋げることでプログラムを記述していく。
+
+	Hoare Logic の検証では、「条件がすべて正しく接続されている」かつ「コマンドが停止する」ことが必要である。
+	これらを満たし、事前条件から事後条件を導けることを検証することで Hoare Logic の健全性を示すことができる。
+
+\section{agda}
+	agdaとは、Agda は依存型をもつ純粋関数型の言語である。 定理証明支援器でもある。
+
+\section{関連研究}
+	外間による研究では CbC にて実装された While Loop を Hoare Logic を用いて検証した。
+
+\section{検証手法}
+    手法は模索中であり、先行研究と同じ手法を取ろうとしている。本章では先行研究で述べられている検証手法について説明する。
+
+% 手法
+\input{./tex/spec/spec.tex}
+
+\section{今後の課題}
+    d
+
+\section{類似技術}
+
+\subsection{coq}

 \begin{thebibliography}{9}

-\bibitem{1}
+\bibitem{1}CbCの論文
+\bibitem{2}外間先輩の先行研究
+\bibitem{3}Hoare Logicの論文
+\bibitem{4}Hoare Logicのスライド
+\bibitem{5}agda のサイト
+\bibitem{6}Aaron Stumpの本
+\bibitem{7}atttonさんの論文
+\bibitem{8}Haskell
+\bibitem{9}Coq

 \end{thebibliography}
+\end{multicols}
+
 \end{document}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/spec.tex	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,23 @@
+\subsection{CbC記法で書くagda}
+	CbCプログラムの検証をするに当たり、agdaコードもCbC記法で記述を行う。つまり継続渡しを用いて記述する必要がある。
+	以下が例となるコードである。
+	前述した加算を行うコードと比較すると、不定の型 (t) により継続を行なっている部分が見える。
+	これがAgdaで表現された CodeGear となる。
+
+\subsection{agda による Meta Gears}
+	通常の Meta Gears はノーマルレベルの CodeGear、 DataGear では扱えないメタレベルの計算を扱う単位である。
+	Meta DataGear はメタ計算で使われる DataGear で、実行するメタ計算によって異なる。
+	今回はその Meta Gears をagdaによる検証の為に用いる。
+	検証での Meta Gears は DataGear が持つ同値関係や、
+	大小関係などの関係を表す DataGear がそれに当たると考えられる。
+	Agda 上で Meta DataGear を持つことでデータ構造自体が関係を持つデータを作ることができる。
+	以下が While Program での制約条件をまとめたものになる。
+	Agdaにおける Meta DataGear のコードを載せるi。
+    \lstinputlisting[label=agda-mdg, caption= Agda における Meta DataGear] {./src/agda-mdg.agda.replaced}
+
+	whileTestState で Meta DataGear を識別するためのデータを分け、
+	whileTestStatePでそれぞれの Meta DataGear を返している。
+	ここでは = の後ろの (vari env ≡ 0) (varn env ≡
+	c10 env)/ などのデータを Meta DataGear として扱う。
+	aa
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaBasics.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,1 @@
+module AgdaBasics where
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaBasics.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,1 @@
+module AgdaBasics where
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaBool.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+data Bool : Set where
+  true  : Bool
+  false : Bool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaBool.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+data Bool : Set where
+  true  : Bool
+  false : Bool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaDebug.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,32 @@
+open import Level renaming (suc to succ ; zero to Zero )
+
+module AgdaDebug where
+
+open import stack
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Data.Nat
+open import Function
+
+
+open SingleLinkedStack
+open Stack
+
+testStack07 : {m : Level } -> Maybe (Element ℕ)
+testStack07 = pushSingleLinkedStack emptySingleLinkedStack 1 (\s -> pushSingleLinkedStack s 2 (\s -> top s))
+
+testStack08 = pushSingleLinkedStack emptySingleLinkedStack 1
+  $ \s -> pushSingleLinkedStack s 2
+  $ \s -> pushSingleLinkedStack s 3
+  $ \s -> pushSingleLinkedStack s 4
+  $ \s -> pushSingleLinkedStack s 5
+  $ \s -> top s
+
+
+testStack10 = pushStack emptySingleLinkedStack 1
+  $ \s -> pushStack 2
+  $ \s -> pushStack 3
+  $ \s -> pushStack 4
+  $ \s -> pushStack 5
+  $ \s -> top s
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaDebug.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,32 @@
+open import Level renaming (suc to succ ; zero to Zero )
+
+module AgdaDebug where
+
+open import stack
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Data.Nat
+open import Function
+
+
+open SingleLinkedStack
+open Stack
+
+testStack07 : {m : Level } @$\rightarrow$@ Maybe (Element @$\mathbb{N}$@)
+testStack07 = pushSingleLinkedStack emptySingleLinkedStack 1 (\s @$\rightarrow$@ pushSingleLinkedStack s 2 (\s @$\rightarrow$@ top s))
+
+testStack08 = pushSingleLinkedStack emptySingleLinkedStack 1
+  $ \s @$\rightarrow$@ pushSingleLinkedStack s 2
+  $ \s @$\rightarrow$@ pushSingleLinkedStack s 3
+  $ \s @$\rightarrow$@ pushSingleLinkedStack s 4
+  $ \s @$\rightarrow$@ pushSingleLinkedStack s 5
+  $ \s @$\rightarrow$@ top s
+
+
+testStack10 = pushStack emptySingleLinkedStack 1
+  $ \s @$\rightarrow$@ pushStack 2
+  $ \s @$\rightarrow$@ pushStack 3
+  $ \s @$\rightarrow$@ pushStack 4
+  $ \s @$\rightarrow$@ pushStack 5
+  $ \s @$\rightarrow$@ top s
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaElem.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+elem : {A : Set} {{eqA : Eq A}} → A → List A → Bool
+elem {{eqA}} x (y ∷ xs) = (Eq._==_ eqA x y) || (elem {{eqA}} x xs)
+elem         x []        = false
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaElem.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+elem : {A : Set} {{eqA : Eq A}} @$\rightarrow$@ A @$\rightarrow$@ List A @$\rightarrow$@ Bool
+elem {{eqA}} x (y @$\text{::}$@ xs) = (Eq._==_ eqA x y) || (elem {{eqA}} x xs)
+elem         x []        = false
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaElemApply.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+listHas4 : Bool
+listHas4 = elem 4 (3 ∷ 2 ∷ 5 ∷ 4 ∷ []) -- true
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaElemApply.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+listHas4 : Bool
+listHas4 = elem 4 (3 @$\text{::}$@ 2 @$\text{::}$@ 5 @$\text{::}$@ 4 @$\text{::}$@ []) -- true
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaFunction.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+f : Bool -> Bool
+f x = true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaFunction.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+f : Bool @$\rightarrow$@ Bool
+f x = true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaId.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+identity : (A : Set) -> A -> A
+identity A x = x
+
+identity-zero : Nat
+identity-zero = identity Nat zero
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaId.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+identity : (A : Set) @$\rightarrow$@ A @$\rightarrow$@ A
+identity A x = x
+
+identity-zero : Nat
+identity-zero = identity Nat zero
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaImplicitId.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
+id : {A : Set} -> A -> A
+id x = x
+
+id-zero : Nat
+id-zero = id zero
+
+id' : {A : Set} -> A -> A
+id' {A} x = x
+
+id-true : Bool
+id-true = id {Bool} true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaImplicitId.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
+id : {A : Set} @$\rightarrow$@ A @$\rightarrow$@ A
+id x = x
+
+id-zero : Nat
+id-zero = id zero
+
+id' : {A : Set} @$\rightarrow$@ A @$\rightarrow$@ A
+id' {A} x = x
+
+id-true : Bool
+id-true = id {Bool} true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaImport.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+import Data.Nat                  -- import module
+import Data.Bool as B            -- renamed module
+import Data.List using (head)    -- import Data.head function
+import Level renaming (suc to S) -- import module with rename suc to S
+import Data.String hiding (_++_) -- import module without _++_
+open import Data.List            -- import and expand Data.List
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaImport.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+import Data.Nat                  -- import module
+import Data.Bool as B            -- renamed module
+import Data.List using (head)    -- import Data.head function
+import Level renaming (suc to S) -- import module with rename suc to S
+import Data.String hiding (_++_) -- import module without _++_
+open import Data.List            -- import and expand Data.List
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaInstance.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+_==Nat_ : Nat -> Nat -> Bool
+zero    ==Nat zero    = true
+(suc n) ==Nat zero    = false
+zero    ==Nat (suc m) = false
+(suc n) ==Nat (suc m) = n ==Nat m
+
+instance
+  natHas== : Eq Nat
+  natHas== = record { _==_ = _==Nat_}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaInstance.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+_==Nat_ : Nat @$\rightarrow$@ Nat @$\rightarrow$@ Bool
+zero    ==Nat zero    = true
+(suc n) ==Nat zero    = false
+zero    ==Nat (suc m) = false
+(suc n) ==Nat (suc m) = n ==Nat m
+
+instance
+  natHas== : Eq Nat
+  natHas== = record { _==_ = _==Nat_}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaInterface.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+record StackMethods {n m : Level } (a : Set n ) {t : Set m }(stackImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    push : stackImpl -> a -> (stackImpl -> t) -> t
+    pop  : stackImpl -> (stackImpl -> Maybe a -> t) -> t
+open StackMethods
+
+record Stack {n m : Level } (a : Set n ) {t : Set m } (si : Set n ) : Set (m Level.⊔ n) where
+  field
+    stack : si
+    stackMethods : StackMethods {n} {m} a {t} si
+  pushStack :  a -> (Stack a si -> t) -> t
+  pushStack d next = push (stackMethods ) (stack ) d (\s1 -> next (record {stack = s1 ; stackMethods = stackMethods } ))
+  popStack : (Stack a si -> Maybe a  -> t) -> t
+  popStack next = pop (stackMethods ) (stack ) (\s1 d1 -> next (record {stack = s1 ; stackMethods = stackMethods }) d1 )
+open Stack
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaInterface.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+record StackMethods {n m : Level } (a : Set n ) {t : Set m }(stackImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    push : stackImpl @$\rightarrow$@ a @$\rightarrow$@ (stackImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+    pop  : stackImpl @$\rightarrow$@ (stackImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+open StackMethods
+
+record Stack {n m : Level } (a : Set n ) {t : Set m } (si : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    stack : si
+    stackMethods : StackMethods {n} {m} a {t} si
+  pushStack :  a @$\rightarrow$@ (Stack a si @$\rightarrow$@ t) @$\rightarrow$@ t
+  pushStack d next = push (stackMethods ) (stack ) d (\s1 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods } ))
+  popStack : (Stack a si @$\rightarrow$@ Maybe a  @$\rightarrow$@ t) @$\rightarrow$@ t
+  popStack next = pop (stackMethods ) (stack ) (\s1 d1 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods }) d1 )
+open Stack
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaLambda.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
++1 : ℕ → ℕ
++1 n = suc n -- not use lambda
+
+λ+1 : ℕ → ℕ
+λ+1 = (\n -> suc n)   -- use lambda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaLambda.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
++1 : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
++1 n = suc n -- not use lambda
+
+@$\lambda$@+1 : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+@$\lambda$@+1 = (\n @$\rightarrow$@ suc n)   -- use lambda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaModusPonens.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+f : {A B C : Set} -> ((A -> B) × (B -> C)) -> (A -> C)
+f = \p x -> (snd p) ((fst p) x)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaModusPonens.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+f : {A B C : Set} @$\rightarrow$@ ((A @$\rightarrow$@ B) @$\times$@ (B @$\rightarrow$@ C)) @$\rightarrow$@ (A @$\rightarrow$@ C)
+f = \p x @$\rightarrow$@ (snd p) ((fst p) x)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNPushNPop.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+n-push : {m : Meta} {{_ : M.DataSegment Meta}} (n : ℕ) -> M.CodeSegment Meta Meta
+n-push {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-push {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m -> M.exec {{mm}} {{mm}} (n-push {m} {{mm}} n) (pushOnce m))
+
+n-pop : {m : Meta} {{_ : M.DataSegment Meta}} (n : ℕ) -> M.CodeSegment Meta Meta
+n-pop {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-pop {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m -> M.exec {{mm}} {{mm}} (n-pop {m} {{mm}} n) (popOnce m))
+
+pop-n-push-type : ℕ -> ℕ -> ℕ -> SingleLinkedStack ℕ -> Set₁
+pop-n-push-type n cn ce s = M.exec (M.csComp {meta} (M.cs popOnce) (n-push {meta} (suc n))) meta
+                         ≡ M.exec (n-push {meta} n) meta
+  where
+    meta = id-meta cn ce s
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNPushNPop.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+n-push : {m : Meta} {{_ : M.DataSegment Meta}} (n : @$\mathbb{N}$@) @$\rightarrow$@ M.CodeSegment Meta Meta
+n-push {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-push {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m @$\rightarrow$@ M.exec {{mm}} {{mm}} (n-push {m} {{mm}} n) (pushOnce m))
+
+n-pop : {m : Meta} {{_ : M.DataSegment Meta}} (n : @$\mathbb{N}$@) @$\rightarrow$@ M.CodeSegment Meta Meta
+n-pop {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-pop {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m @$\rightarrow$@ M.exec {{mm}} {{mm}} (n-pop {m} {{mm}} n) (popOnce m))
+
+pop-n-push-type : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+pop-n-push-type n cn ce s = M.exec (M.csComp {meta} (M.cs popOnce) (n-push {meta} (suc n))) meta
+                         @$\equiv$@ M.exec (n-push {meta} n) meta
+  where
+    meta = id-meta cn ce s
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNPushNPopProof.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,58 @@
+pop-n-push-type : ℕ -> ℕ -> ℕ -> SingleLinkedStack ℕ -> Set₁
+pop-n-push-type n cn ce s = M.exec (M.csComp (M.cs popOnce) (n-push (suc n))) meta
+                         ≡ M.exec (n-push n) meta
+  where
+    meta = id-meta cn ce s
+
+pop-n-push : (n cn ce : ℕ) -> (s : SingleLinkedStack ℕ) -> pop-n-push-type n cn ce s
+pop-n-push zero cn ce s    = refl
+pop-n-push (suc n) cn ce s = begin
+  M.exec (M.csComp  (M.cs popOnce) (n-push  (suc (suc n)))) (id-meta cn ce s)
+  ≡⟨ refl ⟩
+  M.exec (M.csComp (M.cs popOnce) (M.csComp  (n-push  (suc n)) (M.cs pushOnce))) (id-meta cn ce s)
+  ≡⟨ exec-comp (M.cs popOnce) (M.csComp  (n-push  (suc n)) (M.cs pushOnce)) (id-meta cn ce s) ⟩
+  M.exec (M.cs popOnce) (M.exec (M.csComp  (n-push  (suc n)) (M.cs pushOnce)) (id-meta cn ce s))
+  ≡⟨ cong (\x -> M.exec (M.cs popOnce) x) (exec-comp (n-push (suc n)) (M.cs pushOnce) (id-meta cn ce s)) ⟩
+  M.exec (M.cs popOnce) (M.exec (n-push  (suc n))(M.exec (M.cs pushOnce) (id-meta cn ce s)))
+  ≡⟨ refl ⟩
+  M.exec (M.cs popOnce) (M.exec (n-push  (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})))
+  ≡⟨ sym (exec-comp (M.cs popOnce) (n-push (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))) ⟩
+  M.exec (M.csComp  (M.cs popOnce) (n-push  (suc n))) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  ≡⟨ pop-n-push n cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}) ⟩
+  M.exec (n-push n) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  ≡⟨ refl ⟩
+  M.exec (n-push n) (pushOnce (id-meta cn ce s))
+  ≡⟨ refl ⟩
+  M.exec (n-push n) (M.exec (M.cs pushOnce) (id-meta cn ce s))
+  ≡⟨ refl ⟩
+  M.exec (n-push (suc n)) (id-meta cn ce s)
+  ∎
+
+
+
+n-push-pop-type : ℕ ->  ℕ  -> ℕ -> SingleLinkedStack ℕ -> Set₁
+n-push-pop-type n cn ce st = M.exec (M.csComp (n-pop n) (n-push n)) meta ≡ meta
+  where
+    meta = id-meta cn ce st
+
+n-push-pop : (n cn ce : ℕ) -> (s : SingleLinkedStack ℕ) -> n-push-pop-type n cn ce s
+n-push-pop zero    cn ce s = refl
+n-push-pop (suc n) cn ce s = begin
+  M.exec (M.csComp (n-pop (suc n)) (n-push (suc n))) (id-meta cn ce s)
+  ≡⟨ refl ⟩
+  M.exec (M.csComp (M.cs (\m -> M.exec (n-pop n) (popOnce m))) (n-push (suc n))) (id-meta cn ce s)
+  ≡⟨ exec-comp (M.cs (\m -> M.exec (n-pop n) (popOnce m))) (n-push (suc n))  (id-meta cn ce s) ⟩
+  M.exec (M.cs (\m -> M.exec (n-pop  n) (popOnce m))) (M.exec (n-push (suc n)) (id-meta cn ce s))
+  ≡⟨ refl ⟩
+  M.exec (n-pop n) (popOnce (M.exec (n-push (suc n)) (id-meta cn ce s)))
+  ≡⟨ refl ⟩
+  M.exec (n-pop n) (M.exec (M.cs popOnce) (M.exec (n-push (suc n)) (id-meta cn ce s)))
+  ≡⟨ cong (\x -> M.exec (n-pop n) x) (sym (exec-comp (M.cs popOnce) (n-push (suc n)) (id-meta cn ce s))) ⟩
+  M.exec (n-pop n) (M.exec (M.csComp (M.cs popOnce) (n-push (suc n))) (id-meta cn ce s))
+  ≡⟨ cong (\x -> M.exec (n-pop n) x) (pop-n-push n cn ce s) ⟩
+  M.exec (n-pop n) (M.exec (n-push n) (id-meta cn ce s))
+  ≡⟨ sym (exec-comp (n-pop n) (n-push n) (id-meta cn ce s)) ⟩
+  M.exec (M.csComp (n-pop n) (n-push n)) (id-meta cn ce s)
+  ≡⟨ n-push-pop n cn ce s ⟩
+  id-meta cn ce s
+  ∎
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNPushNPopProof.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,58 @@
+pop-n-push-type : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+pop-n-push-type n cn ce s = M.exec (M.csComp (M.cs popOnce) (n-push (suc n))) meta
+                         @$\equiv$@ M.exec (n-push n) meta
+  where
+    meta = id-meta cn ce s
+
+pop-n-push : (n cn ce : @$\mathbb{N}$@) @$\rightarrow$@ (s : SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ pop-n-push-type n cn ce s
+pop-n-push zero cn ce s    = refl
+pop-n-push (suc n) cn ce s = begin
+  M.exec (M.csComp  (M.cs popOnce) (n-push  (suc (suc n)))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (M.csComp (M.cs popOnce) (M.csComp  (n-push  (suc n)) (M.cs pushOnce))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ exec-comp (M.cs popOnce) (M.csComp  (n-push  (suc n)) (M.cs pushOnce)) (id-meta cn ce s) @$\rangle$@
+  M.exec (M.cs popOnce) (M.exec (M.csComp  (n-push  (suc n)) (M.cs pushOnce)) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ cong (\x @$\rightarrow$@ M.exec (M.cs popOnce) x) (exec-comp (n-push (suc n)) (M.cs pushOnce) (id-meta cn ce s)) @$\rangle$@
+  M.exec (M.cs popOnce) (M.exec (n-push  (suc n))(M.exec (M.cs pushOnce) (id-meta cn ce s)))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (M.cs popOnce) (M.exec (n-push  (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})))
+  @$\equiv$@@$\langle$@ sym (exec-comp (M.cs popOnce) (n-push (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))) @$\rangle$@
+  M.exec (M.csComp  (M.cs popOnce) (n-push  (suc n))) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  @$\equiv$@@$\langle$@ pop-n-push n cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}) @$\rangle$@
+  M.exec (n-push n) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-push n) (pushOnce (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-push n) (M.exec (M.cs pushOnce) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-push (suc n)) (id-meta cn ce s)
+  @$\blacksquare$@
+
+
+
+n-push-pop-type : @$\mathbb{N}$@ @$\rightarrow$@  @$\mathbb{N}$@  @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+n-push-pop-type n cn ce st = M.exec (M.csComp (n-pop n) (n-push n)) meta @$\equiv$@ meta
+  where
+    meta = id-meta cn ce st
+
+n-push-pop : (n cn ce : @$\mathbb{N}$@) @$\rightarrow$@ (s : SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ n-push-pop-type n cn ce s
+n-push-pop zero    cn ce s = refl
+n-push-pop (suc n) cn ce s = begin
+  M.exec (M.csComp (n-pop (suc n)) (n-push (suc n))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (M.csComp (M.cs (\m @$\rightarrow$@ M.exec (n-pop n) (popOnce m))) (n-push (suc n))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ exec-comp (M.cs (\m @$\rightarrow$@ M.exec (n-pop n) (popOnce m))) (n-push (suc n))  (id-meta cn ce s) @$\rangle$@
+  M.exec (M.cs (\m @$\rightarrow$@ M.exec (n-pop  n) (popOnce m))) (M.exec (n-push (suc n)) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-pop n) (popOnce (M.exec (n-push (suc n)) (id-meta cn ce s)))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-pop n) (M.exec (M.cs popOnce) (M.exec (n-push (suc n)) (id-meta cn ce s)))
+  @$\equiv$@@$\langle$@ cong (\x @$\rightarrow$@ M.exec (n-pop n) x) (sym (exec-comp (M.cs popOnce) (n-push (suc n)) (id-meta cn ce s))) @$\rangle$@
+  M.exec (n-pop n) (M.exec (M.csComp (M.cs popOnce) (n-push (suc n))) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ cong (\x @$\rightarrow$@ M.exec (n-pop n) x) (pop-n-push n cn ce s) @$\rangle$@
+  M.exec (n-pop n) (M.exec (n-push n) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ sym (exec-comp (n-pop n) (n-push n) (id-meta cn ce s)) @$\rangle$@
+  M.exec (M.csComp (n-pop n) (n-push n)) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ n-push-pop n cn ce s @$\rangle$@
+  id-meta cn ce s
+  @$\blacksquare$@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNat.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+data Nat : Set where
+  zero : Nat
+  suc  : Nat -> Nat
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNat.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+data Nat : Set where
+  zero : Nat
+  suc  : Nat @$\rightarrow$@ Nat
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNot.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+not : Bool -> Bool
+not  true = false
+not false = true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaNot.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+not : Bool @$\rightarrow$@ Bool
+not  true = false
+not false = true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaParameterizedModule.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+module Sort (A : Set) (_<_ : A -> A -> Bool) where
+sort : List A -> List A
+sort = -- 実装は省略 ...
+
+-- Parameterized Module により N.sort や B.sort が可能
+open import Sort Nat  Nat._<_  as N
+open import Sort Bool Bool._<_ as B
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaParameterizedModule.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+module Sort (A : Set) (_<_ : A @$\rightarrow$@ A @$\rightarrow$@ Bool) where
+sort : List A @$\rightarrow$@ List A
+sort = -- 実装は省略 ...
+
+-- Parameterized Module により N.sort や B.sort が可能
+open import Sort Nat  Nat._<_  as N
+open import Sort Bool Bool._<_ as B
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPattern.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+not : Bool -> Bool
+not false = true
+not x     = false
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPattern.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+not : Bool @$\rightarrow$@ Bool
+not false = true
+not x     = false
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPlus.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+_+_ : Nat -> Nat -> Nat
+zero  + m = m
+suc n + m = suc (n + m)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPlus.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+_+_ : Nat @$\rightarrow$@ Nat @$\rightarrow$@ Nat
+zero  + m = m
+suc n + m = suc (n + m)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaProduct.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+data _×_ (A B : Set) : Set where
+  <_,_> : A -> B -> A × B
+
+fst : {A B : Set} -> A × B -> A
+fst < a , _ > = a
+
+snd : {A B : Set} -> A × B -> B
+snd < _ , b > = b
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaProduct.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+data _@$\times$@_ (A B : Set) : Set where
+  <_,_> : A @$\rightarrow$@ B @$\rightarrow$@ A @$\times$@ B
+
+fst : {A B : Set} @$\rightarrow$@ A @$\times$@ B @$\rightarrow$@ A
+fst < a , _ > = a
+
+snd : {A B : Set} @$\rightarrow$@ A @$\times$@ B @$\rightarrow$@ B
+snd < _ , b > = b
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaProp.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+prop : Bool
+prop = true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaProp.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+prop : Bool
+prop = true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPushPop.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,28 @@
+pushSingleLinkedStack : Meta -> Meta
+pushSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (push s e) })
+  where
+    n = Meta.nextCS m
+    s = Meta.stack  m
+    e = Context.element (Meta.context m)
+    push : SingleLinkedStack A -> Maybe A -> SingleLinkedStack A
+    push s nothing  = s
+    push s (just x) = record {top = just (cons x (top s))}
+
+popSingleLinkedStack : Meta -> Meta
+popSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (st m) ; context = record con {element = (elem m)}})
+  where
+    n = Meta.nextCS m
+    con  = Meta.context m
+    elem : Meta -> Maybe A
+    elem record {stack = record { top = (just (cons x _)) }} = just x
+    elem record {stack = record { top = nothing           }} = nothing
+    st : Meta -> SingleLinkedStack A
+    st record {stack = record { top = (just (cons _ s)) }} = record {top = s}
+    st record {stack = record { top = nothing           }} = record {top = nothing}
+
+
+pushSingleLinkedStackCS : M.CodeSegment Meta Meta
+pushSingleLinkedStackCS = M.cs pushSingleLinkedStack
+
+popSingleLinkedStackCS : M.CodeSegment Meta Meta
+popSingleLinkedStackCS = M.cs popSingleLinkedStack
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPushPop.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,28 @@
+pushSingleLinkedStack : Meta @$\rightarrow$@ Meta
+pushSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (push s e) })
+  where
+    n = Meta.nextCS m
+    s = Meta.stack  m
+    e = Context.element (Meta.context m)
+    push : SingleLinkedStack A @$\rightarrow$@ Maybe A @$\rightarrow$@ SingleLinkedStack A
+    push s nothing  = s
+    push s (just x) = record {top = just (cons x (top s))}
+
+popSingleLinkedStack : Meta @$\rightarrow$@ Meta
+popSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (st m) ; context = record con {element = (elem m)}})
+  where
+    n = Meta.nextCS m
+    con  = Meta.context m
+    elem : Meta @$\rightarrow$@ Maybe A
+    elem record {stack = record { top = (just (cons x _)) }} = just x
+    elem record {stack = record { top = nothing           }} = nothing
+    st : Meta @$\rightarrow$@ SingleLinkedStack A
+    st record {stack = record { top = (just (cons _ s)) }} = record {top = s}
+    st record {stack = record { top = nothing           }} = record {top = nothing}
+
+
+pushSingleLinkedStackCS : M.CodeSegment Meta Meta
+pushSingleLinkedStackCS = M.cs pushSingleLinkedStack
+
+popSingleLinkedStackCS : M.CodeSegment Meta Meta
+popSingleLinkedStackCS = M.cs popSingleLinkedStack
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPushPopProof.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
+id-meta : ℕ -> ℕ -> SingleLinkedStack ℕ -> Meta
+id-meta n e s = record { context = record {n = n ; element = just e}
+                       ; nextCS = (N.cs id) ; stack = s}
+
+push-pop-type : ℕ -> ℕ  -> ℕ -> Element ℕ -> Set₁
+push-pop-type n e x s = M.exec (M.csComp {meta} (M.cs popOnce) (M.cs pushOnce)) meta ≡ meta
+  where
+    meta = id-meta n e record {top = just (cons x (just s))}
+
+push-pop : (n e x : ℕ) -> (s : Element ℕ) ->  push-pop-type n e x s
+push-pop n e x s = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaPushPopProof.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
+id-meta : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Meta
+id-meta n e s = record { context = record {n = n ; element = just e}
+                       ; nextCS = (N.cs id) ; stack = s}
+
+push-pop-type : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@  @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Element @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+push-pop-type n e x s = M.exec (M.csComp {meta} (M.cs popOnce) (M.cs pushOnce)) meta @$\equiv$@ meta
+  where
+    meta = id-meta n e record {top = just (cons x (just s))}
+
+push-pop : (n e x : @$\mathbb{N}$@) @$\rightarrow$@ (s : Element @$\mathbb{N}$@) @$\rightarrow$@  push-pop-type n e x s
+push-pop n e x s = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaRecord.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+record Point : Set where
+  field
+    x : Nat
+    y : Nat
+
+makePoint : Nat -> Nat -> Point
+makePoint a b = record { x = a ; y = b }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaRecord.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+record Point : Set where
+  field
+    x : Nat
+    y : Nat
+
+makePoint : Nat @$\rightarrow$@ Nat @$\rightarrow$@ Point
+makePoint a b = record { x = a ; y = b }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaRecordProj.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+getX : Point -> Nat
+getX p = Point.x p
+
+getY : Point -> Nat
+getY record { x = a ; y = b} = b
+
+xPlus5 : Point -> Point
+xPlus5 p = record p { x = (Point.x p) + 5}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaRecordProj.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+getX : Point @$\rightarrow$@ Nat
+getX p = Point.x p
+
+getY : Point @$\rightarrow$@ Nat
+getY record { x = a ; y = b} = b
+
+xPlus5 : Point @$\rightarrow$@ Point
+xPlus5 p = record p { x = (Point.x p) + 5}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaSingleLinkedStack.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,63 @@
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} -> StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+push = pushSingleLinkedStack
+; pop  = popSingleLinkedStack
+; pop2 = pop2SingleLinkedStack
+; get  = getSingleLinkedStack
+; get2 = get2SingleLinkedStack
+; clear = clearSingleLinkedStack
+}
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} -> Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+stack = emptySingleLinkedStack ;
+stackMethods = singleLinkedStackSpec
+}
+
+-- Implementation
+
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} -> SingleLinkedStack Data -> Data -> (Code : SingleLinkedStack Data -> t) -> t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+
+popSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> t) -> t
+popSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack1 (Just data1)
+  where
+    data1  = datum d
+    stack1 = record { top = (next d) }
+
+pop2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+pop2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = pop2SingleLinkedStack' {n} {m} stack cs
+  where
+    pop2SingleLinkedStack' : {n m : Level } {t : Set m }  -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+    pop2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs (record {top = (next d1)}) (Just (datum d)) (Just (datum d1))
+
+
+getSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> t) -> t
+getSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack (Just data1)
+  where
+    data1  = datum d
+
+get2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+get2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = get2SingleLinkedStack' {n} {m} stack cs
+  where
+    get2SingleLinkedStack' : {n m : Level} {t : Set m } -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+    get2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs stack (Just (datum d)) (Just (datum d1))
+
+clearSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} -> SingleLinkedStack a -> (SingleLinkedStack a -> t) -> t
+clearSingleLinkedStack stack next = next (record {top = Nothing})
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaSingleLinkedStack.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,63 @@
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+push = pushSingleLinkedStack
+; pop  = popSingleLinkedStack
+; pop2 = pop2SingleLinkedStack
+; get  = getSingleLinkedStack
+; get2 = get2SingleLinkedStack
+; clear = clearSingleLinkedStack
+}
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+stack = emptySingleLinkedStack ;
+stackMethods = singleLinkedStackSpec
+}
+
+-- Implementation
+
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} @$\rightarrow$@ SingleLinkedStack Data @$\rightarrow$@ Data @$\rightarrow$@ (Code : SingleLinkedStack Data @$\rightarrow$@ t) @$\rightarrow$@ t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+
+popSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+popSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack1 (Just data1)
+  where
+    data1  = datum d
+    stack1 = record { top = (next d) }
+
+pop2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+pop2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = pop2SingleLinkedStack' {n} {m} stack cs
+  where
+    pop2SingleLinkedStack' : {n m : Level } {t : Set m }  @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+    pop2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs (record {top = (next d1)}) (Just (datum d)) (Just (datum d1))
+
+
+getSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+getSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack (Just data1)
+  where
+    data1  = datum d
+
+get2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+get2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = get2SingleLinkedStack' {n} {m} stack cs
+  where
+    get2SingleLinkedStack' : {n m : Level} {t : Set m } @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+    get2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs stack (Just (datum d)) (Just (datum d1))
+
+clearSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (SingleLinkedStack a @$\rightarrow$@ t) @$\rightarrow$@ t
+clearSingleLinkedStack stack next = next (record {top = Nothing})
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStack.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+data Element (a : Set) : Set where
+  cons : a -> Maybe (Element a) -> Element a
+
+datum : {a : Set} -> Element a -> a
+datum (cons a _) = a
+
+next : {a : Set} -> Element a -> Maybe (Element a)
+next (cons _ n) = n
+
+record SingleLinkedStack (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStack.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+data Element (a : Set) : Set where
+  cons : a @$\rightarrow$@ Maybe (Element a) @$\rightarrow$@ Element a
+
+datum : {a : Set} @$\rightarrow$@ Element a @$\rightarrow$@ a
+datum (cons a _) = a
+
+next : {a : Set} @$\rightarrow$@ Element a @$\rightarrow$@ Maybe (Element a)
+next (cons _ n) = n
+
+record SingleLinkedStack (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackDS.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,17 @@
+record Context : Set where
+  field
+    -- fields for stack
+    element : Maybe A
+
+
+open import subtype Context as N
+
+record Meta  : Set₁ where
+  field
+    -- context as set of data segments
+    context : Context
+    stack   : SingleLinkedStack A
+    nextCS  : N.CodeSegment Context Context
+
+open import subtype Meta as M
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackDS.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,17 @@
+record Context : Set where
+  field
+    -- fields for stack
+    element : Maybe A
+
+
+open import subtype Context as N
+
+record Meta  : Set@$\_{1}$@ where
+  field
+    -- context as set of data segments
+    context : Context
+    stack   : SingleLinkedStack A
+    nextCS  : N.CodeSegment Context Context
+
+open import subtype Meta as M
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackImpl.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,19 @@
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} -> SingleLinkedStack Data -> Data -> (Code : SingleLinkedStack Data -> t) -> t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+-- Basic stack implementations are specifications of a Stack
+
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} -> StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+                           push = pushSingleLinkedStack
+                         ; pop  = popSingleLinkedStack
+                         }
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} -> Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+                        stack = emptySingleLinkedStack ;
+                        tackMethods = singleLinkedStackSpec
+                        }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackImpl.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,19 @@
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} @$\rightarrow$@ SingleLinkedStack Data @$\rightarrow$@ Data @$\rightarrow$@ (Code : SingleLinkedStack Data @$\rightarrow$@ t) @$\rightarrow$@ t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+-- Basic stack implementations are specifications of a Stack
+
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+                           push = pushSingleLinkedStack
+                         ; pop  = popSingleLinkedStack
+                         }
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+                        stack = emptySingleLinkedStack ;
+                        tackMethods = singleLinkedStackSpec
+                        }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackSomeState.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+stackInSomeState : {l m : Level} {D : Set l} {t : Set m} (s : SingleLinkedStack D) -> Stack {l} {m} D {t}  ( SingleLinkedStack  D)
+stackInSomeState s =  record { stack = s ; stackMethods = singleLinkedStackSpec }
+
+push->push->pop2 : {l : Level} {D : Set l} (x y : D) (s : SingleLinkedStack D) -> pushStack (stackInSomeState s) x (\s1 -> pushStack s1 y (\s2 -> pop2Stack s2 (\s3 y1 x1 -> (Just x ≡ x1) ∧ (Just y ≡ y1))))
+push->push->pop2 {l} {D} x y s = record {pi1 = refl ; pi2 = refl}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackSomeState.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+stackInSomeState : {l m : Level} {D : Set l} {t : Set m} (s : SingleLinkedStack D) @$\rightarrow$@ Stack {l} {m} D {t}  ( SingleLinkedStack  D)
+stackInSomeState s =  record { stack = s ; stackMethods = singleLinkedStackSpec }
+
+push@$\rightarrow$@push@$\rightarrow$@pop2 : {l : Level} {D : Set l} (x y : D) (s : SingleLinkedStack D) @$\rightarrow$@ pushStack (stackInSomeState s) x (\s1 @$\rightarrow$@ pushStack s1 y (\s2 @$\rightarrow$@ pop2Stack s2 (\s3 y1 x1 @$\rightarrow$@ (Just x @$\equiv$@ x1) @$\wedge$@ (Just y @$\equiv$@ y1))))
+push@$\rightarrow$@push@$\rightarrow$@pop2 {l} {D} x y s = record {pi1 = refl ; pi2 = refl}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackTest.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,22 @@
+-- after push 1 and 2, pop2 get 1 and 2
+
+testStack02 : {m : Level } ->  ( Stack  ℕ (SingleLinkedStack ℕ) -> Bool {m} ) -> Bool {m}
+testStack02 cs = pushStack createSingleLinkedStack 1 (\s -> pushStack s 2 cs)
+
+
+testStack031 : (d1 d2 : ℕ ) -> Bool {Zero}
+testStack031 2 1 = True
+testStack031 _ _ = False
+
+testStack032 : (d1 d2 : Maybe ℕ) -> Bool {Zero}
+testStack032  (Just d1) (Just d2) = testStack031 d1 d2
+testStack032  _ _ = False
+
+testStack03 : {m : Level } -> Stack  ℕ (SingleLinkedStack ℕ) -> ((Maybe ℕ) -> (Maybe ℕ) -> Bool {m} ) -> Bool {m}
+testStack03 s cs = pop2Stack s (\s d1 d2 -> cs d1 d2 )
+
+testStack04 : Bool
+testStack04 = testStack02 (\s -> testStack03 s testStack032)
+
+testStack05 : testStack04 ≡ True
+testStack05 = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaStackTest.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,22 @@
+-- after push 1 and 2, pop2 get 1 and 2
+
+testStack02 : {m : Level } @$\rightarrow$@  ( Stack  @$\mathbb{N}$@ (SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ Bool {m} ) @$\rightarrow$@ Bool {m}
+testStack02 cs = pushStack createSingleLinkedStack 1 (\s @$\rightarrow$@ pushStack s 2 cs)
+
+
+testStack031 : (d1 d2 : @$\mathbb{N}$@ ) @$\rightarrow$@ Bool {Zero}
+testStack031 2 1 = True
+testStack031 _ _ = False
+
+testStack032 : (d1 d2 : Maybe @$\mathbb{N}$@) @$\rightarrow$@ Bool {Zero}
+testStack032  (Just d1) (Just d2) = testStack031 d1 d2
+testStack032  _ _ = False
+
+testStack03 : {m : Level } @$\rightarrow$@ Stack  @$\mathbb{N}$@ (SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ ((Maybe @$\mathbb{N}$@) @$\rightarrow$@ (Maybe @$\mathbb{N}$@) @$\rightarrow$@ Bool {m} ) @$\rightarrow$@ Bool {m}
+testStack03 s cs = pop2Stack s (\s d1 d2 @$\rightarrow$@ cs d1 d2 )
+
+testStack04 : Bool
+testStack04 = testStack02 (\s @$\rightarrow$@ testStack03 s testStack032)
+
+testStack05 : testStack04 @$\equiv$@ True
+testStack05 = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTree.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,22 @@
+record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    putImpl : treeImpl -> a -> (treeImpl -> t) -> t
+    getImpl  : treeImpl -> (treeImpl -> Maybe a -> t) -> t
+open TreeMethods
+
+record Tree  {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    tree : treeImpl
+    treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
+  putTree : a -> (Tree treeImpl -> t) -> t
+  putTree d next = putImpl (treeMethods ) tree d (\t1 -> next (record {tree = t1 ; treeMethods = treeMethods} ))
+  getTree : (Tree treeImpl -> Maybe a -> t) -> t
+  getTree next = getImpl (treeMethods ) tree (\t1 d -> next (record {tree = t1 ; treeMethods = treeMethods} ) d )
+open Tree
+
+record RedBlackTree {n m : Level } {t : Set m} (a k : Set n) : Set (m Level.⊔ n) where
+  field
+    root : Maybe (Node a k)
+    nodeStack : SingleLinkedStack  (Node a k)
+    compare : k -> k -> CompareResult {n}
+open RedBlackTree
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTree.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,22 @@
+record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    putImpl : treeImpl @$\rightarrow$@ a @$\rightarrow$@ (treeImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+    getImpl  : treeImpl @$\rightarrow$@ (treeImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+open TreeMethods
+
+record Tree  {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    tree : treeImpl
+    treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
+  putTree : a @$\rightarrow$@ (Tree treeImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+  putTree d next = putImpl (treeMethods ) tree d (\t1 @$\rightarrow$@ next (record {tree = t1 ; treeMethods = treeMethods} ))
+  getTree : (Tree treeImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+  getTree next = getImpl (treeMethods ) tree (\t1 d @$\rightarrow$@ next (record {tree = t1 ; treeMethods = treeMethods} ) d )
+open Tree
+
+record RedBlackTree {n m : Level } {t : Set m} (a k : Set n) : Set (m Level.@$\sqcup$@ n) where
+  field
+    root : Maybe (Node a k)
+    nodeStack : SingleLinkedStack  (Node a k)
+    compare : k @$\rightarrow$@ k @$\rightarrow$@ CompareResult {n}
+open RedBlackTree
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeDebug.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+test31 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 1 1
+  $ \t -> putTree1 t 2 2
+  $ \t -> putTree1 t 3 3
+  $ \t -> putTree1 t 4 4
+  $ \t -> getRedBlackTree t 4
+  $ \t x -> x
+
+-- Just
+-- (record
+-- { key = 4
+-- ; value = 4
+-- ; right = Nothing
+-- ; left = Nothing
+-- ; color = Red
+-- })
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeDebug.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+test31 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 1 1
+  $ \t @$\rightarrow$@ putTree1 t 2 2
+  $ \t @$\rightarrow$@ putTree1 t 3 3
+  $ \t @$\rightarrow$@ putTree1 t 4 4
+  $ \t @$\rightarrow$@ getRedBlackTree t 4
+  $ \t x @$\rightarrow$@ x
+
+-- Just
+-- (record
+-- { key = 4
+-- ; value = 4
+-- ; right = Nothing
+-- ; left = Nothing
+-- ; color = Red
+-- })
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeDebugReturnNode4.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,16 @@
+test31 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 1 1
+$ \t -> putTree1 t 2 2
+$ \t -> putTree1 t 3 3
+$ \t -> putTree1 t 4 4
+$ \t -> getRedBlackTree t 4
+$ \t x -> x
+
+-- C-c C-n test31 return
+  -- Just
+  -- (record
+  -- { key = 4
+  -- ; value = 4
+  -- ; right = Nothing
+  -- ; left = Nothing
+  -- ; color = Red
+  -- })
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeDebugReturnNode4.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,16 @@
+test31 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 1 1
+$ \t @$\rightarrow$@ putTree1 t 2 2
+$ \t @$\rightarrow$@ putTree1 t 3 3
+$ \t @$\rightarrow$@ putTree1 t 4 4
+$ \t @$\rightarrow$@ getRedBlackTree t 4
+$ \t x @$\rightarrow$@ x
+
+-- C-c C-n test31 return
+  -- Just
+  -- (record
+  -- { key = 4
+  -- ; value = 4
+  -- ; right = Nothing
+  -- ; left = Nothing
+  -- ; color = Red
+  -- })
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeImpl.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,14 @@
+record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    putImpl : treeImpl -> a -> (treeImpl -> t) -> t
+  getImpl  : treeImpl -> (treeImpl -> Maybe a -> t) -> t
+
+record Tree  {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    tree : treeImpl
+    treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
+  putTree : a -> (Tree treeImpl -> t) -> t
+  putTree d next = putImpl (treeMethods ) tree d (\t1 -> next (record {tree = t1 ; treeMethods = treeMethods} ))
+  getTree : (Tree treeImpl -> Maybe a -> t) -> t
+  getTree next = getImpl (treeMethods ) tree (\t1 d -> next (record {tree = t1 ; treeMethods = treeMethods} ) d )
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeImpl.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,14 @@
+record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    putImpl : treeImpl @$\rightarrow$@ a @$\rightarrow$@ (treeImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+  getImpl  : treeImpl @$\rightarrow$@ (treeImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+
+record Tree  {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    tree : treeImpl
+    treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
+  putTree : a @$\rightarrow$@ (Tree treeImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+  putTree d next = putImpl (treeMethods ) tree d (\t1 @$\rightarrow$@ next (record {tree = t1 ; treeMethods = treeMethods} ))
+  getTree : (Tree treeImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+  getTree next = getImpl (treeMethods ) tree (\t1 d @$\rightarrow$@ next (record {tree = t1 ; treeMethods = treeMethods} ) d )
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeProof.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,34 @@
+redBlackInSomeState : { m : Level } (a : Set Level.zero) (n : Maybe (Node a ℕ)) {t : Set m} -> RedBlackTree {Level.zero} {m} {t} a ℕ
+redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compare2 }
+
+putTest1 :{ m : Level } (n : Maybe (Node ℕ ℕ))
+         -> (k : ℕ) (x : ℕ)
+         -> putTree1 {_} {_} {ℕ} {ℕ} (redBlackInSomeState {_} ℕ n {Set Level.zero}) k x
+         (\ t -> getRedBlackTree t k (\ t x1 -> check2 x1 x  ≡ True))
+putTest1 n k x with n
+...  | Just n1 = lemma2 ( record { top = Nothing } )
+   where
+     lemma2 : (s : SingleLinkedStack (Node ℕ ℕ) ) -> putTree1 (record { root = Just n1 ; nodeStack = s ; compare = compare2 }) k x (λ t →
+         GetRedBlackTree.checkNode t k (λ t₁ x1 → check2 x1 x ≡ True) (root t))
+     lemma2 s with compare2 k (key n1)
+     ... |  EQ = lemma3 {!!}
+        where
+           lemma3 : compare2 k (key n1) ≡  EQ -> getRedBlackTree {_} {_} {ℕ} {ℕ} {Set Level.zero} ( record {  root = Just ( record {
+               key   = key n1 ; value = x ; right = right n1 ; left  = left n1 ; color = Black
+               } ) ; nodeStack = s ; compare = λ x₁ y → compare2 x₁ y  } ) k ( \ t x1 -> check2 x1 x  ≡ True)
+           lemma3 eq with compare2 x x | putTest1Lemma2 x
+           ... | EQ | refl with compare2 k (key n1)  | eq
+           ...              | EQ | refl with compare2 x x | putTest1Lemma2 x
+           ...                    | EQ | refl = refl
+     ... |  GT = {!!}
+     ... |  LT = {!!}
+
+...  | Nothing =  lemma1
+   where
+     lemma1 : getRedBlackTree {_} {_} {ℕ} {ℕ} {Set Level.zero} ( record {  root = Just ( record {
+               key   = k ; value = x ; right = Nothing ; left  = Nothing ; color = Red
+        } ) ; nodeStack = record { top = Nothing } ; compare = λ x₁ y → compare2 x₁ y  } ) k
+        ( \ t x1 -> check2 x1 x  ≡ True)
+     lemma1 with compare2 k k | putTest1Lemma2 k
+     ... | EQ | refl with compare2 x x | putTest1Lemma2 x
+     ...              | EQ | refl = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeProof.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,34 @@
+redBlackInSomeState : { m : Level } (a : Set Level.zero) (n : Maybe (Node a @$\mathbb{N}$@)) {t : Set m} @$\rightarrow$@ RedBlackTree {Level.zero} {m} {t} a @$\mathbb{N}$@
+redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compare2 }
+
+putTest1 :{ m : Level } (n : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@))
+         @$\rightarrow$@ (k : @$\mathbb{N}$@) (x : @$\mathbb{N}$@)
+         @$\rightarrow$@ putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (redBlackInSomeState {_} @$\mathbb{N}$@ n {Set Level.zero}) k x
+         (\ t @$\rightarrow$@ getRedBlackTree t k (\ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True))
+putTest1 n k x with n
+...  | Just n1 = lemma2 ( record { top = Nothing } )
+   where
+     lemma2 : (s : SingleLinkedStack (Node @$\mathbb{N}$@ @$\mathbb{N}$@) ) @$\rightarrow$@ putTree1 (record { root = Just n1 ; nodeStack = s ; compare = compare2 }) k x (@$\lambda$@ t @$\rightarrow$@
+         GetRedBlackTree.checkNode t k (@$\lambda$@ t@$\_{1}$@ x1 @$\rightarrow$@ check2 x1 x @$\equiv$@ True) (root t))
+     lemma2 s with compare2 k (key n1)
+     ... |  EQ = lemma3 {!!}
+        where
+           lemma3 : compare2 k (key n1) @$\equiv$@  EQ @$\rightarrow$@ getRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {Set Level.zero} ( record {  root = Just ( record {
+               key   = key n1 ; value = x ; right = right n1 ; left  = left n1 ; color = Black
+               } ) ; nodeStack = s ; compare = @$\lambda$@ x@$\_{1}$@ y @$\rightarrow$@ compare2 x@$\_{1}$@ y  } ) k ( \ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True)
+           lemma3 eq with compare2 x x | putTest1Lemma2 x
+           ... | EQ | refl with compare2 k (key n1)  | eq
+           ...              | EQ | refl with compare2 x x | putTest1Lemma2 x
+           ...                    | EQ | refl = refl
+     ... |  GT = {!!}
+     ... |  LT = {!!}
+
+...  | Nothing =  lemma1
+   where
+     lemma1 : getRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {Set Level.zero} ( record {  root = Just ( record {
+               key   = k ; value = x ; right = Nothing ; left  = Nothing ; color = Red
+        } ) ; nodeStack = record { top = Nothing } ; compare = @$\lambda$@ x@$\_{1}$@ y @$\rightarrow$@ compare2 x@$\_{1}$@ y  } ) k
+        ( \ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True)
+     lemma1 with compare2 k k | putTest1Lemma2 k
+     ... | EQ | refl with compare2 x x | putTest1Lemma2 x
+     ...              | EQ | refl = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeTest.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+test31 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 1 1
+$ \t -> putTree1 t 2 2
+$ \t -> putTree1 t 3 3
+$ \t -> putTree1 t 4 4
+$ \t -> getRedBlackTree t 4
+$ \t x -> x
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTreeTest.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+test31 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 1 1
+$ \t @$\rightarrow$@ putTree1 t 2 2
+$ \t @$\rightarrow$@ putTree1 t 3 3
+$ \t @$\rightarrow$@ putTree1 t 4 4
+$ \t @$\rightarrow$@ getRedBlackTree t 4
+$ \t x @$\rightarrow$@ x
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTypeClass.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+record Eq (A : Set) : Set where
+  field
+    _==_ : A -> A -> Bool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaTypeClass.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+record Eq (A : Set) : Set where
+  field
+    _==_ : A @$\rightarrow$@ A @$\rightarrow$@ Bool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaWhere.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+f : Int -> Int -> Int
+f a b c = (t a) + (t b) + (t c)
+  where
+    t x = x + x + x
+
+f' : Int -> Int -> Int
+f' a b c = (a + a + a) + (b + b + b) + (c + c + c)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/AgdaWhere.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+f : Int @$\rightarrow$@ Int @$\rightarrow$@ Int
+f a b c = (t a) + (t b) + (t c)
+  where
+    t x = x + x + x
+
+f' : Int @$\rightarrow$@ Int @$\rightarrow$@ Int
+f' a b c = (a + a + a) + (b + b + b) + (c + c + c)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CodeSegment.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+data CodeSegment {l1 l2 : Level} (I : Set l1) (O : Set l2) : Set (l ⊔ l1 ⊔ l2) where
+  cs : (I -> O) -> CodeSegment I O
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CodeSegment.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+data CodeSegment {l1 l2 : Level} (I : Set l1) (O : Set l2) : Set (l @$\sqcup$@ l1 @$\sqcup$@ l2) where
+  cs : (I @$\rightarrow$@ O) @$\rightarrow$@ CodeSegment I O
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CodeSegments.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+cs2 : CodeSegment ds1 ds1
+cs2 = cs id
+
+cs1 : CodeSegment ds1 ds1
+cs1 = cs (\d -> goto cs2 d)
+
+cs0 : CodeSegment ds0 ds1
+cs0 = cs (\d -> goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+main : ds1
+main = goto cs0 (record {a = 100 ; b = 50})
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/CodeSegments.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+cs2 : CodeSegment ds1 ds1
+cs2 = cs id
+
+cs1 : CodeSegment ds1 ds1
+cs1 = cs (\d @$\rightarrow$@ goto cs2 d)
+
+cs0 : CodeSegment ds0 ds1
+cs0 = cs (\d @$\rightarrow$@ goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+main : ds1
+main = goto cs0 (record {a = 100 ; b = 50})
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/DataSegment.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+record ds0 : Set where
+  field
+    a : Int
+    b : Int
+
+record ds1 : Set where
+  field
+    c : Int
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/DataSegment.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+record ds0 : Set where
+  field
+    a : Int
+    b : Int
+
+record ds1 : Set where
+  field
+    c : Int
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Equiv.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,1 @@
+data _≡_ {a} {A : Set a} (x : A) : A → Set a where
  refl : x ≡ x
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Equiv.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,1 @@
+data _@$\equiv$@_ {a} {A : Set a} (x : A) : A @$\rightarrow$@ Set a where
  refl : x @$\equiv$@ x
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Exec.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+exec : {l1 l2 : Level} {I : Set l1} {O : Set l2}
+       {{_ : DataSegment I}} {{_ : DataSegment O}}
+       -> CodeSegment I O -> Context -> Context
+exec {l} {{i}} {{o}}  (cs b) c = set o c (b (get i c))
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Exec.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+exec : {l1 l2 : Level} {I : Set l1} {O : Set l2}
+       {{_ : DataSegment I}} {{_ : DataSegment O}}
+       @$\rightarrow$@ CodeSegment I O @$\rightarrow$@ Context @$\rightarrow$@ Context
+exec {l} {{i}} {{o}}  (cs b) c = set o c (b (get i c))
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Goto.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+goto : {l1 l2 : Level} {I : Set l1} {O : Set l2}
+   -> CodeSegment I O -> I -> O
+goto (cs b) i = b i
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Goto.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+goto : {l1 l2 : Level} {I : Set l1} {O : Set l2}
+   @$\rightarrow$@ CodeSegment I O @$\rightarrow$@ I @$\rightarrow$@ O
+goto (cs b) i = b i
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Hoare.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,79 @@
+module Hoare
+        (PrimComm : Set)
+        (Cond : Set)
+        (Axiom : Cond -> PrimComm -> Cond -> Set)
+        (Tautology : Cond -> Cond -> Set)
+        (_and_ :  Cond -> Cond -> Cond)
+        (neg :  Cond -> Cond )
+  where
+
+data Comm : Set where
+  Skip  : Comm
+  Abort : Comm
+  PComm : PrimComm -> Comm
+  Seq   : Comm -> Comm -> Comm
+  If    : Cond -> Comm -> Comm -> Comm
+  While : Cond -> Comm -> Comm
+
+-- Hoare Triple
+data HT : Set where
+  ht : Cond -> Comm -> Cond -> HT
+
+{-
+                prPre              pr              prPost
+             -------------  ------------------  ----------------
+             bPre => bPre'  {bPre'} c {bPost'}  bPost' => bPost
+Weakening : ----------------------------------------------------
+                       {bPre} c {bPost}
+
+Assign: ----------------------------
+         {bPost[v<-e]} v:=e {bPost}
+
+             pr1                pr2
+      -----------------  ------------------
+      {bPre} cm1 {bMid}  {bMid} cm2 {bPost}
+Seq: ---------------------------------------
+      {bPre} cm1 ; cm2 {bPost}
+
+               pr1                         pr2
+     -----------------------  ---------------------------
+     {bPre /\ c} cm1 {bPost}  {bPre /\ neg c} cm2 {bPost}
+If: ------------------------------------------------------
+     {bPre} If c then cm1 else cm2 fi {bPost}
+
+                          pr
+                 -------------------
+                 {inv /\ c} cm {inv}
+While: ---------------------------------------
+        {inv} while c do cm od {inv /\ neg c}
+-}
+
+
+data HTProof : Cond -> Comm -> Cond -> Set where
+  PrimRule : {bPre : Cond} -> {pcm : PrimComm} -> {bPost : Cond} ->
+             (pr : Axiom bPre pcm bPost) ->
+             HTProof bPre (PComm pcm) bPost
+  SkipRule : (b : Cond) -> HTProof b Skip b
+  AbortRule : (bPre : Cond) -> (bPost : Cond) ->
+              HTProof bPre Abort bPost
+  WeakeningRule : {bPre : Cond} -> {bPre' : Cond} -> {cm : Comm} ->
+                {bPost' : Cond} -> {bPost : Cond} ->
+                Tautology bPre bPre' ->
+                HTProof bPre' cm bPost' ->
+                Tautology bPost' bPost ->
+                HTProof bPre cm bPost
+  SeqRule : {bPre : Cond} -> {cm1 : Comm} -> {bMid : Cond} ->
+            {cm2 : Comm} -> {bPost : Cond} ->
+            HTProof bPre cm1 bMid ->
+            HTProof bMid cm2 bPost ->
+            HTProof bPre (Seq cm1 cm2) bPost
+  IfRule : {cmThen : Comm} -> {cmElse : Comm} ->
+           {bPre : Cond} -> {bPost : Cond} ->
+           {b : Cond} ->
+           HTProof (bPre and b) cmThen bPost ->
+           HTProof (bPre and neg b) cmElse bPost ->
+           HTProof bPre (If b cmThen cmElse) bPost
+  WhileRule : {cm : Comm} -> {bInv : Cond} -> {b : Cond} ->
+              HTProof (bInv and b) cm bInv ->
+              HTProof bInv (While b cm) (bInv and neg b)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Hoare.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,79 @@
+module Hoare
+        (PrimComm : Set)
+        (Cond : Set)
+        (Axiom : Cond @$\rightarrow$@ PrimComm @$\rightarrow$@ Cond @$\rightarrow$@ Set)
+        (Tautology : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Set)
+        (_and_ :  Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond)
+        (neg :  Cond @$\rightarrow$@ Cond )
+  where
+
+data Comm : Set where
+  Skip  : Comm
+  Abort : Comm
+  PComm : PrimComm @$\rightarrow$@ Comm
+  Seq   : Comm @$\rightarrow$@ Comm @$\rightarrow$@ Comm
+  If    : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Comm @$\rightarrow$@ Comm
+  While : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Comm
+
+-- Hoare Triple
+data HT : Set where
+  ht : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Cond @$\rightarrow$@ HT
+
+{-
+                prPre              pr              prPost
+             -------------  ------------------  ----------------
+             bPre => bPre'  {bPre'} c {bPost'}  bPost' => bPost
+Weakening : ----------------------------------------------------
+                       {bPre} c {bPost}
+
+Assign: ----------------------------
+         {bPost[v<-e]} v:=e {bPost}
+
+             pr1                pr2
+      -----------------  ------------------
+      {bPre} cm1 {bMid}  {bMid} cm2 {bPost}
+Seq: ---------------------------------------
+      {bPre} cm1 ; cm2 {bPost}
+
+               pr1                         pr2
+     -----------------------  ---------------------------
+     {bPre @$\wedge$@ c} cm1 {bPost}  {bPre @$\wedge$@ neg c} cm2 {bPost}
+If: ------------------------------------------------------
+     {bPre} If c then cm1 else cm2 fi {bPost}
+
+                          pr
+                 -------------------
+                 {inv @$\wedge$@ c} cm {inv}
+While: ---------------------------------------
+        {inv} while c do cm od {inv @$\wedge$@ neg c}
+-}
+
+
+data HTProof : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Cond @$\rightarrow$@ Set where
+  PrimRule : {bPre : Cond} @$\rightarrow$@ {pcm : PrimComm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+             (pr : Axiom bPre pcm bPost) @$\rightarrow$@
+             HTProof bPre (PComm pcm) bPost
+  SkipRule : (b : Cond) @$\rightarrow$@ HTProof b Skip b
+  AbortRule : (bPre : Cond) @$\rightarrow$@ (bPost : Cond) @$\rightarrow$@
+              HTProof bPre Abort bPost
+  WeakeningRule : {bPre : Cond} @$\rightarrow$@ {bPre' : Cond} @$\rightarrow$@ {cm : Comm} @$\rightarrow$@
+                {bPost' : Cond} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+                Tautology bPre bPre' @$\rightarrow$@
+                HTProof bPre' cm bPost' @$\rightarrow$@
+                Tautology bPost' bPost @$\rightarrow$@
+                HTProof bPre cm bPost
+  SeqRule : {bPre : Cond} @$\rightarrow$@ {cm1 : Comm} @$\rightarrow$@ {bMid : Cond} @$\rightarrow$@
+            {cm2 : Comm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+            HTProof bPre cm1 bMid @$\rightarrow$@
+            HTProof bMid cm2 bPost @$\rightarrow$@
+            HTProof bPre (Seq cm1 cm2) bPost
+  IfRule : {cmThen : Comm} @$\rightarrow$@ {cmElse : Comm} @$\rightarrow$@
+           {bPre : Cond} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+           {b : Cond} @$\rightarrow$@
+           HTProof (bPre and b) cmThen bPost @$\rightarrow$@
+           HTProof (bPre and neg b) cmElse bPost @$\rightarrow$@
+           HTProof bPre (If b cmThen cmElse) bPost
+  WhileRule : {cm : Comm} @$\rightarrow$@ {bInv : Cond} @$\rightarrow$@ {b : Cond} @$\rightarrow$@
+              HTProof (bInv and b) cm bInv @$\rightarrow$@
+              HTProof bInv (While b cm) (bInv and neg b)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HoareSoundness.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,197 @@
+{-# OPTIONS --universe-polymorphism #-}
+
+open import Level
+open import Data.Nat.Base
+open import Data.Product
+open import Data.Bool.Base
+open import Data.Empty
+open import Data.Sum
+open import Relation.Binary
+open import Relation.Nullary
+open import Relation.Binary.Core
+open import Relation.Binary.PropositionalEquality
+open import RelOp
+open import utilities
+
+module HoareSoundness
+    (Cond : Set)
+    (PrimComm : Set)
+    (neg : Cond -> Cond)
+    (_/\_ : Cond -> Cond -> Cond)
+    (Tautology : Cond -> Cond -> Set)
+    (State : Set)
+    (SemCond : Cond -> State -> Set)
+    (tautValid : (b1 b2 : Cond) -> Tautology b1 b2 ->
+                 (s : State) -> SemCond b1 s -> SemCond b2 s)
+    (respNeg : (b : Cond) -> (s : State) ->
+               Iff (SemCond (neg b) s) (¬ SemCond b s))
+    (respAnd : (b1 b2 : Cond) -> (s : State) ->
+               Iff (SemCond (b1 /\ b2) s)
+                   ((SemCond b1 s) × (SemCond b2 s)))
+    (PrimSemComm : ∀ {l} -> PrimComm -> Rel State l)
+    (Axiom : Cond -> PrimComm -> Cond -> Set)
+    (axiomValid : ∀ {l} -> (bPre : Cond) -> (pcm : PrimComm) -> (bPost : Cond) ->
+                  (ax : Axiom bPre pcm bPost) -> (s1 s2 : State) ->
+                  SemCond bPre s1 -> PrimSemComm {l} pcm s1 s2 -> SemCond bPost s2) where
+
+open import Hoare PrimComm Cond Axiom Tautology _/\_ neg
+
+open import RelOp
+module RelOpState = RelOp State
+
+NotP : {S : Set} -> Pred S -> Pred S
+NotP X s = ¬ X s
+
+_\/_ : Cond -> Cond -> Cond
+b1 \/ b2 = neg (neg b1 /\ neg b2)
+
+when : {X  Y  Z : Set} -> (X -> Z) -> (Y -> Z) ->
+       X ⊎ Y -> Z
+when f g (inj₁ x) = f x
+when f g (inj₂ y) = g y
+
+-- semantics of commands
+SemComm : Comm -> Rel State (Level.zero)
+SemComm Skip = RelOpState.deltaGlob
+SemComm Abort = RelOpState.emptyRel
+SemComm (PComm pc) = PrimSemComm pc
+SemComm (Seq c1 c2) = RelOpState.comp (SemComm c1) (SemComm c2)
+SemComm (If b c1 c2)
+  = RelOpState.union
+      (RelOpState.comp (RelOpState.delta (SemCond b))
+                       (SemComm c1))
+      (RelOpState.comp (RelOpState.delta (NotP (SemCond b)))
+                       (SemComm c2))
+SemComm (While b c)
+  = RelOpState.unionInf
+      (λ (n : ℕ) ->
+        RelOpState.comp (RelOpState.repeat
+                           n
+                           (RelOpState.comp
+                             (RelOpState.delta (SemCond b))
+                             (SemComm c)))
+                         (RelOpState.delta (NotP (SemCond b))))
+
+Satisfies : Cond -> Comm -> Cond -> Set
+Satisfies bPre cm bPost
+  = (s1 : State) -> (s2 : State) ->
+      SemCond bPre s1 -> SemComm cm s1 s2 -> SemCond bPost s2
+
+Soundness : {bPre : Cond} -> {cm : Comm} -> {bPost : Cond} ->
+            HTProof bPre cm bPost -> Satisfies bPre cm bPost
+Soundness (PrimRule {bPre} {cm} {bPost} pr) s1 s2 q1 q2
+  = axiomValid bPre cm bPost pr s1 s2 q1 q2
+Soundness {.bPost} {.Skip} {bPost} (SkipRule .bPost) s1 s2 q1 q2
+  = substId1 State {Level.zero} {State} {s1} {s2} (proj₂ q2) (SemCond bPost) q1
+Soundness {bPre} {.Abort} {bPost} (AbortRule .bPre .bPost) s1 s2 q1 ()
+Soundness (WeakeningRule {bPre} {bPre'} {cm} {bPost'} {bPost} tautPre pr tautPost)
+          s1 s2 q1 q2
+  = let hyp : Satisfies bPre' cm bPost'
+        hyp = Soundness pr
+        r1 : SemCond bPre' s1
+        r1 = tautValid bPre bPre' tautPre s1 q1
+        r2 : SemCond bPost' s2
+        r2 = hyp s1 s2 r1 q2
+    in tautValid bPost' bPost tautPost s2 r2
+Soundness (SeqRule {bPre} {cm1} {bMid} {cm2} {bPost} pr1 pr2)
+           s1 s2 q1 q2
+  = let hyp1 : Satisfies bPre cm1 bMid
+        hyp1 = Soundness pr1
+        hyp2 : Satisfies bMid cm2 bPost
+        hyp2 = Soundness pr2
+        sMid : State
+        sMid = proj₁ q2
+        r1 : SemComm cm1 s1 sMid × SemComm cm2 sMid s2
+        r1 = proj₂ q2
+        r2 : SemComm cm1 s1 sMid
+        r2 = proj₁ r1
+        r3 : SemComm cm2 sMid s2
+        r3 = proj₂ r1
+        r4 : SemCond bMid sMid
+        r4 = hyp1 s1 sMid q1 r2
+    in hyp2 sMid s2 r4 r3
+Soundness (IfRule {cmThen} {cmElse} {bPre} {bPost} {b} pThen pElse)
+          s1 s2 q1 q2
+  = let hypThen : Satisfies (bPre /\ b) cmThen bPost
+        hypThen = Soundness pThen
+        hypElse : Satisfies (bPre /\ neg b) cmElse bPost
+        hypElse = Soundness pElse
+        rThen : RelOpState.comp
+                  (RelOpState.delta (SemCond b))
+                  (SemComm cmThen) s1 s2 ->
+                SemCond bPost s2
+        rThen = λ h ->
+                  let t1 : SemCond b s1 × SemComm cmThen s1 s2
+                      t1 = (proj₂ (RelOpState.deltaRestPre
+                                     (SemCond b)
+                                     (SemComm cmThen) s1 s2)) h
+                      t2 : SemCond (bPre /\ b) s1
+                      t2 = (proj₂ (respAnd bPre b s1))
+                           (q1 , proj₁ t1)
+                  in hypThen s1 s2 t2 (proj₂ t1)
+        rElse : RelOpState.comp
+                  (RelOpState.delta (NotP (SemCond b)))
+                  (SemComm cmElse) s1 s2 ->
+                SemCond bPost s2
+        rElse = λ h ->
+                  let t10 : (NotP (SemCond b) s1) ×
+                            (SemComm cmElse s1 s2)
+                      t10 = proj₂ (RelOpState.deltaRestPre
+                                    (NotP (SemCond b)) (SemComm cmElse) s1 s2)
+                            h
+                      t6 : SemCond (neg b) s1
+                      t6 = proj₂ (respNeg b s1) (proj₁ t10)
+                      t7 : SemComm cmElse s1 s2
+                      t7 = proj₂ t10
+                      t8 : SemCond (bPre /\ neg b) s1
+                      t8 = proj₂ (respAnd bPre (neg b) s1)
+                           (q1 , t6)
+                  in hypElse s1 s2 t8 t7
+    in when rThen rElse q2
+Soundness (WhileRule {cm'} {bInv} {b} pr) s1 s2 q1 q2
+  = proj₂ (respAnd bInv (neg b) s2) t20
+    where
+      hyp : Satisfies (bInv /\ b) cm' bInv
+      hyp = Soundness pr
+      n : ℕ
+      n = proj₁ q2
+      Rel1 : ℕ -> Rel State (Level.zero)
+      Rel1 = λ m ->
+               RelOpState.repeat
+                 m
+                 (RelOpState.comp (RelOpState.delta (SemCond b))
+                                  (SemComm cm'))
+      t1 : RelOpState.comp
+             (Rel1 n)
+             (RelOpState.delta (NotP (SemCond b))) s1 s2
+      t1 = proj₂ q2
+      t15 : (Rel1 n s1 s2) × (NotP (SemCond b) s2)
+      t15 = proj₂ (RelOpState.deltaRestPost
+                    (NotP (SemCond b)) (Rel1 n) s1 s2)
+              t1
+      t16 : Rel1 n s1 s2
+      t16 = proj₁ t15
+      t17 : NotP (SemCond b) s2
+      t17 = proj₂ t15
+      lem1 : (m : ℕ) -> (ss2 : State) -> Rel1 m s1 ss2 ->
+             SemCond bInv ss2
+      lem1 ℕ.zero ss2 h
+        = substId1 State (proj₂ h) (SemCond bInv) q1
+      lem1 (ℕ.suc n) ss2 h
+        = let hyp2 : (z : State) -> Rel1 n s1 z ->
+                     SemCond bInv z
+              hyp2 = lem1 n
+              s20 : State
+              s20 = proj₁ h
+              t21 : Rel1 n s1 s20
+              t21 = proj₁ (proj₂ h)
+              t22 : (SemCond b s20) × (SemComm cm' s20 ss2)
+              t22 = proj₂ (RelOpState.deltaRestPre
+                            (SemCond b) (SemComm cm') s20 ss2)
+                    (proj₂ (proj₂ h))
+              t23 : SemCond (bInv /\ b) s20
+              t23 = proj₂ (respAnd bInv b s20)
+                    (hyp2 s20 t21 , proj₁ t22)
+          in hyp s20 ss2 t23 (proj₂ t22)
+      t20 : SemCond bInv s2 × SemCond (neg b) s2
+      t20 = lem1 n s2 t16 , proj₂ (respNeg b s2) t17
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HoareSoundness.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,197 @@
+{-@$\#$@ OPTIONS --universe-polymorphism @$\#$@-}
+
+open import Level
+open import Data.Nat.Base
+open import Data.Product
+open import Data.Bool.Base
+open import Data.Empty
+open import Data.Sum
+open import Relation.Binary
+open import Relation.Nullary
+open import Relation.Binary.Core
+open import Relation.Binary.PropositionalEquality
+open import RelOp
+open import utilities
+
+module HoareSoundness
+    (Cond : Set)
+    (PrimComm : Set)
+    (neg : Cond @$\rightarrow$@ Cond)
+    (_@$\wedge$@_ : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond)
+    (Tautology : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Set)
+    (State : Set)
+    (SemCond : Cond @$\rightarrow$@ State @$\rightarrow$@ Set)
+    (tautValid : (b1 b2 : Cond) @$\rightarrow$@ Tautology b1 b2 @$\rightarrow$@
+                 (s : State) @$\rightarrow$@ SemCond b1 s @$\rightarrow$@ SemCond b2 s)
+    (respNeg : (b : Cond) @$\rightarrow$@ (s : State) @$\rightarrow$@
+               Iff (SemCond (neg b) s) (@$\neg$@ SemCond b s))
+    (respAnd : (b1 b2 : Cond) @$\rightarrow$@ (s : State) @$\rightarrow$@
+               Iff (SemCond (b1 @$\wedge$@ b2) s)
+                   ((SemCond b1 s) @$\times$@ (SemCond b2 s)))
+    (PrimSemComm : @$\forall$@ {l} @$\rightarrow$@ PrimComm @$\rightarrow$@ Rel State l)
+    (Axiom : Cond @$\rightarrow$@ PrimComm @$\rightarrow$@ Cond @$\rightarrow$@ Set)
+    (axiomValid : @$\forall$@ {l} @$\rightarrow$@ (bPre : Cond) @$\rightarrow$@ (pcm : PrimComm) @$\rightarrow$@ (bPost : Cond) @$\rightarrow$@
+                  (ax : Axiom bPre pcm bPost) @$\rightarrow$@ (s1 s2 : State) @$\rightarrow$@
+                  SemCond bPre s1 @$\rightarrow$@ PrimSemComm {l} pcm s1 s2 @$\rightarrow$@ SemCond bPost s2) where
+
+open import Hoare PrimComm Cond Axiom Tautology _@$\wedge$@_ neg
+
+open import RelOp
+module RelOpState = RelOp State
+
+NotP : {S : Set} @$\rightarrow$@ Pred S @$\rightarrow$@ Pred S
+NotP X s = @$\neg$@ X s
+
+_\/_ : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond
+b1 \/ b2 = neg (neg b1 @$\wedge$@ neg b2)
+
+when : {X  Y  Z : Set} @$\rightarrow$@ (X @$\rightarrow$@ Z) @$\rightarrow$@ (Y @$\rightarrow$@ Z) @$\rightarrow$@
+       X ⊎ Y @$\rightarrow$@ Z
+when f g (inj@$\_{1}$@ x) = f x
+when f g (inj@$\_{2}$@ y) = g y
+
+-- semantics of commands
+SemComm : Comm @$\rightarrow$@ Rel State (Level.zero)
+SemComm Skip = RelOpState.deltaGlob
+SemComm Abort = RelOpState.emptyRel
+SemComm (PComm pc) = PrimSemComm pc
+SemComm (Seq c1 c2) = RelOpState.comp (SemComm c1) (SemComm c2)
+SemComm (If b c1 c2)
+  = RelOpState.union
+      (RelOpState.comp (RelOpState.delta (SemCond b))
+                       (SemComm c1))
+      (RelOpState.comp (RelOpState.delta (NotP (SemCond b)))
+                       (SemComm c2))
+SemComm (While b c)
+  = RelOpState.unionInf
+      (@$\lambda$@ (n : @$\mathbb{N}$@) @$\rightarrow$@
+        RelOpState.comp (RelOpState.repeat
+                           n
+                           (RelOpState.comp
+                             (RelOpState.delta (SemCond b))
+                             (SemComm c)))
+                         (RelOpState.delta (NotP (SemCond b))))
+
+Satisfies : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Cond @$\rightarrow$@ Set
+Satisfies bPre cm bPost
+  = (s1 : State) @$\rightarrow$@ (s2 : State) @$\rightarrow$@
+      SemCond bPre s1 @$\rightarrow$@ SemComm cm s1 s2 @$\rightarrow$@ SemCond bPost s2
+
+Soundness : {bPre : Cond} @$\rightarrow$@ {cm : Comm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+            HTProof bPre cm bPost @$\rightarrow$@ Satisfies bPre cm bPost
+Soundness (PrimRule {bPre} {cm} {bPost} pr) s1 s2 q1 q2
+  = axiomValid bPre cm bPost pr s1 s2 q1 q2
+Soundness {.bPost} {.Skip} {bPost} (SkipRule .bPost) s1 s2 q1 q2
+  = substId1 State {Level.zero} {State} {s1} {s2} (proj@$\_{2}$@ q2) (SemCond bPost) q1
+Soundness {bPre} {.Abort} {bPost} (AbortRule .bPre .bPost) s1 s2 q1 ()
+Soundness (WeakeningRule {bPre} {bPre'} {cm} {bPost'} {bPost} tautPre pr tautPost)
+          s1 s2 q1 q2
+  = let hyp : Satisfies bPre' cm bPost'
+        hyp = Soundness pr
+        r1 : SemCond bPre' s1
+        r1 = tautValid bPre bPre' tautPre s1 q1
+        r2 : SemCond bPost' s2
+        r2 = hyp s1 s2 r1 q2
+    in tautValid bPost' bPost tautPost s2 r2
+Soundness (SeqRule {bPre} {cm1} {bMid} {cm2} {bPost} pr1 pr2)
+           s1 s2 q1 q2
+  = let hyp1 : Satisfies bPre cm1 bMid
+        hyp1 = Soundness pr1
+        hyp2 : Satisfies bMid cm2 bPost
+        hyp2 = Soundness pr2
+        sMid : State
+        sMid = proj@$\_{1}$@ q2
+        r1 : SemComm cm1 s1 sMid @$\times$@ SemComm cm2 sMid s2
+        r1 = proj@$\_{2}$@ q2
+        r2 : SemComm cm1 s1 sMid
+        r2 = proj@$\_{1}$@ r1
+        r3 : SemComm cm2 sMid s2
+        r3 = proj@$\_{2}$@ r1
+        r4 : SemCond bMid sMid
+        r4 = hyp1 s1 sMid q1 r2
+    in hyp2 sMid s2 r4 r3
+Soundness (IfRule {cmThen} {cmElse} {bPre} {bPost} {b} pThen pElse)
+          s1 s2 q1 q2
+  = let hypThen : Satisfies (bPre @$\wedge$@ b) cmThen bPost
+        hypThen = Soundness pThen
+        hypElse : Satisfies (bPre @$\wedge$@ neg b) cmElse bPost
+        hypElse = Soundness pElse
+        rThen : RelOpState.comp
+                  (RelOpState.delta (SemCond b))
+                  (SemComm cmThen) s1 s2 @$\rightarrow$@
+                SemCond bPost s2
+        rThen = @$\lambda$@ h @$\rightarrow$@
+                  let t1 : SemCond b s1 @$\times$@ SemComm cmThen s1 s2
+                      t1 = (proj@$\_{2}$@ (RelOpState.deltaRestPre
+                                     (SemCond b)
+                                     (SemComm cmThen) s1 s2)) h
+                      t2 : SemCond (bPre @$\wedge$@ b) s1
+                      t2 = (proj@$\_{2}$@ (respAnd bPre b s1))
+                           (q1 , proj@$\_{1}$@ t1)
+                  in hypThen s1 s2 t2 (proj@$\_{2}$@ t1)
+        rElse : RelOpState.comp
+                  (RelOpState.delta (NotP (SemCond b)))
+                  (SemComm cmElse) s1 s2 @$\rightarrow$@
+                SemCond bPost s2
+        rElse = @$\lambda$@ h @$\rightarrow$@
+                  let t10 : (NotP (SemCond b) s1) @$\times$@
+                            (SemComm cmElse s1 s2)
+                      t10 = proj@$\_{2}$@ (RelOpState.deltaRestPre
+                                    (NotP (SemCond b)) (SemComm cmElse) s1 s2)
+                            h
+                      t6 : SemCond (neg b) s1
+                      t6 = proj@$\_{2}$@ (respNeg b s1) (proj@$\_{1}$@ t10)
+                      t7 : SemComm cmElse s1 s2
+                      t7 = proj@$\_{2}$@ t10
+                      t8 : SemCond (bPre @$\wedge$@ neg b) s1
+                      t8 = proj@$\_{2}$@ (respAnd bPre (neg b) s1)
+                           (q1 , t6)
+                  in hypElse s1 s2 t8 t7
+    in when rThen rElse q2
+Soundness (WhileRule {cm'} {bInv} {b} pr) s1 s2 q1 q2
+  = proj@$\_{2}$@ (respAnd bInv (neg b) s2) t20
+    where
+      hyp : Satisfies (bInv @$\wedge$@ b) cm' bInv
+      hyp = Soundness pr
+      n : @$\mathbb{N}$@
+      n = proj@$\_{1}$@ q2
+      Rel1 : @$\mathbb{N}$@ @$\rightarrow$@ Rel State (Level.zero)
+      Rel1 = @$\lambda$@ m @$\rightarrow$@
+               RelOpState.repeat
+                 m
+                 (RelOpState.comp (RelOpState.delta (SemCond b))
+                                  (SemComm cm'))
+      t1 : RelOpState.comp
+             (Rel1 n)
+             (RelOpState.delta (NotP (SemCond b))) s1 s2
+      t1 = proj@$\_{2}$@ q2
+      t15 : (Rel1 n s1 s2) @$\times$@ (NotP (SemCond b) s2)
+      t15 = proj@$\_{2}$@ (RelOpState.deltaRestPost
+                    (NotP (SemCond b)) (Rel1 n) s1 s2)
+              t1
+      t16 : Rel1 n s1 s2
+      t16 = proj@$\_{1}$@ t15
+      t17 : NotP (SemCond b) s2
+      t17 = proj@$\_{2}$@ t15
+      lem1 : (m : @$\mathbb{N}$@) @$\rightarrow$@ (ss2 : State) @$\rightarrow$@ Rel1 m s1 ss2 @$\rightarrow$@
+             SemCond bInv ss2
+      lem1 @$\mathbb{N}$@.zero ss2 h
+        = substId1 State (proj@$\_{2}$@ h) (SemCond bInv) q1
+      lem1 (@$\mathbb{N}$@.suc n) ss2 h
+        = let hyp2 : (z : State) @$\rightarrow$@ Rel1 n s1 z @$\rightarrow$@
+                     SemCond bInv z
+              hyp2 = lem1 n
+              s20 : State
+              s20 = proj@$\_{1}$@ h
+              t21 : Rel1 n s1 s20
+              t21 = proj@$\_{1}$@ (proj@$\_{2}$@ h)
+              t22 : (SemCond b s20) @$\times$@ (SemComm cm' s20 ss2)
+              t22 = proj@$\_{2}$@ (RelOpState.deltaRestPre
+                            (SemCond b) (SemComm cm') s20 ss2)
+                    (proj@$\_{2}$@ (proj@$\_{2}$@ h))
+              t23 : SemCond (bInv @$\wedge$@ b) s20
+              t23 = proj@$\_{2}$@ (respAnd bInv b s20)
+                    (hyp2 s20 t21 , proj@$\_{1}$@ t22)
+          in hyp s20 ss2 t23 (proj@$\_{2}$@ t22)
+      t20 : SemCond bInv s2 @$\times$@ SemCond (neg b) s2
+      t20 = lem1 n s2 t16 , proj@$\_{2}$@ (respNeg b s2) t17
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Maybe.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+data Maybe {a} (A : Set a) : Set a where
+  just    : (x : A) -> Maybe A
+  nothing : Maybe A
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Maybe.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+data Maybe {a} (A : Set a) : Set a where
+  just    : (x : A) @$\rightarrow$@ Maybe A
+  nothing : Maybe A
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaCodeSegment.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+data CodeSegment {l1 l2 : Level} (A : Set l1) (B : Set l2) : Set (l ⊔ l1 ⊔ l2) where
+  cs : {{_ : DataSegment A}} {{_ : DataSegment B}}
+        -> (A -> B) -> CodeSegment A B
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaCodeSegment.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+data CodeSegment {l1 l2 : Level} (A : Set l1) (B : Set l2) : Set (l @$\sqcup$@ l1 @$\sqcup$@ l2) where
+  cs : {{_ : DataSegment A}} {{_ : DataSegment B}}
+        @$\rightarrow$@ (A @$\rightarrow$@ B) @$\rightarrow$@ CodeSegment A B
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaDataSegment.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+module subtype {l : Level} (Context : Set l) where
+
+record DataSegment {ll : Level} (A : Set ll) : Set (l ⊔ ll) where
+  field
+    get : Context -> A
+    set : Context -> A -> Context
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaDataSegment.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+module subtype {l : Level} (Context : Set l) where
+
+record DataSegment {ll : Level} (A : Set ll) : Set (l @$\sqcup$@ ll) where
+  field
+    get : Context @$\rightarrow$@ A
+    set : Context @$\rightarrow$@ A @$\rightarrow$@ Context
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaMetaCodeSegment.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,29 @@
+-- meta level
+liftContext : {X Y : Set} {{_ : N.DataSegment X}} {{_ : N.DataSegment Y}} -> N.CodeSegment X Y -> N.CodeSegment Context Context
+liftContext {{x}} {{y}} (N.cs f) = N.cs (\c -> N.DataSegment.set y c (f (N.DataSegment.get x c)))
+
+liftMeta : {X Y : Set} {{_ : M.DataSegment X}} {{_ : M.DataSegment Y}} -> N.CodeSegment X Y -> M.CodeSegment X Y
+liftMeta (N.cs f) = M.cs f
+
+gotoMeta : {I O : Set} {{_ : N.DataSegment I}} {{_ : N.DataSegment O}} -> M.CodeSegment Meta Meta -> N.CodeSegment I O -> Meta -> Meta
+gotoMeta mCode code m = M.exec mCode (record m {next = (liftContext code)})
+
+push : M.CodeSegment Meta Meta
+push = M.cs (\m -> M.exec (liftMeta (Meta.next m)) (record m {c' = Context.c (Meta.context m)}))
+
+-- normal level
+
+cs2 : N.CodeSegment ds1 ds1
+cs2 = N.cs id
+
+cs1 : N.CodeSegment ds1 ds1
+cs1 = N.cs (\d -> N.goto cs2 d)
+
+cs0 : N.CodeSegment ds0 ds1
+cs0 = N.cs (\d -> N.goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+-- meta level (with extended normal)
+main : Meta
+main = gotoMeta push cs0 (record {context = (record {a = 100 ; b = 50 ; c = 70}) ; c' = 0 ; next = (N.cs id)})
+-- record {context = record {a = 100 ; b = 50 ; c = 150} ; c' = 70 ; next = (N.cs id)}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaMetaCodeSegment.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,29 @@
+-- meta level
+liftContext : {X Y : Set} {{_ : N.DataSegment X}} {{_ : N.DataSegment Y}} @$\rightarrow$@ N.CodeSegment X Y @$\rightarrow$@ N.CodeSegment Context Context
+liftContext {{x}} {{y}} (N.cs f) = N.cs (\c @$\rightarrow$@ N.DataSegment.set y c (f (N.DataSegment.get x c)))
+
+liftMeta : {X Y : Set} {{_ : M.DataSegment X}} {{_ : M.DataSegment Y}} @$\rightarrow$@ N.CodeSegment X Y @$\rightarrow$@ M.CodeSegment X Y
+liftMeta (N.cs f) = M.cs f
+
+gotoMeta : {I O : Set} {{_ : N.DataSegment I}} {{_ : N.DataSegment O}} @$\rightarrow$@ M.CodeSegment Meta Meta @$\rightarrow$@ N.CodeSegment I O @$\rightarrow$@ Meta @$\rightarrow$@ Meta
+gotoMeta mCode code m = M.exec mCode (record m {next = (liftContext code)})
+
+push : M.CodeSegment Meta Meta
+push = M.cs (\m @$\rightarrow$@ M.exec (liftMeta (Meta.next m)) (record m {c' = Context.c (Meta.context m)}))
+
+-- normal level
+
+cs2 : N.CodeSegment ds1 ds1
+cs2 = N.cs id
+
+cs1 : N.CodeSegment ds1 ds1
+cs1 = N.cs (\d @$\rightarrow$@ N.goto cs2 d)
+
+cs0 : N.CodeSegment ds0 ds1
+cs0 = N.cs (\d @$\rightarrow$@ N.goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+-- meta level (with extended normal)
+main : Meta
+main = gotoMeta push cs0 (record {context = (record {a = 100 ; b = 50 ; c = 70}) ; c' = 0 ; next = (N.cs id)})
+-- record {context = record {a = 100 ; b = 50 ; c = 150} ; c' = 70 ; next = (N.cs id)}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaMetaDataSegment.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+-- 上で各 DataSegement の定義を行なっているとする
+open import subtype Context as N    -- Meta Datasegment を定義
+
+-- Meta DataSegment を持つ Meta Meta DataSegment を定義できる
+record Meta : Set where
+  field
+    context : Context
+    c'      : Int
+    next    : N.CodeSegment Context Context
+
+open import subtype Meta as M
+-- 以下よりメタメタレベルのプログラムを記述できる
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/MetaMetaDataSegment.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+-- 上で各 DataSegement の定義を行なっているとする
+open import subtype Context as N    -- Meta Datasegment を定義
+
+-- Meta DataSegment を持つ Meta Meta DataSegment を定義できる
+record Meta : Set where
+  field
+    context : Context
+    c'      : Int
+    next    : N.CodeSegment Context Context
+
+open import subtype Meta as M
+-- 以下よりメタメタレベルのプログラムを記述できる
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Nat.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+data ℕ : Set where
+  zero : ℕ
+  suc  : ℕ → ℕ
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Nat.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+data @$\mathbb{N}$@ : Set where
+  zero : @$\mathbb{N}$@
+  suc  : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/NatAdd.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+open import nat
+module nat_add where
+
+_+_ : Nat -> Nat -> Nat
+O + m     = m
+(S n) + m = S (n + m)
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/NatAdd.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+open import nat
+module nat_add where
+
+_+_ : Nat @$\rightarrow$@ Nat @$\rightarrow$@ Nat
+O + m     = m
+(S n) + m = S (n + m)
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/NatAddSym.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+open import Relation.Binary.PropositionalEquality
+open import nat
+open import nat_add
+open ≡-Reasoning
+
+module nat_add_sym where
+
+addSym : (n m : Nat) -> n + m ≡ m + n
+addSym O       O   = refl
+addSym O    (S m)  = cong S (addSym O m)
+addSym (S n)   O   = cong S (addSym n O)
+addSym (S n) (S m) = {!!} -- 後述
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/NatAddSym.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+open import Relation.Binary.PropositionalEquality
+open import nat
+open import nat_add
+open @$\equiv$@-Reasoning
+
+module nat_add_sym where
+
+addSym : (n m : Nat) @$\rightarrow$@ n + m @$\equiv$@ m + n
+addSym O       O   = refl
+addSym O    (S m)  = cong S (addSym O m)
+addSym (S n)   O   = cong S (addSym n O)
+addSym (S n) (S m) = {!!} -- 後述
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/PushPopType.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+pushOnce : Meta -> Meta
+pushOnce m = M.exec pushSingleLinkedStackCS m
+
+popOnce : Meta -> Meta
+popOnce m = M.exec popSingleLinkedStackCS m
+
+push-pop-type : Meta -> Set₁
+push-pop-type meta =
+    M.exec (M.csComp  (M.cs popOnce) (M.cs pushOnce)) meta ≡ meta
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/PushPopType.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+pushOnce : Meta @$\rightarrow$@ Meta
+pushOnce m = M.exec pushSingleLinkedStackCS m
+
+popOnce : Meta @$\rightarrow$@ Meta
+popOnce m = M.exec popSingleLinkedStackCS m
+
+push-pop-type : Meta @$\rightarrow$@ Set@$\_{1}$@
+push-pop-type meta =
+    M.exec (M.csComp  (M.cs popOnce) (M.cs pushOnce)) meta @$\equiv$@ meta
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Reasoning.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,21 @@
+open import Relation.Binary.PropositionalEquality
+open import nat
+open import nat_add
+open ≡-Reasoning
+
+module nat_add_sym_reasoning where
+
+addToRight : (n m : Nat) -> S (n + m) ≡ n + (S m)
+addToRight O m     = refl
+addToRight (S n) m = cong S (addToRight n m)
+
+addSym : (n m : Nat) -> n + m ≡ m + n
+addSym O       O   = refl
+addSym O    (S m)  = cong S (addSym O m)
+addSym (S n)   O   = cong S (addSym n O)
+addSym (S n) (S m) = begin
+  (S n) + (S m)  ≡⟨ refl ⟩
+  S (n + S m)    ≡⟨ cong S (addSym n (S m)) ⟩
+  S ((S m) + n)  ≡⟨ addToRight (S m) n ⟩
+  S (m + S n)    ≡⟨ refl ⟩
+  (S m) + (S n)  ∎
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Reasoning.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,21 @@
+open import Relation.Binary.PropositionalEquality
+open import nat
+open import nat_add
+open @$\equiv$@-Reasoning
+
+module nat_add_sym_reasoning where
+
+addToRight : (n m : Nat) @$\rightarrow$@ S (n + m) @$\equiv$@ n + (S m)
+addToRight O m     = refl
+addToRight (S n) m = cong S (addToRight n m)
+
+addSym : (n m : Nat) @$\rightarrow$@ n + m @$\equiv$@ m + n
+addSym O       O   = refl
+addSym O    (S m)  = cong S (addSym O m)
+addSym (S n)   O   = cong S (addSym n O)
+addSym (S n) (S m) = begin
+  (S n) + (S m)  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  S (n + S m)    @$\equiv$@@$\langle$@ cong S (addSym n (S m)) @$\rangle$@
+  S ((S m) + n)  @$\equiv$@@$\langle$@ addToRight (S m) n @$\rangle$@
+  S (m + S n)    @$\equiv$@@$\langle$@ refl @$\rangle$@
+  (S m) + (S n)  @$\blacksquare$@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/RedBlackTree.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,231 @@
+module RedBlackTree where
+
+open import stack
+open import Level hiding (zero)
+record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    putImpl : treeImpl -> a -> (treeImpl -> t) -> t
+    getImpl  : treeImpl -> (treeImpl -> Maybe a -> t) -> t
+open TreeMethods
+
+record Tree  {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    tree : treeImpl
+    treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
+  putTree : a -> (Tree treeImpl -> t) -> t
+  putTree d next = putImpl (treeMethods ) tree d (\t1 -> next (record {tree = t1 ; treeMethods = treeMethods} ))
+  getTree : (Tree treeImpl -> Maybe a -> t) -> t
+  getTree next = getImpl (treeMethods ) tree (\t1 d -> next (record {tree = t1 ; treeMethods = treeMethods} ) d )
+
+open Tree
+
+data Color {n : Level } : Set n where
+  Red   : Color
+  Black : Color
+
+data CompareResult {n : Level } : Set n where
+  LT : CompareResult
+  GT : CompareResult
+  EQ : CompareResult
+
+record Node {n : Level } (a k : Set n) : Set n where
+  inductive
+  field
+    key   : k
+    value : a
+    right : Maybe (Node a k)
+    left  : Maybe (Node a k)
+    color : Color {n}
+open Node
+
+record RedBlackTree {n m : Level } {t : Set m} (a k : Set n) : Set (m Level.⊔ n) where
+  field
+    root : Maybe (Node a k)
+    nodeStack : SingleLinkedStack  (Node a k)
+    compare : k -> k -> CompareResult {n}
+
+open RedBlackTree
+
+open SingleLinkedStack
+
+--
+-- put new node at parent node, and rebuild tree to the top
+--
+{-# TERMINATING #-}   -- https://agda.readthedocs.io/en/v2.5.3/language/termination-checking.html
+replaceNode : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) ->  Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+replaceNode {n} {m} {t} {a} {k} tree s n0 next = popSingleLinkedStack s (
+      \s parent -> replaceNode1 s parent)
+        where
+          replaceNode1 : SingleLinkedStack (Node a k) -> Maybe ( Node a k ) -> t
+          replaceNode1 s Nothing = next ( record tree { root = Just (record n0 { color = Black}) } )
+          replaceNode1 s (Just n1) with compare tree (key n1) (key n0)
+          ... | EQ =  replaceNode tree s ( record n1 { value = value n0 ; left = left n0 ; right = right n0 } ) next
+          ... | GT =  replaceNode tree s ( record n1 { left = Just n0 } ) next
+          ... | LT =  replaceNode tree s ( record n1 { right = Just n0 } ) next
+
+
+rotateRight : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k) -> Maybe (Node a k) -> Maybe (Node a k) ->
+  (RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k) -> Maybe (Node a k) -> Maybe (Node a k) -> t) -> t
+rotateRight {n} {m} {t} {a} {k}  tree s n0 parent rotateNext = getSingleLinkedStack s (\ s n0 -> rotateRight1 tree s n0 parent rotateNext)
+  where
+        rotateRight1 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k)  -> Maybe (Node a k) -> Maybe (Node a k) ->
+          (RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k)  -> Maybe (Node a k) -> Maybe (Node a k) -> t) -> t
+        rotateRight1 {n} {m} {t} {a} {k}  tree s n0 parent rotateNext with n0
+        ... | Nothing  = rotateNext tree s Nothing n0
+        ... | Just n1 with parent
+        ...           | Nothing = rotateNext tree s (Just n1 ) n0
+        ...           | Just parent1 with left parent1
+        ...                | Nothing = rotateNext tree s (Just n1) Nothing
+        ...                | Just leftParent with compare tree (key n1) (key leftParent)
+        ...                                    | EQ = rotateNext tree s (Just n1) parent
+        ...                                    | _ = rotateNext tree s (Just n1) parent
+
+
+rotateLeft : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k) -> Maybe (Node a k) -> Maybe (Node a k) ->
+  (RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k) -> Maybe (Node a k) -> Maybe (Node a k) ->  t) -> t
+rotateLeft {n} {m} {t} {a} {k}  tree s n0 parent rotateNext = getSingleLinkedStack s (\ s n0 -> rotateLeft1 tree s n0 parent rotateNext)
+  where
+        rotateLeft1 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k) -> Maybe (Node a k) -> Maybe (Node a k) ->
+          (RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node  a k) -> Maybe (Node a k) -> Maybe (Node a k) -> t) -> t
+        rotateLeft1 {n} {m} {t} {a} {k}  tree s n0 parent rotateNext with n0
+        ... | Nothing  = rotateNext tree s Nothing n0
+        ... | Just n1 with parent
+        ...           | Nothing = rotateNext tree s (Just n1) Nothing
+        ...           | Just parent1 with right parent1
+        ...                | Nothing = rotateNext tree s (Just n1) Nothing
+        ...                | Just rightParent with compare tree (key n1) (key rightParent)
+        ...                                    | EQ = rotateNext tree s (Just n1) parent
+        ...                                    | _ = rotateNext tree s (Just n1) parent
+
+{-# TERMINATING #-}
+insertCase5 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Maybe (Node a k) -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+insertCase5 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next = pop2SingleLinkedStack s (\ s parent grandParent -> insertCase51 tree s n0 parent grandParent next)
+  where
+    insertCase51 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Maybe (Node a k) -> Maybe (Node a k) -> Maybe (Node a k) -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+    insertCase51 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next with n0
+    ...     | Nothing = next tree
+    ...     | Just n1  with  parent | grandParent
+    ...                 | Nothing | _  = next tree
+    ...                 | _ | Nothing  = next tree
+    ...                 | Just parent1 | Just grandParent1 with left parent1 | left grandParent1
+    ...                                                     | Nothing | _  = next tree
+    ...                                                     | _ | Nothing  = next tree
+    ...                                                     | Just leftParent1 | Just leftGrandParent1
+      with compare tree (key n1) (key leftParent1) | compare tree (key leftParent1) (key leftGrandParent1)
+    ...     | EQ | EQ = rotateRight tree s n0 parent
+                 (\ tree s n0 parent -> insertCase5 tree s n0 parent1 grandParent1 next)
+    ...     | _ | _ = rotateLeft tree s n0 parent
+                 (\ tree s n0 parent -> insertCase5 tree s n0 parent1 grandParent1 next)
+
+insertCase4 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+insertCase4 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next
+       with  (right parent) | (left grandParent)
+...    | Nothing | _ = insertCase5 tree s (Just n0) parent grandParent next
+...    | _ | Nothing = insertCase5 tree s (Just n0) parent grandParent next
+...    | Just rightParent | Just leftGrandParent with compare tree (key n0) (key rightParent) | compare tree (key parent) (key leftGrandParent)
+...                                              | EQ | EQ = popSingleLinkedStack s (\ s n1 -> rotateLeft tree s (left n0) (Just grandParent)
+   (\ tree s n0 parent -> insertCase5 tree s n0 rightParent grandParent next))
+...                                              | _ | _  = insertCase41 tree s n0 parent grandParent next
+  where
+    insertCase41 : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Node a k -> Node a k -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+    insertCase41 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next
+                 with  (left parent) | (right grandParent)
+    ...    | Nothing | _ = insertCase5 tree s (Just n0) parent grandParent next
+    ...    | _ | Nothing = insertCase5 tree s (Just n0) parent grandParent next
+    ...    | Just leftParent | Just rightGrandParent with compare tree (key n0) (key leftParent) | compare tree (key parent) (key rightGrandParent)
+    ...                                              | EQ | EQ = popSingleLinkedStack s (\ s n1 -> rotateRight tree s (right n0) (Just grandParent)
+       (\ tree s n0 parent -> insertCase5 tree s n0 leftParent grandParent next))
+    ...                                              | _ | _  = insertCase5 tree s (Just n0) parent grandParent next
+
+colorNode : {n : Level } {a k : Set n}  -> Node a k -> Color  -> Node a k
+colorNode old c = record old { color = c }
+
+{-# TERMINATING #-}
+insertNode : {n m : Level } {t : Set m } {a k : Set n} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Node a k -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+insertNode {n} {m} {t} {a} {k}  tree s n0 next = get2SingleLinkedStack s (insertCase1 n0)
+   where
+    insertCase1 : Node a k -> SingleLinkedStack (Node a k) -> Maybe (Node a k) -> Maybe (Node a k) -> t    -- placed here to allow mutual recursion
+          -- http://agda.readthedocs.io/en/v2.5.2/language/mutual-recursion.html
+    insertCase3 : SingleLinkedStack (Node a k) -> Node a k -> Node a k -> Node a k -> t
+    insertCase3 s n0 parent grandParent with left grandParent | right grandParent
+    ... | Nothing | Nothing = insertCase4 tree s n0 parent grandParent next
+    ... | Nothing | Just uncle  = insertCase4 tree s n0 parent grandParent next
+    ... | Just uncle | _  with compare tree ( key uncle ) ( key parent )
+    ...                   | EQ =  insertCase4 tree s n0 parent grandParent next
+    ...                   | _ with color uncle
+    ...                           | Red = pop2SingleLinkedStack s ( \s p0 p1 -> insertCase1  (
+           record grandParent { color = Red ; left = Just ( record parent { color = Black } )  ; right = Just ( record uncle { color = Black } ) }) s p0 p1 )
+    ...                           | Black = insertCase4 tree s n0 parent grandParent next
+    insertCase2 : SingleLinkedStack (Node a k) -> Node a k -> Node a k -> Node a k -> t
+    insertCase2 s n0 parent grandParent with color parent
+    ... | Black = replaceNode tree s n0 next
+    ... | Red =   insertCase3 s n0 parent grandParent
+    insertCase1 n0 s Nothing Nothing = next tree
+    insertCase1 n0 s Nothing (Just grandParent) = next tree
+    insertCase1 n0 s (Just parent) Nothing = replaceNode tree s (colorNode n0 Black) next
+    insertCase1 n0 s (Just parent) (Just grandParent) = insertCase2 s n0 parent grandParent
+
+----
+-- find node potition to insert or to delete, the path will be in the stack
+--
+findNode : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> (Node a k) -> (Node a k) -> (RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Node a k -> t) -> t
+findNode {n} {m} {a} {k}  {t} tree s n0 n1 next = pushSingleLinkedStack s n1 (\ s -> findNode1 s n1)
+  where
+    findNode2 : SingleLinkedStack (Node a k) -> (Maybe (Node a k)) -> t
+    findNode2 s Nothing = next tree s n0
+    findNode2 s (Just n) = findNode tree s n0 n next
+    findNode1 : SingleLinkedStack (Node a k) -> (Node a k)  -> t
+    findNode1 s n1 with (compare tree (key n0) (key n1))
+    ...                                | EQ = popSingleLinkedStack s ( \s _ -> next tree s (record n1 { key = key n1 ; value = value n0 } ) )
+    ...                                | GT = findNode2 s (right n1)
+    ...                                | LT = findNode2 s (left n1)
+
+
+leafNode : {n : Level } {a k : Set n}  -> k -> a -> Node a k
+leafNode k1 value = record {
+    key   = k1 ;
+    value = value ;
+    right = Nothing ;
+    left  = Nothing ;
+    color = Red
+  }
+
+putRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k -> k -> a -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+putRedBlackTree {n} {m} {a} {k}  {t} tree k1 value next with (root tree)
+...                                | Nothing = next (record tree {root = Just (leafNode k1 value) })
+...                                | Just n2  = clearSingleLinkedStack (nodeStack tree) (\ s -> findNode tree s (leafNode k1 value) n2 (\ tree1 s n1 -> insertNode tree1 s n1 next))
+
+getRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k -> k -> (RedBlackTree {n} {m} {t} a k -> (Maybe (Node a k)) -> t) -> t
+getRedBlackTree {_} {_} {a} {k} {t} tree k1 cs = checkNode (root tree)
+  module GetRedBlackTree where                     -- http://agda.readthedocs.io/en/v2.5.2/language/let-and-where.html
+    search : Node a k -> t
+    checkNode : Maybe (Node a k) -> t
+    checkNode Nothing = cs tree Nothing
+    checkNode (Just n) = search n
+    search n with compare tree k1 (key n)
+    search n | LT = checkNode (left n)
+    search n | GT = checkNode (right n)
+    search n | EQ = cs tree (Just n)
+
+open import Data.Nat hiding (compare)
+
+compareℕ :  ℕ → ℕ → CompareResult {Level.zero}
+compareℕ x y with Data.Nat.compare x y
+... | less _ _ = LT
+... | equal _ = EQ
+... | greater _ _ = GT
+
+compare2 : (x y : ℕ ) -> CompareResult {Level.zero}
+compare2 zero zero = EQ
+compare2 (suc _) zero = GT
+compare2  zero (suc _) = LT
+compare2  (suc x) (suc y) = compare2 x y
+
+
+createEmptyRedBlackTreeℕ : { m : Level } (a : Set Level.zero) {t : Set m} -> RedBlackTree {Level.zero} {m} {t} a ℕ
+createEmptyRedBlackTreeℕ  {m} a {t} = record {
+        root = Nothing
+     ;  nodeStack = emptySingleLinkedStack
+     ;  compare = compare2
+   }
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/RedBlackTree.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,231 @@
+module RedBlackTree where
+
+open import stack
+open import Level hiding (zero)
+record TreeMethods {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    putImpl : treeImpl @$\rightarrow$@ a @$\rightarrow$@ (treeImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+    getImpl  : treeImpl @$\rightarrow$@ (treeImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+open TreeMethods
+
+record Tree  {n m : Level } {a : Set n } {t : Set m } (treeImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    tree : treeImpl
+    treeMethods : TreeMethods {n} {m} {a} {t} treeImpl
+  putTree : a @$\rightarrow$@ (Tree treeImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+  putTree d next = putImpl (treeMethods ) tree d (\t1 @$\rightarrow$@ next (record {tree = t1 ; treeMethods = treeMethods} ))
+  getTree : (Tree treeImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+  getTree next = getImpl (treeMethods ) tree (\t1 d @$\rightarrow$@ next (record {tree = t1 ; treeMethods = treeMethods} ) d )
+
+open Tree
+
+data Color {n : Level } : Set n where
+  Red   : Color
+  Black : Color
+
+data CompareResult {n : Level } : Set n where
+  LT : CompareResult
+  GT : CompareResult
+  EQ : CompareResult
+
+record Node {n : Level } (a k : Set n) : Set n where
+  inductive
+  field
+    key   : k
+    value : a
+    right : Maybe (Node a k)
+    left  : Maybe (Node a k)
+    color : Color {n}
+open Node
+
+record RedBlackTree {n m : Level } {t : Set m} (a k : Set n) : Set (m Level.@$\sqcup$@ n) where
+  field
+    root : Maybe (Node a k)
+    nodeStack : SingleLinkedStack  (Node a k)
+    compare : k @$\rightarrow$@ k @$\rightarrow$@ CompareResult {n}
+
+open RedBlackTree
+
+open SingleLinkedStack
+
+--
+-- put new node at parent node, and rebuild tree to the top
+--
+{-@$\#$@ TERMINATING @$\#$@-}   -- https://agda.readthedocs.io/en/v2.5.3/language/termination-checking.html
+replaceNode : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@  Node a k @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+replaceNode {n} {m} {t} {a} {k} tree s n0 next = popSingleLinkedStack s (
+      \s parent @$\rightarrow$@ replaceNode1 s parent)
+        where
+          replaceNode1 : SingleLinkedStack (Node a k) @$\rightarrow$@ Maybe ( Node a k ) @$\rightarrow$@ t
+          replaceNode1 s Nothing = next ( record tree { root = Just (record n0 { color = Black}) } )
+          replaceNode1 s (Just n1) with compare tree (key n1) (key n0)
+          ... | EQ =  replaceNode tree s ( record n1 { value = value n0 ; left = left n0 ; right = right n0 } ) next
+          ... | GT =  replaceNode tree s ( record n1 { left = Just n0 } ) next
+          ... | LT =  replaceNode tree s ( record n1 { right = Just n0 } ) next
+
+
+rotateRight : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@
+  (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ t) @$\rightarrow$@ t
+rotateRight {n} {m} {t} {a} {k}  tree s n0 parent rotateNext = getSingleLinkedStack s (\ s n0 @$\rightarrow$@ rotateRight1 tree s n0 parent rotateNext)
+  where
+        rotateRight1 : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k)  @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@
+          (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k)  @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ t) @$\rightarrow$@ t
+        rotateRight1 {n} {m} {t} {a} {k}  tree s n0 parent rotateNext with n0
+        ... | Nothing  = rotateNext tree s Nothing n0
+        ... | Just n1 with parent
+        ...           | Nothing = rotateNext tree s (Just n1 ) n0
+        ...           | Just parent1 with left parent1
+        ...                | Nothing = rotateNext tree s (Just n1) Nothing
+        ...                | Just leftParent with compare tree (key n1) (key leftParent)
+        ...                                    | EQ = rotateNext tree s (Just n1) parent
+        ...                                    | _ = rotateNext tree s (Just n1) parent
+
+
+rotateLeft : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@
+  (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@  t) @$\rightarrow$@ t
+rotateLeft {n} {m} {t} {a} {k}  tree s n0 parent rotateNext = getSingleLinkedStack s (\ s n0 @$\rightarrow$@ rotateLeft1 tree s n0 parent rotateNext)
+  where
+        rotateLeft1 : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@
+          (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node  a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ t) @$\rightarrow$@ t
+        rotateLeft1 {n} {m} {t} {a} {k}  tree s n0 parent rotateNext with n0
+        ... | Nothing  = rotateNext tree s Nothing n0
+        ... | Just n1 with parent
+        ...           | Nothing = rotateNext tree s (Just n1) Nothing
+        ...           | Just parent1 with right parent1
+        ...                | Nothing = rotateNext tree s (Just n1) Nothing
+        ...                | Just rightParent with compare tree (key n1) (key rightParent)
+        ...                                    | EQ = rotateNext tree s (Just n1) parent
+        ...                                    | _ = rotateNext tree s (Just n1) parent
+
+{-@$\#$@ TERMINATING @$\#$@-}
+insertCase5 : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+insertCase5 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next = pop2SingleLinkedStack s (\ s parent grandParent @$\rightarrow$@ insertCase51 tree s n0 parent grandParent next)
+  where
+    insertCase51 : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+    insertCase51 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next with n0
+    ...     | Nothing = next tree
+    ...     | Just n1  with  parent | grandParent
+    ...                 | Nothing | _  = next tree
+    ...                 | _ | Nothing  = next tree
+    ...                 | Just parent1 | Just grandParent1 with left parent1 | left grandParent1
+    ...                                                     | Nothing | _  = next tree
+    ...                                                     | _ | Nothing  = next tree
+    ...                                                     | Just leftParent1 | Just leftGrandParent1
+      with compare tree (key n1) (key leftParent1) | compare tree (key leftParent1) (key leftGrandParent1)
+    ...     | EQ | EQ = rotateRight tree s n0 parent
+                 (\ tree s n0 parent @$\rightarrow$@ insertCase5 tree s n0 parent1 grandParent1 next)
+    ...     | _ | _ = rotateLeft tree s n0 parent
+                 (\ tree s n0 parent @$\rightarrow$@ insertCase5 tree s n0 parent1 grandParent1 next)
+
+insertCase4 : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+insertCase4 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next
+       with  (right parent) | (left grandParent)
+...    | Nothing | _ = insertCase5 tree s (Just n0) parent grandParent next
+...    | _ | Nothing = insertCase5 tree s (Just n0) parent grandParent next
+...    | Just rightParent | Just leftGrandParent with compare tree (key n0) (key rightParent) | compare tree (key parent) (key leftGrandParent)
+...                                              | EQ | EQ = popSingleLinkedStack s (\ s n1 @$\rightarrow$@ rotateLeft tree s (left n0) (Just grandParent)
+   (\ tree s n0 parent @$\rightarrow$@ insertCase5 tree s n0 rightParent grandParent next))
+...                                              | _ | _  = insertCase41 tree s n0 parent grandParent next
+  where
+    insertCase41 : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+    insertCase41 {n} {m} {t} {a} {k}  tree s n0 parent grandParent next
+                 with  (left parent) | (right grandParent)
+    ...    | Nothing | _ = insertCase5 tree s (Just n0) parent grandParent next
+    ...    | _ | Nothing = insertCase5 tree s (Just n0) parent grandParent next
+    ...    | Just leftParent | Just rightGrandParent with compare tree (key n0) (key leftParent) | compare tree (key parent) (key rightGrandParent)
+    ...                                              | EQ | EQ = popSingleLinkedStack s (\ s n1 @$\rightarrow$@ rotateRight tree s (right n0) (Just grandParent)
+       (\ tree s n0 parent @$\rightarrow$@ insertCase5 tree s n0 leftParent grandParent next))
+    ...                                              | _ | _  = insertCase5 tree s (Just n0) parent grandParent next
+
+colorNode : {n : Level } {a k : Set n}  @$\rightarrow$@ Node a k @$\rightarrow$@ Color  @$\rightarrow$@ Node a k
+colorNode old c = record old { color = c }
+
+{-@$\#$@ TERMINATING @$\#$@-}
+insertNode : {n m : Level } {t : Set m } {a k : Set n} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+insertNode {n} {m} {t} {a} {k}  tree s n0 next = get2SingleLinkedStack s (insertCase1 n0)
+   where
+    insertCase1 : Node a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ Maybe (Node a k) @$\rightarrow$@ t    -- placed here to allow mutual recursion
+          -- http://agda.readthedocs.io/en/v2.5.2/language/mutual-recursion.html
+    insertCase3 : SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ t
+    insertCase3 s n0 parent grandParent with left grandParent | right grandParent
+    ... | Nothing | Nothing = insertCase4 tree s n0 parent grandParent next
+    ... | Nothing | Just uncle  = insertCase4 tree s n0 parent grandParent next
+    ... | Just uncle | _  with compare tree ( key uncle ) ( key parent )
+    ...                   | EQ =  insertCase4 tree s n0 parent grandParent next
+    ...                   | _ with color uncle
+    ...                           | Red = pop2SingleLinkedStack s ( \s p0 p1 @$\rightarrow$@ insertCase1  (
+           record grandParent { color = Red ; left = Just ( record parent { color = Black } )  ; right = Just ( record uncle { color = Black } ) }) s p0 p1 )
+    ...                           | Black = insertCase4 tree s n0 parent grandParent next
+    insertCase2 : SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ Node a k @$\rightarrow$@ t
+    insertCase2 s n0 parent grandParent with color parent
+    ... | Black = replaceNode tree s n0 next
+    ... | Red =   insertCase3 s n0 parent grandParent
+    insertCase1 n0 s Nothing Nothing = next tree
+    insertCase1 n0 s Nothing (Just grandParent) = next tree
+    insertCase1 n0 s (Just parent) Nothing = replaceNode tree s (colorNode n0 Black) next
+    insertCase1 n0 s (Just parent) (Just grandParent) = insertCase2 s n0 parent grandParent
+
+----
+-- find node potition to insert or to delete, the path will be in the stack
+--
+findNode : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ (Node a k) @$\rightarrow$@ (Node a k) @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ t) @$\rightarrow$@ t
+findNode {n} {m} {a} {k}  {t} tree s n0 n1 next = pushSingleLinkedStack s n1 (\ s @$\rightarrow$@ findNode1 s n1)
+  where
+    findNode2 : SingleLinkedStack (Node a k) @$\rightarrow$@ (Maybe (Node a k)) @$\rightarrow$@ t
+    findNode2 s Nothing = next tree s n0
+    findNode2 s (Just n) = findNode tree s n0 n next
+    findNode1 : SingleLinkedStack (Node a k) @$\rightarrow$@ (Node a k)  @$\rightarrow$@ t
+    findNode1 s n1 with (compare tree (key n0) (key n1))
+    ...                                | EQ = popSingleLinkedStack s ( \s _ @$\rightarrow$@ next tree s (record n1 { key = key n1 ; value = value n0 } ) )
+    ...                                | GT = findNode2 s (right n1)
+    ...                                | LT = findNode2 s (left n1)
+
+
+leafNode : {n : Level } {a k : Set n}  @$\rightarrow$@ k @$\rightarrow$@ a @$\rightarrow$@ Node a k
+leafNode k1 value = record {
+    key   = k1 ;
+    value = value ;
+    right = Nothing ;
+    left  = Nothing ;
+    color = Red
+  }
+
+putRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ k @$\rightarrow$@ a @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+putRedBlackTree {n} {m} {a} {k}  {t} tree k1 value next with (root tree)
+...                                | Nothing = next (record tree {root = Just (leafNode k1 value) })
+...                                | Just n2  = clearSingleLinkedStack (nodeStack tree) (\ s @$\rightarrow$@ findNode tree s (leafNode k1 value) n2 (\ tree1 s n1 @$\rightarrow$@ insertNode tree1 s n1 next))
+
+getRedBlackTree : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ k @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ (Maybe (Node a k)) @$\rightarrow$@ t) @$\rightarrow$@ t
+getRedBlackTree {_} {_} {a} {k} {t} tree k1 cs = checkNode (root tree)
+  module GetRedBlackTree where                     -- http://agda.readthedocs.io/en/v2.5.2/language/let-and-where.html
+    search : Node a k @$\rightarrow$@ t
+    checkNode : Maybe (Node a k) @$\rightarrow$@ t
+    checkNode Nothing = cs tree Nothing
+    checkNode (Just n) = search n
+    search n with compare tree k1 (key n)
+    search n | LT = checkNode (left n)
+    search n | GT = checkNode (right n)
+    search n | EQ = cs tree (Just n)
+
+open import Data.Nat hiding (compare)
+
+compare@$\mathbb{N}$@ :  @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ CompareResult {Level.zero}
+compare@$\mathbb{N}$@ x y with Data.Nat.compare x y
+... | less _ _ = LT
+... | equal _ = EQ
+... | greater _ _ = GT
+
+compare2 : (x y : @$\mathbb{N}$@ ) @$\rightarrow$@ CompareResult {Level.zero}
+compare2 zero zero = EQ
+compare2 (suc _) zero = GT
+compare2  zero (suc _) = LT
+compare2  (suc x) (suc y) = compare2 x y
+
+
+createEmptyRedBlackTree@$\mathbb{N}$@ : { m : Level } (a : Set Level.zero) {t : Set m} @$\rightarrow$@ RedBlackTree {Level.zero} {m} {t} a @$\mathbb{N}$@
+createEmptyRedBlackTree@$\mathbb{N}$@  {m} a {t} = record {
+        root = Nothing
+     ;  nodeStack = emptySingleLinkedStack
+     ;  compare = compare2
+   }
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/RelOp.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,81 @@
+{-# OPTIONS --universe-polymorphism #-}
+
+open import Level
+open import Data.Empty
+open import Data.Product
+open import Data.Nat.Base
+open import Data.Sum
+open import Data.Unit
+open import Relation.Binary
+open import Relation.Binary.Core
+open import Relation.Nullary
+open import utilities
+
+module RelOp (S : Set) where
+
+data Id {l} {X : Set} : Rel X l where
+  ref : {x : X} -> Id x x
+
+-- substId1 | x == y & P(x) => P(y)
+substId1 :  ∀ {l} -> {X : Set} -> {x y : X} ->
+           Id {l} x y -> (P : Pred X) -> P x -> P y
+substId1 ref P q = q
+
+-- substId2 | x == y & P(y) => P(x)
+substId2 :  ∀ {l} -> {X : Set} -> {x y : X} ->
+           Id {l} x  y -> (P : Pred X) -> P y -> P x
+substId2 ref P q = q
+
+-- for X ⊆ S (formally, X : Pred S)
+-- delta X = { (a, a) | a ∈ X }
+delta : ∀ {l} -> Pred S -> Rel S l
+delta X a b = X a × Id a b
+
+-- deltaGlob = delta S
+deltaGlob : ∀ {l} -> Rel S l
+deltaGlob = delta (λ (s : S) → ⊤)
+
+-- emptyRel = \varnothing
+emptyRel : Rel S Level.zero
+emptyRel a b = ⊥
+
+-- comp R1 R2 = R2 ∘ R1 (= R1; R2)
+comp : ∀ {l} -> Rel S l -> Rel S l -> Rel S l
+comp R1 R2 a b = ∃ (λ (a' : S) → R1 a a' × R2 a' b)
+
+-- union R1 R2 = R1 ∪ R2
+union : ∀ {l} -> Rel S l -> Rel S l -> Rel S l
+union R1 R2 a b = R1 a b ⊎ R2 a b
+
+-- repeat n R = R^n
+repeat : ∀ {l} -> ℕ -> Rel S l -> Rel S l
+repeat ℕ.zero R = deltaGlob
+repeat (ℕ.suc m) R = comp (repeat m R) R
+
+-- unionInf f = ⋃_{n ∈ ω} f(n)
+unionInf : ∀ {l} -> (ℕ -> Rel S l) -> Rel S l
+unionInf f a b = ∃ (λ (n : ℕ) → f n a b)
+-- restPre X R = { (s1,s2) ∈ R | s1 ∈ X }
+restPre : ∀ {l} -> Pred S -> Rel S l -> Rel S l
+restPre X R a b = X a × R a b
+
+-- restPost X R = { (s1,s2) ∈ R | s2 ∈ X }
+restPost : ∀ {l} -> Pred S -> Rel S l -> Rel S l
+restPost X R a b = R a b × X b
+
+deltaRestPre : (X : Pred S) -> (R : Rel S Level.zero) -> (a b : S) ->
+               Iff (restPre X R a b) (comp (delta X) R a b)
+deltaRestPre X R a b
+  = (λ (h : restPre X R a b) → a , (proj₁ h , ref) , proj₂ h) ,
+     λ (h : comp (delta X) R a b) → proj₁ (proj₁ (proj₂ h)) ,
+       substId2
+         (proj₂ (proj₁ (proj₂ h)))
+         (λ z → R z b) (proj₂ (proj₂ h))
+
+deltaRestPost : (X : Pred S) -> (R : Rel S Level.zero) -> (a b : S) ->
+                Iff (restPost X R a b) (comp R (delta X) a b)
+deltaRestPost X R a b
+  = (λ (h : restPost X R a b) → b , proj₁ h , proj₂ h , ref) ,
+     λ (h : comp R (delta X) a b) →
+       substId1 (proj₂ (proj₂ (proj₂ h))) (R a) (proj₁ (proj₂ h)) ,
+       substId1 (proj₂ (proj₂ (proj₂ h))) X (proj₁ (proj₂ (proj₂ h)))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/RelOp.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,81 @@
+{-@$\#$@ OPTIONS --universe-polymorphism @$\#$@-}
+
+open import Level
+open import Data.Empty
+open import Data.Product
+open import Data.Nat.Base
+open import Data.Sum
+open import Data.Unit
+open import Relation.Binary
+open import Relation.Binary.Core
+open import Relation.Nullary
+open import utilities
+
+module RelOp (S : Set) where
+
+data Id {l} {X : Set} : Rel X l where
+  ref : {x : X} @$\rightarrow$@ Id x x
+
+-- substId1 | x == y & P(x) => P(y)
+substId1 :  @$\forall$@ {l} @$\rightarrow$@ {X : Set} @$\rightarrow$@ {x y : X} @$\rightarrow$@
+           Id {l} x y @$\rightarrow$@ (P : Pred X) @$\rightarrow$@ P x @$\rightarrow$@ P y
+substId1 ref P q = q
+
+-- substId2 | x == y & P(y) => P(x)
+substId2 :  @$\forall$@ {l} @$\rightarrow$@ {X : Set} @$\rightarrow$@ {x y : X} @$\rightarrow$@
+           Id {l} x  y @$\rightarrow$@ (P : Pred X) @$\rightarrow$@ P y @$\rightarrow$@ P x
+substId2 ref P q = q
+
+-- for X ⊆ S (formally, X : Pred S)
+-- delta X = { (a, a) | a ∈ X }
+delta : @$\forall$@ {l} @$\rightarrow$@ Pred S @$\rightarrow$@ Rel S l
+delta X a b = X a @$\times$@ Id a b
+
+-- deltaGlob = delta S
+deltaGlob : @$\forall$@ {l} @$\rightarrow$@ Rel S l
+deltaGlob = delta (@$\lambda$@ (s : S) @$\rightarrow$@ @$\top$@)
+
+-- emptyRel = \varnothing
+emptyRel : Rel S Level.zero
+emptyRel a b = @$\bot$@
+
+-- comp R1 R2 = R2 ∘ R1 (= R1; R2)
+comp : @$\forall$@ {l} @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l
+comp R1 R2 a b = ∃ (@$\lambda$@ (a' : S) @$\rightarrow$@ R1 a a' @$\times$@ R2 a' b)
+
+-- union R1 R2 = R1 ∪ R2
+union : @$\forall$@ {l} @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l
+union R1 R2 a b = R1 a b ⊎ R2 a b
+
+-- repeat n R = R^n
+repeat : @$\forall$@ {l} @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l
+repeat @$\mathbb{N}$@.zero R = deltaGlob
+repeat (@$\mathbb{N}$@.suc m) R = comp (repeat m R) R
+
+-- unionInf f = ⋃_{n ∈ ω} f(n)
+unionInf : @$\forall$@ {l} @$\rightarrow$@ (@$\mathbb{N}$@ @$\rightarrow$@ Rel S l) @$\rightarrow$@ Rel S l
+unionInf f a b = ∃ (@$\lambda$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ f n a b)
+-- restPre X R = { (s1,s2) ∈ R | s1 ∈ X }
+restPre : @$\forall$@ {l} @$\rightarrow$@ Pred S @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l
+restPre X R a b = X a @$\times$@ R a b
+
+-- restPost X R = { (s1,s2) ∈ R | s2 ∈ X }
+restPost : @$\forall$@ {l} @$\rightarrow$@ Pred S @$\rightarrow$@ Rel S l @$\rightarrow$@ Rel S l
+restPost X R a b = R a b @$\times$@ X b
+
+deltaRestPre : (X : Pred S) @$\rightarrow$@ (R : Rel S Level.zero) @$\rightarrow$@ (a b : S) @$\rightarrow$@
+               Iff (restPre X R a b) (comp (delta X) R a b)
+deltaRestPre X R a b
+  = (@$\lambda$@ (h : restPre X R a b) @$\rightarrow$@ a , (proj@$\_{1}$@ h , ref) , proj@$\_{2}$@ h) ,
+     @$\lambda$@ (h : comp (delta X) R a b) @$\rightarrow$@ proj@$\_{1}$@ (proj@$\_{1}$@ (proj@$\_{2}$@ h)) ,
+       substId2
+         (proj@$\_{2}$@ (proj@$\_{1}$@ (proj@$\_{2}$@ h)))
+         (@$\lambda$@ z @$\rightarrow$@ R z b) (proj@$\_{2}$@ (proj@$\_{2}$@ h))
+
+deltaRestPost : (X : Pred S) @$\rightarrow$@ (R : Rel S Level.zero) @$\rightarrow$@ (a b : S) @$\rightarrow$@
+                Iff (restPost X R a b) (comp R (delta X) a b)
+deltaRestPost X R a b
+  = (@$\lambda$@ (h : restPost X R a b) @$\rightarrow$@ b , proj@$\_{1}$@ h , proj@$\_{2}$@ h , ref) ,
+     @$\lambda$@ (h : comp R (delta X) a b) @$\rightarrow$@
+       substId1 (proj@$\_{2}$@ (proj@$\_{2}$@ (proj@$\_{2}$@ h))) (R a) (proj@$\_{1}$@ (proj@$\_{2}$@ h)) ,
+       substId1 (proj@$\_{2}$@ (proj@$\_{2}$@ (proj@$\_{2}$@ h))) X (proj@$\_{1}$@ (proj@$\_{2}$@ (proj@$\_{2}$@ h)))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/SingleLinkedStack.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,110 @@
+#include "../context.h"
+#include "../origin_cs.h"
+#include <stdio.h>
+
+// typedef struct SingleLinkedStack {
+//     struct Element* top;
+// } SingleLinkedStack;
+
+Stack* createSingleLinkedStack(struct Context* context) {
+    struct Stack* stack = new Stack();
+    struct SingleLinkedStack* singleLinkedStack = new SingleLinkedStack();
+    stack->stack = (union Data*)singleLinkedStack;
+    singleLinkedStack->top = NULL;
+    stack->push = C_pushSingleLinkedStack;
+    stack->pop  = C_popSingleLinkedStack;
+    stack->pop2  = C_pop2SingleLinkedStack;
+    stack->get  = C_getSingleLinkedStack;
+    stack->get2  = C_get2SingleLinkedStack;
+    stack->isEmpty = C_isEmptySingleLinkedStack;
+    stack->clear = C_clearSingleLinkedStack;
+    return stack;
+}
+
+void printStack1(union Data* data) {
+    struct Node* node = &data->Element.data->Node;
+    if (node == NULL) {
+        printf("NULL");
+    } else {
+        printf("key = %d ,", node->key);
+        printStack1((union Data*)data->Element.next);
+    }
+}
+
+void printStack(union Data* data) {
+    printStack1(data);
+    printf("\n");
+}
+
+__code clearSingleLinkedStack(struct SingleLinkedStack* stack,__code next(...)) {
+    stack->top = NULL;
+    goto next(...);
+}
+
+__code pushSingleLinkedStack(struct SingleLinkedStack* stack,union Data* data, __code next(...)) {
+    Element* element = new Element();
+    element->next = stack->top;
+    element->data = data;
+    stack->top = element;
+    goto next(...);
+}
+
+__code popSingleLinkedStack(struct SingleLinkedStack* stack, __code next(union Data* data, ...)) {
+    if (stack->top) {
+        data = stack->top->data;
+        stack->top = stack->top->next;
+    } else {
+        data = NULL;
+    }
+    goto next(data, ...);
+}
+
+__code pop2SingleLinkedStack(struct SingleLinkedStack* stack, __code next(union Data* data, union Data* data1, ...)) {
+    if (stack->top) {
+        data = stack->top->data;
+        stack->top = stack->top->next;
+    } else {
+        data = NULL;
+    }
+    if (stack->top) {
+        data1 = stack->top->data;
+        stack->top = stack->top->next;
+    } else {
+        data1 = NULL;
+    }
+    goto next(data, data1, ...);
+}
+
+
+__code getSingleLinkedStack(struct SingleLinkedStack* stack, __code next(union Data* data, ...)) {
+    if (stack->top)
+        data = stack->top->data;
+    else
+        data = NULL;
+    goto next(data, ...);
+}
+
+__code get2SingleLinkedStack(struct SingleLinkedStack* stack, __code next(union Data* data, union Data* data1, ...)) {
+    if (stack->top) {
+        data = stack->top->data;
+        if (stack->top->next) {
+            data1 = stack->top->next->data;
+        } else {
+            data1 = NULL;
+        }
+    } else {
+        data = NULL;
+        data1 = NULL;
+    }
+    goto next(data, data1, ...);
+}
+
+__code isEmptySingleLinkedStack(struct SingleLinkedStack* stack, __code next(...), __code whenEmpty(...)) {
+    if (stack->top)
+        goto next(...);
+    else
+        goto whenEmpty(...);
+}
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Stack.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,14 @@
+typedef struct Stack<Impl>{
+    union Data* stack;
+    union Data* data;
+    union Data* data1;
+    __code whenEmpty(...);
+    __code clear(Impl* stack,__code next(...));
+    __code push(Impl* stack,union Data* data, __code next(...));
+    __code pop(Impl* stack, __code next(union Data*, ...));
+    __code pop2(Impl* stack, union Data** data, union Data** data1, __code next(union Data**, union Data**, ...));
+    __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
+    __code get(Impl* stack, union Data** data, __code next(...));
+    __code get2(Impl* stack,..., __code next(...));
+    __code next(...);
+} Stack;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ThreePlusOne.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+open import Relation.Binary.PropositionalEquality
+open import nat
+open import nat_add
+
+module three_plus_one where
+
+3+1 : (S (S (S O)))  +  (S O) ≡ (S (S (S (S O))))
+3+1 = refl
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ThreePlusOne.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+open import Relation.Binary.PropositionalEquality
+open import nat
+open import nat_add
+
+module three_plus_one where
+
+3+1 : (S (S (S O)))  +  (S O) @$\equiv$@ (S (S (S (S O))))
+3+1 = refl
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-func.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
++1 : ℕ → ℕ
++1 m = suc m
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-func.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
++1 : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
++1 m = suc m
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-interpret.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+{-# TERMINATING #-}
+interpret : Env → Comm → Env
+interpret env Skip = env
+interpret env Abort = env
+interpret env (PComm x) = x env
+interpret env (Seq comm comm1) = interpret (interpret env comm) comm1
+interpret env (If x then else) with x env
+... | true = interpret env then
+... | false = interpret env else
+interpret env (While x comm) with x env
+... | true = interpret (interpret env comm) (While x comm)
+... | false = env
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-interpret.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+{-@$\#$@ TERMINATING @$\#$@-}
+interpret : Env @$\rightarrow$@ Comm @$\rightarrow$@ Env
+interpret env Skip = env
+interpret env Abort = env
+interpret env (PComm x) = x env
+interpret env (Seq comm comm1) = interpret (interpret env comm) comm1
+interpret env (If x then else) with x env
+... | true = interpret env then
+... | false = interpret env else
+interpret env (While x comm) with x env
+... | true = interpret (interpret env comm) (While x comm)
+... | false = env
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-prog.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+program : Comm
+program =
+  Seq ( PComm (λ env → record env {varn = 10}))
+    $ Seq ( PComm (λ env → record env {vari = 0}))
+    $ While (λ env → lt zero (varn env ) )
+      (Seq (PComm (λ env → record env {vari = ((vari env) + 1)} ))
+        $ PComm (λ env → record env {varn = ((varn env) - 1)} ))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-prog.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+program : Comm
+program =
+  Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = 10}))
+    $ Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0}))
+    $ While (@$\lambda$@ env @$\rightarrow$@ lt zero (varn env ) )
+      (Seq (PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = ((vari env) + 1)} ))
+        $ PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = ((varn env) - 1)} ))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-rule.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,27 @@
+data HTProof : Cond -> Comm -> Cond -> Set where
+  PrimRule : {bPre : Cond} -> {pcm : PrimComm} -> {bPost : Cond} ->
+             (pr : Axiom bPre pcm bPost) ->
+             HTProof bPre (PComm pcm) bPost
+  SkipRule : (b : Cond) -> HTProof b Skip b
+  AbortRule : (bPre : Cond) -> (bPost : Cond) ->
+              HTProof bPre Abort bPost
+  WeakeningRule : {bPre : Cond} -> {bPre' : Cond} -> {cm : Comm} ->
+                {bPost' : Cond} -> {bPost : Cond} ->
+                Tautology bPre bPre' ->
+                HTProof bPre' cm bPost' ->
+                Tautology bPost' bPost ->
+                HTProof bPre cm bPost
+  SeqRule : {bPre : Cond} -> {cm1 : Comm} -> {bMid : Cond} ->
+            {cm2 : Comm} -> {bPost : Cond} ->
+            HTProof bPre cm1 bMid ->
+            HTProof bMid cm2 bPost ->
+            HTProof bPre (Seq cm1 cm2) bPost
+  IfRule : {cmThen : Comm} -> {cmElse : Comm} ->
+           {bPre : Cond} -> {bPost : Cond} ->
+           {b : Cond} ->
+           HTProof (bPre /\ b) cmThen bPost ->
+           HTProof (bPre /\ neg b) cmElse bPost ->
+           HTProof bPre (If b cmThen cmElse) bPost
+  WhileRule : {cm : Comm} -> {bInv : Cond} -> {b : Cond} ->
+              HTProof (bInv /\ b) cm bInv ->
+              HTProof bInv (While b cm) (bInv /\ neg b)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-rule.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,27 @@
+data HTProof : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Cond @$\rightarrow$@ Set where
+  PrimRule : {bPre : Cond} @$\rightarrow$@ {pcm : PrimComm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+             (pr : Axiom bPre pcm bPost) @$\rightarrow$@
+             HTProof bPre (PComm pcm) bPost
+  SkipRule : (b : Cond) @$\rightarrow$@ HTProof b Skip b
+  AbortRule : (bPre : Cond) @$\rightarrow$@ (bPost : Cond) @$\rightarrow$@
+              HTProof bPre Abort bPost
+  WeakeningRule : {bPre : Cond} @$\rightarrow$@ {bPre' : Cond} @$\rightarrow$@ {cm : Comm} @$\rightarrow$@
+                {bPost' : Cond} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+                Tautology bPre bPre' @$\rightarrow$@
+                HTProof bPre' cm bPost' @$\rightarrow$@
+                Tautology bPost' bPost @$\rightarrow$@
+                HTProof bPre cm bPost
+  SeqRule : {bPre : Cond} @$\rightarrow$@ {cm1 : Comm} @$\rightarrow$@ {bMid : Cond} @$\rightarrow$@
+            {cm2 : Comm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+            HTProof bPre cm1 bMid @$\rightarrow$@
+            HTProof bMid cm2 bPost @$\rightarrow$@
+            HTProof bPre (Seq cm1 cm2) bPost
+  IfRule : {cmThen : Comm} @$\rightarrow$@ {cmElse : Comm} @$\rightarrow$@
+           {bPre : Cond} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+           {b : Cond} @$\rightarrow$@
+           HTProof (bPre @$\wedge$@ b) cmThen bPost @$\rightarrow$@
+           HTProof (bPre @$\wedge$@ neg b) cmElse bPost @$\rightarrow$@
+           HTProof bPre (If b cmThen cmElse) bPost
+  WhileRule : {cm : Comm} @$\rightarrow$@ {bInv : Cond} @$\rightarrow$@ {b : Cond} @$\rightarrow$@
+              HTProof (bInv @$\wedge$@ b) cm bInv @$\rightarrow$@
+              HTProof bInv (While b cm) (bInv @$\wedge$@ neg b)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-satisfies.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,25 @@
+SemComm : Comm -> Rel State (Level.zero)
+SemComm Skip = RelOpState.deltaGlob
+SemComm Abort = RelOpState.emptyRel
+SemComm (PComm pc) = PrimSemComm pc
+SemComm (Seq c1 c2) = RelOpState.comp (SemComm c1) (SemComm c2)
+SemComm (If b c1 c2)
+  = RelOpState.union
+    (RelOpState.comp (RelOpState.delta (SemCond b))
+                     (SemComm c1))
+    (RelOpState.comp (RelOpState.delta (NotP (SemCond b)))
+                     (SemComm c2))
+SemComm (While b c)
+  = RelOpState.unionInf
+    (λ (n : $mathbb{N}$) ->
+      RelOpState.comp (RelOpState.repeat
+        n
+        (RelOpState.comp
+          (RelOpState.delta (SemCond b))
+          (SemComm c)))
+      (RelOpState.delta (NotP (SemCond b))))
+
+Satisfies : Cond -> Comm -> Cond -> Set
+Satisfies bPre cm bPost
+  = (s1 : State) -> (s2 : State) ->
+    SemCond bPre s1 -> SemComm cm s1 s2 -> SemCond bPost s2
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-satisfies.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,25 @@
+SemComm : Comm @$\rightarrow$@ Rel State (Level.zero)
+SemComm Skip = RelOpState.deltaGlob
+SemComm Abort = RelOpState.emptyRel
+SemComm (PComm pc) = PrimSemComm pc
+SemComm (Seq c1 c2) = RelOpState.comp (SemComm c1) (SemComm c2)
+SemComm (If b c1 c2)
+  = RelOpState.union
+    (RelOpState.comp (RelOpState.delta (SemCond b))
+                     (SemComm c1))
+    (RelOpState.comp (RelOpState.delta (NotP (SemCond b)))
+                     (SemComm c2))
+SemComm (While b c)
+  = RelOpState.unionInf
+    (@$\lambda$@ (n : $mathbb{N}$) @$\rightarrow$@
+      RelOpState.comp (RelOpState.repeat
+        n
+        (RelOpState.comp
+          (RelOpState.delta (SemCond b))
+          (SemComm c)))
+      (RelOpState.delta (NotP (SemCond b))))
+
+Satisfies : Cond @$\rightarrow$@ Comm @$\rightarrow$@ Cond @$\rightarrow$@ Set
+Satisfies bPre cm bPost
+  = (s1 : State) @$\rightarrow$@ (s2 : State) @$\rightarrow$@
+    SemCond bPre s1 @$\rightarrow$@ SemComm cm s1 s2 @$\rightarrow$@ SemCond bPost s2
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-soundness.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,66 @@
+Soundness : {bPre : Cond} -> {cm : Comm} -> {bPost : Cond} ->
+            HTProof bPre cm bPost -> Satisfies bPre cm bPost
+Soundness (PrimRule {bPre} {cm} {bPost} pr) s1 s2 q1 q2
+  = axiomValid bPre cm bPost pr s1 s2 q1 q2
+Soundness {.bPost} {.Skip} {bPost} (SkipRule .bPost) s1 s2 q1 q2
+  = substId1 State {Level.zero} {State} {s1} {s2} (proj₂ q2) (SemCond bPost) q1
+Soundness {bPre} {.Abort} {bPost} (AbortRule .bPre .bPost) s1 s2 q1 ()
+Soundness (WeakeningRule {bPre} {bPre'} {cm} {bPost'} {bPost} tautPre pr tautPost)
+          s1 s2 q1 q2
+  = let hyp : Satisfies bPre' cm bPost'
+        hyp = Soundness pr
+    in tautValid bPost' bPost tautPost s2 (hyp s1 s2 (tautValid bPre bPre' tautPre s1 q1) q2)
+Soundness (SeqRule {bPre} {cm1} {bMid} {cm2} {bPost} pr1 pr2)
+           s1 s2 q1 q2
+  = let hyp1 : Satisfies bPre cm1 bMid
+        hyp1 = Soundness pr1
+        hyp2 : Satisfies bMid cm2 bPost
+        hyp2 = Soundness pr2
+    in hyp2 (proj₁ q2) s2 (hyp1 s1 (proj₁ q2) q1 (proj₁ (proj₂ q2))) (proj₂ (proj₂ q2))
+Soundness (IfRule {cmThen} {cmElse} {bPre} {bPost} {b} pThen pElse)
+          s1 s2 q1 q2
+  = let hypThen : Satisfies (bPre /\ b) cmThen bPost
+        hypThen = Soundness pThen
+        hypElse : Satisfies (bPre /\ neg b) cmElse bPost
+        hypElse = Soundness pElse
+        rThen : RelOpState.comp (RelOpState.delta (SemCond b))
+                  (SemComm cmThen) s1 s2 -> SemCond bPost s2
+        rThen = λ h -> hypThen s1 s2 ((proj₂ (respAnd bPre b s1)) (q1 , proj₁ t1))
+          (proj₂ ((proj₂ (RelOpState.deltaRestPre (SemCond b) (SemComm cmThen) s1 s2)) h))
+        rElse : RelOpState.comp (RelOpState.delta (NotP (SemCond b)))
+                  (SemComm cmElse) s1 s2 -> SemCond bPost s2
+        rElse = λ h ->
+                  let t10 : (NotP (SemCond b) s1) × (SemComm cmElse s1 s2)
+                      t10 = proj₂ (RelOpState.deltaRestPre
+                                  (NotP (SemCond b)) (SemComm cmElse) s1 s2) h
+                  in hypElse s1 s2 (proj₂ (respAnd bPre (neg b) s1)
+                             (q1 , (proj₂ (respNeg b s1) (proj₁ t10)))) (proj₂ t10)
+    in when rThen rElse q2
+Soundness (WhileRule {cm'} {bInv} {b} pr) s1 s2 q1 q2
+  = proj₂ (respAnd bInv (neg b) s2)
+          (lem1 (proj₁ q2) s2 (proj₁ t15) , proj₂ (respNeg b s2) (proj₂ t15))
+    where
+      hyp : Satisfies (bInv /\ b) cm' bInv
+      hyp = Soundness pr
+      Rel1 : ℕ -> Rel State (Level.zero)
+      Rel1 = λ m ->
+               RelOpState.repeat
+                 m
+                 (RelOpState.comp (RelOpState.delta (SemCond b))
+                                  (SemComm cm'))
+      t15 : (Rel1 (proj₁ q2) s1 s2) × (NotP (SemCond b) s2)
+      t15 = proj₂ (RelOpState.deltaRestPost
+        (NotP (SemCond b)) (Rel1 (proj₁ q2)) s1 s2) (proj₂ q2)
+      lem1 : (m : ℕ) -> (ss2 : State) -> Rel1 m s1 ss2 -> SemCond bInv ss2
+      lem1 zero ss2 h = substId1 State (proj₂ h) (SemCond bInv) q1
+      lem1 (suc n) ss2 h
+    = let hyp2 : (z : State) -> Rel1 (proj₁ q2) s1 z ->
+                     SemCond bInv z
+              hyp2 = lem1 n
+              t22 : (SemCond b (proj₁ h)) × (SemComm cm' (proj₁ h) ss2)
+              t22 = proj₂ (RelOpState.deltaRestPre (SemCond b) (SemComm cm') (proj₁ h) ss2)
+                    (proj₂ (proj₂ h))
+              t23 : SemCond (bInv /\ b) (proj₁ h)
+              t23 = proj₂ (respAnd bInv b (proj₁ h))
+                (hyp2 (proj₁ h) (proj₁ (proj₂ h)) , proj₁ t22)
+      in hyp (proj₁ h) ss2 t23 (proj₂ t22)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-soundness.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,66 @@
+Soundness : {bPre : Cond} @$\rightarrow$@ {cm : Comm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+            HTProof bPre cm bPost @$\rightarrow$@ Satisfies bPre cm bPost
+Soundness (PrimRule {bPre} {cm} {bPost} pr) s1 s2 q1 q2
+  = axiomValid bPre cm bPost pr s1 s2 q1 q2
+Soundness {.bPost} {.Skip} {bPost} (SkipRule .bPost) s1 s2 q1 q2
+  = substId1 State {Level.zero} {State} {s1} {s2} (proj@$\_{2}$@ q2) (SemCond bPost) q1
+Soundness {bPre} {.Abort} {bPost} (AbortRule .bPre .bPost) s1 s2 q1 ()
+Soundness (WeakeningRule {bPre} {bPre'} {cm} {bPost'} {bPost} tautPre pr tautPost)
+          s1 s2 q1 q2
+  = let hyp : Satisfies bPre' cm bPost'
+        hyp = Soundness pr
+    in tautValid bPost' bPost tautPost s2 (hyp s1 s2 (tautValid bPre bPre' tautPre s1 q1) q2)
+Soundness (SeqRule {bPre} {cm1} {bMid} {cm2} {bPost} pr1 pr2)
+           s1 s2 q1 q2
+  = let hyp1 : Satisfies bPre cm1 bMid
+        hyp1 = Soundness pr1
+        hyp2 : Satisfies bMid cm2 bPost
+        hyp2 = Soundness pr2
+    in hyp2 (proj@$\_{1}$@ q2) s2 (hyp1 s1 (proj@$\_{1}$@ q2) q1 (proj@$\_{1}$@ (proj@$\_{2}$@ q2))) (proj@$\_{2}$@ (proj@$\_{2}$@ q2))
+Soundness (IfRule {cmThen} {cmElse} {bPre} {bPost} {b} pThen pElse)
+          s1 s2 q1 q2
+  = let hypThen : Satisfies (bPre @$\wedge$@ b) cmThen bPost
+        hypThen = Soundness pThen
+        hypElse : Satisfies (bPre @$\wedge$@ neg b) cmElse bPost
+        hypElse = Soundness pElse
+        rThen : RelOpState.comp (RelOpState.delta (SemCond b))
+                  (SemComm cmThen) s1 s2 @$\rightarrow$@ SemCond bPost s2
+        rThen = @$\lambda$@ h @$\rightarrow$@ hypThen s1 s2 ((proj@$\_{2}$@ (respAnd bPre b s1)) (q1 , proj@$\_{1}$@ t1))
+          (proj@$\_{2}$@ ((proj@$\_{2}$@ (RelOpState.deltaRestPre (SemCond b) (SemComm cmThen) s1 s2)) h))
+        rElse : RelOpState.comp (RelOpState.delta (NotP (SemCond b)))
+                  (SemComm cmElse) s1 s2 @$\rightarrow$@ SemCond bPost s2
+        rElse = @$\lambda$@ h @$\rightarrow$@
+                  let t10 : (NotP (SemCond b) s1) @$\times$@ (SemComm cmElse s1 s2)
+                      t10 = proj@$\_{2}$@ (RelOpState.deltaRestPre
+                                  (NotP (SemCond b)) (SemComm cmElse) s1 s2) h
+                  in hypElse s1 s2 (proj@$\_{2}$@ (respAnd bPre (neg b) s1)
+                             (q1 , (proj@$\_{2}$@ (respNeg b s1) (proj@$\_{1}$@ t10)))) (proj@$\_{2}$@ t10)
+    in when rThen rElse q2
+Soundness (WhileRule {cm'} {bInv} {b} pr) s1 s2 q1 q2
+  = proj@$\_{2}$@ (respAnd bInv (neg b) s2)
+          (lem1 (proj@$\_{1}$@ q2) s2 (proj@$\_{1}$@ t15) , proj@$\_{2}$@ (respNeg b s2) (proj@$\_{2}$@ t15))
+    where
+      hyp : Satisfies (bInv @$\wedge$@ b) cm' bInv
+      hyp = Soundness pr
+      Rel1 : @$\mathbb{N}$@ @$\rightarrow$@ Rel State (Level.zero)
+      Rel1 = @$\lambda$@ m @$\rightarrow$@
+               RelOpState.repeat
+                 m
+                 (RelOpState.comp (RelOpState.delta (SemCond b))
+                                  (SemComm cm'))
+      t15 : (Rel1 (proj@$\_{1}$@ q2) s1 s2) @$\times$@ (NotP (SemCond b) s2)
+      t15 = proj@$\_{2}$@ (RelOpState.deltaRestPost
+        (NotP (SemCond b)) (Rel1 (proj@$\_{1}$@ q2)) s1 s2) (proj@$\_{2}$@ q2)
+      lem1 : (m : @$\mathbb{N}$@) @$\rightarrow$@ (ss2 : State) @$\rightarrow$@ Rel1 m s1 ss2 @$\rightarrow$@ SemCond bInv ss2
+      lem1 zero ss2 h = substId1 State (proj@$\_{2}$@ h) (SemCond bInv) q1
+      lem1 (suc n) ss2 h
+    = let hyp2 : (z : State) @$\rightarrow$@ Rel1 (proj@$\_{1}$@ q2) s1 z @$\rightarrow$@
+                     SemCond bInv z
+              hyp2 = lem1 n
+              t22 : (SemCond b (proj@$\_{1}$@ h)) @$\times$@ (SemComm cm' (proj@$\_{1}$@ h) ss2)
+              t22 = proj@$\_{2}$@ (RelOpState.deltaRestPre (SemCond b) (SemComm cm') (proj@$\_{1}$@ h) ss2)
+                    (proj@$\_{2}$@ (proj@$\_{2}$@ h))
+              t23 : SemCond (bInv @$\wedge$@ b) (proj@$\_{1}$@ h)
+              t23 = proj@$\_{2}$@ (respAnd bInv b (proj@$\_{1}$@ h))
+                (hyp2 (proj@$\_{1}$@ h) (proj@$\_{1}$@ (proj@$\_{2}$@ h)) , proj@$\_{1}$@ t22)
+      in hyp (proj@$\_{1}$@ h) ss2 t23 (proj@$\_{2}$@ t22)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-term.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+loopP' : {l : Level} {t : Set l} → Envc → (exit : Envc → t) → t
+loopP' record { c10 = c10 ; varn = zero ; vari = vari } exit =
+  exit (record { c10 = c10 ; varn = zero ; vari = vari })
+loopP' record { c10 = c10 ; varn = (suc varn₁) ; vari = vari } exit =
+  whileLoopP' (record { c10 = c10 ; varn = (suc varn₁) ; vari = vari })
+  (λ env → loopP' (record { c10 = c10 ; varn = varn₁ ; vari = vari }) exit ) exit
+
+whileTestPCall' : (c10 :  ℕ ) → Envc
+whileTestPCall' c10 = whileTestP' {_} {_} c10 (λ env → loopP' env (λ env →  env))
+
+-- whileTestP' 10
+-- record { c10 = 10 ; varn = 0 ; vari = 10 }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-term.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+loopP' : {l : Level} {t : Set l} @$\rightarrow$@ Envc @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+loopP' record { c10 = c10 ; varn = zero ; vari = vari } exit =
+  exit (record { c10 = c10 ; varn = zero ; vari = vari })
+loopP' record { c10 = c10 ; varn = (suc varn@$\_{1}$@) ; vari = vari } exit =
+  whileLoopP' (record { c10 = c10 ; varn = (suc varn@$\_{1}$@) ; vari = vari })
+  (@$\lambda$@ env @$\rightarrow$@ loopP' (record { c10 = c10 ; varn = varn@$\_{1}$@ ; vari = vari }) exit ) exit
+
+whileTestPCall' : (c10 :  @$\mathbb{N}$@ ) @$\rightarrow$@ Envc
+whileTestPCall' c10 = whileTestP' {_} {_} c10 (@$\lambda$@ env @$\rightarrow$@ loopP' env (@$\lambda$@ env @$\rightarrow$@  env))
+
+-- whileTestP' 10
+-- record { c10 = 10 ; varn = 0 ; vari = 10 }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-while.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+proof1 : HTProof initCond program termCond
+proof1 =
+  SeqRule {λ e → true} ( PrimRule empty-case )
+    $ SeqRule {λ e →  Equal (varn e) 10} ( PrimRule lemma1   )
+    $ WeakeningRule {λ e → (Equal (varn e) 10) ∧ (Equal (vari e) 0)}  lemma2 (
+      WhileRule {_} {λ e → Equal ((varn e) + (vari e)) 10}
+        $ SeqRule (PrimRule {λ e →  whileInv e  ∧ lt zero (varn e) } lemma3 )
+        $ PrimRule {whileInv'} {_} {whileInv}  lemma4 ) lemma5
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-while.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+proof1 : HTProof initCond program termCond
+proof1 =
+  SeqRule {@$\lambda$@ e @$\rightarrow$@ true} ( PrimRule empty-case )
+    $ SeqRule {@$\lambda$@ e @$\rightarrow$@  Equal (varn e) 10} ( PrimRule lemma1   )
+    $ WeakeningRule {@$\lambda$@ e @$\rightarrow$@ (Equal (varn e) 10) @$\wedge$@ (Equal (vari e) 0)}  lemma2 (
+      WhileRule {_} {@$\lambda$@ e @$\rightarrow$@ Equal ((varn e) + (vari e)) 10}
+        $ SeqRule (PrimRule {@$\lambda$@ e @$\rightarrow$@  whileInv e  @$\wedge$@ lt zero (varn e) } lemma3 )
+        $ PrimRule {whileInv'} {_} {whileInv}  lemma4 ) lemma5
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-whileprog.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,16 @@
+whileTestP : {l : Level} {t : Set l} → (c10 : ℕ) → (Code : Envc → t) → t
+whileTestP c10 next = next (record {c10 = c10 ; varn = c10 ; vari = 0 })
+
+whileLoopP' : {l : Level} {t : Set l} → Envc → (next : Envc → t) → (exit : Envc → t) → t
+whileLoopP' record { c10 = c10 ; varn = zero ; vari = vari } _ exit = exit record { c10 = c10 ; varn = zero ; vari = vari }
+whileLoopP' record { c10 = c10 ; varn = suc varn1 ; vari = vari } next _ = next (record {c10 = c10 ; varn = varn1 ; vari = suc vari })
+
+{-# TERMINATING #-}
+loopP : {l : Level} {t : Set l} → Envc → (exit : Envc → t) → t
+loopP env exit = whileLoopP' env (λ env → loopP env exit ) exit
+
+whileTestPCall : (c10 :  ℕ ) → Envc
+whileTestPCall c10 = whileTestP {_} {_} c10 (λ env → loopP env (λ env →  env))
+
+-- whileTestPCall 10
+-- record { c10 = 10 ; varn = 0 ; vari = 10 }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-whileprog.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,16 @@
+whileTestP : {l : Level} {t : Set l} @$\rightarrow$@ (c10 : @$\mathbb{N}$@) @$\rightarrow$@ (Code : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+whileTestP c10 next = next (record {c10 = c10 ; varn = c10 ; vari = 0 })
+
+whileLoopP' : {l : Level} {t : Set l} @$\rightarrow$@ Envc @$\rightarrow$@ (next : Envc @$\rightarrow$@ t) @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopP' record { c10 = c10 ; varn = zero ; vari = vari } _ exit = exit record { c10 = c10 ; varn = zero ; vari = vari }
+whileLoopP' record { c10 = c10 ; varn = suc varn1 ; vari = vari } next _ = next (record {c10 = c10 ; varn = varn1 ; vari = suc vari })
+
+{-@$\#$@ TERMINATING @$\#$@-}
+loopP : {l : Level} {t : Set l} @$\rightarrow$@ Envc @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+loopP env exit = whileLoopP' env (@$\lambda$@ env @$\rightarrow$@ loopP env exit ) exit
+
+whileTestPCall : (c10 :  @$\mathbb{N}$@ ) @$\rightarrow$@ Envc
+whileTestPCall c10 = whileTestP {_} {_} c10 (@$\lambda$@ env @$\rightarrow$@ loopP env (@$\lambda$@ env @$\rightarrow$@  env))
+
+-- whileTestPCall 10
+-- record { c10 = 10 ; varn = 0 ; vari = 10 }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-write.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+-- Nomal CodeGear
+whileLoop' : {l : Level} {t : Set l} → (n : ℕ) → (env : Envc)
+  → (n ≡ varn env)
+  → (next : Envc → t)
+  → (exit : Envc → t) → t
+whileLoop' zero env refl _ exit = exit env
+whileLoop' (suc n) env refl next _ = next (record env {varn = pred (varn env) ; vari = suc (vari env) })
+
+-- Hoare Logic base CodeGear
+whileLoopPwP' : {l : Level} {t : Set l} → (n : ℕ) → (env : Envc )
+  → (n ≡ varn env) → (pre : varn env + vari env ≡ c10 env)
+  → (next : (env : Envc ) → (pred n ≡ varn env) → (post : varn env + vari env ≡ c10 env) → t)
+  → (exit : (env : Envc ) → (fin : vari env ≡ c10 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))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-hoare-write.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+-- Nomal CodeGear
+whileLoop' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc)
+  @$\rightarrow$@ (n @$\equiv$@ varn env)
+  @$\rightarrow$@ (next : Envc @$\rightarrow$@ t)
+  @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoop' zero env refl _ exit = exit env
+whileLoop' (suc n) env refl next _ = next (record env {varn = pred (varn env) ; vari = suc (vari env) })
+
+-- Hoare Logic base CodeGear
+whileLoopPwP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc )
+  @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ (pre : varn env + vari env @$\equiv$@ c10 env)
+  @$\rightarrow$@ (next : (env : Envc ) @$\rightarrow$@ (pred n @$\equiv$@ varn env) @$\rightarrow$@ (post : varn env + vari env @$\equiv$@ c10 env) @$\rightarrow$@ t)
+  @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ (fin : vari env @$\equiv$@ c10 env)  @$\rightarrow$@ t) @$\rightarrow$@ 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))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-mcg.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+whileTestPwP : {l : Level} {t : Set l} → (c10 : ℕ) →
+             ((env : Envc ) → (mdg : (vari env ≡ 0) /\ (varn env ≡ c10 env)) → t) → t
+whileTestPwP c10 next = next env record { pi1 = refl ; pi2 = refl } where
+  env : Envc
+  env = whileTestP c10 ( λ env → env )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-mcg.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+whileTestPwP : {l : Level} {t : Set l} @$\rightarrow$@ (c10 : @$\mathbb{N}$@) @$\rightarrow$@
+             ((env : Envc ) @$\rightarrow$@ (mdg : (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 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 )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-mdg.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+data whileTestState  : Set where
+  s1 : whileTestState
+  s2 : whileTestState
+  sf : whileTestState
+
+
+whileTestStateP : whileTestState → Envc →  Set
+whileTestStateP s1 env = (vari env ≡ 0) /\ (varn env ≡ c10 env)
+whileTestStateP s2 env = (varn env + vari env ≡ c10 env)
+whileTestStateP sf env = (vari env ≡ c10 env)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-mdg.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+data whileTestState  : Set where
+  s1 : whileTestState
+  s2 : whileTestState
+  sf : whileTestState
+
+
+whileTestStateP : whileTestState @$\rightarrow$@ Envc @$\rightarrow$@  Set
+whileTestStateP s1 env = (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env)
+whileTestStateP s2 env = (varn env + vari env @$\equiv$@ c10 env)
+whileTestStateP sf env = (vari env @$\equiv$@ c10 env)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-pattern.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+_-_ : Nat → Nat → Nat
+n     - zero = n
+zero  - suc m = zero
+suc n - suc m = n - m
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-pattern.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+_-_ : Nat @$\rightarrow$@ Nat @$\rightarrow$@ Nat
+n     - zero = n
+zero  - suc m = zero
+suc n - suc m = n - m
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-plus.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+_+_ : ℕ → ℕ → ℕ
+zero  + m = m
+suc n + m = suc (n + m)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-plus.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+_+_ : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+zero  + m = m
+suc n + m = suc (n + m)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-rewrite.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+rewrite-+-comm : (x y : ℕ) → x + y ≡ y + x
+rewrite-+-comm zero y rewrite (+zero {y}) = refl
+rewrite-+-comm (suc x) y = ?
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-rewrite.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+rewrite-+-comm : (x y : @$\mathbb{N}$@) @$\rightarrow$@ x + y @$\equiv$@ y + x
+rewrite-+-comm zero y rewrite (+zero {y}) = refl
+rewrite-+-comm (suc x) y = ?
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,28 @@
+module agda-term where
+
+open import Data.Nat.Base
+open import Relation.Binary.PropositionalEquality
+
++zero : {y : ℕ} → y + zero ≡ y
++zero {zero} = refl
++zero {suc y} = cong (λ yy → suc yy) (+zero {y})
+
++-suc : {x y : ℕ} → x + suc y ≡ suc (x + y)
++-suc {zero} {y} = refl
++-suc {suc x} {y} = cong suc (+-suc {x} {y})
+
++-comm : (x y : ℕ) → x + y ≡ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open ≡-Reasoning in
+  begin
+  suc (x + y) ≡⟨⟩
+  suc (x + y) ≡⟨ cong suc (+-comm x y) ⟩
+  suc (y + x) ≡⟨ sym (+-suc {y} {x}) ⟩
+  y + suc x ∎
+
++-come : (x y : ℕ) → x + y ≡ y + x
++-come zero y rewrite (+zero {y}) = refl
++-come (suc x) y
+  rewrite (cong suc (+-come x y)) | sym (+-suc {y} {x}) = refl
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,28 @@
+module agda-term where
+
+open import Data.Nat.Base
+open import Relation.Binary.PropositionalEquality
+
++zero : {y : @$\mathbb{N}$@} @$\rightarrow$@ y + zero @$\equiv$@ y
++zero {zero} = refl
++zero {suc y} = cong (@$\lambda$@ yy @$\rightarrow$@ suc yy) (+zero {y})
+
++-suc : {x y : @$\mathbb{N}$@} @$\rightarrow$@ x + suc y @$\equiv$@ suc (x + y)
++-suc {zero} {y} = refl
++-suc {suc x} {y} = cong suc (+-suc {x} {y})
+
++-comm : (x y : @$\mathbb{N}$@) @$\rightarrow$@ x + y @$\equiv$@ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open @$\equiv$@-Reasoning in
+  begin
+  suc (x + y) @$\equiv$@@$\langle$@@$\rangle$@
+  suc (x + y) @$\equiv$@@$\langle$@ cong suc (+-comm x y) @$\rangle$@
+  suc (y + x) @$\equiv$@@$\langle$@ sym (+-suc {y} {x}) @$\rangle$@
+  y + suc x @$\blacksquare$@
+
++-come : (x y : @$\mathbb{N}$@) @$\rightarrow$@ x + y @$\equiv$@ y + x
++-come zero y rewrite (+zero {y}) = refl
++-come (suc x) y
+  rewrite (cong suc (+-come x y)) | sym (+-suc {y} {x}) = refl
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term1.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
++-comm : (x y : ℕ) → x + y ≡ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open ≡-Reasoning in
+  begin
+  ?0 ≡⟨ ?1 ⟩
+  ?2 ∎
+
+-- ?0 : ℕ {(suc x) + y}
+-- ?1 : suc x + y ≡ y + suc x
+-- ?2 : ℕ
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term1.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
++-comm : (x y : @$\mathbb{N}$@) @$\rightarrow$@ x + y @$\equiv$@ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open @$\equiv$@-Reasoning in
+  begin
+  ?0 @$\equiv$@@$\langle$@ ?1 @$\rangle$@
+  ?2 @$\blacksquare$@
+
+-- ?0 : @$\mathbb{N}$@ {(suc x) + y}
+-- ?1 : suc x + y @$\equiv$@ y + suc x
+-- ?2 : @$\mathbb{N}$@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term2.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
++-comm : (x y : ℕ) → x + y ≡ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open ≡-Reasoning in
+  begin
+  (suc x) + y ≡⟨⟩
+  suc (x + y) ≡⟨ cong suc (+-comm x y) ⟩
+  suc (y + x) ≡⟨ ?0 ⟩
+  ?1 ∎
+
+-- ?0 : suc (y + x) ≡ y + suc x
+-- ?1 : y + suc x
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term2.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
++-comm : (x y : @$\mathbb{N}$@) @$\rightarrow$@ x + y @$\equiv$@ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open @$\equiv$@-Reasoning in
+  begin
+  (suc x) + y @$\equiv$@@$\langle$@@$\rangle$@
+  suc (x + y) @$\equiv$@@$\langle$@ cong suc (+-comm x y) @$\rangle$@
+  suc (y + x) @$\equiv$@@$\langle$@ ?0 @$\rangle$@
+  ?1 @$\blacksquare$@
+
+-- ?0 : suc (y + x) @$\equiv$@ y + suc x
+-- ?1 : y + suc x
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term3.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
++-comm : (x y : ℕ) → x + y ≡ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open ≡-Reasoning in
+  begin
+  suc (x + y) ≡⟨⟩
+  suc (x + y) ≡⟨ cong suc (+-comm x y) ⟩
+  suc (y + x) ≡⟨ sym (+-suc {y} {x}) ⟩
+  y + suc x ∎
+
+-- +-suc : {x y : ℕ} → x + suc y ≡ suc (x + y)
+-- +-suc {zero} {y} = refl
+-- +-suc {suc x} {y} = cong suc (+-suc {x} {y})
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/agda-term3.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
++-comm : (x y : @$\mathbb{N}$@) @$\rightarrow$@ x + y @$\equiv$@ y + x
++-comm zero y rewrite (+zero {y}) = refl
++-comm (suc x) y = let open @$\equiv$@-Reasoning in
+  begin
+  suc (x + y) @$\equiv$@@$\langle$@@$\rangle$@
+  suc (x + y) @$\equiv$@@$\langle$@ cong suc (+-comm x y) @$\rangle$@
+  suc (y + x) @$\equiv$@@$\langle$@ sym (+-suc {y} {x}) @$\rangle$@
+  y + suc x @$\blacksquare$@
+
+-- +-suc : {x y : @$\mathbb{N}$@} @$\rightarrow$@ x + suc y @$\equiv$@ suc (x + y)
+-- +-suc {zero} {y} = refl
+-- +-suc {suc x} {y} = cong suc (+-suc {x} {y})
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/atomicImpl.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+__code checkAndSetAtomicReference(struct AtomicReference* atomic, union Data** ptr, union Data* oldData, union Data* newData, __code next(...), __code fail(...)) {
+    if (__sync_bool_compare_and_swap(ptr, oldData, newData)) {
+        goto next(...);
+    }
+    goto fail(...);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/atton-master-meta-sample.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,77 @@
+module atton-master-meta-sample where
+
+open import Data.Nat
+open import Data.Unit
+open import Function
+Int = ℕ
+
+record Context : Set where
+  field
+    a  : Int
+    b  : Int
+    c  : Int
+
+open import subtype Context as N
+
+record Meta : Set where
+  field
+    context : Context
+    c'      : Int
+    next    : N.CodeSegment Context Context
+
+open import subtype Meta as M
+
+instance
+  _ : N.DataSegment Context
+  _ = record { get = id ; set = (\_ c -> c) }
+  _ : M.DataSegment Context
+  _ = record { get = (\m -> Meta.context m)  ;
+               set = (\m c -> record m {context = c}) }
+  _ : M.DataSegment Meta
+  _ = record { get = id ; set = (\_ m -> m) }
+
+
+liftContext : {X Y : Set} {{_ : N.DataSegment X}} {{_ : N.DataSegment Y}} -> N.CodeSegment X Y -> N.CodeSegment Context Context
+liftContext {{x}} {{y}} (N.cs f) = N.cs (\c -> N.DataSegment.set y c (f (N.DataSegment.get x c)))
+
+liftMeta : {X Y : Set} {{_ : M.DataSegment X}} {{_ : M.DataSegment Y}} -> N.CodeSegment X Y -> M.CodeSegment X Y
+liftMeta (N.cs f) = M.cs f
+
+
+gotoMeta : {I O : Set} {{_ : N.DataSegment I}} {{_ : N.DataSegment O}} -> M.CodeSegment Meta Meta -> N.CodeSegment I O -> Meta -> Meta
+gotoMeta mCode code m = M.exec mCode (record m {next = (liftContext code)})
+
+push : M.CodeSegment Meta Meta
+push = M.cs (\m -> M.exec (liftMeta (Meta.next m)) (record m {c' = Context.c (Meta.context m)}))
+
+
+record ds0 : Set where
+  field
+    a : Int
+    b : Int
+
+record ds1 : Set where
+  field
+    c : Int
+
+instance
+  _ : N.DataSegment ds0
+  _ = record { set = (\c d -> record c {a = (ds0.a d) ; b = (ds0.b d)})
+             ; get = (\c ->   record { a = (Context.a c) ; b = (Context.b c)})}
+  _ : N.DataSegment ds1
+  _ = record { set = (\c d -> record c {c = (ds1.c d)})
+             ; get = (\c ->   record { c = (Context.c c)})}
+
+cs2 : N.CodeSegment ds1 ds1
+cs2 = N.cs id
+
+cs1 : N.CodeSegment ds1 ds1
+cs1 = N.cs (\d -> N.goto cs2 d)
+
+cs0 : N.CodeSegment ds0 ds1
+cs0 = N.cs (\d -> N.goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+
+main : Meta
+main = gotoMeta push cs0 (record {context = (record {a = 100 ; b = 50 ; c = 70}) ; c' = 0 ; next = (N.cs id)})
+-- record {context = record {a = 100 ; b = 50 ; c = 150} ; c' = 70 ; next = (N.cs id)}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/atton-master-meta-sample.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,77 @@
+module atton-master-meta-sample where
+
+open import Data.Nat
+open import Data.Unit
+open import Function
+Int = @$\mathbb{N}$@
+
+record Context : Set where
+  field
+    a  : Int
+    b  : Int
+    c  : Int
+
+open import subtype Context as N
+
+record Meta : Set where
+  field
+    context : Context
+    c'      : Int
+    next    : N.CodeSegment Context Context
+
+open import subtype Meta as M
+
+instance
+  _ : N.DataSegment Context
+  _ = record { get = id ; set = (\_ c @$\rightarrow$@ c) }
+  _ : M.DataSegment Context
+  _ = record { get = (\m @$\rightarrow$@ Meta.context m)  ;
+               set = (\m c @$\rightarrow$@ record m {context = c}) }
+  _ : M.DataSegment Meta
+  _ = record { get = id ; set = (\_ m @$\rightarrow$@ m) }
+
+
+liftContext : {X Y : Set} {{_ : N.DataSegment X}} {{_ : N.DataSegment Y}} @$\rightarrow$@ N.CodeSegment X Y @$\rightarrow$@ N.CodeSegment Context Context
+liftContext {{x}} {{y}} (N.cs f) = N.cs (\c @$\rightarrow$@ N.DataSegment.set y c (f (N.DataSegment.get x c)))
+
+liftMeta : {X Y : Set} {{_ : M.DataSegment X}} {{_ : M.DataSegment Y}} @$\rightarrow$@ N.CodeSegment X Y @$\rightarrow$@ M.CodeSegment X Y
+liftMeta (N.cs f) = M.cs f
+
+
+gotoMeta : {I O : Set} {{_ : N.DataSegment I}} {{_ : N.DataSegment O}} @$\rightarrow$@ M.CodeSegment Meta Meta @$\rightarrow$@ N.CodeSegment I O @$\rightarrow$@ Meta @$\rightarrow$@ Meta
+gotoMeta mCode code m = M.exec mCode (record m {next = (liftContext code)})
+
+push : M.CodeSegment Meta Meta
+push = M.cs (\m @$\rightarrow$@ M.exec (liftMeta (Meta.next m)) (record m {c' = Context.c (Meta.context m)}))
+
+
+record ds0 : Set where
+  field
+    a : Int
+    b : Int
+
+record ds1 : Set where
+  field
+    c : Int
+
+instance
+  _ : N.DataSegment ds0
+  _ = record { set = (\c d @$\rightarrow$@ record c {a = (ds0.a d) ; b = (ds0.b d)})
+             ; get = (\c @$\rightarrow$@   record { a = (Context.a c) ; b = (Context.b c)})}
+  _ : N.DataSegment ds1
+  _ = record { set = (\c d @$\rightarrow$@ record c {c = (ds1.c d)})
+             ; get = (\c @$\rightarrow$@   record { c = (Context.c c)})}
+
+cs2 : N.CodeSegment ds1 ds1
+cs2 = N.cs id
+
+cs1 : N.CodeSegment ds1 ds1
+cs1 = N.cs (\d @$\rightarrow$@ N.goto cs2 d)
+
+cs0 : N.CodeSegment ds0 ds1
+cs0 = N.cs (\d @$\rightarrow$@ N.goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+
+main : Meta
+main = gotoMeta push cs0 (record {context = (record {a = 100 ; b = 50 ; c = 70}) ; c' = 0 ; next = (N.cs id)})
+-- record {context = record {a = 100 ; b = 50 ; c = 150} ; c' = 70 ; next = (N.cs id)}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/atton-master-sample.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,46 @@
+module atton-master-sample where
+
+open import Data.Nat
+open import Data.Unit
+open import Function
+Int = ℕ
+
+record Context : Set where
+  field
+    a : Int
+    b : Int
+    c : Int
+
+
+open import subtype Context
+
+
+
+record ds0 : Set where
+  field
+    a : Int
+    b : Int
+
+record ds1 : Set where
+  field
+    c : Int
+
+instance
+  _ : DataSegment ds0
+  _ = record { set = (\c d -> record c {a = (ds0.a d) ; b = (ds0.b d)})
+             ; get = (\c ->   record { a = (Context.a c) ; b = (Context.b c)})}
+  _ : DataSegment ds1
+  _ = record { set = (\c d -> record c {c = (ds1.c d)})
+             ; get = (\c ->   record { c = (Context.c c)})}
+
+cs2 : CodeSegment ds1 ds1
+cs2 = cs id
+
+cs1 : CodeSegment ds1 ds1
+cs1 = cs (\d -> goto cs2 d)
+
+cs0 : CodeSegment ds0 ds1
+cs0 = cs (\d -> goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+main : ds1
+main = goto cs0 (record {a = 100 ; b = 50})
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/atton-master-sample.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,46 @@
+module atton-master-sample where
+
+open import Data.Nat
+open import Data.Unit
+open import Function
+Int = @$\mathbb{N}$@
+
+record Context : Set where
+  field
+    a : Int
+    b : Int
+    c : Int
+
+
+open import subtype Context
+
+
+
+record ds0 : Set where
+  field
+    a : Int
+    b : Int
+
+record ds1 : Set where
+  field
+    c : Int
+
+instance
+  _ : DataSegment ds0
+  _ = record { set = (\c d @$\rightarrow$@ record c {a = (ds0.a d) ; b = (ds0.b d)})
+             ; get = (\c @$\rightarrow$@   record { a = (Context.a c) ; b = (Context.b c)})}
+  _ : DataSegment ds1
+  _ = record { set = (\c d @$\rightarrow$@ record c {c = (ds1.c d)})
+             ; get = (\c @$\rightarrow$@   record { c = (Context.c c)})}
+
+cs2 : CodeSegment ds1 ds1
+cs2 = cs id
+
+cs1 : CodeSegment ds1 ds1
+cs1 = cs (\d @$\rightarrow$@ goto cs2 d)
+
+cs0 : CodeSegment ds0 ds1
+cs0 = cs (\d @$\rightarrow$@ goto cs1 (record {c = (ds0.a d) + (ds0.b d)}))
+
+main : ds1
+main = goto cs0 (record {a = 100 ; b = 50})
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/axiom-taut.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+_⇒_ : Bool → Bool → Bool
+false  ⇒  _ = true
+true  ⇒  true = true
+true  ⇒  false = false
+
+Axiom : Cond -> PrimComm -> Cond -> Set
+Axiom pre comm post = ∀ (env : Env) →  (pre env) ⇒ ( post (comm env)) ≡ true
+
+Tautology : Cond -> Cond -> Set
+Tautology pre post = ∀ (env : Env) →  (pre env)  ⇒ (post env) ≡ true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/axiom-taut.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+_@$\Rightarrow$@_ : Bool @$\rightarrow$@ Bool @$\rightarrow$@ Bool
+false  @$\Rightarrow$@  _ = true
+true  @$\Rightarrow$@  true = true
+true  @$\Rightarrow$@  false = false
+
+Axiom : Cond @$\rightarrow$@ PrimComm @$\rightarrow$@ Cond @$\rightarrow$@ Set
+Axiom pre comm post = @$\forall$@ (env : Env) @$\rightarrow$@  (pre env) @$\Rightarrow$@ ( post (comm env)) @$\equiv$@ true
+
+Tautology : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Set
+Tautology pre post = @$\forall$@ (env : Env) @$\rightarrow$@  (pre env)  @$\Rightarrow$@ (post env) @$\equiv$@ true
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-agda.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+plus : {l : Level} {t : Set l} → (x y : ℕ) → (next : ℕ -> t) -> t
+plus x zero next = next x
+plus x (suc y) next = plus (suc x) y next
+
+-- plus 10 20
+--   λ next → next 30
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-agda.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+plus : {l : Level} {t : Set l} @$\rightarrow$@ (x y : @$\mathbb{N}$@) @$\rightarrow$@ (next : @$\mathbb{N}$@ @$\rightarrow$@ t) @$\rightarrow$@ t
+plus x zero next = next x
+plus x (suc y) next = plus (suc x) y next
+
+-- plus 10 20
+--   @$\lambda$@ next @$\rightarrow$@ next 30
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-condition.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+data whileTestState  : Set where
+  s1 : whileTestState
+  s2 : whileTestState
+  sf : whileTestState
+
+whileTestStateP : whileTestState → Envc →  Set
+whileTestStateP s1 env = (vari env ≡ 0) /\ (varn env ≡ c10 env)
+whileTestStateP s2 env = (varn env + vari env ≡ c10 env)
+whileTestStateP sf env = (vari env ≡ c10 env)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-condition.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+data whileTestState  : Set where
+  s1 : whileTestState
+  s2 : whileTestState
+  sf : whileTestState
+
+whileTestStateP : whileTestState @$\rightarrow$@ Envc @$\rightarrow$@  Set
+whileTestStateP s1 env = (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env)
+whileTestStateP s2 env = (varn env + vari env @$\equiv$@ c10 env)
+whileTestStateP sf env = (vari env @$\equiv$@ c10 env)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-helperCall.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+whileCallwP : (c : ℕ) → whileTestPCallwP' c
+whileCallwP c = whileTestPwP {_} {_} c
+  (λ env s → loopHelper c (record { c10 = c ; varn = c ; vari = zero }) refl +zero)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-helperCall.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+whileCallwP : (c : @$\mathbb{N}$@) @$\rightarrow$@ whileTestPCallwP' c
+whileCallwP c = whileTestPwP {_} {_} c
+  (@$\lambda$@ env s @$\rightarrow$@ loopHelper c (record { c10 = c ; varn = c ; vari = zero }) refl +zero)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-loop.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+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 _ exit = exit env refl
+whileLoopPwP' (suc n) env refl refl next _ =
+    next (record env {varn = pred (varn env) ; vari = suc (vari env) }) refl (+-suc n (vari env))
+
+
+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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-loop.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+whileLoopPwP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc )
+    @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env
+    @$\rightarrow$@ (next : (env : Envc ) @$\rightarrow$@ (pred n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env  @$\rightarrow$@ t)
+    @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env  @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopPwP' zero env refl refl _ exit = exit env refl
+whileLoopPwP' (suc n) env refl refl next _ =
+    next (record env {varn = pred (varn env) ; vari = suc (vari env) }) refl (+-suc n (vari env))
+
+
+loopPwP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc )
+    @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env
+    @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env @$\rightarrow$@ t) @$\rightarrow$@ t
+loopPwP' zero env refl refl exit = exit env refl
+loopPwP' (suc n) env refl refl exit
+    = whileLoopPwP' (suc n) env refl refl (@$\lambda$@ env x y @$\rightarrow$@ loopPwP' n env x y exit) exit
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-loophelper.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+loopHelper : (n : ℕ) → (env : Envc ) → (eq : varn env ≡ n) → (seq : whileTestStateP s2 env)
+           → loopPwP' n env (sym eq) seq (λ env₁ x → (vari env₁ ≡ c10 env₁))
+loopHelper zero env eq refl rewrite eq = refl
+loopHelper (suc n) env refl refl =
+           loopHelper n (record { c10 = suc (n + vari env) ; varn = n ; vari = suc (vari env) }) refl (+-suc n (vari env))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-loophelper.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+loopHelper : (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ (eq : varn env @$\equiv$@ n) @$\rightarrow$@ (seq : whileTestStateP s2 env)
+           @$\rightarrow$@ loopPwP' n env (sym eq) seq (@$\lambda$@ env@$\_{1}$@ x @$\rightarrow$@ (vari env@$\_{1}$@ @$\equiv$@ c10 env@$\_{1}$@))
+loopHelper zero env eq refl rewrite eq = refl
+loopHelper (suc n) env refl refl =
+           loopHelper n (record { c10 = suc (n + vari env) ; varn = n ; vari = suc (vari env) }) refl (+-suc n (vari env))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-prim.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+whileTestPwP : {l : Level} {t : Set l} → (c10 : ℕ) → ((env : Envc ) → whileTestStateP s1 env → t) → t
+whileTestPwP c10 next = next env record { pi1 = refl ; pi2 = refl } where
+  env : Envc
+  env = whileTestP c10 ( λ env → env )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-prim.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+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 )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-soundness.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+whileCallwP : (c : ℕ) → whileTestPCallwP' c
+whileCallwP c = whileTestPwP {_} {_} c
+  (λ env s → loopPwP' (c10 env) env (sym (pi2 s)) (conv env s) {!!})
+  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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-soundness.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+whileCallwP : (c : @$\mathbb{N}$@) @$\rightarrow$@ whileTestPCallwP' c
+whileCallwP c = whileTestPwP {_} {_} c
+  (@$\lambda$@ env s @$\rightarrow$@ loopPwP' (c10 env) env (sym (pi2 s)) (conv env s) {!!})
+  where
+    conv : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+    conv e record { pi1 = refl ; pi2 = refl } = +zero
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-while.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+whileCallwP : (c :  ℕ ) → Set
+whileCallwP c = whileTestPwP {_} {_} c (λ env s → loopPwP' (varn env) env refl (conv env s) ( λ env s → vari env ≡ c10 env )  )
+  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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare-while.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+whileCallwP : (c :  @$\mathbb{N}$@ ) @$\rightarrow$@ Set
+whileCallwP c = whileTestPwP {_} {_} c (@$\lambda$@ env s @$\rightarrow$@ loopPwP' (varn env) env refl (conv env s) ( @$\lambda$@ env s @$\rightarrow$@ vari env @$\equiv$@ c10 env )  )
+  where
+    conv : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+    conv e record { pi1 = refl ; pi2 = refl } = +zero
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,14 @@
+whileTestPwP : {l : Level} {t : Set l} → (c10 : ℕ) → ((env : Envc ) → whileTestStateP s1 env → t) → t
+whileTestPwP c10 next = next env record { pi1 = refl ; pi2 = refl } where
+  env : Envc
+  env = whileTestP c10 ( λ env → env )
+
+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
+
+
+whileTestPCallwP' : (c :  ℕ ) → Set
+whileTestPCallwP' c = whileTestPwP {_} {_} c (λ env s → loopPwP' (varn env) env refl (conv env s) ( λ env s → vari env ≡ c10 env )  )
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cbc-hoare.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,14 @@
+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 )
+
+loopPwP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env @$\rightarrow$@ t) @$\rightarrow$@ t
+loopPwP' zero env refl refl exit = exit env refl
+loopPwP' (suc n) env refl refl exit  = whileLoopPwP' (suc n) env refl refl (@$\lambda$@ env x y @$\rightarrow$@ loopPwP' n env x y exit) exit
+
+
+whileTestPCallwP' : (c :  @$\mathbb{N}$@ ) @$\rightarrow$@ Set
+whileTestPCallwP' c = whileTestPwP {_} {_} c (@$\lambda$@ env s @$\rightarrow$@ loopPwP' (varn env) env refl (conv env s) ( @$\lambda$@ env s @$\rightarrow$@ vari env @$\equiv$@ c10 env )  )
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cg1.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+__code cg0(int a, int b) {
+    goto cg1(a+b);
+}
+
+__code cg1(int c) {
+    goto cg2(c);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/codeGearExample.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+__code add(struct Integer* input1, struct Integer* input2, __code next(struct Integer* output, ...)) {
+    output->value = input1->value + input2->value;
+    goto next(output, ...);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/contextContinuation.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,14 @@
+// normal level Code Gear
+__code cg0(struct Context* context, struct Integer integer, struct Queue queue) {
+    ...
+}
+
+// meta level stub Code Gear
+__code cg0_stub(struct Context* context) {
+    // get data index number
+    Integer integer = &context->data[context->dataNum]->Integer
+    // get enum data
+    Queue* queue = &context->data[Queue]->Queue;
+    // continuation Code Gear
+    goto cg0(context, integer, queue);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/createCPUWorker.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,21 @@
+Worker* createCPUWorker(struct Context* context, int id, Queue* queue) {
+    struct Worker* worker = new Worker();
+    struct CPUWorker* cpuWorker = new CPUWorker();
+    worker->worker = (union Data*)cpuWorker;
+    worker->tasks = queue;
+    cpuWorker->id = id;
+    cpuWorker->loopCounter = 0;
+    worker->taskReceive = C_taskReceiveCPUWorker;
+    worker->shutdown = C_shutdownCPUWorker;
+    pthread_create(&worker->thread, NULL, (void*)&startWorker, worker);
+    return worker;
+}
+
+static void startWorker(struct Worker* worker) {
+    struct CPUWorker* cpuWorker = &worker->worker->CPUWorker;
+    cpuWorker->context = NEW(struct Context);
+    initContext(cpuWorker->context);
+    Gearef(cpuWorker->context, Worker)->worker = (union Data*)worker;
+    Gearef(cpuWorker->context, Worker)->tasks = worker->tasks;
+    goto meta(cpuWorker->context, worker->taskReceive);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/createTaskManager.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,46 @@
+TaskManager* createTaskManagerImpl(struct Context* context, int numCPU, int numGPU, int numIO) {
+    struct TaskManager* taskManager = new TaskManager();
+    taskManager->spawnTasks = C_spawnTasksTaskManagerImpl;
+    taskManager->spawn = C_spawnTaskManagerImpl;
+    taskManager->shutdown  = C_shutdownTaskManagerImpl;
+    taskManager->incrementTaskCount = C_incrementTaskCountTaskManagerImpl;
+    taskManager->decrementTaskCount = C_decrementTaskCountTaskManagerImpl;
+    taskManager->setWaitTask = C_setWaitTaskTaskManagerImpl;
+    struct TaskManagerImpl* taskManagerImpl = new TaskManagerImpl();
+    // 0...numIO-1 IOProcessor
+    // numIO...numIO+numGPU-1 GPUProcessor
+    // numIO+numGPU...numIO+numGPU+numCPU-1 CPUProcessor
+    taskManagerImpl->io = 0;
+    taskManagerImpl->gpu = numIO;
+    taskManagerImpl->cpu = numIO+numGPU;
+    taskManagerImpl->maxCPU = numIO+numGPU+numCPU;
+    taskManagerImpl->numWorker = taskManagerImpl->maxCPU;
+    taskManagerImpl->sendGPUWorkerIndex = taskManagerImpl->gpu;
+    taskManagerImpl->sendCPUWorkerIndex = taskManagerImpl->cpu;
+    taskManagerImpl->taskCount = 0;
+    taskManagerImpl->loopCounter = 0;
+    createWorkers(context, taskManagerImpl);
+    taskManager->taskManager = (union Data*)taskManagerImpl;
+    return taskManager;
+}
+
+void createWorkers(struct Context* context, TaskManagerImpl* taskManager) {
+    int i = 0;
+    taskManager->workers = (Worker**)ALLOCATE_PTR_ARRAY(context, Worker, taskManager->maxCPU);
+    for (;i<taskManager->gpu;i++) {
+        Queue* queue = createSynchronizedQueue(context);
+        taskManager->workers[i] = (Worker*)createCPUWorker(context, i, queue);
+    }
+    for (;i<taskManager->cpu;i++) {
+        Queue* queue = createSynchronizedQueue(context);
+#ifdef USE_CUDAWorker
+        taskManager->workers[i] = (Worker*)createCUDAWorker(context, i, queue,0);
+#else
+        taskManager->workers[i] = (Worker*)createCPUWorker(context, i, queue);
+#endif
+    }
+    for (;i<taskManager->maxCPU;i++) {
+        Queue* queue = createSynchronizedQueue(context);
+        taskManager->workers[i] = (Worker*)createCPUWorker(context, i, queue);
+    }
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/cuLaunchKernel.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,21 @@
+int computeblockDim(int count, int maxThreadPerBlock) {
+    return count < maxThreadPerBlock ? count : maxThreadPerBlock;
+}
+
+__code execCUDAExecutor(struct CUDAExecutor* executor, struct Context* task, __code next(...)) {
+    // check data parallelism task
+    if (task->iterate) {
+        struct MultiDimIterator* iterator = &task->iterator->iterator->MultiDimIterator;
+
+        // compute block thread size
+        int blockDimX = computeblockDim(iterator->x, executor->maxThreadPerBlock);
+        int blockDimY = computeblockDim(iterator->y, executor->maxThreadPerBlock);
+        int blockDimZ = computeblockDim(iterator->z, executor->maxThreadPerBlock);
+
+        checkCudaErrors(cuLaunchKernel(task->function,
+                    iterator->x/blockDimX, iterator->y/blockDimY, iterator->z/blockDimZ,
+                    blockDimX, blockDimY, blockDimZ,
+                    0, NULL, (void**)executor->kernelParams, NULL));
+    }
+    ...
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/env.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+record Envc : Set where
+  field
+    vari : ℕ
+    varn : ℕ
+    c10  : ℕ
+
+makeEnv : ℕ → ℕ → ℕ → Envc
+makeEnv i n c = record { vari = i ; varn = n ; c10 = c }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/env.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,8 @@
+record Envc : Set where
+  field
+    vari : @$\mathbb{N}$@
+    varn : @$\mathbb{N}$@
+    c10  : @$\mathbb{N}$@
+
+makeEnv : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Envc
+makeEnv i n c = record { vari = i ; varn = n ; c10 = c }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/ex_stack.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+__code clearSingleLinkedStack(struct SingleLinkedStack* stack,__code next(...)) {
+    stack->top = NULL;
+    goto next(...);
+}
+
+__code pushSingleLinkedStack(struct SingleLinkedStack* stack,union Data* data, __code next(...)) {
+    Element* element = new Element();
+    element->next = stack->top;
+    element->data = data;
+    stack->top = element;
+    goto next(...);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/excbc.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+__code cs0(int a, int b) {
+    goto cs1(a+b);
+}
+
+__code cs1(int c) {
+    goto cs2(c);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/factrial.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,29 @@
+__code print_factorial(int prod)
+{
+  printf("factorial = %d\n", prod);
+  exit(0);
+}
+
+__code factorial0(int prod, int x)
+{
+  if (x >= 1) {
+    goto factorial0(prod*x, x-1);
+  } else {
+    goto print_factorial(prod);
+  }
+
+}
+
+__code factorial(int x)
+{
+  goto factorial0(1, x);
+}
+
+int main(int argc, char **argv)
+{
+  int i;
+  i = atoi(argv[1]);
+
+  goto factorial(i);
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/function.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+_-_ :ℕ →ℕ →ℕ
+x - zero  = x
+zero - _  = zero
+(suc x) - (suc y)  = x - y
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/function.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+_-_ :@$\mathbb{N}$@ @$\rightarrow$@@$\mathbb{N}$@ @$\rightarrow$@@$\mathbb{N}$@
+x - zero  = x
+zero - _  = zero
+(suc x) - (suc y)  = x - y
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gears-while.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,51 @@
+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)
+    proof2 = record {pi1 = refl ; pi2 = refl}
+
+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 ) (pi2 p1 ) ⟩
+            c10 + vari env
+          ≡⟨ cong ( λ n → c10 + n ) (pi1 p1 ) ⟩
+            c10 + 0
+          ≡⟨ +-sym {c10} {0} ⟩
+            c10
+          ∎
+
+{-# 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 env1 (proof3 p ) next
+    where
+      env1 = record {varn = (varn  env) - 1 ; vari = (vari env) + 1}
+      1<0 : 1 ≤ zero → ⊥
+      1<0 ()
+      proof3 : (suc zero  ≤ (varn  env))  → varn env1 + vari env1 ≡ c10
+      proof3 (s≤s lt) with varn  env
+      proof3 (s≤s z≤n) | zero = ⊥-elim (1<0 p)
+      proof3 (s≤s (z≤n {n'}) ) | suc n =  let open ≡-Reasoning  in
+          begin
+             n' + (vari env + 1)
+          ≡⟨ cong ( λ z → n' + z ) ( +-sym  {vari env} {1} )  ⟩
+             n' + (1 + vari env )
+          ≡⟨ sym ( +-assoc (n')  1 (vari env) ) ⟩
+             (n' + 1) + vari env
+          ≡⟨ cong ( λ z → z + vari env )  +1≡suc  ⟩
+             (suc n' ) + vari env
+          ≡⟨⟩
+             varn env + vari env
+          ≡⟨ proof  ⟩
+             c10
+          ∎
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gears-while.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,51 @@
+whileTest : {l : Level} {t : Set l}  @$\rightarrow$@ {c10 : @$\mathbb{N}$@ } @$\rightarrow$@ (Code : (env : Env)  @$\rightarrow$@
+            ((vari env) @$\equiv$@ 0) @$\wedge$@ ((varn env) @$\equiv$@ c10) @$\rightarrow$@ t) @$\rightarrow$@ t
+whileTest {_} {_} {c10} next = next env proof2
+  where
+    env : Env
+    env = record {vari = 0 ; varn = c10}
+    proof2 : ((vari env) @$\equiv$@ 0) @$\wedge$@ ((varn env) @$\equiv$@ c10)
+    proof2 = record {pi1 = refl ; pi2 = refl}
+
+conversion1 : {l : Level} {t : Set l } @$\rightarrow$@ (env : Env) @$\rightarrow$@ {c10 : @$\mathbb{N}$@ } @$\rightarrow$@ ((vari env) @$\equiv$@ 0) @$\wedge$@ ((varn env) @$\equiv$@ c10)
+               @$\rightarrow$@ (Code : (env1 : Env) @$\rightarrow$@ (varn env1 + vari env1 @$\equiv$@ c10) @$\rightarrow$@ t) @$\rightarrow$@ t
+conversion1 env {c10} p1 next = next env proof4
+   where
+      proof4 : varn env + vari env @$\equiv$@ c10
+      proof4 = let open @$\equiv$@-Reasoning  in
+          begin
+            varn env + vari env
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ n @$\rightarrow$@ n + vari env ) (pi2 p1 ) @$\rangle$@
+            c10 + vari env
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ n @$\rightarrow$@ c10 + n ) (pi1 p1 ) @$\rangle$@
+            c10 + 0
+          @$\equiv$@@$\langle$@ +-sym {c10} {0} @$\rangle$@
+            c10
+          @$\blacksquare$@
+
+{-@$\#$@ TERMINATING @$\#$@-}
+whileLoop : {l : Level} {t : Set l} @$\rightarrow$@ (env : Env) @$\rightarrow$@ {c10 : @$\mathbb{N}$@ } @$\rightarrow$@ ((varn env) + (vari env) @$\equiv$@ c10) @$\rightarrow$@ (Code : Env @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoop env proof next with  ( suc zero  @$\leq$@? (varn  env) )
+whileLoop env proof next | no p = next env
+whileLoop env {c10} proof next | yes p = whileLoop env1 (proof3 p ) next
+    where
+      env1 = record {varn = (varn  env) - 1 ; vari = (vari env) + 1}
+      1<0 : 1 @$\leq$@ zero @$\rightarrow$@ @$\bot$@
+      1<0 ()
+      proof3 : (suc zero  @$\leq$@ (varn  env))  @$\rightarrow$@ varn env1 + vari env1 @$\equiv$@ c10
+      proof3 (s@$\leq$@s lt) with varn  env
+      proof3 (s@$\leq$@s z@$\leq$@n) | zero = @$\bot$@-elim (1<0 p)
+      proof3 (s@$\leq$@s (z@$\leq$@n {n'}) ) | suc n =  let open @$\equiv$@-Reasoning  in
+          begin
+             n' + (vari env + 1)
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ n' + z ) ( +-sym  {vari env} {1} )  @$\rangle$@
+             n' + (1 + vari env )
+          @$\equiv$@@$\langle$@ sym ( +-assoc (n')  1 (vari env) ) @$\rangle$@
+             (n' + 1) + vari env
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ z + vari env )  +1@$\equiv$@suc  @$\rangle$@
+             (suc n' ) + vari env
+          @$\equiv$@@$\langle$@@$\rangle$@
+             varn env + vari env
+          @$\equiv$@@$\langle$@ proof  @$\rangle$@
+             c10
+          @$\blacksquare$@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gears.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+proofGears : {c10 : ℕ } → Set
+proofGears {c10} = whileTest {_} {_} {c10} (λ n p1 →  conversion1 n p1 (λ n1 p2 → whileLoop' n1 p2 (λ n2 →  ( vari n2 ≡ c10 ))))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/gears.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+proofGears : {c10 : @$\mathbb{N}$@ } @$\rightarrow$@ Set
+proofGears {c10} = whileTest {_} {_} {c10} (@$\lambda$@ n p1 @$\rightarrow$@  conversion1 n p1 (@$\lambda$@ n1 p2 @$\rightarrow$@ whileLoop' n1 p2 (@$\lambda$@ n2 @$\rightarrow$@  ( vari n2 @$\equiv$@ c10 ))))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/goto.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+__code cs0(int a, int b){
+  goto cs1(a+b);
+}
+
+__code cs1(int c){
+  goto cs2(c);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/implies.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+data _implies_  (A B : Set ) : Set (succ Zero) where
+  proof : ( A → B ) → A implies B
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/implies.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+data _implies_  (A B : Set ) : Set (succ Zero) where
+  proof : ( A @$\rightarrow$@ B ) @$\rightarrow$@ A implies B
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/interface.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+typedef struct Stack<Type, Impl>{
+        union Data* stack;
+        union Data* data;
+        union Data* data1;
+
+        __code whenEmpty(...);
+        __code clear(Impl* stack,__code next(...));
+        __code push(Impl* stack,Type* data, __code next(...));
+        __code pop(Impl* stack, __code next(Type* data, ...));
+        __code get(Impl* stack, __code next(Type* data, ...));
+        __code next(...);
+} Stack;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/iterateCall.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,96 @@
+#include "../context.h"
+#interface "Iterator.h"
+#interface "TaskManager.h"
+#include <stdio.h>
+
+Iterator* createMultiDimIterator(struct Context* context, int x, int y, int z) {
+    struct Iterator* iterator = new Iterator();
+    struct MultiDimIterator* multiDimIterator = new MultiDimIterator();
+    iterator->iterator = (union Data*)multiDimIterator;
+    iterator->exec = C_execMultiDimIterator;
+    iterator->barrier = C_barrierMultiDimIterator;
+    multiDimIterator->x = x;
+    multiDimIterator->y = y;
+    multiDimIterator->z = z;
+    multiDimIterator->count = x * y * z;
+    multiDimIterator->counterX = 0;
+    multiDimIterator->counterY = 0;
+    multiDimIterator->counterZ = 0;
+    return iterator;
+}
+
+/**
+ * create iterateTask with index, that copy from task argument
+ * @return created iterateTask
+ * @param task      task of the copy source
+ * @x     index
+ */
+struct Context* createMultiDimIterateTask(struct Context* task, int x, int y, int z) {
+    struct Context* task1 = NEW(struct Context);
+    initContext(task1);
+    task1->taskManager = task->taskManager;
+    task1->next     = task->next;
+    task1->iterate  = 1;
+    task1->iterator = task->iterator;
+    task1->idgCount = task->idgCount;
+    task1->idg      = task->idg;
+    task1->maxIdg   = task->maxIdg;
+    for(int i = task1->idg; i < task1->maxIdg; i++) {
+        task1->data[i] = task->data[i];
+    }
+
+    // create index data gear and register input data to iterate task
+    struct MultiDim* multiDim = &ALLOCATE_DATA_GEAR(task1, MultiDim)->MultiDim;
+    multiDim->x = x;
+    multiDim->y = y;
+    multiDim->z = z;
+    task1->data[task1->maxIdg++] = (union Data*)multiDim;
+    task1->odg      = task->odg + 1;
+    task1->maxOdg   = task->maxOdg + 1;
+    for (int i = task1->odg; i < task1->maxOdg; i++) {
+        task1->data[i] = task->data[i-1];
+    }
+
+    return task1;
+}
+
+__code execMultiDimIterator(struct MultiDimIterator* iterator, struct Context* task, int numGPU, __code next(...)) {
+    // No GPU device
+    if (numGPU == 0) {
+        goto execMultiDimIterator1();
+    }
+    task->iterate = 1;
+    task->gpu = 1;
+    struct TaskManager* taskManager = task->taskManager;
+    goto taskManager->spawn(task, next(...));
+}
+
+__code execMultiDimIterator1(struct MultiDimIterator* iterator, struct Context* task, __code next(...)) {
+    int x = iterator->counterX;
+    int y = iterator->counterY;
+    int z = iterator->counterZ;
+    struct Context* iterateTask = createMultiDimIterateTask(task, x, y, z);
+    struct TaskManager* taskManager = task->taskManager;
+    goto taskManager->spawn(iterateTask, execMultiDimIterator2);
+}
+
+__code execMultiDimIterator2(struct MultiDimIterator* iterator, struct Context* task, __code next(...)) {
+    if (++iterator->counterX >= iterator->x) {
+        iterator->counterX = 0;
+        if (++iterator->counterY >= iterator->y) {
+            iterator->counterY = 0;
+            if (++iterator->counterZ >= iterator->z) {
+                iterator->counterZ = 0;
+                goto next(...);
+            }
+        }
+    }
+    goto execMultiDimIterator1();
+}
+
+__code barrierMultiDimIterator(struct MultiDimIterator* iterator, struct Context* task, __code next(...), __code whenWait(...)) {
+    if (task->gpu || __sync_fetch_and_sub(&iterator->count, 1) == 1) {
+        goto next(...);
+    }
+    goto whenWait(...);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/iteratePargoto.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+__code code1() {
+    par goto printIterator(input, output, iterate(2), __exit);
+    goto code2();
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/metaCodeGearExample.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+__code add_stub(struct Context* context) {
+    // Input Data Gear
+	Integer* input1 = &context->data[context->idg + 0]->Integer;
+	Integer* input2 = &context->data[context->idg + 1]->Integer;
+
+    // set Continuation
+	enum Code next = context->next;
+
+    // Output Data Gear
+	Integer** O_output = (Integer **)&context->data[context->odg + 0];
+	goto add(context, input1, input2, next, O_output);
+}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/metaCreateTask.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,42 @@
+__code code1(struct Context *context, Integer *integer1, Integer *integer2, Integer *output) {
+    // create context
+    context->task = NEW(struct Context);
+    initContext(context->task);
+
+    // set task parameter
+    context->task->next = C_add;
+    context->task->idgCount = 2;
+    context->task->idg = context->task->dataNum;
+    context->task->maxIdg = context->task->idg + 2;
+    context->task->odg = context->task->maxIdg;
+    context->task->maxOdg = context->task->odg + 1;
+
+    // create Data Gear Queue
+    GET_META(integer1)->wait = createSynchronizedQueue(context);
+    GET_META(integer2)->wait = createSynchronizedQueue(context);
+    GET_META(integer3)->wait = createSynchronizedQueue(context);
+
+    // set Input Data Gear
+    context->task->data[context->task->idg+0] = (union Data*)integer1;
+    context->task->data[context->task->idg+1] = (union Data*)integer2;
+
+    // set Output Data Gear
+    context->task->data[context->task->odg+0] = (union Data*)integer3;
+
+    // add taskList Element
+    struct Element* element;
+    element = &ALLOCATE(context, Element)->Element;
+    element->data = (union Data*)context->task;
+    element->next = context->taskList;
+    context->taskList = element;
+
+    // set TaskManager->spawns parameter
+    Gearef(context, TaskManager)->taskList = context->taskList;
+    Gearef(context, TaskManager)->next1 = C_code2;
+    goto meta(context, C_code2);
+}
+
+// code gear
+__code add(Integer *integer1, Integer *integer2, next(Integer *output, ...)) {
+	....
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parGotoCreateTask.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+__code code1(Integer *integer1, Integer * integer2, Integer *output) {
+    par goto add(integer1, integer2, output, __exit);
+    goto code2();
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/putSynchronizedQueue.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,17 @@
+__code putSynchronizedQueue(struct SynchronizedQueue* queue, union Data* data, __code next(...)) {
+    Element* element = new Element();
+    element->data = data;
+    element->next = NULL;
+    Element* last = queue->last;
+    Element* nextElement = last->next;
+    if (last != queue->last) {
+        goto putSynchronizedQueue();
+    }
+    if (nextElement == NULL) {
+        struct Atomic* atomic = queue->atomic;
+        goto atomic->checkAndSet(&last->next, nextElement, element, next(...), putSynchronizedQueue);
+    } else { // wrong last element
+        struct Atomic* atomic = queue->atomic;
+        goto atomic->checkAndSet(&queue->last, last, nextElement, putSynchronizedQueue, putSynchronizedQueue);
+    }
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/record.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+record Env : Set where
+  field
+    varn : ℕ
+    vari : ℕ
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/record.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+record Env : Set where
+  field
+    varn : @$\mathbb{N}$@
+    vari : @$\mathbb{N}$@
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/redBlackTreeTest.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,196 @@
+module redBlackTreeTest where
+
+open import RedBlackTree
+open import stack
+open import Level hiding (zero)
+
+open import Data.Nat
+
+open Tree
+open Node
+open RedBlackTree.RedBlackTree
+open Stack
+
+-- tests
+
+putTree1 : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k -> k -> a -> (RedBlackTree {n} {m} {t} a k -> t) -> t
+putTree1 {n} {m} {a} {k} {t} tree k1 value next with (root tree)
+...                                | Nothing = next (record tree {root = Just (leafNode k1 value) })
+...                                | Just n2  = clearSingleLinkedStack (nodeStack tree) (\ s -> findNode tree s (leafNode k1 value) n2 (\ tree1 s n1 -> replaceNode tree1 s n1 next))
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Function
+
+
+check1 : {m : Level } (n : Maybe (Node  ℕ ℕ)) -> ℕ -> Bool {m}
+check1 Nothing _ = False
+check1 (Just n)  x with Data.Nat.compare (value n)  x
+...  | equal _ = True
+...  | _ = False
+
+check2 : {m : Level } (n : Maybe (Node  ℕ ℕ)) -> ℕ -> Bool {m}
+check2 Nothing _ = False
+check2 (Just n)  x with compare2 (value n)  x
+...  | EQ = True
+...  | _ = False
+
+test1 : putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( \t -> getRedBlackTree t 1 ( \t x -> check2 x 1 ≡ True   ))
+test1 = refl
+
+test2 : putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 (
+    \t -> putTree1 t 2 2 (
+    \t -> getRedBlackTree t 1 (
+    \t x -> check2 x 1 ≡ True   )))
+test2 = refl
+
+open ≡-Reasoning
+test3 : putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero}) 1 1
+    $ \t -> putTree1 t 2 2
+    $ \t -> putTree1 t 3 3
+    $ \t -> putTree1 t 4 4
+    $ \t -> getRedBlackTree t 1
+    $ \t x -> check2 x 1 ≡ True
+test3 = begin
+    check2 (Just (record {key = 1 ; value = 1 ; color = Black ; left = Nothing ; right = Just (leafNode 2 2)})) 1
+  ≡⟨ refl ⟩
+    True
+  ∎
+
+test31 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 1 1
+    $ \t -> putTree1 t 2 2
+    $ \t -> putTree1 t 3 3
+    $ \t -> putTree1 t 4 4
+    $ \t -> getRedBlackTree t 4
+    $ \t x -> x
+
+-- test5 : Maybe (Node ℕ ℕ)
+test5 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ ) 4 4
+    $ \t -> putTree1 t 6 6
+    $ \t0 ->  clearSingleLinkedStack (nodeStack t0)
+    $ \s -> findNode1 t0 s (leafNode 3 3) ( root t0 )
+    $ \t1 s n1 -> replaceNode t1 s n1
+    $ \t -> getRedBlackTree t 3
+    -- $ \t x -> SingleLinkedStack.top (stack s)
+    -- $ \t x -> n1
+    $ \t x -> root t
+  where
+     findNode1 : {n m : Level } {a k : Set n} {t : Set m} -> RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> (Node a k) -> (Maybe (Node a k)) -> (RedBlackTree {n} {m} {t} a k -> SingleLinkedStack (Node a k) -> Node a k -> t) -> t
+     findNode1 t s n1 Nothing next = next t s n1
+     findNode1 t s n1 ( Just n2 ) next = findNode t s n1 n2 next
+
+-- test51 : putTree1 {_} {_} {ℕ} {ℕ} {_} {Maybe (Node ℕ ℕ)} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 $ \t ->
+--   putTree1 t 2 2 $ \t -> putTree1 t 3 3 $ \t -> root t ≡ Just (record { key = 1; value = 1; left = Just (record { key = 2 ; value = 2 } ); right = Nothing} )
+-- test51 = refl
+
+test6 : Maybe (Node ℕ ℕ)
+test6 = root (createEmptyRedBlackTreeℕ {_} ℕ {Maybe (Node ℕ ℕ)})
+
+
+test7 : Maybe (Node ℕ ℕ)
+test7 = clearSingleLinkedStack (nodeStack tree2) (\ s -> replaceNode tree2 s n2 (\ t -> root t))
+  where
+    tree2 = createEmptyRedBlackTreeℕ {_} ℕ {Maybe (Node ℕ ℕ)}
+    k1 = 1
+    n2 = leafNode 0 0
+    value1 = 1
+
+test8 : Maybe (Node ℕ ℕ)
+test8 = putTree1 {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 1 1
+    $ \t -> putTree1 t 2 2 (\ t -> root t)
+
+
+test9 : putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 ( \t -> getRedBlackTree t 1 ( \t x -> check2 x 1 ≡ True   ))
+test9 = refl
+
+test10 : putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ {Set Level.zero} ) 1 1 (
+    \t -> putRedBlackTree t 2 2 (
+    \t -> getRedBlackTree t 1 (
+    \t x -> check2 x 1 ≡ True   )))
+test10 = refl
+
+test11 = putRedBlackTree {_} {_} {ℕ} {ℕ} (createEmptyRedBlackTreeℕ ℕ) 1 1
+    $ \t -> putRedBlackTree t 2 2
+    $ \t -> putRedBlackTree t 3 3
+    $ \t -> getRedBlackTree t 2
+    $ \t x -> root t
+
+
+redBlackInSomeState : { m : Level } (a : Set Level.zero) (n : Maybe (Node a ℕ)) {t : Set m} -> RedBlackTree {Level.zero} {m} {t} a ℕ
+redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compare2 }
+
+-- compare2 : (x y : ℕ ) -> compareresult
+-- compare2 zero zero = eq
+-- compare2 (suc _) zero = gt
+-- compare2  zero (suc _) = lt
+-- compare2  (suc x) (suc y) = compare2 x y
+
+putTest1Lemma2 : (k : ℕ)  -> compare2 k k ≡ EQ
+putTest1Lemma2 zero = refl
+putTest1Lemma2 (suc k) = putTest1Lemma2 k
+
+putTest1Lemma1 : (x y : ℕ)  -> compareℕ x y ≡ compare2 x y
+putTest1Lemma1 zero    zero    = refl
+putTest1Lemma1 (suc m) zero    = refl
+putTest1Lemma1 zero    (suc n) = refl
+putTest1Lemma1 (suc m) (suc n) with Data.Nat.compare m n
+putTest1Lemma1 (suc .m)           (suc .(Data.Nat.suc m + k)) | less    m k = lemma1  m
+ where
+    lemma1 : (m :  ℕ) -> LT  ≡ compare2 m (ℕ.suc (m + k))
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+putTest1Lemma1 (suc .m)           (suc .m)           | equal   m   = lemma1 m
+ where
+    lemma1 : (m :  ℕ) -> EQ  ≡ compare2 m m
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+putTest1Lemma1 (suc .(Data.Nat.suc m + k)) (suc .m)           | greater m k = lemma1 m
+ where
+    lemma1 : (m :  ℕ) -> GT  ≡ compare2  (ℕ.suc (m + k))  m
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+
+putTest1Lemma3 : (k : ℕ)  -> compareℕ k k ≡ EQ
+putTest1Lemma3 k = trans (putTest1Lemma1 k k) ( putTest1Lemma2 k  )
+
+compareLemma1 : {x  y : ℕ}  -> compare2 x y ≡ EQ -> x  ≡ y
+compareLemma1 {zero} {zero} refl = refl
+compareLemma1 {zero} {suc _} ()
+compareLemma1 {suc _} {zero} ()
+compareLemma1 {suc x} {suc y} eq = cong ( \z -> ℕ.suc z ) ( compareLemma1 ( trans lemma2 eq ) )
+   where
+      lemma2 : compare2 (ℕ.suc x) (ℕ.suc y) ≡ compare2 x y
+      lemma2 = refl
+
+
+putTest1 :{ m : Level } (n : Maybe (Node ℕ ℕ))
+         -> (k : ℕ) (x : ℕ)
+         -> putTree1 {_} {_} {ℕ} {ℕ} (redBlackInSomeState {_} ℕ n {Set Level.zero}) k x
+         (\ t -> getRedBlackTree t k (\ t x1 -> check2 x1 x  ≡ True))
+putTest1 n k x with n
+...  | Just n1 = lemma2 ( record { top = Nothing } )
+   where
+     lemma2 : (s : SingleLinkedStack (Node ℕ ℕ) ) -> putTree1 (record { root = Just n1 ; nodeStack = s ; compare = compare2 }) k x (λ t →
+         GetRedBlackTree.checkNode t k (λ t₁ x1 → check2 x1 x ≡ True) (root t))
+     lemma2 s with compare2 k (key n1)
+     ... |  EQ = lemma3 {!!}
+        where
+           lemma3 : compare2 k (key n1) ≡  EQ -> getRedBlackTree {_} {_} {ℕ} {ℕ} {Set Level.zero} ( record {  root = Just ( record {
+               key   = key n1 ; value = x ; right = right n1 ; left  = left n1 ; color = Black
+               } ) ; nodeStack = s ; compare = λ x₁ y → compare2 x₁ y  } ) k ( \ t x1 -> check2 x1 x  ≡ True)
+           lemma3 eq with compare2 x x | putTest1Lemma2 x
+           ... | EQ | refl with compare2 k (key n1)  | eq
+           ...              | EQ | refl with compare2 x x | putTest1Lemma2 x
+           ...                    | EQ | refl = refl
+     ... |  GT = {!!}
+     ... |  LT = {!!}
+
+...  | Nothing =  lemma1
+   where
+     lemma1 : getRedBlackTree {_} {_} {ℕ} {ℕ} {Set Level.zero} ( record {  root = Just ( record {
+               key   = k ; value = x ; right = Nothing ; left  = Nothing ; color = Red
+        } ) ; nodeStack = record { top = Nothing } ; compare = λ x₁ y → compare2 x₁ y  } ) k
+        ( \ t x1 -> check2 x1 x  ≡ True)
+     lemma1 with compare2 k k | putTest1Lemma2 k
+     ... | EQ | refl with compare2 x x | putTest1Lemma2 x
+     ...              | EQ | refl = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/redBlackTreeTest.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,196 @@
+module redBlackTreeTest where
+
+open import RedBlackTree
+open import stack
+open import Level hiding (zero)
+
+open import Data.Nat
+
+open Tree
+open Node
+open RedBlackTree.RedBlackTree
+open Stack
+
+-- tests
+
+putTree1 : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ k @$\rightarrow$@ a @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ t) @$\rightarrow$@ t
+putTree1 {n} {m} {a} {k} {t} tree k1 value next with (root tree)
+...                                | Nothing = next (record tree {root = Just (leafNode k1 value) })
+...                                | Just n2  = clearSingleLinkedStack (nodeStack tree) (\ s @$\rightarrow$@ findNode tree s (leafNode k1 value) n2 (\ tree1 s n1 @$\rightarrow$@ replaceNode tree1 s n1 next))
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Function
+
+
+check1 : {m : Level } (n : Maybe (Node  @$\mathbb{N}$@ @$\mathbb{N}$@)) @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Bool {m}
+check1 Nothing _ = False
+check1 (Just n)  x with Data.Nat.compare (value n)  x
+...  | equal _ = True
+...  | _ = False
+
+check2 : {m : Level } (n : Maybe (Node  @$\mathbb{N}$@ @$\mathbb{N}$@)) @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Bool {m}
+check2 Nothing _ = False
+check2 (Just n)  x with compare2 (value n)  x
+...  | EQ = True
+...  | _ = False
+
+test1 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 ( \t @$\rightarrow$@ getRedBlackTree t 1 ( \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   ))
+test1 = refl
+
+test2 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 (
+    \t @$\rightarrow$@ putTree1 t 2 2 (
+    \t @$\rightarrow$@ getRedBlackTree t 1 (
+    \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   )))
+test2 = refl
+
+open @$\equiv$@-Reasoning
+test3 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero}) 1 1
+    $ \t @$\rightarrow$@ putTree1 t 2 2
+    $ \t @$\rightarrow$@ putTree1 t 3 3
+    $ \t @$\rightarrow$@ putTree1 t 4 4
+    $ \t @$\rightarrow$@ getRedBlackTree t 1
+    $ \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True
+test3 = begin
+    check2 (Just (record {key = 1 ; value = 1 ; color = Black ; left = Nothing ; right = Just (leafNode 2 2)})) 1
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+    True
+  @$\blacksquare$@
+
+test31 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 1 1
+    $ \t @$\rightarrow$@ putTree1 t 2 2
+    $ \t @$\rightarrow$@ putTree1 t 3 3
+    $ \t @$\rightarrow$@ putTree1 t 4 4
+    $ \t @$\rightarrow$@ getRedBlackTree t 4
+    $ \t x @$\rightarrow$@ x
+
+-- test5 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test5 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ ) 4 4
+    $ \t @$\rightarrow$@ putTree1 t 6 6
+    $ \t0 @$\rightarrow$@  clearSingleLinkedStack (nodeStack t0)
+    $ \s @$\rightarrow$@ findNode1 t0 s (leafNode 3 3) ( root t0 )
+    $ \t1 s n1 @$\rightarrow$@ replaceNode t1 s n1
+    $ \t @$\rightarrow$@ getRedBlackTree t 3
+    -- $ \t x @$\rightarrow$@ SingleLinkedStack.top (stack s)
+    -- $ \t x @$\rightarrow$@ n1
+    $ \t x @$\rightarrow$@ root t
+  where
+     findNode1 : {n m : Level } {a k : Set n} {t : Set m} @$\rightarrow$@ RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ (Node a k) @$\rightarrow$@ (Maybe (Node a k)) @$\rightarrow$@ (RedBlackTree {n} {m} {t} a k @$\rightarrow$@ SingleLinkedStack (Node a k) @$\rightarrow$@ Node a k @$\rightarrow$@ t) @$\rightarrow$@ t
+     findNode1 t s n1 Nothing next = next t s n1
+     findNode1 t s n1 ( Just n2 ) next = findNode t s n1 n2 next
+
+-- test51 : putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {_} {Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 $ \t @$\rightarrow$@
+--   putTree1 t 2 2 $ \t @$\rightarrow$@ putTree1 t 3 3 $ \t @$\rightarrow$@ root t @$\equiv$@ Just (record { key = 1; value = 1; left = Just (record { key = 2 ; value = 2 } ); right = Nothing} )
+-- test51 = refl
+
+test6 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test6 = root (createEmptyRedBlackTree@$\mathbb{N}$@ {_} @$\mathbb{N}$@ {Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)})
+
+
+test7 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test7 = clearSingleLinkedStack (nodeStack tree2) (\ s @$\rightarrow$@ replaceNode tree2 s n2 (\ t @$\rightarrow$@ root t))
+  where
+    tree2 = createEmptyRedBlackTree@$\mathbb{N}$@ {_} @$\mathbb{N}$@ {Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)}
+    k1 = 1
+    n2 = leafNode 0 0
+    value1 = 1
+
+test8 : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@)
+test8 = putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@) 1 1
+    $ \t @$\rightarrow$@ putTree1 t 2 2 (\ t @$\rightarrow$@ root t)
+
+
+test9 : putRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 ( \t @$\rightarrow$@ getRedBlackTree t 1 ( \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   ))
+test9 = refl
+
+test10 : putRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@ {Set Level.zero} ) 1 1 (
+    \t @$\rightarrow$@ putRedBlackTree t 2 2 (
+    \t @$\rightarrow$@ getRedBlackTree t 1 (
+    \t x @$\rightarrow$@ check2 x 1 @$\equiv$@ True   )))
+test10 = refl
+
+test11 = putRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (createEmptyRedBlackTree@$\mathbb{N}$@ @$\mathbb{N}$@) 1 1
+    $ \t @$\rightarrow$@ putRedBlackTree t 2 2
+    $ \t @$\rightarrow$@ putRedBlackTree t 3 3
+    $ \t @$\rightarrow$@ getRedBlackTree t 2
+    $ \t x @$\rightarrow$@ root t
+
+
+redBlackInSomeState : { m : Level } (a : Set Level.zero) (n : Maybe (Node a @$\mathbb{N}$@)) {t : Set m} @$\rightarrow$@ RedBlackTree {Level.zero} {m} {t} a @$\mathbb{N}$@
+redBlackInSomeState {m} a n {t} = record { root = n ; nodeStack = emptySingleLinkedStack ; compare = compare2 }
+
+-- compare2 : (x y : @$\mathbb{N}$@ ) @$\rightarrow$@ compareresult
+-- compare2 zero zero = eq
+-- compare2 (suc _) zero = gt
+-- compare2  zero (suc _) = lt
+-- compare2  (suc x) (suc y) = compare2 x y
+
+putTest1Lemma2 : (k : @$\mathbb{N}$@)  @$\rightarrow$@ compare2 k k @$\equiv$@ EQ
+putTest1Lemma2 zero = refl
+putTest1Lemma2 (suc k) = putTest1Lemma2 k
+
+putTest1Lemma1 : (x y : @$\mathbb{N}$@)  @$\rightarrow$@ compare@$\mathbb{N}$@ x y @$\equiv$@ compare2 x y
+putTest1Lemma1 zero    zero    = refl
+putTest1Lemma1 (suc m) zero    = refl
+putTest1Lemma1 zero    (suc n) = refl
+putTest1Lemma1 (suc m) (suc n) with Data.Nat.compare m n
+putTest1Lemma1 (suc .m)           (suc .(Data.Nat.suc m + k)) | less    m k = lemma1  m
+ where
+    lemma1 : (m :  @$\mathbb{N}$@) @$\rightarrow$@ LT  @$\equiv$@ compare2 m (@$\mathbb{N}$@.suc (m + k))
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+putTest1Lemma1 (suc .m)           (suc .m)           | equal   m   = lemma1 m
+ where
+    lemma1 : (m :  @$\mathbb{N}$@) @$\rightarrow$@ EQ  @$\equiv$@ compare2 m m
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+putTest1Lemma1 (suc .(Data.Nat.suc m + k)) (suc .m)           | greater m k = lemma1 m
+ where
+    lemma1 : (m :  @$\mathbb{N}$@) @$\rightarrow$@ GT  @$\equiv$@ compare2  (@$\mathbb{N}$@.suc (m + k))  m
+    lemma1  zero = refl
+    lemma1  (suc y) = lemma1 y
+
+putTest1Lemma3 : (k : @$\mathbb{N}$@)  @$\rightarrow$@ compare@$\mathbb{N}$@ k k @$\equiv$@ EQ
+putTest1Lemma3 k = trans (putTest1Lemma1 k k) ( putTest1Lemma2 k  )
+
+compareLemma1 : {x  y : @$\mathbb{N}$@}  @$\rightarrow$@ compare2 x y @$\equiv$@ EQ @$\rightarrow$@ x  @$\equiv$@ y
+compareLemma1 {zero} {zero} refl = refl
+compareLemma1 {zero} {suc _} ()
+compareLemma1 {suc _} {zero} ()
+compareLemma1 {suc x} {suc y} eq = cong ( \z @$\rightarrow$@ @$\mathbb{N}$@.suc z ) ( compareLemma1 ( trans lemma2 eq ) )
+   where
+      lemma2 : compare2 (@$\mathbb{N}$@.suc x) (@$\mathbb{N}$@.suc y) @$\equiv$@ compare2 x y
+      lemma2 = refl
+
+
+putTest1 :{ m : Level } (n : Maybe (Node @$\mathbb{N}$@ @$\mathbb{N}$@))
+         @$\rightarrow$@ (k : @$\mathbb{N}$@) (x : @$\mathbb{N}$@)
+         @$\rightarrow$@ putTree1 {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} (redBlackInSomeState {_} @$\mathbb{N}$@ n {Set Level.zero}) k x
+         (\ t @$\rightarrow$@ getRedBlackTree t k (\ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True))
+putTest1 n k x with n
+...  | Just n1 = lemma2 ( record { top = Nothing } )
+   where
+     lemma2 : (s : SingleLinkedStack (Node @$\mathbb{N}$@ @$\mathbb{N}$@) ) @$\rightarrow$@ putTree1 (record { root = Just n1 ; nodeStack = s ; compare = compare2 }) k x (@$\lambda$@ t @$\rightarrow$@
+         GetRedBlackTree.checkNode t k (@$\lambda$@ t@$\_{1}$@ x1 @$\rightarrow$@ check2 x1 x @$\equiv$@ True) (root t))
+     lemma2 s with compare2 k (key n1)
+     ... |  EQ = lemma3 {!!}
+        where
+           lemma3 : compare2 k (key n1) @$\equiv$@  EQ @$\rightarrow$@ getRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {Set Level.zero} ( record {  root = Just ( record {
+               key   = key n1 ; value = x ; right = right n1 ; left  = left n1 ; color = Black
+               } ) ; nodeStack = s ; compare = @$\lambda$@ x@$\_{1}$@ y @$\rightarrow$@ compare2 x@$\_{1}$@ y  } ) k ( \ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True)
+           lemma3 eq with compare2 x x | putTest1Lemma2 x
+           ... | EQ | refl with compare2 k (key n1)  | eq
+           ...              | EQ | refl with compare2 x x | putTest1Lemma2 x
+           ...                    | EQ | refl = refl
+     ... |  GT = {!!}
+     ... |  LT = {!!}
+
+...  | Nothing =  lemma1
+   where
+     lemma1 : getRedBlackTree {_} {_} {@$\mathbb{N}$@} {@$\mathbb{N}$@} {Set Level.zero} ( record {  root = Just ( record {
+               key   = k ; value = x ; right = Nothing ; left  = Nothing ; color = Red
+        } ) ; nodeStack = record { top = Nothing } ; compare = @$\lambda$@ x@$\_{1}$@ y @$\rightarrow$@ compare2 x@$\_{1}$@ y  } ) k
+        ( \ t x1 @$\rightarrow$@ check2 x1 x  @$\equiv$@ True)
+     lemma1 with compare2 k k | putTest1Lemma2 k
+     ... | EQ | refl with compare2 x x | putTest1Lemma2 x
+     ...              | EQ | refl = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sendTask.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,32 @@
+__code spawnTaskManagerImpl(struct TaskManagerImpl* taskManager, struct Context* task, __code next(...)) {
+    if (task->idgCount == 0) {
+        goto taskSend();
+    }
+    goto next(...);
+}
+
+__code taskSend(struct TaskManagerImpl* taskManager, struct Context* task, __code next(...)) {
+    if (task->gpu) {
+        goto taskSend1();
+    } else {
+        goto taskSend2();
+    }
+}
+
+__code taskSend1(struct TaskManagerImpl* taskManager, struct Context* task, __code next(...)) {
+    int workerId = taskManager->sendGPUWorkerIndex;
+    if(++taskManager->sendGPUWorkerIndex >= taskManager->cpu) {
+        taskManager->sendGPUWorkerIndex = taskManager->gpu;
+    }
+    struct Queue* queue = taskManager->workers[workerId]->tasks;
+    goto queue->put(task, next(...));
+}
+
+__code taskSend2(struct TaskManagerImpl* taskManager, struct Context* task, __code next(...)) {
+    int workerId = taskManager->sendCPUWorkerIndex;
+    if(++taskManager->sendCPUWorkerIndex >= taskManager->maxCPU) {
+        taskManager->sendCPUWorkerIndex = taskManager->cpu;
+    }
+    struct Queue* queue = taskManager->workers[workerId]->tasks;
+    goto queue->put(task, next(...));
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/singleLinkedQueue.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,30 @@
+#interface "Queue.h"
+
+Queue* createSingleLinkedQueue(struct Context* context) {
+    struct Queue* queue = new Queue(); // Allocate Queue interface
+    struct SingleLinkedQueue* singleLinkedQueue = new SingleLinkedQueue(); // Allocate Queue implement
+    queue->queue = (union Data*)singleLinkedQueue;
+    singleLinkedQueue->top  = new Element();
+    singleLinkedQueue->last = singleLinkedQueue->top;
+    queue->clear = C_clearSingleLinkedQueue;
+    queue->put  = C_putSingleLinkedQueue;
+    queue->take  = C_takeSingleLinkedQueue;
+    queue->isEmpty = C_isEmptySingleLinkedQueue;
+    return queue;
+}
+
+__code clearSingleLinkedQueue(struct SingleLinkedQueue* queue, __code next(...)) {
+    queue->top = NULL;
+    goto next(...);
+}
+
+__code putSingleLinkedQueue(struct SingleLinkedQueue* queue, union Data* data, __code next(...)) {
+    Element* element = new Element();
+    element->data = data;
+    element->next = NULL;
+    queue->last->next  = element;
+    queue->last = element;
+    goto next(...);
+}
+
+.....
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/singleLinkedQueueTest.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
+__code code1() {
+    Queue* queue = createSingleLinkedQueue(context);
+    Node* node = new Node();
+    node->color = Red;
+    goto queue->put(node, queueTest2);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/singleLinkedQueueTest_script.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+__code code1(struct Context *context) {
+    Queue* queue = createSingleLinkedQueue(context);
+    Node* node = &ALLOCATE(context, Node)->Node;
+    node->color = Red;
+	Gearef(context, Queue)->queue = (union Data*) queue;
+	Gearef(context, Queue)->data = (union Data*) node;
+	Gearef(context, Queue)->next = C_queueTest2;
+    goto meta(context, queue->put);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/singleLinkedStackInterface.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,12 @@
+Stack* createSingleLinkedStack(struct Context* context) {
+    struct Stack* stack = new Stack();
+    struct SingleLinkedStack* singleLinkedStack = new SingleLinkedStack();
+    stack->stack = (union Data*)singleLinkedStack;
+    singleLinkedStack->top = NULL;
+    stack->push = C_pushSingleLinkedStack;
+    stack->pop  = C_popSingleLinkedStack;
+    stack->get  = C_getSingleLinkedStack;
+    stack->isEmpty = C_isEmptySingleLinkedStack;
+    stack->clear = C_clearSingleLinkedStack;
+    return stack;
+}
\ No newline at end of file
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack-product.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,158 @@
+module stack-product where
+
+open import product
+open import Data.Product
+open import Data.Nat
+open import Function using (id)
+open import Relation.Binary.PropositionalEquality
+
+-- definition based from Gears(209:5708390a9d88) src/parallel_execution
+goto = executeCS
+
+data Bool : Set where
+  True  : Bool
+  False : Bool
+
+data Maybe (a : Set) : Set  where
+  Nothing : Maybe a
+  Just    : a -> Maybe a
+
+
+record Stack {a t : Set} (stackImpl : Set) : Set  where
+  field
+    stack : stackImpl
+    push : CodeSegment (stackImpl × a × (CodeSegment stackImpl t)) t
+    pop  : CodeSegment (stackImpl × (CodeSegment (stackImpl × Maybe a) t)) t
+
+
+data Element (a : Set) : Set where
+  cons : a -> Maybe (Element a) -> Element a
+
+datum : {a : Set} -> Element a -> a
+datum (cons a _) = a
+
+next : {a : Set} -> Element a -> Maybe (Element a)
+next (cons _ n) = n
+
+record SingleLinkedStack (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+open SingleLinkedStack
+
+emptySingleLinkedStack : {a : Set} -> SingleLinkedStack a
+emptySingleLinkedStack = record {top = Nothing}
+
+
+
+
+pushSingleLinkedStack : {a t : Set} -> CodeSegment ((SingleLinkedStack a) × a × (CodeSegment (SingleLinkedStack a) t)) t
+pushSingleLinkedStack = cs push
+  where
+    push : {a t : Set} -> ((SingleLinkedStack a) × a × (CodeSegment (SingleLinkedStack a) t)) -> t
+    push (stack , datum , next) = goto next stack1
+      where
+        element = cons datum (top stack)
+        stack1  = record {top = Just element}
+
+popSingleLinkedStack : {a t : Set} -> CodeSegment (SingleLinkedStack a × (CodeSegment (SingleLinkedStack a × Maybe a) t))  t
+popSingleLinkedStack = cs pop
+  where
+    pop : {a t : Set} -> (SingleLinkedStack a × (CodeSegment (SingleLinkedStack a × Maybe a) t)) -> t
+    pop (record { top = Nothing } , nextCS) = goto nextCS (emptySingleLinkedStack , Nothing)
+    pop (record { top = Just x } , nextCS)  = goto nextCS (stack1 , (Just datum1))
+      where
+        datum1 = datum x
+        stack1 = record { top = (next x) }
+
+
+
+
+
+createSingleLinkedStack : {a b : Set} -> Stack {a} {b} (SingleLinkedStack a)
+createSingleLinkedStack = record { stack = emptySingleLinkedStack
+                                 ; push = pushSingleLinkedStack
+                                 ; pop  = popSingleLinkedStack
+                                 }
+
+
+
+
+test01 : {a : Set} -> CodeSegment (SingleLinkedStack a × Maybe a) Bool
+test01 = cs test01'
+  where
+    test01' : {a : Set} -> (SingleLinkedStack a × Maybe a) -> Bool
+    test01' (record { top = Nothing } , _) = False
+    test01' (record { top = Just x } ,  _)  = True
+
+
+test02 : {a : Set} -> CodeSegment (SingleLinkedStack a) (SingleLinkedStack a × Maybe a)
+test02 = cs test02'
+  where
+    test02' : {a : Set} -> SingleLinkedStack a -> (SingleLinkedStack a × Maybe a)
+    test02' stack = goto popSingleLinkedStack (stack , (cs id))
+
+
+test03 : {a : Set} -> CodeSegment a (SingleLinkedStack a)
+test03  = cs test03'
+  where
+    test03' : {a : Set} -> a -> SingleLinkedStack a
+    test03' a = goto pushSingleLinkedStack (emptySingleLinkedStack , a , (cs id))
+
+
+lemma : {A : Set} {a : A} -> goto (test03 ◎ test02 ◎ test01) a ≡ False
+lemma = refl
+
+
+n-push : {A : Set} {a : A} -> CodeSegment (ℕ  × SingleLinkedStack A) (ℕ × SingleLinkedStack A)
+n-push {A} {a} = cs (push {A} {a})
+  where
+    push : {A : Set} {a : A} -> (ℕ × SingleLinkedStack A) -> (ℕ × SingleLinkedStack A)
+    push {A} {a} (zero  , s) = (zero , s)
+    push {A} {a} (suc n , s) = goto pushSingleLinkedStack (s , a , {!!} {- n-push -}) -- needs subtype
+
+
+{-
+
+n-push : {A : Set} {a : A} -> Nat -> SingleLinkedStack A -> SingleLinkedStack A
+n-push zero s            = s
+n-push {A} {a} (suc n) s = pushSingleLinkedStack (n-push {A} {a} n s) a (\s -> s)
+
+n-pop : {A : Set} {a : A} -> Nat -> SingleLinkedStack A -> SingleLinkedStack A
+n-pop zero    s         = s
+n-pop {A} {a} (suc n) s = popSingleLinkedStack (n-pop {A} {a} n s) (\s _ -> s)
+
+open ≡-Reasoning
+
+push-pop-equiv : {A : Set} {a : A} (s : SingleLinkedStack A) -> popSingleLinkedStack (pushSingleLinkedStack s a (\s -> s)) (\s _ -> s) ≡ s
+push-pop-equiv s = refl
+
+push-and-n-pop : {A : Set} {a : A} (n : Nat) (s : SingleLinkedStack A) -> n-pop {A} {a} (suc n) (pushSingleLinkedStack s a id) ≡ n-pop {A} {a} n s
+push-and-n-pop zero s            = refl
+push-and-n-pop {A} {a} (suc n) s = begin
+  n-pop (suc (suc n)) (pushSingleLinkedStack s a id)
+  ≡⟨ refl ⟩
+  popSingleLinkedStack (n-pop (suc n) (pushSingleLinkedStack s a id)) (\s _ -> s)
+  ≡⟨ cong (\s -> popSingleLinkedStack s (\s _ -> s)) (push-and-n-pop n s) ⟩
+  popSingleLinkedStack (n-pop n s) (\s _ -> s)
+  ≡⟨ refl ⟩
+  n-pop (suc n) s
+  ∎
+
+
+n-push-pop-equiv : {A : Set} {a : A} (n : Nat) (s : SingleLinkedStack A) -> (n-pop {A} {a} n (n-push {A} {a} n s)) ≡ s
+n-push-pop-equiv zero s            = refl
+n-push-pop-equiv {A} {a} (suc n) s = begin
+  n-pop (suc n) (n-push (suc n) s)
+  ≡⟨ refl ⟩
+  n-pop (suc n) (pushSingleLinkedStack (n-push n s) a (\s -> s))
+  ≡⟨ push-and-n-pop n (n-push n s)  ⟩
+  n-pop n (n-push n s)
+  ≡⟨ n-push-pop-equiv n s ⟩
+  s
+  ∎
+
+
+n-push-pop-equiv-empty : {A : Set} {a : A} -> (n : Nat) -> n-pop {A} {a} n (n-push {A} {a} n emptySingleLinkedStack)  ≡ emptySingleLinkedStack
+n-push-pop-equiv-empty n = n-push-pop-equiv n emptySingleLinkedStack
+-}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack-product.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,158 @@
+module stack-product where
+
+open import product
+open import Data.Product
+open import Data.Nat
+open import Function using (id)
+open import Relation.Binary.PropositionalEquality
+
+-- definition based from Gears(209:5708390a9d88) src/parallel_execution
+goto = executeCS
+
+data Bool : Set where
+  True  : Bool
+  False : Bool
+
+data Maybe (a : Set) : Set  where
+  Nothing : Maybe a
+  Just    : a @$\rightarrow$@ Maybe a
+
+
+record Stack {a t : Set} (stackImpl : Set) : Set  where
+  field
+    stack : stackImpl
+    push : CodeSegment (stackImpl @$\times$@ a @$\times$@ (CodeSegment stackImpl t)) t
+    pop  : CodeSegment (stackImpl @$\times$@ (CodeSegment (stackImpl @$\times$@ Maybe a) t)) t
+
+
+data Element (a : Set) : Set where
+  cons : a @$\rightarrow$@ Maybe (Element a) @$\rightarrow$@ Element a
+
+datum : {a : Set} @$\rightarrow$@ Element a @$\rightarrow$@ a
+datum (cons a _) = a
+
+next : {a : Set} @$\rightarrow$@ Element a @$\rightarrow$@ Maybe (Element a)
+next (cons _ n) = n
+
+record SingleLinkedStack (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+open SingleLinkedStack
+
+emptySingleLinkedStack : {a : Set} @$\rightarrow$@ SingleLinkedStack a
+emptySingleLinkedStack = record {top = Nothing}
+
+
+
+
+pushSingleLinkedStack : {a t : Set} @$\rightarrow$@ CodeSegment ((SingleLinkedStack a) @$\times$@ a @$\times$@ (CodeSegment (SingleLinkedStack a) t)) t
+pushSingleLinkedStack = cs push
+  where
+    push : {a t : Set} @$\rightarrow$@ ((SingleLinkedStack a) @$\times$@ a @$\times$@ (CodeSegment (SingleLinkedStack a) t)) @$\rightarrow$@ t
+    push (stack , datum , next) = goto next stack1
+      where
+        element = cons datum (top stack)
+        stack1  = record {top = Just element}
+
+popSingleLinkedStack : {a t : Set} @$\rightarrow$@ CodeSegment (SingleLinkedStack a @$\times$@ (CodeSegment (SingleLinkedStack a @$\times$@ Maybe a) t))  t
+popSingleLinkedStack = cs pop
+  where
+    pop : {a t : Set} @$\rightarrow$@ (SingleLinkedStack a @$\times$@ (CodeSegment (SingleLinkedStack a @$\times$@ Maybe a) t)) @$\rightarrow$@ t
+    pop (record { top = Nothing } , nextCS) = goto nextCS (emptySingleLinkedStack , Nothing)
+    pop (record { top = Just x } , nextCS)  = goto nextCS (stack1 , (Just datum1))
+      where
+        datum1 = datum x
+        stack1 = record { top = (next x) }
+
+
+
+
+
+createSingleLinkedStack : {a b : Set} @$\rightarrow$@ Stack {a} {b} (SingleLinkedStack a)
+createSingleLinkedStack = record { stack = emptySingleLinkedStack
+                                 ; push = pushSingleLinkedStack
+                                 ; pop  = popSingleLinkedStack
+                                 }
+
+
+
+
+test01 : {a : Set} @$\rightarrow$@ CodeSegment (SingleLinkedStack a @$\times$@ Maybe a) Bool
+test01 = cs test01'
+  where
+    test01' : {a : Set} @$\rightarrow$@ (SingleLinkedStack a @$\times$@ Maybe a) @$\rightarrow$@ Bool
+    test01' (record { top = Nothing } , _) = False
+    test01' (record { top = Just x } ,  _)  = True
+
+
+test02 : {a : Set} @$\rightarrow$@ CodeSegment (SingleLinkedStack a) (SingleLinkedStack a @$\times$@ Maybe a)
+test02 = cs test02'
+  where
+    test02' : {a : Set} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (SingleLinkedStack a @$\times$@ Maybe a)
+    test02' stack = goto popSingleLinkedStack (stack , (cs id))
+
+
+test03 : {a : Set} @$\rightarrow$@ CodeSegment a (SingleLinkedStack a)
+test03  = cs test03'
+  where
+    test03' : {a : Set} @$\rightarrow$@ a @$\rightarrow$@ SingleLinkedStack a
+    test03' a = goto pushSingleLinkedStack (emptySingleLinkedStack , a , (cs id))
+
+
+lemma : {A : Set} {a : A} @$\rightarrow$@ goto (test03 ◎ test02 ◎ test01) a @$\equiv$@ False
+lemma = refl
+
+
+n-push : {A : Set} {a : A} @$\rightarrow$@ CodeSegment (@$\mathbb{N}$@  @$\times$@ SingleLinkedStack A) (@$\mathbb{N}$@ @$\times$@ SingleLinkedStack A)
+n-push {A} {a} = cs (push {A} {a})
+  where
+    push : {A : Set} {a : A} @$\rightarrow$@ (@$\mathbb{N}$@ @$\times$@ SingleLinkedStack A) @$\rightarrow$@ (@$\mathbb{N}$@ @$\times$@ SingleLinkedStack A)
+    push {A} {a} (zero  , s) = (zero , s)
+    push {A} {a} (suc n , s) = goto pushSingleLinkedStack (s , a , {!!} {- n-push -}) -- needs subtype
+
+
+{-
+
+n-push : {A : Set} {a : A} @$\rightarrow$@ Nat @$\rightarrow$@ SingleLinkedStack A @$\rightarrow$@ SingleLinkedStack A
+n-push zero s            = s
+n-push {A} {a} (suc n) s = pushSingleLinkedStack (n-push {A} {a} n s) a (\s @$\rightarrow$@ s)
+
+n-pop : {A : Set} {a : A} @$\rightarrow$@ Nat @$\rightarrow$@ SingleLinkedStack A @$\rightarrow$@ SingleLinkedStack A
+n-pop zero    s         = s
+n-pop {A} {a} (suc n) s = popSingleLinkedStack (n-pop {A} {a} n s) (\s _ @$\rightarrow$@ s)
+
+open @$\equiv$@-Reasoning
+
+push-pop-equiv : {A : Set} {a : A} (s : SingleLinkedStack A) @$\rightarrow$@ popSingleLinkedStack (pushSingleLinkedStack s a (\s @$\rightarrow$@ s)) (\s _ @$\rightarrow$@ s) @$\equiv$@ s
+push-pop-equiv s = refl
+
+push-and-n-pop : {A : Set} {a : A} (n : Nat) (s : SingleLinkedStack A) @$\rightarrow$@ n-pop {A} {a} (suc n) (pushSingleLinkedStack s a id) @$\equiv$@ n-pop {A} {a} n s
+push-and-n-pop zero s            = refl
+push-and-n-pop {A} {a} (suc n) s = begin
+  n-pop (suc (suc n)) (pushSingleLinkedStack s a id)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  popSingleLinkedStack (n-pop (suc n) (pushSingleLinkedStack s a id)) (\s _ @$\rightarrow$@ s)
+  @$\equiv$@@$\langle$@ cong (\s @$\rightarrow$@ popSingleLinkedStack s (\s _ @$\rightarrow$@ s)) (push-and-n-pop n s) @$\rangle$@
+  popSingleLinkedStack (n-pop n s) (\s _ @$\rightarrow$@ s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  n-pop (suc n) s
+  @$\blacksquare$@
+
+
+n-push-pop-equiv : {A : Set} {a : A} (n : Nat) (s : SingleLinkedStack A) @$\rightarrow$@ (n-pop {A} {a} n (n-push {A} {a} n s)) @$\equiv$@ s
+n-push-pop-equiv zero s            = refl
+n-push-pop-equiv {A} {a} (suc n) s = begin
+  n-pop (suc n) (n-push (suc n) s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  n-pop (suc n) (pushSingleLinkedStack (n-push n s) a (\s @$\rightarrow$@ s))
+  @$\equiv$@@$\langle$@ push-and-n-pop n (n-push n s)  @$\rangle$@
+  n-pop n (n-push n s)
+  @$\equiv$@@$\langle$@ n-push-pop-equiv n s @$\rangle$@
+  s
+  @$\blacksquare$@
+
+
+n-push-pop-equiv-empty : {A : Set} {a : A} @$\rightarrow$@ (n : Nat) @$\rightarrow$@ n-pop {A} {a} n (n-push {A} {a} n emptySingleLinkedStack)  @$\equiv$@ emptySingleLinkedStack
+n-push-pop-equiv-empty n = n-push-pop-equiv n emptySingleLinkedStack
+-}
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack-subtype-sample.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,212 @@
+module stack-subtype-sample where
+
+open import Level renaming (suc to S ; zero to O)
+open import Function
+open import Data.Nat
+open import Data.Maybe
+open import Relation.Binary.PropositionalEquality
+
+open import stack-subtype ℕ
+open import subtype Context  as N
+open import subtype Meta     as M
+
+
+record Num : Set where
+  field
+    num : ℕ
+
+instance
+  NumIsNormalDataSegment : N.DataSegment Num
+  NumIsNormalDataSegment = record { get = (\c -> record { num = Context.n c})
+                                  ; set = (\c n -> record c {n = Num.num n})}
+  NumIsMetaDataSegment : M.DataSegment Num
+  NumIsMetaDataSegment = record { get = (\m -> record {num = Context.n (Meta.context m)})
+                                ; set = (\m n -> record m {context = record (Meta.context m) {n = Num.num n}})}
+
+
+plus3 : Num -> Num
+plus3 record { num = n } = record {num = n + 3}
+
+plus3CS : N.CodeSegment Num Num
+plus3CS = N.cs plus3
+
+
+
+plus5AndPushWithPlus3 : {mc : Meta} {{_ : N.DataSegment Num}}
+               -> M.CodeSegment Num (Meta)
+plus5AndPushWithPlus3 {mc} {{nn}} = M.cs (\n -> record {context = con n ; nextCS = (liftContext {{nn}} {{nn}} plus3CS) ; stack = st} )
+  where
+    co    = Meta.context mc
+    con : Num -> Context
+    con record { num = num } = N.DataSegment.set nn co record {num = num + 5}
+    st    = Meta.stack mc
+
+
+
+
+push-sample : {{_ : N.DataSegment Num}} {{_ : M.DataSegment Num}} ->  Meta
+push-sample {{nd}} {{md}} = M.exec {{md}} (plus5AndPushWithPlus3 {mc} {{nd}}) mc
+  where
+    con  = record { n = 4 ; element = just 0}
+    code = N.cs (\c -> c)
+    mc   = record {context = con ; stack = emptySingleLinkedStack ; nextCS = code}
+
+
+push-sample-equiv : push-sample ≡ record { nextCS  = liftContext plus3CS
+                                          ; stack   = record { top = nothing}
+                                          ; context = record { n = 9} }
+push-sample-equiv = refl
+
+
+pushed-sample : {m : Meta} {{_ : N.DataSegment Num}} {{_ : M.DataSegment Num}} ->  Meta
+pushed-sample {m} {{nd}} {{md}} = M.exec {{md}} (M.csComp {m} {{md}} pushSingleLinkedStackCS (plus5AndPushWithPlus3 {mc} {{nd}})) mc
+  where
+    con  = record { n = 4 ; element = just 0}
+    code = N.cs (\c -> c)
+    mc   = record {context = con ; stack = emptySingleLinkedStack ; nextCS = code}
+
+
+
+pushed-sample-equiv : {m : Meta} ->
+                      pushed-sample {m} ≡ record { nextCS  = liftContext plus3CS
+                                                  ; stack   = record { top = just (cons 0 nothing) }
+                                                  ; context = record { n   = 12} }
+pushed-sample-equiv = refl
+
+
+
+pushNum : N.CodeSegment Context Context
+pushNum = N.cs pn
+  where
+    pn : Context -> Context
+    pn record { n = n } = record { n = pred n  ; element = just n}
+
+
+pushOnce : Meta -> Meta
+pushOnce m = M.exec pushSingleLinkedStackCS m
+
+n-push : {m : Meta} {{_ : M.DataSegment Meta}} (n : ℕ) -> M.CodeSegment Meta Meta
+n-push {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-push {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m -> M.exec {{mm}} {{mm}} (n-push {m} {{mm}} n) (pushOnce m))
+
+popOnce : Meta -> Meta
+popOnce m = M.exec popSingleLinkedStackCS m
+
+n-pop : {m : Meta} {{_ : M.DataSegment Meta}} (n : ℕ) -> M.CodeSegment Meta Meta
+n-pop {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-pop {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m -> M.exec {{mm}} {{mm}} (n-pop {m} {{mm}} n) (popOnce m))
+
+
+
+initMeta : ℕ  -> Maybe ℕ -> N.CodeSegment Context Context -> Meta
+initMeta n mn code = record { context = record { n = n ; element = mn}
+                         ; stack   = emptySingleLinkedStack
+                         ; nextCS  = code
+                         }
+
+n-push-cs-exec = M.exec (n-push {meta} 3) meta
+  where
+    meta = (initMeta 5 (just 9) pushNum)
+
+
+n-push-cs-exec-equiv : n-push-cs-exec ≡ record { nextCS  = pushNum
+                                                ; context = record {n = 2 ; element = just 3}
+                                                ; stack   = record {top = just (cons 4 (just (cons 5 (just (cons 9 nothing)))))}}
+n-push-cs-exec-equiv = refl
+
+
+n-pop-cs-exec = M.exec (n-pop {meta} 4) meta
+  where
+    meta = record { nextCS  = N.cs id
+                  ; context = record { n = 0 ; element = nothing}
+                  ; stack   = record {top = just (cons 9 (just (cons 8 (just (cons 7 (just (cons 6 (just (cons 5 nothing)))))))))}
+                  }
+
+n-pop-cs-exec-equiv : n-pop-cs-exec ≡ record { nextCS  = N.cs id
+                                              ; context = record { n = 0 ; element = just 6}
+                                              ; stack   = record { top = just (cons 5 nothing)}
+                                              }
+
+n-pop-cs-exec-equiv = refl
+
+
+open ≡-Reasoning
+
+id-meta : ℕ -> ℕ -> SingleLinkedStack ℕ -> Meta
+id-meta n e s = record { context = record {n = n ; element = just e}
+                       ; nextCS = (N.cs id) ; stack = s}
+
+exec-comp : (f g : M.CodeSegment Meta Meta) (m : Meta) -> M.exec (M.csComp {m} f g) m ≡ M.exec f (M.exec g m)
+exec-comp (M.cs x) (M.cs _) m = refl
+
+
+push-pop-type : ℕ -> ℕ  -> ℕ -> Element ℕ -> Set₁
+push-pop-type n e x s = M.exec (M.csComp {meta} (M.cs popOnce) (M.cs pushOnce)) meta ≡ meta
+  where
+    meta = id-meta n e record {top = just (cons x (just s))}
+
+push-pop : (n e x : ℕ) -> (s : Element ℕ) ->  push-pop-type n e x s
+push-pop n e x s = refl
+
+
+
+pop-n-push-type : ℕ -> ℕ -> ℕ -> SingleLinkedStack ℕ -> Set₁
+pop-n-push-type n cn ce s = M.exec (M.csComp {meta} (M.cs popOnce) (n-push {meta} (suc n))) meta
+                         ≡ M.exec (n-push {meta} n) meta
+  where
+    meta = id-meta cn ce s
+
+pop-n-push : (n cn ce : ℕ) -> (s : SingleLinkedStack ℕ) -> pop-n-push-type n cn ce s
+
+pop-n-push zero cn ce s    = refl
+pop-n-push (suc n) cn ce s = begin
+  M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc (suc n)))) (id-meta cn ce s)
+  ≡⟨ refl ⟩
+  M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (M.csComp {id-meta cn ce s} (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce))) (id-meta cn ce s)
+  ≡⟨ exec-comp (M.cs popOnce) (M.csComp {id-meta cn ce s} (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce)) (id-meta cn ce s) ⟩
+  M.exec (M.cs popOnce) (M.exec (M.csComp {id-meta cn ce s} (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce)) (id-meta cn ce s))
+  ≡⟨ cong (\x -> M.exec (M.cs popOnce) x) (exec-comp (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce) (id-meta cn ce s)) ⟩
+  M.exec (M.cs popOnce) (M.exec (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n))(M.exec (M.cs pushOnce) (id-meta cn ce s)))
+  ≡⟨ refl ⟩
+  M.exec (M.cs popOnce) (M.exec (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})))
+  ≡⟨ sym (exec-comp (M.cs popOnce) (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))) ⟩
+  M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n))) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  ≡⟨ pop-n-push n cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}) ⟩
+  M.exec (n-push n) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  ≡⟨ refl ⟩
+  M.exec (n-push n) (pushOnce (id-meta cn ce s))
+  ≡⟨ refl ⟩
+  M.exec (n-push n) (M.exec (M.cs pushOnce) (id-meta cn ce s))
+  ≡⟨ refl ⟩
+  M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s)
+  ∎
+
+
+
+n-push-pop-type : ℕ ->  ℕ  -> ℕ -> SingleLinkedStack ℕ -> Set₁
+n-push-pop-type n cn ce st = M.exec (M.csComp {meta} (n-pop {meta} n) (n-push {meta} n)) meta ≡ meta
+  where
+    meta = id-meta cn ce st
+
+n-push-pop : (n cn ce : ℕ) -> (s : SingleLinkedStack ℕ) -> n-push-pop-type n cn ce s
+n-push-pop zero    cn ce s = refl
+n-push-pop (suc n) cn ce s = begin
+  M.exec (M.csComp {id-meta cn ce s} (n-pop {id-meta cn ce s}  (suc n)) (n-push {id-meta cn ce s} (suc n))) (id-meta cn ce s)
+  ≡⟨ refl ⟩
+  M.exec (M.csComp  {id-meta cn ce s}  (M.cs (\m -> M.exec (n-pop {id-meta cn ce s} n) (popOnce m))) (n-push {id-meta cn ce s} (suc n))) (id-meta cn ce s)
+  ≡⟨ exec-comp (M.cs (\m -> M.exec (n-pop n) (popOnce m))) (n-push {id-meta cn ce s}  (suc n))  (id-meta cn ce s) ⟩
+  M.exec (M.cs (\m -> M.exec (n-pop  {id-meta cn ce s}  n) (popOnce m))) (M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s))
+  ≡⟨ refl ⟩
+  M.exec (n-pop n) (popOnce (M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s)))
+  ≡⟨ refl ⟩
+  M.exec (n-pop n) (M.exec (M.cs popOnce) (M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s)))
+  ≡⟨ cong (\x -> M.exec (n-pop  {id-meta cn ce s}  n) x) (sym (exec-comp (M.cs popOnce) (n-push {id-meta cn ce s}  (suc n)) (id-meta cn ce s))) ⟩
+  M.exec (n-pop n) (M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (n-push {id-meta cn ce s} (suc n))) (id-meta cn ce s))
+  ≡⟨ cong (\x -> M.exec (n-pop {id-meta cn ce s}  n) x) (pop-n-push n cn ce s) ⟩
+  M.exec (n-pop n) (M.exec (n-push n) (id-meta cn ce s))
+  ≡⟨ sym (exec-comp (n-pop n) (n-push n) (id-meta cn ce s)) ⟩
+  M.exec (M.csComp (n-pop n) (n-push n)) (id-meta cn ce s)
+  ≡⟨ n-push-pop n cn ce s ⟩
+  id-meta cn ce s
+  ∎
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack-subtype-sample.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,212 @@
+module stack-subtype-sample where
+
+open import Level renaming (suc to S ; zero to O)
+open import Function
+open import Data.Nat
+open import Data.Maybe
+open import Relation.Binary.PropositionalEquality
+
+open import stack-subtype @$\mathbb{N}$@
+open import subtype Context  as N
+open import subtype Meta     as M
+
+
+record Num : Set where
+  field
+    num : @$\mathbb{N}$@
+
+instance
+  NumIsNormalDataSegment : N.DataSegment Num
+  NumIsNormalDataSegment = record { get = (\c @$\rightarrow$@ record { num = Context.n c})
+                                  ; set = (\c n @$\rightarrow$@ record c {n = Num.num n})}
+  NumIsMetaDataSegment : M.DataSegment Num
+  NumIsMetaDataSegment = record { get = (\m @$\rightarrow$@ record {num = Context.n (Meta.context m)})
+                                ; set = (\m n @$\rightarrow$@ record m {context = record (Meta.context m) {n = Num.num n}})}
+
+
+plus3 : Num @$\rightarrow$@ Num
+plus3 record { num = n } = record {num = n + 3}
+
+plus3CS : N.CodeSegment Num Num
+plus3CS = N.cs plus3
+
+
+
+plus5AndPushWithPlus3 : {mc : Meta} {{_ : N.DataSegment Num}}
+               @$\rightarrow$@ M.CodeSegment Num (Meta)
+plus5AndPushWithPlus3 {mc} {{nn}} = M.cs (\n @$\rightarrow$@ record {context = con n ; nextCS = (liftContext {{nn}} {{nn}} plus3CS) ; stack = st} )
+  where
+    co    = Meta.context mc
+    con : Num @$\rightarrow$@ Context
+    con record { num = num } = N.DataSegment.set nn co record {num = num + 5}
+    st    = Meta.stack mc
+
+
+
+
+push-sample : {{_ : N.DataSegment Num}} {{_ : M.DataSegment Num}} @$\rightarrow$@  Meta
+push-sample {{nd}} {{md}} = M.exec {{md}} (plus5AndPushWithPlus3 {mc} {{nd}}) mc
+  where
+    con  = record { n = 4 ; element = just 0}
+    code = N.cs (\c @$\rightarrow$@ c)
+    mc   = record {context = con ; stack = emptySingleLinkedStack ; nextCS = code}
+
+
+push-sample-equiv : push-sample @$\equiv$@ record { nextCS  = liftContext plus3CS
+                                          ; stack   = record { top = nothing}
+                                          ; context = record { n = 9} }
+push-sample-equiv = refl
+
+
+pushed-sample : {m : Meta} {{_ : N.DataSegment Num}} {{_ : M.DataSegment Num}} @$\rightarrow$@  Meta
+pushed-sample {m} {{nd}} {{md}} = M.exec {{md}} (M.csComp {m} {{md}} pushSingleLinkedStackCS (plus5AndPushWithPlus3 {mc} {{nd}})) mc
+  where
+    con  = record { n = 4 ; element = just 0}
+    code = N.cs (\c @$\rightarrow$@ c)
+    mc   = record {context = con ; stack = emptySingleLinkedStack ; nextCS = code}
+
+
+
+pushed-sample-equiv : {m : Meta} @$\rightarrow$@
+                      pushed-sample {m} @$\equiv$@ record { nextCS  = liftContext plus3CS
+                                                  ; stack   = record { top = just (cons 0 nothing) }
+                                                  ; context = record { n   = 12} }
+pushed-sample-equiv = refl
+
+
+
+pushNum : N.CodeSegment Context Context
+pushNum = N.cs pn
+  where
+    pn : Context @$\rightarrow$@ Context
+    pn record { n = n } = record { n = pred n  ; element = just n}
+
+
+pushOnce : Meta @$\rightarrow$@ Meta
+pushOnce m = M.exec pushSingleLinkedStackCS m
+
+n-push : {m : Meta} {{_ : M.DataSegment Meta}} (n : @$\mathbb{N}$@) @$\rightarrow$@ M.CodeSegment Meta Meta
+n-push {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-push {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m @$\rightarrow$@ M.exec {{mm}} {{mm}} (n-push {m} {{mm}} n) (pushOnce m))
+
+popOnce : Meta @$\rightarrow$@ Meta
+popOnce m = M.exec popSingleLinkedStackCS m
+
+n-pop : {m : Meta} {{_ : M.DataSegment Meta}} (n : @$\mathbb{N}$@) @$\rightarrow$@ M.CodeSegment Meta Meta
+n-pop {{mm}} (zero)      = M.cs {{mm}} {{mm}} id
+n-pop {m} {{mm}} (suc n) = M.cs {{mm}} {{mm}} (\m @$\rightarrow$@ M.exec {{mm}} {{mm}} (n-pop {m} {{mm}} n) (popOnce m))
+
+
+
+initMeta : @$\mathbb{N}$@  @$\rightarrow$@ Maybe @$\mathbb{N}$@ @$\rightarrow$@ N.CodeSegment Context Context @$\rightarrow$@ Meta
+initMeta n mn code = record { context = record { n = n ; element = mn}
+                         ; stack   = emptySingleLinkedStack
+                         ; nextCS  = code
+                         }
+
+n-push-cs-exec = M.exec (n-push {meta} 3) meta
+  where
+    meta = (initMeta 5 (just 9) pushNum)
+
+
+n-push-cs-exec-equiv : n-push-cs-exec @$\equiv$@ record { nextCS  = pushNum
+                                                ; context = record {n = 2 ; element = just 3}
+                                                ; stack   = record {top = just (cons 4 (just (cons 5 (just (cons 9 nothing)))))}}
+n-push-cs-exec-equiv = refl
+
+
+n-pop-cs-exec = M.exec (n-pop {meta} 4) meta
+  where
+    meta = record { nextCS  = N.cs id
+                  ; context = record { n = 0 ; element = nothing}
+                  ; stack   = record {top = just (cons 9 (just (cons 8 (just (cons 7 (just (cons 6 (just (cons 5 nothing)))))))))}
+                  }
+
+n-pop-cs-exec-equiv : n-pop-cs-exec @$\equiv$@ record { nextCS  = N.cs id
+                                              ; context = record { n = 0 ; element = just 6}
+                                              ; stack   = record { top = just (cons 5 nothing)}
+                                              }
+
+n-pop-cs-exec-equiv = refl
+
+
+open @$\equiv$@-Reasoning
+
+id-meta : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Meta
+id-meta n e s = record { context = record {n = n ; element = just e}
+                       ; nextCS = (N.cs id) ; stack = s}
+
+exec-comp : (f g : M.CodeSegment Meta Meta) (m : Meta) @$\rightarrow$@ M.exec (M.csComp {m} f g) m @$\equiv$@ M.exec f (M.exec g m)
+exec-comp (M.cs x) (M.cs _) m = refl
+
+
+push-pop-type : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@  @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Element @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+push-pop-type n e x s = M.exec (M.csComp {meta} (M.cs popOnce) (M.cs pushOnce)) meta @$\equiv$@ meta
+  where
+    meta = id-meta n e record {top = just (cons x (just s))}
+
+push-pop : (n e x : @$\mathbb{N}$@) @$\rightarrow$@ (s : Element @$\mathbb{N}$@) @$\rightarrow$@  push-pop-type n e x s
+push-pop n e x s = refl
+
+
+
+pop-n-push-type : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+pop-n-push-type n cn ce s = M.exec (M.csComp {meta} (M.cs popOnce) (n-push {meta} (suc n))) meta
+                         @$\equiv$@ M.exec (n-push {meta} n) meta
+  where
+    meta = id-meta cn ce s
+
+pop-n-push : (n cn ce : @$\mathbb{N}$@) @$\rightarrow$@ (s : SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ pop-n-push-type n cn ce s
+
+pop-n-push zero cn ce s    = refl
+pop-n-push (suc n) cn ce s = begin
+  M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc (suc n)))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (M.csComp {id-meta cn ce s} (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ exec-comp (M.cs popOnce) (M.csComp {id-meta cn ce s} (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce)) (id-meta cn ce s) @$\rangle$@
+  M.exec (M.cs popOnce) (M.exec (M.csComp {id-meta cn ce s} (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce)) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ cong (\x @$\rightarrow$@ M.exec (M.cs popOnce) x) (exec-comp (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (M.cs pushOnce) (id-meta cn ce s)) @$\rangle$@
+  M.exec (M.cs popOnce) (M.exec (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n))(M.exec (M.cs pushOnce) (id-meta cn ce s)))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (M.cs popOnce) (M.exec (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})))
+  @$\equiv$@@$\langle$@ sym (exec-comp (M.cs popOnce) (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n)) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))) @$\rangle$@
+  M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (n-push {id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))})} (suc n))) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  @$\equiv$@@$\langle$@ pop-n-push n cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}) @$\rangle$@
+  M.exec (n-push n) (id-meta cn ce (record {top = just (cons ce (SingleLinkedStack.top s))}))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-push n) (pushOnce (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-push n) (M.exec (M.cs pushOnce) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s)
+  @$\blacksquare$@
+
+
+
+n-push-pop-type : @$\mathbb{N}$@ @$\rightarrow$@  @$\mathbb{N}$@  @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Set@$\_{1}$@
+n-push-pop-type n cn ce st = M.exec (M.csComp {meta} (n-pop {meta} n) (n-push {meta} n)) meta @$\equiv$@ meta
+  where
+    meta = id-meta cn ce st
+
+n-push-pop : (n cn ce : @$\mathbb{N}$@) @$\rightarrow$@ (s : SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ n-push-pop-type n cn ce s
+n-push-pop zero    cn ce s = refl
+n-push-pop (suc n) cn ce s = begin
+  M.exec (M.csComp {id-meta cn ce s} (n-pop {id-meta cn ce s}  (suc n)) (n-push {id-meta cn ce s} (suc n))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (M.csComp  {id-meta cn ce s}  (M.cs (\m @$\rightarrow$@ M.exec (n-pop {id-meta cn ce s} n) (popOnce m))) (n-push {id-meta cn ce s} (suc n))) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ exec-comp (M.cs (\m @$\rightarrow$@ M.exec (n-pop n) (popOnce m))) (n-push {id-meta cn ce s}  (suc n))  (id-meta cn ce s) @$\rangle$@
+  M.exec (M.cs (\m @$\rightarrow$@ M.exec (n-pop  {id-meta cn ce s}  n) (popOnce m))) (M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-pop n) (popOnce (M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s)))
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+  M.exec (n-pop n) (M.exec (M.cs popOnce) (M.exec (n-push {id-meta cn ce s} (suc n)) (id-meta cn ce s)))
+  @$\equiv$@@$\langle$@ cong (\x @$\rightarrow$@ M.exec (n-pop  {id-meta cn ce s}  n) x) (sym (exec-comp (M.cs popOnce) (n-push {id-meta cn ce s}  (suc n)) (id-meta cn ce s))) @$\rangle$@
+  M.exec (n-pop n) (M.exec (M.csComp {id-meta cn ce s} (M.cs popOnce) (n-push {id-meta cn ce s} (suc n))) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ cong (\x @$\rightarrow$@ M.exec (n-pop {id-meta cn ce s}  n) x) (pop-n-push n cn ce s) @$\rangle$@
+  M.exec (n-pop n) (M.exec (n-push n) (id-meta cn ce s))
+  @$\equiv$@@$\langle$@ sym (exec-comp (n-pop n) (n-push n) (id-meta cn ce s)) @$\rangle$@
+  M.exec (M.csComp (n-pop n) (n-push n)) (id-meta cn ce s)
+  @$\equiv$@@$\langle$@ n-push-pop n cn ce s @$\rangle$@
+  id-meta cn ce s
+  @$\blacksquare$@
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack-subtype.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,123 @@
+open import Level hiding (lift)
+open import Data.Maybe
+open import Data.Product
+open import Data.Nat hiding (suc)
+open import Function
+
+module stack-subtype (A : Set) where
+
+-- data definitions
+
+data Element (a : Set) : Set where
+  cons : a -> Maybe (Element a) -> Element a
+
+datum : {a : Set} -> Element a -> a
+datum (cons a _) = a
+
+next : {a : Set} -> Element a -> Maybe (Element a)
+next (cons _ n) = n
+
+record SingleLinkedStack (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+open SingleLinkedStack
+
+record Context : Set where
+  field
+    -- fields for concrete data segments
+    n       : ℕ
+    -- fields for stack
+    element : Maybe A
+
+
+
+
+
+open import subtype Context as N
+
+instance
+  ContextIsDataSegment : N.DataSegment Context
+  ContextIsDataSegment = record {get = (\c -> c) ; set = (\_ c -> c)}
+
+
+record Meta  : Set₁ where
+  field
+    -- context as set of data segments
+    context : Context
+    stack   : SingleLinkedStack A
+    nextCS  : N.CodeSegment Context Context
+
+
+
+
+open import subtype Meta as M
+
+instance
+  MetaIncludeContext : M.DataSegment Context
+  MetaIncludeContext = record { get = Meta.context
+                              ; set = (\m c -> record m {context = c}) }
+
+  MetaIsMetaDataSegment : M.DataSegment Meta
+  MetaIsMetaDataSegment  = record { get = (\m -> m) ; set = (\_ m -> m) }
+
+
+liftMeta : {X Y : Set} {{_ : M.DataSegment X}} {{_ : M.DataSegment Y}} -> N.CodeSegment X Y -> M.CodeSegment X Y
+liftMeta (N.cs f) = M.cs f
+
+liftContext : {X Y : Set} {{_ : N.DataSegment X}} {{_ : N.DataSegment Y}} -> N.CodeSegment X Y -> N.CodeSegment Context Context
+liftContext {{x}} {{y}} (N.cs f) = N.cs (\c -> N.DataSegment.set y c (f (N.DataSegment.get x c)))
+
+-- definition based from Gears(209:5708390a9d88) src/parallel_execution
+
+emptySingleLinkedStack : SingleLinkedStack A
+emptySingleLinkedStack = record {top = nothing}
+
+
+pushSingleLinkedStack : Meta -> Meta
+pushSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (push s e) })
+  where
+    n = Meta.nextCS m
+    s = Meta.stack  m
+    e = Context.element (Meta.context m)
+    push : SingleLinkedStack A -> Maybe A -> SingleLinkedStack A
+    push s nothing  = s
+    push s (just x) = record {top = just (cons x (top s))}
+
+
+
+popSingleLinkedStack : Meta -> Meta
+popSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (st m) ; context = record con {element = (elem m)}})
+  where
+    n = Meta.nextCS m
+    con  = Meta.context m
+    elem : Meta -> Maybe A
+    elem record {stack = record { top = (just (cons x _)) }} = just x
+    elem record {stack = record { top = nothing           }} = nothing
+    st : Meta -> SingleLinkedStack A
+    st record {stack = record { top = (just (cons _ s)) }} = record {top = s}
+    st record {stack = record { top = nothing           }} = record {top = nothing}
+
+
+
+
+pushSingleLinkedStackCS : M.CodeSegment Meta Meta
+pushSingleLinkedStackCS = M.cs pushSingleLinkedStack
+
+popSingleLinkedStackCS : M.CodeSegment Meta Meta
+popSingleLinkedStackCS = M.cs popSingleLinkedStack
+
+
+-- for sample
+
+firstContext : Context
+firstContext = record {element = nothing ; n = 0}
+
+
+firstMeta : Meta
+firstMeta = record { context = firstContext
+                   ; stack = emptySingleLinkedStack
+                   ; nextCS = (N.cs (\m -> m))
+                   }
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack-subtype.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,123 @@
+open import Level hiding (lift)
+open import Data.Maybe
+open import Data.Product
+open import Data.Nat hiding (suc)
+open import Function
+
+module stack-subtype (A : Set) where
+
+-- data definitions
+
+data Element (a : Set) : Set where
+  cons : a @$\rightarrow$@ Maybe (Element a) @$\rightarrow$@ Element a
+
+datum : {a : Set} @$\rightarrow$@ Element a @$\rightarrow$@ a
+datum (cons a _) = a
+
+next : {a : Set} @$\rightarrow$@ Element a @$\rightarrow$@ Maybe (Element a)
+next (cons _ n) = n
+
+record SingleLinkedStack (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+open SingleLinkedStack
+
+record Context : Set where
+  field
+    -- fields for concrete data segments
+    n       : @$\mathbb{N}$@
+    -- fields for stack
+    element : Maybe A
+
+
+
+
+
+open import subtype Context as N
+
+instance
+  ContextIsDataSegment : N.DataSegment Context
+  ContextIsDataSegment = record {get = (\c @$\rightarrow$@ c) ; set = (\_ c @$\rightarrow$@ c)}
+
+
+record Meta  : Set@$\_{1}$@ where
+  field
+    -- context as set of data segments
+    context : Context
+    stack   : SingleLinkedStack A
+    nextCS  : N.CodeSegment Context Context
+
+
+
+
+open import subtype Meta as M
+
+instance
+  MetaIncludeContext : M.DataSegment Context
+  MetaIncludeContext = record { get = Meta.context
+                              ; set = (\m c @$\rightarrow$@ record m {context = c}) }
+
+  MetaIsMetaDataSegment : M.DataSegment Meta
+  MetaIsMetaDataSegment  = record { get = (\m @$\rightarrow$@ m) ; set = (\_ m @$\rightarrow$@ m) }
+
+
+liftMeta : {X Y : Set} {{_ : M.DataSegment X}} {{_ : M.DataSegment Y}} @$\rightarrow$@ N.CodeSegment X Y @$\rightarrow$@ M.CodeSegment X Y
+liftMeta (N.cs f) = M.cs f
+
+liftContext : {X Y : Set} {{_ : N.DataSegment X}} {{_ : N.DataSegment Y}} @$\rightarrow$@ N.CodeSegment X Y @$\rightarrow$@ N.CodeSegment Context Context
+liftContext {{x}} {{y}} (N.cs f) = N.cs (\c @$\rightarrow$@ N.DataSegment.set y c (f (N.DataSegment.get x c)))
+
+-- definition based from Gears(209:5708390a9d88) src/parallel_execution
+
+emptySingleLinkedStack : SingleLinkedStack A
+emptySingleLinkedStack = record {top = nothing}
+
+
+pushSingleLinkedStack : Meta @$\rightarrow$@ Meta
+pushSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (push s e) })
+  where
+    n = Meta.nextCS m
+    s = Meta.stack  m
+    e = Context.element (Meta.context m)
+    push : SingleLinkedStack A @$\rightarrow$@ Maybe A @$\rightarrow$@ SingleLinkedStack A
+    push s nothing  = s
+    push s (just x) = record {top = just (cons x (top s))}
+
+
+
+popSingleLinkedStack : Meta @$\rightarrow$@ Meta
+popSingleLinkedStack m = M.exec (liftMeta n) (record m {stack = (st m) ; context = record con {element = (elem m)}})
+  where
+    n = Meta.nextCS m
+    con  = Meta.context m
+    elem : Meta @$\rightarrow$@ Maybe A
+    elem record {stack = record { top = (just (cons x _)) }} = just x
+    elem record {stack = record { top = nothing           }} = nothing
+    st : Meta @$\rightarrow$@ SingleLinkedStack A
+    st record {stack = record { top = (just (cons _ s)) }} = record {top = s}
+    st record {stack = record { top = nothing           }} = record {top = nothing}
+
+
+
+
+pushSingleLinkedStackCS : M.CodeSegment Meta Meta
+pushSingleLinkedStackCS = M.cs pushSingleLinkedStack
+
+popSingleLinkedStackCS : M.CodeSegment Meta Meta
+popSingleLinkedStackCS = M.cs popSingleLinkedStack
+
+
+-- for sample
+
+firstContext : Context
+firstContext = record {element = nothing ; n = 0}
+
+
+firstMeta : Meta
+firstMeta = record { context = firstContext
+                   ; stack = emptySingleLinkedStack
+                   ; nextCS = (N.cs (\m @$\rightarrow$@ m))
+                   }
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,149 @@
+open import Level renaming (suc to succ ; zero to Zero )
+module stack  where
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Data.Nat
+
+ex : 1 + 2 ≡ 3
+ex = refl
+
+data Bool {n : Level } : Set n where
+  True  : Bool
+  False : Bool
+
+record _∧_ {n : Level } (a : Set n) (b : Set n): Set n where
+  field
+    pi1 : a
+    pi2 : b
+
+data Maybe {n : Level } (a : Set n) : Set n where
+  Nothing : Maybe a
+  Just    : a -> Maybe a
+
+record StackMethods {n m : Level } (a : Set n ) {t : Set m }(stackImpl : Set n ) : Set (m Level.⊔ n) where
+  field
+    push : stackImpl -> a -> (stackImpl -> t) -> t
+    pop  : stackImpl -> (stackImpl -> Maybe a -> t) -> t
+    pop2 : stackImpl -> (stackImpl -> Maybe a -> Maybe a -> t) -> t
+    get  : stackImpl -> (stackImpl -> Maybe a -> t) -> t
+    get2 : stackImpl -> (stackImpl -> Maybe a -> Maybe a -> t) -> t
+    clear : stackImpl -> (stackImpl -> t) -> t
+open StackMethods
+
+record Stack {n m : Level } (a : Set n ) {t : Set m } (si : Set n ) : Set (m Level.⊔ n) where
+  field
+    stack : si
+    stackMethods : StackMethods {n} {m} a {t} si
+  pushStack :  a -> (Stack a si -> t) -> t
+  pushStack d next = push (stackMethods ) (stack ) d (\s1 -> next (record {stack = s1 ; stackMethods = stackMethods } ))
+  popStack : (Stack a si -> Maybe a  -> t) -> t
+  popStack next = pop (stackMethods ) (stack ) (\s1 d1 -> next (record {stack = s1 ; stackMethods = stackMethods }) d1 )
+  pop2Stack :  (Stack a si -> Maybe a -> Maybe a -> t) -> t
+  pop2Stack next = pop2 (stackMethods ) (stack ) (\s1 d1 d2 -> next (record {stack = s1 ; stackMethods = stackMethods }) d1 d2)
+  getStack :  (Stack a si -> Maybe a  -> t) -> t
+  getStack next = get (stackMethods ) (stack ) (\s1 d1 -> next (record {stack = s1 ; stackMethods = stackMethods }) d1 )
+  get2Stack :  (Stack a si -> Maybe a -> Maybe a -> t) -> t
+  get2Stack next = get2 (stackMethods ) (stack ) (\s1 d1 d2 -> next (record {stack = s1 ; stackMethods = stackMethods }) d1 d2)
+  clearStack : (Stack a si -> t) -> t
+  clearStack next = clear (stackMethods ) (stack ) (\s1 -> next (record {stack = s1 ; stackMethods = stackMethods } ))
+
+open Stack
+
+{--
+data Element {n : Level } (a : Set n) : Set n where
+  cons : a -> Maybe (Element a) -> Element a
+
+
+datum : {n : Level } {a : Set n} -> Element a -> a
+datum (cons a _) = a
+
+next : {n : Level } {a : Set n} -> Element a -> Maybe (Element a)
+next (cons _ n) = n
+--}
+
+
+-- cannot define recrusive record definition. so use linked list with maybe.
+record Element {l : Level} (a : Set l) : Set l where
+  inductive
+  constructor cons
+  field
+    datum : a  -- `data` is reserved by Agda.
+    next : Maybe (Element a)
+
+open Element
+
+
+record SingleLinkedStack {n : Level } (a : Set n) : Set n where
+  field
+    top : Maybe (Element a)
+open SingleLinkedStack
+
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} -> SingleLinkedStack Data -> Data -> (Code : SingleLinkedStack Data -> t) -> t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+
+popSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> t) -> t
+popSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack1 (Just data1)
+  where
+    data1  = datum d
+    stack1 = record { top = (next d) }
+
+pop2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+pop2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = pop2SingleLinkedStack' {n} {m} stack cs
+  where
+    pop2SingleLinkedStack' : {n m : Level } {t : Set m }  -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+    pop2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs (record {top = (next d1)}) (Just (datum d)) (Just (datum d1))
+
+
+getSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> t) -> t
+getSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack (Just data1)
+  where
+    data1  = datum d
+
+get2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+get2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = get2SingleLinkedStack' {n} {m} stack cs
+  where
+    get2SingleLinkedStack' : {n m : Level} {t : Set m } -> SingleLinkedStack a -> (Code : SingleLinkedStack a -> (Maybe a) -> (Maybe a) -> t) -> t
+    get2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs stack (Just (datum d)) (Just (datum d1))
+
+clearSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} -> SingleLinkedStack a -> (SingleLinkedStack a -> t) -> t
+clearSingleLinkedStack stack next = next (record {top = Nothing})
+
+
+emptySingleLinkedStack : {n : Level } {a : Set n} -> SingleLinkedStack a
+emptySingleLinkedStack = record {top = Nothing}
+
+-----
+-- Basic stack implementations are specifications of a Stack
+--
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} -> StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+                                   push = pushSingleLinkedStack
+                                 ; pop  = popSingleLinkedStack
+                                 ; pop2 = pop2SingleLinkedStack
+                                 ; get  = getSingleLinkedStack
+                                 ; get2 = get2SingleLinkedStack
+                                 ; clear = clearSingleLinkedStack
+                           }
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} -> Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+                             stack = emptySingleLinkedStack ;
+                             stackMethods = singleLinkedStackSpec
+                           }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stack.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,149 @@
+open import Level renaming (suc to succ ; zero to Zero )
+module stack  where
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Data.Nat
+
+ex : 1 + 2 @$\equiv$@ 3
+ex = refl
+
+data Bool {n : Level } : Set n where
+  True  : Bool
+  False : Bool
+
+record _@$\wedge$@_ {n : Level } (a : Set n) (b : Set n): Set n where
+  field
+    pi1 : a
+    pi2 : b
+
+data Maybe {n : Level } (a : Set n) : Set n where
+  Nothing : Maybe a
+  Just    : a @$\rightarrow$@ Maybe a
+
+record StackMethods {n m : Level } (a : Set n ) {t : Set m }(stackImpl : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    push : stackImpl @$\rightarrow$@ a @$\rightarrow$@ (stackImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+    pop  : stackImpl @$\rightarrow$@ (stackImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+    pop2 : stackImpl @$\rightarrow$@ (stackImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+    get  : stackImpl @$\rightarrow$@ (stackImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+    get2 : stackImpl @$\rightarrow$@ (stackImpl @$\rightarrow$@ Maybe a @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+    clear : stackImpl @$\rightarrow$@ (stackImpl @$\rightarrow$@ t) @$\rightarrow$@ t
+open StackMethods
+
+record Stack {n m : Level } (a : Set n ) {t : Set m } (si : Set n ) : Set (m Level.@$\sqcup$@ n) where
+  field
+    stack : si
+    stackMethods : StackMethods {n} {m} a {t} si
+  pushStack :  a @$\rightarrow$@ (Stack a si @$\rightarrow$@ t) @$\rightarrow$@ t
+  pushStack d next = push (stackMethods ) (stack ) d (\s1 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods } ))
+  popStack : (Stack a si @$\rightarrow$@ Maybe a  @$\rightarrow$@ t) @$\rightarrow$@ t
+  popStack next = pop (stackMethods ) (stack ) (\s1 d1 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods }) d1 )
+  pop2Stack :  (Stack a si @$\rightarrow$@ Maybe a @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+  pop2Stack next = pop2 (stackMethods ) (stack ) (\s1 d1 d2 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods }) d1 d2)
+  getStack :  (Stack a si @$\rightarrow$@ Maybe a  @$\rightarrow$@ t) @$\rightarrow$@ t
+  getStack next = get (stackMethods ) (stack ) (\s1 d1 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods }) d1 )
+  get2Stack :  (Stack a si @$\rightarrow$@ Maybe a @$\rightarrow$@ Maybe a @$\rightarrow$@ t) @$\rightarrow$@ t
+  get2Stack next = get2 (stackMethods ) (stack ) (\s1 d1 d2 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods }) d1 d2)
+  clearStack : (Stack a si @$\rightarrow$@ t) @$\rightarrow$@ t
+  clearStack next = clear (stackMethods ) (stack ) (\s1 @$\rightarrow$@ next (record {stack = s1 ; stackMethods = stackMethods } ))
+
+open Stack
+
+{--
+data Element {n : Level } (a : Set n) : Set n where
+  cons : a @$\rightarrow$@ Maybe (Element a) @$\rightarrow$@ Element a
+
+
+datum : {n : Level } {a : Set n} @$\rightarrow$@ Element a @$\rightarrow$@ a
+datum (cons a _) = a
+
+next : {n : Level } {a : Set n} @$\rightarrow$@ Element a @$\rightarrow$@ Maybe (Element a)
+next (cons _ n) = n
+--}
+
+
+-- cannot define recrusive record definition. so use linked list with maybe.
+record Element {l : Level} (a : Set l) : Set l where
+  inductive
+  constructor cons
+  field
+    datum : a  -- `data` is reserved by Agda.
+    next : Maybe (Element a)
+
+open Element
+
+
+record SingleLinkedStack {n : Level } (a : Set n) : Set n where
+  field
+    top : Maybe (Element a)
+open SingleLinkedStack
+
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} @$\rightarrow$@ SingleLinkedStack Data @$\rightarrow$@ Data @$\rightarrow$@ (Code : SingleLinkedStack Data @$\rightarrow$@ t) @$\rightarrow$@ t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+
+popSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+popSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack1 (Just data1)
+  where
+    data1  = datum d
+    stack1 = record { top = (next d) }
+
+pop2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+pop2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = pop2SingleLinkedStack' {n} {m} stack cs
+  where
+    pop2SingleLinkedStack' : {n m : Level } {t : Set m }  @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+    pop2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs (record {top = (next d1)}) (Just (datum d)) (Just (datum d1))
+
+
+getSingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+getSingleLinkedStack stack cs with (top stack)
+...                                | Nothing = cs stack  Nothing
+...                                | Just d  = cs stack (Just data1)
+  where
+    data1  = datum d
+
+get2SingleLinkedStack : {n m : Level } {t : Set m } {a  : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+get2SingleLinkedStack {n} {m} {t} {a} stack cs with (top stack)
+...                                | Nothing = cs stack Nothing Nothing
+...                                | Just d = get2SingleLinkedStack' {n} {m} stack cs
+  where
+    get2SingleLinkedStack' : {n m : Level} {t : Set m } @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (Code : SingleLinkedStack a @$\rightarrow$@ (Maybe a) @$\rightarrow$@ (Maybe a) @$\rightarrow$@ t) @$\rightarrow$@ t
+    get2SingleLinkedStack' stack cs with (next d)
+    ...              | Nothing = cs stack Nothing Nothing
+    ...              | Just d1 = cs stack (Just (datum d)) (Just (datum d1))
+
+clearSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ (SingleLinkedStack a @$\rightarrow$@ t) @$\rightarrow$@ t
+clearSingleLinkedStack stack next = next (record {top = Nothing})
+
+
+emptySingleLinkedStack : {n : Level } {a : Set n} @$\rightarrow$@ SingleLinkedStack a
+emptySingleLinkedStack = record {top = Nothing}
+
+-----
+-- Basic stack implementations are specifications of a Stack
+--
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+                                   push = pushSingleLinkedStack
+                                 ; pop  = popSingleLinkedStack
+                                 ; pop2 = pop2SingleLinkedStack
+                                 ; get  = getSingleLinkedStack
+                                 ; get2 = get2SingleLinkedStack
+                                 ; clear = clearSingleLinkedStack
+                           }
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+                             stack = emptySingleLinkedStack ;
+                             stackMethods = singleLinkedStackSpec
+                           }
Binary file src/stack.agdai has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stackImpl.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,38 @@
+record Element {l : Level} (a : Set l) : Set l where
+  inductive
+  constructor cons
+  field
+    datum : a  -- `data` is reserved by Agda.
+    next : Maybe (Element a)
+open Element
+
+record SingleLinkedStack {n : Level } (a : Set n) : Set n where
+  field
+  top : Maybe (Element a)
+open SingleLinkedStack
+
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} -> SingleLinkedStack Data -> Data -> (Code : SingleLinkedStack Data -> t) -> t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+-- push 以下は省略
+
+-- Basic stack implementations are specifications of a Stack
+
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} -> StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+                                   push = pushSingleLinkedStack
+                                 ; pop  = popSingleLinkedStack
+                                 ; pop2 = pop2SingleLinkedStack
+                                 ; get  = getSingleLinkedStack
+                                 ; get2 = get2SingleLinkedStack
+                                 ; clear = clearSingleLinkedStack
+                               }
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} -> Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+                            stack = emptySingleLinkedStack ;
+                            stackMethods = singleLinkedStackSpec
+                          }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stackImpl.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,38 @@
+record Element {l : Level} (a : Set l) : Set l where
+  inductive
+  constructor cons
+  field
+    datum : a  -- `data` is reserved by Agda.
+    next : Maybe (Element a)
+open Element
+
+record SingleLinkedStack {n : Level } (a : Set n) : Set n where
+  field
+  top : Maybe (Element a)
+open SingleLinkedStack
+
+pushSingleLinkedStack : {n m : Level } {t : Set m } {Data : Set n} @$\rightarrow$@ SingleLinkedStack Data @$\rightarrow$@ Data @$\rightarrow$@ (Code : SingleLinkedStack Data @$\rightarrow$@ t) @$\rightarrow$@ t
+pushSingleLinkedStack stack datum next = next stack1
+  where
+    element = cons datum (top stack)
+    stack1  = record {top = Just element}
+
+-- push 以下は省略
+
+-- Basic stack implementations are specifications of a Stack
+
+singleLinkedStackSpec : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ StackMethods {n} {m} a {t} (SingleLinkedStack a)
+singleLinkedStackSpec = record {
+                                   push = pushSingleLinkedStack
+                                 ; pop  = popSingleLinkedStack
+                                 ; pop2 = pop2SingleLinkedStack
+                                 ; get  = getSingleLinkedStack
+                                 ; get2 = get2SingleLinkedStack
+                                 ; clear = clearSingleLinkedStack
+                               }
+
+createSingleLinkedStack : {n m : Level } {t : Set m } {a : Set n} @$\rightarrow$@ Stack {n} {m} a {t} (SingleLinkedStack a)
+createSingleLinkedStack = record {
+                            stack = emptySingleLinkedStack ;
+                            stackMethods = singleLinkedStackSpec
+                          }
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stackTest.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,144 @@
+open import Level renaming (suc to succ ; zero to Zero )
+module stackTest where
+
+open import stack
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Data.Nat
+open import Function
+
+
+open SingleLinkedStack
+open Stack
+
+----
+--
+-- proof of properties ( concrete cases )
+--
+
+test01 : {n : Level } {a : Set n} -> SingleLinkedStack a -> Maybe a -> Bool {n}
+test01 stack _ with (top stack)
+...                  | (Just _) = True
+...                  | Nothing  = False
+
+
+test02 : {n : Level } {a : Set n} -> SingleLinkedStack a -> Bool
+test02 stack = popSingleLinkedStack stack test01
+
+test03 : {n : Level } {a : Set n} -> a ->  Bool
+test03 v = pushSingleLinkedStack emptySingleLinkedStack v test02
+
+-- after a push and a pop, the stack is empty
+lemma : {n : Level} {A : Set n} {a : A} -> test03 a ≡ False
+lemma = refl
+
+testStack01 : {n m : Level } {a : Set n} -> a -> Bool {m}
+testStack01 v = pushStack createSingleLinkedStack v (
+   \s -> popStack s (\s1 d1 -> True))
+
+-- after push 1 and 2, pop2 get 1 and 2
+
+testStack02 : {m : Level } ->  ( Stack  ℕ (SingleLinkedStack ℕ) -> Bool {m} ) -> Bool {m}
+testStack02 cs = pushStack createSingleLinkedStack 1 (
+   \s -> pushStack s 2 cs)
+
+
+testStack031 : (d1 d2 : ℕ ) -> Bool {Zero}
+testStack031 2 1 = True
+testStack031 _ _ = False
+
+testStack032 : (d1 d2 : Maybe ℕ) -> Bool {Zero}
+testStack032  (Just d1) (Just d2) = testStack031 d1 d2
+testStack032  _ _ = False
+
+testStack03 : {m : Level } -> Stack  ℕ (SingleLinkedStack ℕ) -> ((Maybe ℕ) -> (Maybe ℕ) -> Bool {m} ) -> Bool {m}
+testStack03 s cs = pop2Stack s (
+   \s d1 d2 -> cs d1 d2 )
+
+testStack04 : Bool
+testStack04 = testStack02 (\s -> testStack03 s testStack032)
+
+testStack05 : testStack04 ≡ True
+testStack05 = refl
+
+testStack06 : {m : Level } -> Maybe (Element ℕ)
+testStack06 = pushStack createSingleLinkedStack 1 (
+   \s -> pushStack s 2 (\s -> top (stack s)))
+
+testStack07 : {m : Level } -> Maybe (Element ℕ)
+testStack07 = pushSingleLinkedStack emptySingleLinkedStack 1 (
+   \s -> pushSingleLinkedStack s 2 (\s -> top s))
+
+testStack08 = pushSingleLinkedStack emptySingleLinkedStack 1
+   $ \s -> pushSingleLinkedStack s 2
+   $ \s -> pushSingleLinkedStack s 3
+   $ \s -> pushSingleLinkedStack s 4
+   $ \s -> pushSingleLinkedStack s 5
+   $ \s -> top s
+
+------
+--
+-- proof of properties with indefinite state of stack
+--
+-- this should be proved by properties of the stack inteface, not only by the implementation,
+--    and the implementation have to provides the properties.
+--
+--    we cannot write "s ≡ s3", since level of the Set does not fit , but use stack s ≡ stack s3 is ok.
+--    anyway some implementations may result s != s3
+--
+
+stackInSomeState : {l m : Level } {D : Set l} {t : Set m } (s : SingleLinkedStack D ) -> Stack {l} {m} D {t}  ( SingleLinkedStack  D )
+stackInSomeState s =  record { stack = s ; stackMethods = singleLinkedStackSpec }
+
+push->push->pop2 : {l : Level } {D : Set l} (x y : D ) (s : SingleLinkedStack D ) ->
+    pushStack ( stackInSomeState s )  x ( \s1 -> pushStack s1 y ( \s2 -> pop2Stack s2 ( \s3 y1 x1 -> (Just x ≡ x1 ) ∧ (Just y ≡ y1 ) ) ))
+push->push->pop2 {l} {D} x y s = record { pi1 = refl ; pi2 = refl }
+
+
+-- id : {n : Level} {A : Set n} -> A -> A
+-- id a = a
+
+-- push a, n times
+
+n-push : {n : Level} {A : Set n} {a : A} -> ℕ -> SingleLinkedStack A -> SingleLinkedStack A
+n-push zero s            = s
+n-push {l} {A} {a} (suc n) s = pushSingleLinkedStack (n-push {l} {A} {a} n s) a (\s -> s )
+
+n-pop :  {n : Level}{A : Set n} {a : A} -> ℕ -> SingleLinkedStack A -> SingleLinkedStack A
+n-pop zero    s         = s
+n-pop  {_} {A} {a} (suc n) s = popSingleLinkedStack (n-pop {_} {A} {a} n s) (\s _ -> s )
+
+open ≡-Reasoning
+
+push-pop-equiv : {n : Level} {A : Set n} {a : A} (s : SingleLinkedStack A) -> (popSingleLinkedStack (pushSingleLinkedStack s a (\s -> s)) (\s _ -> s) ) ≡ s
+push-pop-equiv s = refl
+
+push-and-n-pop : {n : Level} {A : Set n} {a : A} (n : ℕ) (s : SingleLinkedStack A) -> n-pop {_} {A} {a} (suc n) (pushSingleLinkedStack s a id) ≡ n-pop {_} {A} {a} n s
+push-and-n-pop zero s            = refl
+push-and-n-pop {_} {A} {a} (suc n) s = begin
+   n-pop {_} {A} {a} (suc (suc n)) (pushSingleLinkedStack s a id)
+  ≡⟨ refl ⟩
+   popSingleLinkedStack (n-pop {_} {A} {a} (suc n) (pushSingleLinkedStack s a id)) (\s _ -> s)
+  ≡⟨ cong (\s -> popSingleLinkedStack s (\s _ -> s )) (push-and-n-pop n s) ⟩
+   popSingleLinkedStack (n-pop {_} {A} {a} n s) (\s _ -> s)
+  ≡⟨ refl ⟩
+    n-pop {_} {A} {a} (suc n) s
+  ∎
+
+
+n-push-pop-equiv : {n : Level} {A : Set n} {a : A} (n : ℕ) (s : SingleLinkedStack A) -> (n-pop {_} {A} {a} n (n-push {_} {A} {a} n s)) ≡ s
+n-push-pop-equiv zero s            = refl
+n-push-pop-equiv {_} {A} {a} (suc n) s = begin
+    n-pop {_} {A} {a} (suc n) (n-push (suc n) s)
+  ≡⟨ refl ⟩
+    n-pop {_} {A} {a} (suc n) (pushSingleLinkedStack (n-push n s) a (\s -> s))
+  ≡⟨ push-and-n-pop n (n-push n s)  ⟩
+    n-pop {_} {A} {a} n (n-push n s)
+  ≡⟨ n-push-pop-equiv n s ⟩
+    s
+  ∎
+
+
+n-push-pop-equiv-empty : {n : Level} {A : Set n} {a : A} -> (n : ℕ) -> n-pop {_} {A} {a} n (n-push {_} {A} {a} n emptySingleLinkedStack)  ≡ emptySingleLinkedStack
+n-push-pop-equiv-empty n = n-push-pop-equiv n emptySingleLinkedStack
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stackTest.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,144 @@
+open import Level renaming (suc to succ ; zero to Zero )
+module stackTest where
+
+open import stack
+
+open import Relation.Binary.PropositionalEquality
+open import Relation.Binary.Core
+open import Data.Nat
+open import Function
+
+
+open SingleLinkedStack
+open Stack
+
+----
+--
+-- proof of properties ( concrete cases )
+--
+
+test01 : {n : Level } {a : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ Maybe a @$\rightarrow$@ Bool {n}
+test01 stack _ with (top stack)
+...                  | (Just _) = True
+...                  | Nothing  = False
+
+
+test02 : {n : Level } {a : Set n} @$\rightarrow$@ SingleLinkedStack a @$\rightarrow$@ Bool
+test02 stack = popSingleLinkedStack stack test01
+
+test03 : {n : Level } {a : Set n} @$\rightarrow$@ a @$\rightarrow$@  Bool
+test03 v = pushSingleLinkedStack emptySingleLinkedStack v test02
+
+-- after a push and a pop, the stack is empty
+lemma : {n : Level} {A : Set n} {a : A} @$\rightarrow$@ test03 a @$\equiv$@ False
+lemma = refl
+
+testStack01 : {n m : Level } {a : Set n} @$\rightarrow$@ a @$\rightarrow$@ Bool {m}
+testStack01 v = pushStack createSingleLinkedStack v (
+   \s @$\rightarrow$@ popStack s (\s1 d1 @$\rightarrow$@ True))
+
+-- after push 1 and 2, pop2 get 1 and 2
+
+testStack02 : {m : Level } @$\rightarrow$@  ( Stack  @$\mathbb{N}$@ (SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ Bool {m} ) @$\rightarrow$@ Bool {m}
+testStack02 cs = pushStack createSingleLinkedStack 1 (
+   \s @$\rightarrow$@ pushStack s 2 cs)
+
+
+testStack031 : (d1 d2 : @$\mathbb{N}$@ ) @$\rightarrow$@ Bool {Zero}
+testStack031 2 1 = True
+testStack031 _ _ = False
+
+testStack032 : (d1 d2 : Maybe @$\mathbb{N}$@) @$\rightarrow$@ Bool {Zero}
+testStack032  (Just d1) (Just d2) = testStack031 d1 d2
+testStack032  _ _ = False
+
+testStack03 : {m : Level } @$\rightarrow$@ Stack  @$\mathbb{N}$@ (SingleLinkedStack @$\mathbb{N}$@) @$\rightarrow$@ ((Maybe @$\mathbb{N}$@) @$\rightarrow$@ (Maybe @$\mathbb{N}$@) @$\rightarrow$@ Bool {m} ) @$\rightarrow$@ Bool {m}
+testStack03 s cs = pop2Stack s (
+   \s d1 d2 @$\rightarrow$@ cs d1 d2 )
+
+testStack04 : Bool
+testStack04 = testStack02 (\s @$\rightarrow$@ testStack03 s testStack032)
+
+testStack05 : testStack04 @$\equiv$@ True
+testStack05 = refl
+
+testStack06 : {m : Level } @$\rightarrow$@ Maybe (Element @$\mathbb{N}$@)
+testStack06 = pushStack createSingleLinkedStack 1 (
+   \s @$\rightarrow$@ pushStack s 2 (\s @$\rightarrow$@ top (stack s)))
+
+testStack07 : {m : Level } @$\rightarrow$@ Maybe (Element @$\mathbb{N}$@)
+testStack07 = pushSingleLinkedStack emptySingleLinkedStack 1 (
+   \s @$\rightarrow$@ pushSingleLinkedStack s 2 (\s @$\rightarrow$@ top s))
+
+testStack08 = pushSingleLinkedStack emptySingleLinkedStack 1
+   $ \s @$\rightarrow$@ pushSingleLinkedStack s 2
+   $ \s @$\rightarrow$@ pushSingleLinkedStack s 3
+   $ \s @$\rightarrow$@ pushSingleLinkedStack s 4
+   $ \s @$\rightarrow$@ pushSingleLinkedStack s 5
+   $ \s @$\rightarrow$@ top s
+
+------
+--
+-- proof of properties with indefinite state of stack
+--
+-- this should be proved by properties of the stack inteface, not only by the implementation,
+--    and the implementation have to provides the properties.
+--
+--    we cannot write "s @$\equiv$@ s3", since level of the Set does not fit , but use stack s @$\equiv$@ stack s3 is ok.
+--    anyway some implementations may result s != s3
+--
+
+stackInSomeState : {l m : Level } {D : Set l} {t : Set m } (s : SingleLinkedStack D ) @$\rightarrow$@ Stack {l} {m} D {t}  ( SingleLinkedStack  D )
+stackInSomeState s =  record { stack = s ; stackMethods = singleLinkedStackSpec }
+
+push@$\rightarrow$@push@$\rightarrow$@pop2 : {l : Level } {D : Set l} (x y : D ) (s : SingleLinkedStack D ) @$\rightarrow$@
+    pushStack ( stackInSomeState s )  x ( \s1 @$\rightarrow$@ pushStack s1 y ( \s2 @$\rightarrow$@ pop2Stack s2 ( \s3 y1 x1 @$\rightarrow$@ (Just x @$\equiv$@ x1 ) @$\wedge$@ (Just y @$\equiv$@ y1 ) ) ))
+push@$\rightarrow$@push@$\rightarrow$@pop2 {l} {D} x y s = record { pi1 = refl ; pi2 = refl }
+
+
+-- id : {n : Level} {A : Set n} @$\rightarrow$@ A @$\rightarrow$@ A
+-- id a = a
+
+-- push a, n times
+
+n-push : {n : Level} {A : Set n} {a : A} @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack A @$\rightarrow$@ SingleLinkedStack A
+n-push zero s            = s
+n-push {l} {A} {a} (suc n) s = pushSingleLinkedStack (n-push {l} {A} {a} n s) a (\s @$\rightarrow$@ s )
+
+n-pop :  {n : Level}{A : Set n} {a : A} @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack A @$\rightarrow$@ SingleLinkedStack A
+n-pop zero    s         = s
+n-pop  {_} {A} {a} (suc n) s = popSingleLinkedStack (n-pop {_} {A} {a} n s) (\s _ @$\rightarrow$@ s )
+
+open @$\equiv$@-Reasoning
+
+push-pop-equiv : {n : Level} {A : Set n} {a : A} (s : SingleLinkedStack A) @$\rightarrow$@ (popSingleLinkedStack (pushSingleLinkedStack s a (\s @$\rightarrow$@ s)) (\s _ @$\rightarrow$@ s) ) @$\equiv$@ s
+push-pop-equiv s = refl
+
+push-and-n-pop : {n : Level} {A : Set n} {a : A} (n : @$\mathbb{N}$@) (s : SingleLinkedStack A) @$\rightarrow$@ n-pop {_} {A} {a} (suc n) (pushSingleLinkedStack s a id) @$\equiv$@ n-pop {_} {A} {a} n s
+push-and-n-pop zero s            = refl
+push-and-n-pop {_} {A} {a} (suc n) s = begin
+   n-pop {_} {A} {a} (suc (suc n)) (pushSingleLinkedStack s a id)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+   popSingleLinkedStack (n-pop {_} {A} {a} (suc n) (pushSingleLinkedStack s a id)) (\s _ @$\rightarrow$@ s)
+  @$\equiv$@@$\langle$@ cong (\s @$\rightarrow$@ popSingleLinkedStack s (\s _ @$\rightarrow$@ s )) (push-and-n-pop n s) @$\rangle$@
+   popSingleLinkedStack (n-pop {_} {A} {a} n s) (\s _ @$\rightarrow$@ s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+    n-pop {_} {A} {a} (suc n) s
+  @$\blacksquare$@
+
+
+n-push-pop-equiv : {n : Level} {A : Set n} {a : A} (n : @$\mathbb{N}$@) (s : SingleLinkedStack A) @$\rightarrow$@ (n-pop {_} {A} {a} n (n-push {_} {A} {a} n s)) @$\equiv$@ s
+n-push-pop-equiv zero s            = refl
+n-push-pop-equiv {_} {A} {a} (suc n) s = begin
+    n-pop {_} {A} {a} (suc n) (n-push (suc n) s)
+  @$\equiv$@@$\langle$@ refl @$\rangle$@
+    n-pop {_} {A} {a} (suc n) (pushSingleLinkedStack (n-push n s) a (\s @$\rightarrow$@ s))
+  @$\equiv$@@$\langle$@ push-and-n-pop n (n-push n s)  @$\rangle$@
+    n-pop {_} {A} {a} n (n-push n s)
+  @$\equiv$@@$\langle$@ n-push-pop-equiv n s @$\rangle$@
+    s
+  @$\blacksquare$@
+
+
+n-push-pop-equiv-empty : {n : Level} {A : Set n} {a : A} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ n-pop {_} {A} {a} n (n-push {_} {A} {a} n emptySingleLinkedStack)  @$\equiv$@ emptySingleLinkedStack
+n-push-pop-equiv-empty n = n-push-pop-equiv n emptySingleLinkedStack
Binary file src/stackTest.agdai has changed
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stackimpl.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,27 @@
+Stack* createSingleLinkedStack(struct Context* context) {
+    struct Stack* stack = new Stack();
+    struct SingleLinkedStack* singleLinkedStack = new SingleLinkedStack();
+    stack->stack = (union Data*)singleLinkedStack;
+    singleLinkedStack->top = NULL;
+    stack->push = C_pushSingleLinkedStack;
+    stack->pop  = C_popSingleLinkedStack;
+    stack->pop2  = C_pop2SingleLinkedStack;
+    stack->get  = C_getSingleLinkedStack;
+    stack->get2  = C_get2SingleLinkedStack;
+    stack->isEmpty = C_isEmptySingleLinkedStack;
+    stack->clear = C_clearSingleLinkedStack;
+    return stack;
+}
+
+__code clearSingleLinkedStack(struct SingleLinkedStack* stack,__code next(...)) {
+    stack->top = NULL;
+    goto next(...);
+}
+
+__code pushSingleLinkedStack(struct SingleLinkedStack* stack,union Data* data, __code next(...)) {
+    Element* element = new Element();
+    element->next = stack->top;
+    element->data = data;
+    stack->top = element;
+    goto next(...);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stub.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,17 @@
+__code put(struct Context* context,
+           struct Tree* tree,
+           struct Node* root,
+           struct Allocate* allocate)
+{
+    /* 実装コードは省略 */
+}
+
+__code put_stub(struct Context* context)
+{
+    goto put(context,
+             &context->data[Tree]->tree,
+             context->data[Tree]->tree.root,
+             &context->data[Allocate]->allocate);
+}
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/stubCodeGear.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,16 @@
+__code putSingleLinkedQueue(struct Context *context,struct SingleLinkedQueue* queue, union Data* data, enum Code next) {
+    Element* element = &ALLOCATE(context, Element)->Element;
+    element->data = data;
+    element->next = NULL;
+    queue->last->next  = element;
+    queue->last = element;
+    goto meta(context, next);
+}
+
+// generated by script
+__code putSingleLinkedQueue_stub(struct Context* context) {
+	SingleLinkedQueue* queue = (SingleLinkedQueue*)GearImpl(context, Queue, queue);
+	Data* data = Gearef(context, Queue)->data;
+	enum Code next = Gearef(context, Queue)->next;
+	goto putSingleLinkedQueue(context, queue, data, next);
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/subtype.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,44 @@
+open import Level
+open import Relation.Binary.PropositionalEquality
+
+module subtype {l : Level} (Context : Set l) where
+
+
+record DataSegment {ll : Level} (A : Set ll) : Set (l ⊔ ll) where
+  field
+    get : Context -> A
+    set : Context -> A -> Context
+open DataSegment
+
+data CodeSegment {l1 l2 : Level} (A : Set l1) (B : Set l2) : Set (l ⊔ l1 ⊔ l2) where
+  cs : {{_ : DataSegment A}} {{_ : DataSegment B}} -> (A -> B) -> CodeSegment A B
+
+goto : {l1 l2 : Level} {I : Set l1} {O : Set l2} -> CodeSegment I O -> I -> O
+goto (cs b) i = b i
+
+exec : {l1 l2 : Level} {I : Set l1} {O : Set l2} {{_ : DataSegment I}} {{_ : DataSegment O}}
+     -> CodeSegment I O -> Context -> Context
+exec {l} {{i}} {{o}}  (cs b) c = set o c (b (get i c))
+
+
+comp : {con : Context} -> {l1 l2 l3 l4 : Level}
+       {A : Set l1} {B : Set l2} {C : Set l3} {D : Set l4}
+       {{_ : DataSegment A}} {{_ : DataSegment B}} {{_ : DataSegment C}} {{_ : DataSegment D}}
+       -> (C -> D) -> (A -> B) -> A -> D
+comp {con} {{i}} {{io}} {{oi}} {{o}} g f x = g (get oi (set io con (f x)))
+
+csComp : {con : Context} -> {l1 l2 l3 l4 : Level}
+        {A : Set l1} {B : Set l2} {C : Set l3} {D : Set l4}
+         {{_ : DataSegment A}} {{_ : DataSegment B}} {{_ : DataSegment C}} {{_ : DataSegment D}}
+       -> CodeSegment C D -> CodeSegment A B -> CodeSegment A D
+csComp {con} {A} {B} {C} {D} {{da}} {{db}} {{dc}} {{dd}} (cs g) (cs f)
+      = cs {{da}} {{dd}} (comp {con} {{da}} {{db}} {{dc}} {{dd}} g f)
+
+
+
+comp-associative : {A B C D E F : Set l} {con : Context}
+                   {{da : DataSegment A}} {{db : DataSegment B}} {{dc : DataSegment C}}
+                   {{dd : DataSegment D}} {{de : DataSegment E}} {{df : DataSegment F}}
+                   -> (a : CodeSegment A B) (b : CodeSegment C D) (c : CodeSegment E F)
+                   -> csComp {con} c (csComp {con} b a)  ≡ csComp {con} (csComp {con} c b) a
+comp-associative (cs _) (cs _) (cs _) = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/subtype.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,44 @@
+open import Level
+open import Relation.Binary.PropositionalEquality
+
+module subtype {l : Level} (Context : Set l) where
+
+
+record DataSegment {ll : Level} (A : Set ll) : Set (l @$\sqcup$@ ll) where
+  field
+    get : Context @$\rightarrow$@ A
+    set : Context @$\rightarrow$@ A @$\rightarrow$@ Context
+open DataSegment
+
+data CodeSegment {l1 l2 : Level} (A : Set l1) (B : Set l2) : Set (l @$\sqcup$@ l1 @$\sqcup$@ l2) where
+  cs : {{_ : DataSegment A}} {{_ : DataSegment B}} @$\rightarrow$@ (A @$\rightarrow$@ B) @$\rightarrow$@ CodeSegment A B
+
+goto : {l1 l2 : Level} {I : Set l1} {O : Set l2} @$\rightarrow$@ CodeSegment I O @$\rightarrow$@ I @$\rightarrow$@ O
+goto (cs b) i = b i
+
+exec : {l1 l2 : Level} {I : Set l1} {O : Set l2} {{_ : DataSegment I}} {{_ : DataSegment O}}
+     @$\rightarrow$@ CodeSegment I O @$\rightarrow$@ Context @$\rightarrow$@ Context
+exec {l} {{i}} {{o}}  (cs b) c = set o c (b (get i c))
+
+
+comp : {con : Context} @$\rightarrow$@ {l1 l2 l3 l4 : Level}
+       {A : Set l1} {B : Set l2} {C : Set l3} {D : Set l4}
+       {{_ : DataSegment A}} {{_ : DataSegment B}} {{_ : DataSegment C}} {{_ : DataSegment D}}
+       @$\rightarrow$@ (C @$\rightarrow$@ D) @$\rightarrow$@ (A @$\rightarrow$@ B) @$\rightarrow$@ A @$\rightarrow$@ D
+comp {con} {{i}} {{io}} {{oi}} {{o}} g f x = g (get oi (set io con (f x)))
+
+csComp : {con : Context} @$\rightarrow$@ {l1 l2 l3 l4 : Level}
+        {A : Set l1} {B : Set l2} {C : Set l3} {D : Set l4}
+         {{_ : DataSegment A}} {{_ : DataSegment B}} {{_ : DataSegment C}} {{_ : DataSegment D}}
+       @$\rightarrow$@ CodeSegment C D @$\rightarrow$@ CodeSegment A B @$\rightarrow$@ CodeSegment A D
+csComp {con} {A} {B} {C} {D} {{da}} {{db}} {{dc}} {{dd}} (cs g) (cs f)
+      = cs {{da}} {{dd}} (comp {con} {{da}} {{db}} {{dc}} {{dd}} g f)
+
+
+
+comp-associative : {A B C D E F : Set l} {con : Context}
+                   {{da : DataSegment A}} {{db : DataSegment B}} {{dc : DataSegment C}}
+                   {{dd : DataSegment D}} {{de : DataSegment E}} {{df : DataSegment F}}
+                   @$\rightarrow$@ (a : CodeSegment A B) (b : CodeSegment C D) (c : CodeSegment E F)
+                   @$\rightarrow$@ csComp {con} c (csComp {con} b a)  @$\equiv$@ csComp {con} (csComp {con} c b) a
+comp-associative (cs _) (cs _) (cs _) = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/taskManagerInterface.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,13 @@
+typedef struct TaskManager<Impl>{
+    union Data* taskManager;
+    struct Context* task;
+    struct Element* taskList;
+    __code spawn(Impl* taskManager, struct Context* task, __code next(...));
+    __code spawnTasks(Impl* taskManagerImpl, struct Element* taskList, __code next1(...));
+    __code setWaitTask(Impl* taskManagerImpl, struct Context* task, __code next(...));
+    __code shutdown(Impl* taskManagerImpl, __code next(...));
+    __code incrementTaskCount(Impl* taskManagerImpl, __code next(...));
+    __code decrementTaskCount(Impl* taskManagerImpl, __code next(...));
+    __code next(...);
+    __code next1(...);
+} TaskManager;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/term1.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+stmt2Cond : {c10 :ℕ} → Cond
+stmt2Cond {c10} env = (Equal (varn env) c10) ∧ (Equal (vari env) 0)
+
+lemma1 : {c10 :ℕ} → Axiom (stmt1Cond {c10})
+       (λ env → record { varn = varn env ; vari = 0 }) (stmt2Cond {c10})
+lemma1 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning  in
+  begin
+    ?      -- ?0
+  ≡⟨ ? ⟩    -- ?1
+    ?      -- ?2
+  ∎ )
+
+-- ?0 : Bool
+-- ?1 : stmt2Cond (record { varn = varn env ; vari = 0 }) ≡ true
+-- ?2 : Bool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/term1.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+stmt2Cond : {c10 :@$\mathbb{N}$@} @$\rightarrow$@ Cond
+stmt2Cond {c10} env = (Equal (varn env) c10) @$\wedge$@ (Equal (vari env) 0)
+
+lemma1 : {c10 :@$\mathbb{N}$@} @$\rightarrow$@ Axiom (stmt1Cond {c10})
+       (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env ; vari = 0 }) (stmt2Cond {c10})
+lemma1 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+  begin
+    ?      -- ?0
+  @$\equiv$@@$\langle$@ ? @$\rangle$@    -- ?1
+    ?      -- ?2
+  @$\blacksquare$@ )
+
+-- ?0 : Bool
+-- ?1 : stmt2Cond (record { varn = varn env ; vari = 0 }) @$\equiv$@ true
+-- ?2 : Bool
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/term2.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+∧true : { x : Bool } →  x  ∧  true  ≡ x
+∧true {x} with x
+∧true {x} | false = refl
+∧true {x} | true = refl
+
+stmt1Cond : {c10 :ℕ} → Cond
+stmt1Cond {c10} env = Equal (varn env) c10
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/term2.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,7 @@
+@$\wedge$@true : { x : Bool } @$\rightarrow$@  x  @$\wedge$@  true  @$\equiv$@ x
+@$\wedge$@true {x} with x
+@$\wedge$@true {x} | false = refl
+@$\wedge$@true {x} | true = refl
+
+stmt1Cond : {c10 :@$\mathbb{N}$@} @$\rightarrow$@ Cond
+stmt1Cond {c10} env = Equal (varn env) c10
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/term3.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+lemma1 : {c10 :ℕ} → Axiom (stmt1Cond {c10}) (λ env → record { varn = varn env ; vari = 0 }) (stmt2Cond {c\
+10})
+lemma1 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning  in
+begin
+(Equal (varn env) c10 ) ∧ true
+≡⟨ ∧true ⟩
+Equal (varn env) c10
+≡⟨ cond ⟩
+true
+∎ )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/term3.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+lemma1 : {c10 :@$\mathbb{N}$@} @$\rightarrow$@ Axiom (stmt1Cond {c10}) (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env ; vari = 0 }) (stmt2Cond {c\
+10})
+lemma1 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+begin
+(Equal (varn env) c10 ) @$\wedge$@ true
+@$\equiv$@@$\langle$@ @$\wedge$@true @$\rangle$@
+Equal (varn env) c10
+@$\equiv$@@$\langle$@ cond @$\rangle$@
+true
+@$\blacksquare$@ )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/termination.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
+{-# TERMINATING #-}
+loop : ℕ → ℕ
+loop n = loop (pred n)
+
+-- pred : ℕ → ℕ
+-- pred zero    = zero
+-- pred (suc n) = n
+
+stop : ℕ → ℕ
+stop zero = zero
+stop (suc n) = (stop n)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/termination.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,11 @@
+{-@$\#$@ TERMINATING @$\#$@-}
+loop : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+loop n = loop (pred n)
+
+-- pred : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+-- pred zero    = zero
+-- pred (suc n) = n
+
+stop : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+stop zero = zero
+stop (suc n) = (stop n)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/tree.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+data nomal-tree (A : Set) : Set where
+  nleaf : (key : ℕ) → tree A
+  nnode : (key : ℕ) → (lnode : nomal-tree A) → (rnode : nomal-tree A) → nomal-tree A
+
+data meta-tree (A : Set) : (key : ℕ) → Set where
+  mleaf : (key : ℕ) → meta-tree A key
+  mnode : { l r : ℕ } → (key : ℕ) → (value : A)
+    → (lnode : meta-tree A l)  → (rnode : meta-tree A r)
+    → l ≤ key → key ≤ r → metatree A key
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/tree.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,10 @@
+data nomal-tree (A : Set) : Set where
+  nleaf : (key : @$\mathbb{N}$@) @$\rightarrow$@ tree A
+  nnode : (key : @$\mathbb{N}$@) @$\rightarrow$@ (lnode : nomal-tree A) @$\rightarrow$@ (rnode : nomal-tree A) @$\rightarrow$@ nomal-tree A
+
+data meta-tree (A : Set) : (key : @$\mathbb{N}$@) @$\rightarrow$@ Set where
+  mleaf : (key : @$\mathbb{N}$@) @$\rightarrow$@ meta-tree A key
+  mnode : { l r : @$\mathbb{N}$@ } @$\rightarrow$@ (key : @$\mathbb{N}$@) @$\rightarrow$@ (value : A)
+    @$\rightarrow$@ (lnode : meta-tree A l)  @$\rightarrow$@ (rnode : meta-tree A r)
+    @$\rightarrow$@ l @$\leq$@ key @$\rightarrow$@ key @$\leq$@ r @$\rightarrow$@ metatree A key
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/utilities.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,166 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module utilities where
+
+open import Function
+open import Data.Nat
+open import Data.Product
+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
+
+Pred : Set -> Set₁
+Pred X = X -> Set
+
+Imply : Set -> Set -> Set
+Imply X Y = X -> Y
+
+Iff : Set -> Set -> Set
+Iff X Y = Imply X Y × Imply Y X
+
+record _/\_ {n : Level } (a : Set n) (b : Set n): Set n where
+  field
+    pi1 : a
+    pi2 : b
+
+open  _/\_
+
+_-_ : ℕ → ℕ → ℕ
+x - zero  = x
+zero - _  = zero
+(suc x) - (suc y)  = x - y
+
++zero : { y : ℕ } → y + zero  ≡ y
++zero {zero} = refl
++zero {suc y} = cong ( λ x → suc x ) ( +zero {y} )
+
+
++-sym : { x y : ℕ } → x + y ≡ y + x
++-sym {zero} {zero} = refl
++-sym {zero} {suc y} = let open ≡-Reasoning  in
+          begin
+            zero + suc y
+          ≡⟨⟩
+            suc y
+          ≡⟨ sym +zero ⟩
+            suc y + zero
+          ∎
++-sym {suc x} {zero} =  let open ≡-Reasoning  in
+          begin
+            suc x + zero
+          ≡⟨ +zero  ⟩
+            suc x
+          ≡⟨⟩
+            zero + suc x
+          ∎
++-sym {suc x} {suc y} = cong ( λ z → suc z ) (  let open ≡-Reasoning  in
+          begin
+            x + suc y
+          ≡⟨ +-sym {x} {suc y} ⟩
+            suc (y + x)
+          ≡⟨ cong ( λ z → suc z )  (+-sym {y} {x}) ⟩
+            suc (x + y)
+          ≡⟨ sym ( +-sym {y} {suc x}) ⟩
+            y + suc x
+          ∎ )
+
+
+minus-plus : { x y : ℕ } → (suc x - 1) + (y + 1) ≡ suc x + y
+minus-plus {zero} {y} = +-sym {y} {1}
+minus-plus {suc x} {y} =  cong ( λ z → suc z ) (minus-plus {x} {y})
+
++1≡suc : { x : ℕ } → x + 1 ≡ suc x
++1≡suc {zero} = refl
++1≡suc {suc x} = cong ( λ z → suc z ) ( +1≡suc {x} )
+
+lt : ℕ → ℕ → Bool
+lt x y with (suc x ) ≤? y
+lt x y | yes p = true
+lt x y | no ¬p = false
+
+predℕ : {n :  ℕ } → lt 0 n ≡ true  →  ℕ
+predℕ {zero} ()
+predℕ {suc n} refl = n
+
+predℕ+1=n : {n :  ℕ } → (less : lt 0 n ≡ true ) → (predℕ less) + 1 ≡ n
+predℕ+1=n {zero} ()
+predℕ+1=n {suc n} refl = +1≡suc
+
+suc-predℕ=n : {n :  ℕ } → (less : lt 0 n ≡ true ) → suc (predℕ less) ≡ n
+suc-predℕ=n {zero} ()
+suc-predℕ=n {suc n} refl = refl
+
+Equal : ℕ → ℕ → Bool
+Equal x y with x ≟ y
+Equal x y | yes p = true
+Equal x y | no ¬p = false
+
+_⇒_ : Bool → Bool → Bool
+false  ⇒  _ = true
+true  ⇒  true = true
+true  ⇒  false = false
+
+⇒t : {x : Bool} → x  ⇒ true  ≡ true
+⇒t {x} with x
+⇒t {x} | false = refl
+⇒t {x} | true = refl
+
+f⇒ : {x : Bool} → false  ⇒ x  ≡ true
+f⇒ {x} with x
+f⇒ {x} | false = refl
+f⇒ {x} | true = refl
+
+∧-pi1 : { x y : Bool } → x  ∧  y  ≡ true  → x  ≡ true
+∧-pi1 {x} {y} eq with x | y | eq
+∧-pi1 {x} {y} eq | false | b | ()
+∧-pi1 {x} {y} eq | true | false | ()
+∧-pi1 {x} {y} eq | true | true | refl = refl
+
+∧-pi2 : { x y : Bool } →  x  ∧  y  ≡ true  → y  ≡ true
+∧-pi2 {x} {y} eq with x | y | eq
+∧-pi2 {x} {y} eq | false | b | ()
+∧-pi2 {x} {y} eq | true | false | ()
+∧-pi2 {x} {y} eq | true | true | refl = refl
+
+∧true : { x : Bool } →  x  ∧  true  ≡ x
+∧true {x} with x
+∧true {x} | false = refl
+∧true {x} | true = refl
+
+true∧ : { x : Bool } →  true  ∧  x  ≡ x
+true∧ {x} with x
+true∧ {x} | false = refl
+true∧ {x} | true = refl
+bool-case : ( x : Bool ) { p : Set } → ( x ≡ true  → p ) → ( x ≡ false  → p ) → p
+bool-case x T F with x
+bool-case x T F | false = F refl
+bool-case x T F | true = T refl
+
+impl⇒ :  {x y : Bool} → (x  ≡ true → y  ≡ true ) → x  ⇒ y  ≡ true
+impl⇒ {x} {y} p = bool-case x (λ x=t →   let open ≡-Reasoning  in
+          begin
+            x  ⇒ y
+          ≡⟨  cong ( λ z → x  ⇒ z ) (p x=t ) ⟩
+            x  ⇒  true
+          ≡⟨ ⇒t ⟩
+            true
+          ∎
+    ) ( λ x=f →  let open ≡-Reasoning  in
+          begin
+            x  ⇒  y
+          ≡⟨  cong ( λ z → z  ⇒  y ) x=f ⟩
+            true
+          ∎
+  )
+
+Equal→≡ : { x y : ℕ } →  Equal x y ≡ true → x ≡ y
+Equal→≡ {x} {y} eq with x ≟ y
+Equal→≡ {x} {y} refl | yes refl = refl
+Equal→≡ {x} {y} () | no ¬p
+
+open import Data.Empty
+
+≡→Equal : { x y : ℕ } → x ≡ y →  Equal x y ≡ true
+≡→Equal {x} {.x} refl with x ≟ x
+≡→Equal {x} {.x} refl | yes refl = refl
+≡→Equal {x} {.x} refl | no ¬p = ⊥-elim ( ¬p refl )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/utilities.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,166 @@
+{-@$\#$@ OPTIONS --allow-unsolved-metas @$\#$@-}
+module utilities where
+
+open import Function
+open import Data.Nat
+open import Data.Product
+open import Data.Bool hiding ( _≟_  ; _@$\leq$@?_)
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Relation.Nullary using (@$\neg$@_; Dec; yes; no)
+open import Relation.Binary.PropositionalEquality
+
+Pred : Set @$\rightarrow$@ Set@$\_{1}$@
+Pred X = X @$\rightarrow$@ Set
+
+Imply : Set @$\rightarrow$@ Set @$\rightarrow$@ Set
+Imply X Y = X @$\rightarrow$@ Y
+
+Iff : Set @$\rightarrow$@ Set @$\rightarrow$@ Set
+Iff X Y = Imply X Y @$\times$@ Imply Y X
+
+record _@$\wedge$@_ {n : Level } (a : Set n) (b : Set n): Set n where
+  field
+    pi1 : a
+    pi2 : b
+
+open  _@$\wedge$@_
+
+_-_ : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@
+x - zero  = x
+zero - _  = zero
+(suc x) - (suc y)  = x - y
+
++zero : { y : @$\mathbb{N}$@ } @$\rightarrow$@ y + zero  @$\equiv$@ y
++zero {zero} = refl
++zero {suc y} = cong ( @$\lambda$@ x @$\rightarrow$@ suc x ) ( +zero {y} )
+
+
++-sym : { x y : @$\mathbb{N}$@ } @$\rightarrow$@ x + y @$\equiv$@ y + x
++-sym {zero} {zero} = refl
++-sym {zero} {suc y} = let open @$\equiv$@-Reasoning  in
+          begin
+            zero + suc y
+          @$\equiv$@@$\langle$@@$\rangle$@
+            suc y
+          @$\equiv$@@$\langle$@ sym +zero @$\rangle$@
+            suc y + zero
+          @$\blacksquare$@
++-sym {suc x} {zero} =  let open @$\equiv$@-Reasoning  in
+          begin
+            suc x + zero
+          @$\equiv$@@$\langle$@ +zero  @$\rangle$@
+            suc x
+          @$\equiv$@@$\langle$@@$\rangle$@
+            zero + suc x
+          @$\blacksquare$@
++-sym {suc x} {suc y} = cong ( @$\lambda$@ z @$\rightarrow$@ suc z ) (  let open @$\equiv$@-Reasoning  in
+          begin
+            x + suc y
+          @$\equiv$@@$\langle$@ +-sym {x} {suc y} @$\rangle$@
+            suc (y + x)
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ suc z )  (+-sym {y} {x}) @$\rangle$@
+            suc (x + y)
+          @$\equiv$@@$\langle$@ sym ( +-sym {y} {suc x}) @$\rangle$@
+            y + suc x
+          @$\blacksquare$@ )
+
+
+minus-plus : { x y : @$\mathbb{N}$@ } @$\rightarrow$@ (suc x - 1) + (y + 1) @$\equiv$@ suc x + y
+minus-plus {zero} {y} = +-sym {y} {1}
+minus-plus {suc x} {y} =  cong ( @$\lambda$@ z @$\rightarrow$@ suc z ) (minus-plus {x} {y})
+
++1@$\equiv$@suc : { x : @$\mathbb{N}$@ } @$\rightarrow$@ x + 1 @$\equiv$@ suc x
++1@$\equiv$@suc {zero} = refl
++1@$\equiv$@suc {suc x} = cong ( @$\lambda$@ z @$\rightarrow$@ suc z ) ( +1@$\equiv$@suc {x} )
+
+lt : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Bool
+lt x y with (suc x ) @$\leq$@? y
+lt x y | yes p = true
+lt x y | no @$\neg$@p = false
+
+pred@$\mathbb{N}$@ : {n :  @$\mathbb{N}$@ } @$\rightarrow$@ lt 0 n @$\equiv$@ true  @$\rightarrow$@  @$\mathbb{N}$@
+pred@$\mathbb{N}$@ {zero} ()
+pred@$\mathbb{N}$@ {suc n} refl = n
+
+pred@$\mathbb{N}$@+1=n : {n :  @$\mathbb{N}$@ } @$\rightarrow$@ (less : lt 0 n @$\equiv$@ true ) @$\rightarrow$@ (pred@$\mathbb{N}$@ less) + 1 @$\equiv$@ n
+pred@$\mathbb{N}$@+1=n {zero} ()
+pred@$\mathbb{N}$@+1=n {suc n} refl = +1@$\equiv$@suc
+
+suc-pred@$\mathbb{N}$@=n : {n :  @$\mathbb{N}$@ } @$\rightarrow$@ (less : lt 0 n @$\equiv$@ true ) @$\rightarrow$@ suc (pred@$\mathbb{N}$@ less) @$\equiv$@ n
+suc-pred@$\mathbb{N}$@=n {zero} ()
+suc-pred@$\mathbb{N}$@=n {suc n} refl = refl
+
+Equal : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ Bool
+Equal x y with x ≟ y
+Equal x y | yes p = true
+Equal x y | no @$\neg$@p = false
+
+_@$\Rightarrow$@_ : Bool @$\rightarrow$@ Bool @$\rightarrow$@ Bool
+false  @$\Rightarrow$@  _ = true
+true  @$\Rightarrow$@  true = true
+true  @$\Rightarrow$@  false = false
+
+@$\Rightarrow$@t : {x : Bool} @$\rightarrow$@ x  @$\Rightarrow$@ true  @$\equiv$@ true
+@$\Rightarrow$@t {x} with x
+@$\Rightarrow$@t {x} | false = refl
+@$\Rightarrow$@t {x} | true = refl
+
+f@$\Rightarrow$@ : {x : Bool} @$\rightarrow$@ false  @$\Rightarrow$@ x  @$\equiv$@ true
+f@$\Rightarrow$@ {x} with x
+f@$\Rightarrow$@ {x} | false = refl
+f@$\Rightarrow$@ {x} | true = refl
+
+@$\wedge$@-pi1 : { x y : Bool } @$\rightarrow$@ x  @$\wedge$@  y  @$\equiv$@ true  @$\rightarrow$@ x  @$\equiv$@ true
+@$\wedge$@-pi1 {x} {y} eq with x | y | eq
+@$\wedge$@-pi1 {x} {y} eq | false | b | ()
+@$\wedge$@-pi1 {x} {y} eq | true | false | ()
+@$\wedge$@-pi1 {x} {y} eq | true | true | refl = refl
+
+@$\wedge$@-pi2 : { x y : Bool } @$\rightarrow$@  x  @$\wedge$@  y  @$\equiv$@ true  @$\rightarrow$@ y  @$\equiv$@ true
+@$\wedge$@-pi2 {x} {y} eq with x | y | eq
+@$\wedge$@-pi2 {x} {y} eq | false | b | ()
+@$\wedge$@-pi2 {x} {y} eq | true | false | ()
+@$\wedge$@-pi2 {x} {y} eq | true | true | refl = refl
+
+@$\wedge$@true : { x : Bool } @$\rightarrow$@  x  @$\wedge$@  true  @$\equiv$@ x
+@$\wedge$@true {x} with x
+@$\wedge$@true {x} | false = refl
+@$\wedge$@true {x} | true = refl
+
+true@$\wedge$@ : { x : Bool } @$\rightarrow$@  true  @$\wedge$@  x  @$\equiv$@ x
+true@$\wedge$@ {x} with x
+true@$\wedge$@ {x} | false = refl
+true@$\wedge$@ {x} | true = refl
+bool-case : ( x : Bool ) { p : Set } @$\rightarrow$@ ( x @$\equiv$@ true  @$\rightarrow$@ p ) @$\rightarrow$@ ( x @$\equiv$@ false  @$\rightarrow$@ p ) @$\rightarrow$@ p
+bool-case x T F with x
+bool-case x T F | false = F refl
+bool-case x T F | true = T refl
+
+impl@$\Rightarrow$@ :  {x y : Bool} @$\rightarrow$@ (x  @$\equiv$@ true @$\rightarrow$@ y  @$\equiv$@ true ) @$\rightarrow$@ x  @$\Rightarrow$@ y  @$\equiv$@ true
+impl@$\Rightarrow$@ {x} {y} p = bool-case x (@$\lambda$@ x=t @$\rightarrow$@   let open @$\equiv$@-Reasoning  in
+          begin
+            x  @$\Rightarrow$@ y
+          @$\equiv$@@$\langle$@  cong ( @$\lambda$@ z @$\rightarrow$@ x  @$\Rightarrow$@ z ) (p x=t ) @$\rangle$@
+            x  @$\Rightarrow$@  true
+          @$\equiv$@@$\langle$@ @$\Rightarrow$@t @$\rangle$@
+            true
+          @$\blacksquare$@
+    ) ( @$\lambda$@ x=f @$\rightarrow$@  let open @$\equiv$@-Reasoning  in
+          begin
+            x  @$\Rightarrow$@  y
+          @$\equiv$@@$\langle$@  cong ( @$\lambda$@ z @$\rightarrow$@ z  @$\Rightarrow$@  y ) x=f @$\rangle$@
+            true
+          @$\blacksquare$@
+  )
+
+Equal@$\rightarrow$@@$\equiv$@ : { x y : @$\mathbb{N}$@ } @$\rightarrow$@  Equal x y @$\equiv$@ true @$\rightarrow$@ x @$\equiv$@ y
+Equal@$\rightarrow$@@$\equiv$@ {x} {y} eq with x ≟ y
+Equal@$\rightarrow$@@$\equiv$@ {x} {y} refl | yes refl = refl
+Equal@$\rightarrow$@@$\equiv$@ {x} {y} () | no @$\neg$@p
+
+open import Data.Empty
+
+@$\equiv$@@$\rightarrow$@Equal : { x y : @$\mathbb{N}$@ } @$\rightarrow$@ x @$\equiv$@ y @$\rightarrow$@  Equal x y @$\equiv$@ true
+@$\equiv$@@$\rightarrow$@Equal {x} {.x} refl with x ≟ x
+@$\equiv$@@$\rightarrow$@Equal {x} {.x} refl | yes refl = refl
+@$\equiv$@@$\rightarrow$@Equal {x} {.x} refl | no @$\neg$@p = @$\bot$@-elim ( @$\neg$@p refl )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/while-test.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+whileTest : {l : Level} {t : Set l} -> (c10 : ℕ) → (Code : Env -> t) -> t
+whileTest c10 next = next (record {varn = c10 ; vari = 0} )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/while-test.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,2 @@
+whileTest : {l : Level} {t : Set l} @$\rightarrow$@ (c10 : @$\mathbb{N}$@) @$\rightarrow$@ (Code : Env @$\rightarrow$@ t) @$\rightarrow$@ t
+whileTest c10 next = next (record {varn = c10 ; vari = 0} )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileConvPSemSound.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+whileConvPSemSound : {l : Level} → (input : Envc) → ((vari input ≡ 0) ∧ (varn input ≡ c)) implies (varn input + vari input ≡ c10 input)
+whileConvPSemSound input = proof λ x → (conversion input x) where
+  conversion : (env : Envc ) → (vari env ≡ 0) /\ (varn env ≡ c10 env) → varn env + vari env ≡ c10 env
+  conversion e record { pi1 = refl ; pi2 = refl } = +zero
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileConvPSemSound.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+whileConvPSemSound : {l : Level} @$\rightarrow$@ (input : Envc) @$\rightarrow$@ ((vari input @$\equiv$@ 0) @$\wedge$@ (varn input @$\equiv$@ c)) implies (varn input + vari input @$\equiv$@ c10 input)
+whileConvPSemSound input = proof @$\lambda$@ x @$\rightarrow$@ (conversion input x) where
+  conversion : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+  conversion e record { pi1 = refl ; pi2 = refl } = +zero
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileLoopPSem.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,21 @@
+whileLoopPSem : {l : Level} {t : Set l}   → (input : Envc ) → (vari input) + (varn input) ≡ (c10 input)
+→ (next : (output : Envc ) → ((vari input) + (varn input) ≡ (c10 input) ) implies ((vari output) + (varn output) ≡ (c10 output))  → t)
+→ (exit : (output : Envc ) → ((vari input) + (varn input) ≡ (c10 input) ) implies ((vari output ≡ c10 output))  → t) → t
+whileLoopPSem env s next exit with varn env | s
+... | zero | _ = exit env (proof (λ z → z))
+... | (suc varn ) | refl = next ( record env { varn = varn ; vari = suc (vari env) } ) (proof λ x → +-suc varn (vari env) )
+
+
+loopPPSem : (input output : Envc ) →  output ≡ loopPP (varn input)  input refl
+  → (vari input) + (varn input) ≡ (c10 input) → ((vari input) + (varn input) ≡ (c10 input) ) implies ((vari output ≡ c10 output))
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : ℕ) → (env : Envc) → n + suc (vari env) ≡ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : ℕ) → (current : Envc) → (eq : n ≡ varn current) →  (loopeq : output ≡ loopPP n current eq)
+      → ((vari current) + (varn current) ≡ (c10 current) ) → ((vari current) + (varn current) ≡ (c10 current) ) implies ((vari output ≡ c10 output))
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (λ x → refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileLoopPSem.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,21 @@
+whileLoopPSem : {l : Level} {t : Set l}   @$\rightarrow$@ (input : Envc ) @$\rightarrow$@ (vari input) + (varn input) @$\equiv$@ (c10 input)
+@$\rightarrow$@ (next : (output : Envc ) @$\rightarrow$@ ((vari input) + (varn input) @$\equiv$@ (c10 input) ) implies ((vari output) + (varn output) @$\equiv$@ (c10 output))  @$\rightarrow$@ t)
+@$\rightarrow$@ (exit : (output : Envc ) @$\rightarrow$@ ((vari input) + (varn input) @$\equiv$@ (c10 input) ) implies ((vari output @$\equiv$@ c10 output))  @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopPSem env s next exit with varn env | s
+... | zero | _ = exit env (proof (@$\lambda$@ z @$\rightarrow$@ z))
+... | (suc varn ) | refl = next ( record env { varn = varn ; vari = suc (vari env) } ) (proof @$\lambda$@ x @$\rightarrow$@ +-suc varn (vari env) )
+
+
+loopPPSem : (input output : Envc ) @$\rightarrow$@  output @$\equiv$@ loopPP (varn input)  input refl
+  @$\rightarrow$@ (vari input) + (varn input) @$\equiv$@ (c10 input) @$\rightarrow$@ ((vari input) + (varn input) @$\equiv$@ (c10 input) ) implies ((vari output @$\equiv$@ c10 output))
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc) @$\rightarrow$@ n + suc (vari env) @$\equiv$@ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : @$\mathbb{N}$@) @$\rightarrow$@ (current : Envc) @$\rightarrow$@ (eq : n @$\equiv$@ varn current) @$\rightarrow$@  (loopeq : output @$\equiv$@ loopPP n current eq)
+      @$\rightarrow$@ ((vari current) + (varn current) @$\equiv$@ (c10 current) ) @$\rightarrow$@ ((vari current) + (varn current) @$\equiv$@ (c10 current) ) implies ((vari output @$\equiv$@ c10 output))
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (@$\lambda$@ x @$\rightarrow$@ refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileLoopPSemSound.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,20 @@
+loopPPSem : (input output : Envc ) →  output ≡ loopPP (varn input)  input refl
+  → (whileTestStateP s2 input ) → (whileTestStateP s2 input ) implies (whileTestStateP sf output)
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : ℕ) → (env : Envc) → n + suc (vari env) ≡ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : ℕ) → (current : Envc) → (eq : n ≡ varn current) →  (loopeq : output ≡ loopPP n current eq)
+      → (whileTestStateP s2 current ) → (whileTestStateP s2 current ) implies (whileTestStateP sf output)
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (λ x → refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+
+
+whileLoopPSemSound : {l : Level} → (input output : Envc )
+  → (varn input + vari input ≡ c10 input)
+  →  output ≡ loopPP (varn input) input refl
+  → (varn input + vari input ≡ c10 input) implies (vari output ≡ c10 output)
+whileLoopPSemSound {l} input output pre eq = loopPPSem input output eq pre
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileLoopPSemSound.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,20 @@
+loopPPSem : (input output : Envc ) @$\rightarrow$@  output @$\equiv$@ loopPP (varn input)  input refl
+  @$\rightarrow$@ (whileTestStateP s2 input ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP sf output)
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc) @$\rightarrow$@ n + suc (vari env) @$\equiv$@ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : @$\mathbb{N}$@) @$\rightarrow$@ (current : Envc) @$\rightarrow$@ (eq : n @$\equiv$@ varn current) @$\rightarrow$@  (loopeq : output @$\equiv$@ loopPP n current eq)
+      @$\rightarrow$@ (whileTestStateP s2 current ) @$\rightarrow$@ (whileTestStateP s2 current ) implies (whileTestStateP sf output)
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (@$\lambda$@ x @$\rightarrow$@ refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+
+
+whileLoopPSemSound : {l : Level} @$\rightarrow$@ (input output : Envc )
+  @$\rightarrow$@ (varn input + vari input @$\equiv$@ c10 input)
+  @$\rightarrow$@  output @$\equiv$@ loopPP (varn input) input refl
+  @$\rightarrow$@ (varn input + vari input @$\equiv$@ c10 input) implies (vari output @$\equiv$@ c10 output)
+whileLoopPSemSound {l} input output pre eq = loopPPSem input output eq pre
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestGears.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,276 @@
+module whileTestGears where
+
+open import Function
+open import Data.Nat
+open import Data.Bool hiding ( _≟_ ; _≤?_ ; _≤_ ; _<_)
+open import Data.Product
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Relation.Nullary using (¬_; Dec; yes; no)
+open import Relation.Binary.PropositionalEquality
+open import Agda.Builtin.Unit
+
+open import utilities
+open  _/\_
+
+-- original codeGear (with non terminatinng )
+
+record Env : Set (succ Zero) where
+  field
+    varn : ℕ
+    vari : ℕ
+open Env
+
+whileTest : {l : Level} {t : Set l}  → (c10 : ℕ) → (Code : Env → t) → t
+whileTest c10 next = next (record {varn = c10 ; 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 env {varn = (varn env) - 1 ; vari = (vari env) + 1}) next
+
+test1 : Env
+test1 = whileTest 10 (λ env → whileLoop env (λ env1 → env1 ))
+
+proof1 : whileTest 10 (λ env → whileLoop env (λ e → (vari e) ≡ 10 ))
+proof1 = refl
+
+-- codeGear with pre-condtion and post-condition
+--
+--                                                                              ↓PostCondition
+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 {pi1 = refl ; pi2 = refl}
+
+
+open import Data.Empty
+open import Data.Nat.Properties
+
+
+{-# TERMINATING #-} --                                                  ↓PreCondition(Invaliant)
+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' env1 (proof3 p ) next
+    where
+      env1 = record env {varn = (varn  env) - 1 ; vari = (vari env) + 1}
+      1<0 : 1 ≤ zero → ⊥
+      1<0 ()
+      proof3 : (suc zero  ≤ (varn  env))  → varn env1 + vari env1 ≡ c10
+      proof3 (s≤s lt) with varn  env
+      proof3 (s≤s z≤n) | zero = ⊥-elim (1<0 p)
+      proof3 (s≤s (z≤n {n'}) ) | suc n =  let open ≡-Reasoning  in
+          begin
+             n' + (vari env + 1)
+          ≡⟨ cong ( λ z → n' + z ) ( +-sym  {vari env} {1} )  ⟩
+             n' + (1 + vari env )
+          ≡⟨ sym ( +-assoc (n')  1 (vari env) ) ⟩
+             (n' + 1) + vari env
+          ≡⟨ cong ( λ z → z + vari env )  +1≡suc  ⟩
+             (suc n' ) + vari env
+          ≡⟨⟩
+             varn env + vari env
+          ≡⟨ proof  ⟩
+             c10
+          ∎
+
+-- 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 ) (pi2 p1 ) ⟩
+            c10 + vari env
+          ≡⟨ cong ( λ n → c10 + n ) (pi1 p1 ) ⟩
+            c10 + 0
+          ≡⟨ +-sym {c10} {0} ⟩
+            c10
+          ∎
+
+-- 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 ))))
+
+--
+-- codeGear with loop step and closed environment
+--
+
+open import Relation.Binary
+
+record Envc : Set (succ Zero) where
+  field
+    c10 : ℕ
+    varn : ℕ
+    vari : ℕ
+open Envc
+
+whileTestP : {l : Level} {t : Set l} → (c10 : ℕ) → (Code : Envc → t) → t
+whileTestP c10 next = next (record {varn = c10 ; vari = 0 ; c10 = c10 } )
+
+whileLoopP : {l : Level} {t : Set l} → Envc → (next : Envc → t) → (exit : Envc → t) → t
+whileLoopP env next exit with <-cmp 0 (varn env)
+whileLoopP env next exit | tri≈ ¬a b ¬c = exit env
+whileLoopP env next exit | tri< a ¬b ¬c =
+     next (record env {varn = (varn env) - 1 ; vari = (vari env) + 1 })
+
+-- equivalent of whileLoopP but it looks like an induction on varn
+whileLoopP' : {l : Level} {t : Set l} → (n : ℕ) → (env : Envc) → (n ≡ varn env) → (next : Envc → t) → (exit : Envc → t) → t
+whileLoopP' zero env refl _ exit = exit env
+whileLoopP' (suc n) env refl next _ = next (record {c10 = (c10 env) ; varn = varn env ; vari = suc (vari env) })
+
+-- normal loop without termination
+{-# TERMINATING #-}
+loopP : {l : Level} {t : Set l} → Envc → (exit : Envc → t) → t
+loopP env exit = whileLoopP env (λ env → loopP env exit ) exit
+
+whileTestPCall : (c10 :  ℕ ) → Envc
+whileTestPCall c10 = whileTestP {_} {_} c10 (λ env → loopP env (λ env →  env))
+
+--
+-- codeGears with states of condition
+--
+data whileTestState  : Set where
+  s1 : whileTestState
+  s2 : whileTestState
+  sf : whileTestState
+
+whileTestStateP : whileTestState → Envc →  Set
+whileTestStateP s1 env = (vari env ≡ 0) /\ (varn env ≡ c10 env)
+whileTestStateP s2 env = (varn env + vari env ≡ c10 env)
+whileTestStateP sf env = (vari env ≡ c10 env)
+
+whileTestPwP : {l : Level} {t : Set l} → (c10 : ℕ) → ((env : Envc ) → whileTestStateP s1 env → t) → t
+whileTestPwP c10 next = next env record { pi1 = refl ; pi2 = refl } where
+   env : Envc
+   env = whileTestP c10 ( λ env → env )
+
+whileLoopPwP : {l : Level} {t : Set l}   → (env : Envc ) → whileTestStateP s2 env
+    → (next : (env : Envc ) → whileTestStateP s2 env  → t)
+    → (exit : (env : Envc ) → whileTestStateP sf env  → t) → t
+whileLoopPwP env s next exit with <-cmp 0 (varn env)
+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 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 → ⊥
+    1<0 ()
+    proof5 : (suc zero  ≤ (varn  env))  → (varn env - 1) + (vari env + 1) ≡ c10 env
+    proof5 (s≤s lt) with varn  env
+    proof5 (s≤s z≤n) | zero = ⊥-elim (1<0 a)
+    proof5 (s≤s (z≤n {n'}) ) | suc n = let open ≡-Reasoning in
+      begin
+        n' + (vari env + 1)
+      ≡⟨ cong ( λ z → n' + z ) ( +-sym  {vari env} {1} )  ⟩
+        n' + (1 + vari env )
+      ≡⟨ sym ( +-assoc (n')  1 (vari env) ) ⟩
+        (n' + 1) + vari env
+      ≡⟨ cong ( λ z → z + vari env )  +1≡suc  ⟩
+        (suc n' ) + vari env
+      ≡⟨⟩
+        varn env + vari env
+      ≡⟨ s  ⟩
+         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
+
+
+loopHelper : (n : ℕ) → (env : Envc ) → (eq : varn env ≡ n) → (seq : whileTestStateP s2 env) → loopPwP' n env (sym eq) seq λ env₁ x → (vari env₁ ≡ c10 env₁)
+loopHelper zero env eq refl rewrite eq = refl
+loopHelper (suc n) env eq refl rewrite eq = loopHelper n (record { c10 = suc (n + vari env) ; varn = n ; vari = suc (vari env) }) refl (+-suc n (vari env))
+
+
+--  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
+whileTestPCallwP c = whileTestPwP {_} {_} c ( λ env s → loopPwP env (conv env s) ( λ env s → vari env ≡ c10 env )  ) 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
+
+
+whileTestPCallwP' : (c :  ℕ ) → Set
+whileTestPCallwP' c = whileTestPwP {_} {_} c (λ env s → loopPwP' (varn env) env refl (conv env s) ( λ env s → vari env ≡ c10 env )  ) 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
+
+helperCallwP : (c : ℕ) → whileTestPCallwP' c
+helperCallwP c = whileTestPwP {_} {_} c (λ env s → loopHelper c (record { c10 = c ; varn = c ; vari = zero }) refl +zero)
+
+--
+-- Using imply relation to make soundness explicit
+-- termination is shown by induction on varn
+--
+
+data _implies_  (A B : Set ) : Set (succ Zero) where
+    proof : ( A → B ) → A implies B
+
+whileTestPSem :  (c : ℕ) → whileTestP c ( λ env → ⊤ implies (whileTestStateP s1 env) )
+whileTestPSem c = proof ( λ _ → record { pi1 = refl ; pi2 = refl } )
+
+whileTestPSemSound : (c : ℕ ) (output : Envc ) → output ≡ whileTestP c (λ e → e) → ⊤ implies ((vari output ≡ 0) /\ (varn output ≡ c))
+whileTestPSemSound c output refl = whileTestPSem c
+
+
+whileConvPSemSound : {l : Level} → (input : Envc) → (whileTestStateP s1 input ) implies (whileTestStateP s2 input)
+whileConvPSemSound input = proof λ x → (conv input x) 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
+
+loopPP : (n : ℕ) → (input : Envc ) → (n ≡ varn input) → Envc
+loopPP zero input refl = input
+loopPP (suc n) input refl =
+    loopPP n (record input { varn = pred (varn input) ; vari = suc (vari input)}) refl
+
+whileLoopPSem : {l : Level} {t : Set l}   → (input : Envc ) → whileTestStateP s2 input
+  → (next : (output : Envc ) → (whileTestStateP s2 input ) implies (whileTestStateP s2 output)  → t)
+  → (exit : (output : Envc ) → (whileTestStateP s2 input ) implies (whileTestStateP sf output)  → t) → t
+whileLoopPSem env s next exit with varn env | s
+... | zero | _ = exit env (proof (λ z → z))
+... | (suc varn ) | refl = next ( record env { varn = varn ; vari = suc (vari env) } ) (proof λ x → +-suc varn (vari env) )
+
+loopPPSem : (input output : Envc ) →  output ≡ loopPP (varn input)  input refl
+  → (whileTestStateP s2 input ) → (whileTestStateP s2 input ) implies (whileTestStateP sf output)
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : ℕ) → (env : Envc) → n + suc (vari env) ≡ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : ℕ) → (current : Envc) → (eq : n ≡ varn current) →  (loopeq : output ≡ loopPP n current eq)
+      → (whileTestStateP s2 current ) → (whileTestStateP s2 current ) implies (whileTestStateP sf output)
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (λ x → refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+
+whileLoopPSemSound : {l : Level} → (input output : Envc )
+   → whileTestStateP s2 input
+   →  output ≡ loopPP (varn input) input refl
+   → (whileTestStateP s2 input ) implies ( whileTestStateP sf output )
+whileLoopPSemSound {l} input output pre eq = loopPPSem input output eq pre
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestGears.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,276 @@
+module whileTestGears where
+
+open import Function
+open import Data.Nat
+open import Data.Bool hiding ( _@$\stackrel{?}{=}$@_ ; _@$\leq$@?_ ; _@$\leq$@_ ; _<_)
+open import Data.Product
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Relation.Nullary using (@$\neg$@_; Dec; yes; no)
+open import Relation.Binary.PropositionalEquality
+open import Agda.Builtin.Unit
+
+open import utilities
+open  _@$\wedge$@_
+
+-- original codeGear (with non terminatinng )
+
+record Env : Set (succ Zero) where
+  field
+    varn : @$\mathbb{N}$@
+    vari : @$\mathbb{N}$@
+open Env
+
+whileTest : {l : Level} {t : Set l}  @$\rightarrow$@ (c10 : @$\mathbb{N}$@) @$\rightarrow$@ (Code : Env @$\rightarrow$@ t) @$\rightarrow$@ t
+whileTest c10 next = next (record {varn = c10 ; vari = 0 } )
+
+{-@$\#$@ TERMINATING @$\#$@-}
+whileLoop : {l : Level} {t : Set l} @$\rightarrow$@ Env @$\rightarrow$@ (Code : Env @$\rightarrow$@ t) @$\rightarrow$@ 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 (@$\lambda$@ env @$\rightarrow$@ whileLoop env (@$\lambda$@ env1 @$\rightarrow$@ env1 ))
+
+proof1 : whileTest 10 (@$\lambda$@ env @$\rightarrow$@ whileLoop env (@$\lambda$@ e @$\rightarrow$@ (vari e) @$\equiv$@ 10 ))
+proof1 = refl
+
+-- codeGear with pre-condtion and post-condition
+--
+--                                                                              ↓PostCondition
+whileTest' : {l : Level} {t : Set l} @$\rightarrow$@ {c10 :  @$\mathbb{N}$@ } @$\rightarrow$@ (Code : (env : Env )  @$\rightarrow$@ ((vari env) @$\equiv$@ 0) @$\wedge$@ ((varn env) @$\equiv$@ c10) @$\rightarrow$@ t) @$\rightarrow$@ t
+whileTest' {_} {_}  {c10} next = next env proof2
+  where
+    env : Env
+    env = record {vari = 0 ; varn = c10 }
+    proof2 : ((vari env) @$\equiv$@ 0) @$\wedge$@ ((varn env) @$\equiv$@ c10) -- PostCondition
+    proof2 = record {pi1 = refl ; pi2 = refl}
+
+
+open import Data.Empty
+open import Data.Nat.Properties
+
+
+{-@$\#$@ TERMINATING @$\#$@-} --                                                  ↓PreCondition(Invaliant)
+whileLoop' : {l : Level} {t : Set l} @$\rightarrow$@ (env : Env ) @$\rightarrow$@ {c10 :  @$\mathbb{N}$@ } @$\rightarrow$@ ((varn env) + (vari env) @$\equiv$@ c10) @$\rightarrow$@ (Code : Env  @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoop' env proof next with  ( suc zero  @$\leq$@? (varn  env) )
+whileLoop' env proof next | no p = next env
+whileLoop' env {c10} proof next | yes p = whileLoop' env1 (proof3 p ) next
+    where
+      env1 = record env {varn = (varn  env) - 1 ; vari = (vari env) + 1}
+      1<0 : 1 @$\leq$@ zero @$\rightarrow$@ @$\bot$@
+      1<0 ()
+      proof3 : (suc zero  @$\leq$@ (varn  env))  @$\rightarrow$@ varn env1 + vari env1 @$\equiv$@ c10
+      proof3 (s@$\leq$@s lt) with varn  env
+      proof3 (s@$\leq$@s z@$\leq$@n) | zero = @$\bot$@-elim (1<0 p)
+      proof3 (s@$\leq$@s (z@$\leq$@n {n'}) ) | suc n =  let open @$\equiv$@-Reasoning  in
+          begin
+             n' + (vari env + 1)
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ n' + z ) ( +-sym  {vari env} {1} )  @$\rangle$@
+             n' + (1 + vari env )
+          @$\equiv$@@$\langle$@ sym ( +-assoc (n')  1 (vari env) ) @$\rangle$@
+             (n' + 1) + vari env
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ z + vari env )  +1@$\equiv$@suc  @$\rangle$@
+             (suc n' ) + vari env
+          @$\equiv$@@$\langle$@@$\rangle$@
+             varn env + vari env
+          @$\equiv$@@$\langle$@ proof  @$\rangle$@
+             c10
+          @$\blacksquare$@
+
+-- Condition to Invariant
+conversion1 : {l : Level} {t : Set l } @$\rightarrow$@ (env : Env ) @$\rightarrow$@ {c10 :  @$\mathbb{N}$@ } @$\rightarrow$@ ((vari env) @$\equiv$@ 0) @$\wedge$@ ((varn env) @$\equiv$@ c10)
+               @$\rightarrow$@ (Code : (env1 : Env ) @$\rightarrow$@ (varn env1 + vari env1 @$\equiv$@ c10) @$\rightarrow$@ t) @$\rightarrow$@ t
+conversion1 env {c10} p1 next = next env proof4
+   where
+      proof4 : varn env + vari env @$\equiv$@ c10
+      proof4 = let open @$\equiv$@-Reasoning  in
+          begin
+            varn env + vari env
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ n @$\rightarrow$@ n + vari env ) (pi2 p1 ) @$\rangle$@
+            c10 + vari env
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ n @$\rightarrow$@ c10 + n ) (pi1 p1 ) @$\rangle$@
+            c10 + 0
+          @$\equiv$@@$\langle$@ +-sym {c10} {0} @$\rangle$@
+            c10
+          @$\blacksquare$@
+
+-- all proofs are connected
+proofGears : {c10 :  @$\mathbb{N}$@ } @$\rightarrow$@ Set
+proofGears {c10} = whileTest' {_} {_} {c10} (@$\lambda$@ n p1 @$\rightarrow$@  conversion1 n p1 (@$\lambda$@ n1 p2 @$\rightarrow$@ whileLoop' n1 p2 (@$\lambda$@ n2 @$\rightarrow$@  ( vari n2 @$\equiv$@ c10 ))))
+
+--
+-- codeGear with loop step and closed environment
+--
+
+open import Relation.Binary
+
+record Envc : Set (succ Zero) where
+  field
+    c10 : @$\mathbb{N}$@
+    varn : @$\mathbb{N}$@
+    vari : @$\mathbb{N}$@
+open Envc
+
+whileTestP : {l : Level} {t : Set l} @$\rightarrow$@ (c10 : @$\mathbb{N}$@) @$\rightarrow$@ (Code : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+whileTestP c10 next = next (record {varn = c10 ; vari = 0 ; c10 = c10 } )
+
+whileLoopP : {l : Level} {t : Set l} @$\rightarrow$@ Envc @$\rightarrow$@ (next : Envc @$\rightarrow$@ t) @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopP env next exit with <-cmp 0 (varn env)
+whileLoopP env next exit | tri@$\thickapprox$@ @$\neg$@a b @$\neg$@c = exit env
+whileLoopP env next exit | tri< a @$\neg$@b @$\neg$@c =
+     next (record env {varn = (varn env) - 1 ; vari = (vari env) + 1 })
+
+-- equivalent of whileLoopP but it looks like an induction on varn
+whileLoopP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc) @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ (next : Envc @$\rightarrow$@ t) @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopP' zero env refl _ exit = exit env
+whileLoopP' (suc n) env refl next _ = next (record {c10 = (c10 env) ; varn = varn env ; vari = suc (vari env) })
+
+-- normal loop without termination
+{-@$\#$@ TERMINATING @$\#$@-}
+loopP : {l : Level} {t : Set l} @$\rightarrow$@ Envc @$\rightarrow$@ (exit : Envc @$\rightarrow$@ t) @$\rightarrow$@ t
+loopP env exit = whileLoopP env (@$\lambda$@ env @$\rightarrow$@ loopP env exit ) exit
+
+whileTestPCall : (c10 :  @$\mathbb{N}$@ ) @$\rightarrow$@ Envc
+whileTestPCall c10 = whileTestP {_} {_} c10 (@$\lambda$@ env @$\rightarrow$@ loopP env (@$\lambda$@ env @$\rightarrow$@  env))
+
+--
+-- codeGears with states of condition
+--
+data whileTestState  : Set where
+  s1 : whileTestState
+  s2 : whileTestState
+  sf : whileTestState
+
+whileTestStateP : whileTestState @$\rightarrow$@ Envc @$\rightarrow$@  Set
+whileTestStateP s1 env = (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env)
+whileTestStateP s2 env = (varn env + vari env @$\equiv$@ c10 env)
+whileTestStateP sf env = (vari env @$\equiv$@ c10 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 )
+
+whileLoopPwP : {l : Level} {t : Set l}   @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ whileTestStateP s2 env
+    @$\rightarrow$@ (next : (env : Envc ) @$\rightarrow$@ whileTestStateP s2 env  @$\rightarrow$@ t)
+    @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env  @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopPwP env s next exit with <-cmp 0 (varn env)
+whileLoopPwP env s next exit | tri@$\thickapprox$@ @$\neg$@a b @$\neg$@c = exit env (lem (sym b) s)
+  where
+    lem : (varn env @$\equiv$@ 0) @$\rightarrow$@ (varn env + vari env @$\equiv$@ c10 env) @$\rightarrow$@ vari env @$\equiv$@ c10 env
+    lem refl refl = refl
+whileLoopPwP env s next exit | tri< a @$\neg$@b @$\neg$@c  = next (record env {varn = (varn env) - 1 ; vari = (vari env) + 1 }) (proof5 a)
+  where
+    1<0 : 1 @$\leq$@ zero @$\rightarrow$@ @$\bot$@
+    1<0 ()
+    proof5 : (suc zero  @$\leq$@ (varn  env))  @$\rightarrow$@ (varn env - 1) + (vari env + 1) @$\equiv$@ c10 env
+    proof5 (s@$\leq$@s lt) with varn  env
+    proof5 (s@$\leq$@s z@$\leq$@n) | zero = @$\bot$@-elim (1<0 a)
+    proof5 (s@$\leq$@s (z@$\leq$@n {n'}) ) | suc n = let open @$\equiv$@-Reasoning in
+      begin
+        n' + (vari env + 1)
+      @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ n' + z ) ( +-sym  {vari env} {1} )  @$\rangle$@
+        n' + (1 + vari env )
+      @$\equiv$@@$\langle$@ sym ( +-assoc (n')  1 (vari env) ) @$\rangle$@
+        (n' + 1) + vari env
+      @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ z + vari env )  +1@$\equiv$@suc  @$\rangle$@
+        (suc n' ) + vari env
+      @$\equiv$@@$\langle$@@$\rangle$@
+        varn env + vari env
+      @$\equiv$@@$\langle$@ s  @$\rangle$@
+         c10 env
+      @$\blacksquare$@
+
+
+whileLoopPwP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env
+  @$\rightarrow$@ (next : (env : Envc ) @$\rightarrow$@ (pred n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env  @$\rightarrow$@ t)
+  @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env  @$\rightarrow$@ t) @$\rightarrow$@ 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} @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ whileTestStateP s2 env @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env @$\rightarrow$@ t) @$\rightarrow$@ t
+loopPwP env s exit = whileLoopPwP env s (@$\lambda$@ env s @$\rightarrow$@ loopPwP env s exit ) exit
+
+
+loopPwP' : {l : Level} {t : Set l} @$\rightarrow$@ (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ (n @$\equiv$@ varn env) @$\rightarrow$@ whileTestStateP s2 env @$\rightarrow$@ (exit : (env : Envc ) @$\rightarrow$@ whileTestStateP sf env @$\rightarrow$@ t) @$\rightarrow$@ t
+loopPwP' zero env refl refl exit = exit env refl
+loopPwP' (suc n) env refl refl exit  = whileLoopPwP' (suc n) env refl refl (@$\lambda$@ env x y @$\rightarrow$@ loopPwP' n env x y exit) exit
+
+
+loopHelper : (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc ) @$\rightarrow$@ (eq : varn env @$\equiv$@ n) @$\rightarrow$@ (seq : whileTestStateP s2 env) @$\rightarrow$@ loopPwP' n env (sym eq) seq @$\lambda$@ env@$\_{1}$@ x @$\rightarrow$@ (vari env@$\_{1}$@ @$\equiv$@ c10 env@$\_{1}$@)
+loopHelper zero env eq refl rewrite eq = refl
+loopHelper (suc n) env eq refl rewrite eq = loopHelper n (record { c10 = suc (n + vari env) ; varn = n ; vari = suc (vari env) }) refl (+-suc n (vari env))
+
+
+--  all codtions are correctly connected and required condtion is proved in the continuation
+--      use required condition as t in (env @$\rightarrow$@ t) @$\rightarrow$@ t
+--
+whileTestPCallwP : (c :  @$\mathbb{N}$@ ) @$\rightarrow$@ Set
+whileTestPCallwP c = whileTestPwP {_} {_} c ( @$\lambda$@ env s @$\rightarrow$@ loopPwP env (conv env s) ( @$\lambda$@ env s @$\rightarrow$@ vari env @$\equiv$@ c10 env )  ) where
+   conv : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+   conv e record { pi1 = refl ; pi2 = refl } = +zero
+
+
+whileTestPCallwP' : (c :  @$\mathbb{N}$@ ) @$\rightarrow$@ Set
+whileTestPCallwP' c = whileTestPwP {_} {_} c (@$\lambda$@ env s @$\rightarrow$@ loopPwP' (varn env) env refl (conv env s) ( @$\lambda$@ env s @$\rightarrow$@ vari env @$\equiv$@ c10 env )  ) where
+  conv : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+  conv e record { pi1 = refl ; pi2 = refl } = +zero
+
+helperCallwP : (c : @$\mathbb{N}$@) @$\rightarrow$@ whileTestPCallwP' c
+helperCallwP c = whileTestPwP {_} {_} c (@$\lambda$@ env s @$\rightarrow$@ loopHelper c (record { c10 = c ; varn = c ; vari = zero }) refl +zero)
+
+--
+-- Using imply relation to make soundness explicit
+-- termination is shown by induction on varn
+--
+
+data _implies_  (A B : Set ) : Set (succ Zero) where
+    proof : ( A @$\rightarrow$@ B ) @$\rightarrow$@ A implies B
+
+whileTestPSem :  (c : @$\mathbb{N}$@) @$\rightarrow$@ whileTestP c ( @$\lambda$@ env @$\rightarrow$@ @$\top$@ implies (whileTestStateP s1 env) )
+whileTestPSem c = proof ( @$\lambda$@ _ @$\rightarrow$@ record { pi1 = refl ; pi2 = refl } )
+
+whileTestPSemSound : (c : @$\mathbb{N}$@ ) (output : Envc ) @$\rightarrow$@ output @$\equiv$@ whileTestP c (@$\lambda$@ e @$\rightarrow$@ e) @$\rightarrow$@ @$\top$@ implies ((vari output @$\equiv$@ 0) @$\wedge$@ (varn output @$\equiv$@ c))
+whileTestPSemSound c output refl = whileTestPSem c
+
+
+whileConvPSemSound : {l : Level} @$\rightarrow$@ (input : Envc) @$\rightarrow$@ (whileTestStateP s1 input ) implies (whileTestStateP s2 input)
+whileConvPSemSound input = proof @$\lambda$@ x @$\rightarrow$@ (conv input x) where
+  conv : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+  conv e record { pi1 = refl ; pi2 = refl } = +zero
+
+loopPP : (n : @$\mathbb{N}$@) @$\rightarrow$@ (input : Envc ) @$\rightarrow$@ (n @$\equiv$@ varn input) @$\rightarrow$@ Envc
+loopPP zero input refl = input
+loopPP (suc n) input refl =
+    loopPP n (record input { varn = pred (varn input) ; vari = suc (vari input)}) refl
+
+whileLoopPSem : {l : Level} {t : Set l}   @$\rightarrow$@ (input : Envc ) @$\rightarrow$@ whileTestStateP s2 input
+  @$\rightarrow$@ (next : (output : Envc ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP s2 output)  @$\rightarrow$@ t)
+  @$\rightarrow$@ (exit : (output : Envc ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP sf output)  @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopPSem env s next exit with varn env | s
+... | zero | _ = exit env (proof (@$\lambda$@ z @$\rightarrow$@ z))
+... | (suc varn ) | refl = next ( record env { varn = varn ; vari = suc (vari env) } ) (proof @$\lambda$@ x @$\rightarrow$@ +-suc varn (vari env) )
+
+loopPPSem : (input output : Envc ) @$\rightarrow$@  output @$\equiv$@ loopPP (varn input)  input refl
+  @$\rightarrow$@ (whileTestStateP s2 input ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP sf output)
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc) @$\rightarrow$@ n + suc (vari env) @$\equiv$@ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : @$\mathbb{N}$@) @$\rightarrow$@ (current : Envc) @$\rightarrow$@ (eq : n @$\equiv$@ varn current) @$\rightarrow$@  (loopeq : output @$\equiv$@ loopPP n current eq)
+      @$\rightarrow$@ (whileTestStateP s2 current ) @$\rightarrow$@ (whileTestStateP s2 current ) implies (whileTestStateP sf output)
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (@$\lambda$@ x @$\rightarrow$@ refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+
+whileLoopPSemSound : {l : Level} @$\rightarrow$@ (input output : Envc )
+   @$\rightarrow$@ whileTestStateP s2 input
+   @$\rightarrow$@  output @$\equiv$@ loopPP (varn input) input refl
+   @$\rightarrow$@ (whileTestStateP s2 input ) implies ( whileTestStateP sf output )
+whileLoopPSemSound {l} input output pre eq = loopPPSem input output eq pre
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestPSem.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+whileTestPSem :  (c : ℕ) → whileTestP c
+  ( λ env → ⊤ implies (vari env ≡ 0) ∧ (varn env ≡ c10 env) )
+whileTestPSem c = proof ( λ _ → record { pi1 = refl ; pi2 = refl } )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestPSem.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,3 @@
+whileTestPSem :  (c : @$\mathbb{N}$@) @$\rightarrow$@ whileTestP c
+  ( @$\lambda$@ env @$\rightarrow$@ ⊤ implies (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) )
+whileTestPSem c = proof ( @$\lambda$@ _ @$\rightarrow$@ record { pi1 = refl ; pi2 = refl } )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestPrim.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,71 @@
+module whileTestPrim 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
+
+open import utilities hiding ( _/\_ )
+
+record Env : Set where
+  field
+    varn : ℕ
+    vari : ℕ
+open Env
+
+PrimComm : Set
+PrimComm = Env → Env
+
+Cond : Set
+Cond = (Env → Bool)
+
+Axiom : Cond -> PrimComm -> Cond -> Set
+Axiom pre comm post = ∀ (env : Env) →  (pre env) ⇒ ( post (comm env)) ≡ true
+
+Tautology : Cond -> Cond -> Set
+Tautology pre post = ∀ (env : Env) →  (pre env)  ⇒ (post env) ≡ true
+
+_and_ :  Cond -> Cond -> Cond
+x and y =  λ env → x env ∧ y env
+
+neg :  Cond -> Cond
+neg x  =  λ env → not ( x env )
+
+open import Hoare PrimComm Cond Axiom Tautology _and_ neg
+
+---------------------------
+
+program : ℕ → Comm
+program c10 =
+    Seq ( PComm (λ env → record env {varn = c10}))
+    $ Seq ( PComm (λ env → record env {vari = 0}))
+    $ While (λ env → lt zero (varn env ) )
+      (Seq (PComm (λ env → record env {vari = ((vari env) + 1)} ))
+        $ PComm (λ env → record env {varn = ((varn env) - 1)} ))
+
+simple : ℕ → Comm
+simple c10 =
+    Seq ( PComm (λ env → record env {varn = c10}))
+    $  PComm (λ env → record env {vari = 0})
+
+{-# TERMINATING #-}
+interpret : Env → Comm → Env
+interpret env Skip = env
+interpret env Abort = env
+interpret env (PComm x) = x env
+interpret env (Seq comm comm1) = interpret (interpret env comm) comm1
+interpret env (If x then else) with x env
+... | true = interpret env then
+... | false = interpret env else
+interpret env (While x comm) with x env
+... | true = interpret (interpret env comm) (While x comm)
+... | false = env
+
+test1 : Env
+test1 =  interpret ( record { vari = 0  ; varn = 0 } ) (program 10)
+
+
+tests : Env
+tests =  interpret ( record { vari = 0  ; varn = 0 } ) (simple 10)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestPrim.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,71 @@
+module whileTestPrim where
+
+open import Function
+open import Data.Nat
+open import Data.Bool hiding ( _@$\stackrel{?}{=}$@_ )
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Relation.Nullary using (@$\neg$@_; Dec; yes; no)
+open import Relation.Binary.PropositionalEquality
+
+open import utilities hiding ( _@$\wedge$@_ )
+
+record Env : Set where
+  field
+    varn : @$\mathbb{N}$@
+    vari : @$\mathbb{N}$@
+open Env
+
+PrimComm : Set
+PrimComm = Env @$\rightarrow$@ Env
+
+Cond : Set
+Cond = (Env @$\rightarrow$@ Bool)
+
+Axiom : Cond @$\rightarrow$@ PrimComm @$\rightarrow$@ Cond @$\rightarrow$@ Set
+Axiom pre comm post = @$\forall$@ (env : Env) @$\rightarrow$@  (pre env) @$\Rightarrow$@ ( post (comm env)) @$\equiv$@ true
+
+Tautology : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Set
+Tautology pre post = @$\forall$@ (env : Env) @$\rightarrow$@  (pre env)  @$\Rightarrow$@ (post env) @$\equiv$@ true
+
+_and_ :  Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond
+x and y =  @$\lambda$@ env @$\rightarrow$@ x env @$\wedge$@ y env
+
+neg :  Cond @$\rightarrow$@ Cond
+neg x  =  @$\lambda$@ env @$\rightarrow$@ not ( x env )
+
+open import Hoare PrimComm Cond Axiom Tautology _and_ neg
+
+---------------------------
+
+program : @$\mathbb{N}$@ @$\rightarrow$@ Comm
+program c10 =
+    Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = c10}))
+    $ Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0}))
+    $ While (@$\lambda$@ env @$\rightarrow$@ lt zero (varn env ) )
+      (Seq (PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = ((vari env) + 1)} ))
+        $ PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = ((varn env) - 1)} ))
+
+simple : @$\mathbb{N}$@ @$\rightarrow$@ Comm
+simple c10 =
+    Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = c10}))
+    $  PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0})
+
+{-@$\#$@ TERMINATING @$\#$@-}
+interpret : Env @$\rightarrow$@ Comm @$\rightarrow$@ Env
+interpret env Skip = env
+interpret env Abort = env
+interpret env (PComm x) = x env
+interpret env (Seq comm comm1) = interpret (interpret env comm) comm1
+interpret env (If x then else) with x env
+... | true = interpret env then
+... | false = interpret env else
+interpret env (While x comm) with x env
+... | true = interpret (interpret env comm) (While x comm)
+... | false = env
+
+test1 : Env
+test1 =  interpret ( record { vari = 0  ; varn = 0 } ) (program 10)
+
+
+tests : Env
+tests =  interpret ( record { vari = 0  ; varn = 0 } ) (simple 10)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestPrimProof.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,288 @@
+module whileTestPrimProof 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
+
+open import utilities hiding ( _/\_ )
+open import whileTestPrim
+
+open import Hoare PrimComm Cond Axiom Tautology _and_ neg
+
+open Env
+
+initCond : Cond
+initCond env = true
+
+stmt1Cond : {c10 : ℕ} → Cond
+stmt1Cond {c10} env = Equal (varn env) c10
+
+init-case : {c10 :  ℕ} → (env : Env) → (( λ e → true  ⇒ stmt1Cond {c10} e ) (record { varn = c10 ; vari = vari env }) ) ≡ true
+init-case {c10} _ = impl⇒ ( λ cond → ≡→Equal refl )
+
+init-type : {c10 :  ℕ} → Axiom (λ env → true) (λ env → record { varn = c10 ; vari = vari env }) (stmt1Cond {c10})
+init-type {c10} env = init-case env
+
+stmt2Cond : {c10 : ℕ} → Cond
+stmt2Cond {c10} env = (Equal (varn env) c10) ∧ (Equal (vari env) 0)
+
+lemma1 : {c10 : ℕ} → Axiom (stmt1Cond {c10}) (λ env → record { varn = varn env ; vari = 0 }) (stmt2Cond {c10})
+lemma1 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning  in
+  begin
+    (Equal (varn env) c10 ) ∧ true
+  ≡⟨ ∧true ⟩
+    Equal (varn env) c10
+  ≡⟨ cond ⟩
+    true
+  ∎ )
+
+-- simple : ℕ → Comm
+-- simple c10 =
+--     Seq ( PComm (λ env → record env {varn = c10}))
+--     $  PComm (λ env → record env {vari = 0})
+
+proofs : (c10 : ℕ) → HTProof initCond (simple c10) (stmt2Cond {c10})
+proofs c10 =
+      SeqRule {initCond} ( PrimRule (init-case {c10} ))
+    $ PrimRule {stmt1Cond} {_} {stmt2Cond} (lemma1 {c10})
+
+open import Data.Empty
+
+open import Data.Nat.Properties
+
+whileInv : {c10 : ℕ} → Cond
+whileInv {c10} env = Equal ((varn env) + (vari env)) c10
+
+whileInv' : {c10 : ℕ} → Cond
+whileInv'{c10}  env = Equal ((varn env) + (vari env)) (suc c10) ∧ lt zero (varn env)
+
+termCond : {c10 : ℕ} → Cond
+termCond {c10} env = Equal (vari env) c10
+
+
+--  program : ℕ → Comm
+--  program c10 =
+--      Seq ( PComm (λ env → record env {varn = c10}))
+--      $ Seq ( PComm (λ env → record env {vari = 0}))
+--      $ While (λ env → lt zero (varn env ) )
+--        (Seq (PComm (λ env → record env {vari = ((vari env) + 1)} ))
+--          $ PComm (λ env → record env {varn = ((varn env) - 1)} ))
+
+
+proof1 : (c10 : ℕ) → HTProof initCond (program c10 ) (termCond {c10})
+proof1 c10 =
+      SeqRule {λ e → true} ( PrimRule (init-case {c10} ))
+    $ SeqRule {λ e →  Equal (varn e) c10} ( PrimRule lemma1   )
+    $ WeakeningRule {λ e → (Equal (varn e) c10) ∧ (Equal (vari e) 0)}  lemma2 (
+            WhileRule {_} {λ e → Equal ((varn e) + (vari e)) c10}
+            $ SeqRule (PrimRule {λ e →  whileInv e  ∧ lt zero (varn e) } lemma3 )
+                     $ PrimRule {whileInv'} {_} {whileInv}  lemma4 ) lemma5
+  where
+     lemma21 : {env : Env } → {c10 : ℕ} → stmt2Cond env ≡ true → varn env ≡ c10
+     lemma21 eq = Equal→≡ (∧-pi1 eq)
+     lemma22 : {env : Env } → {c10 : ℕ} → stmt2Cond {c10} env ≡ true → vari env ≡ 0
+     lemma22 eq = Equal→≡ (∧-pi2 eq)
+     lemma23 :  {env : Env } → {c10 : ℕ} → stmt2Cond env ≡ true → varn env + vari env ≡ c10
+     lemma23 {env} {c10} eq = let open ≡-Reasoning  in
+          begin
+            varn env + vari env
+          ≡⟨ cong ( \ x -> x + vari env ) (lemma21 eq  ) ⟩
+            c10 + vari env
+          ≡⟨ cong ( \ x -> c10 + x) (lemma22 {env} {c10} eq ) ⟩
+            c10 + 0
+          ≡⟨ +-sym {c10} {0} ⟩
+            0 + c10
+          ≡⟨⟩
+            c10
+          ∎
+     lemma2 :  {c10 : ℕ} → Tautology stmt2Cond whileInv
+     lemma2 {c10} env = bool-case (stmt2Cond env) (
+        λ eq → let open ≡-Reasoning  in
+          begin
+            (stmt2Cond env)  ⇒  (whileInv env)
+          ≡⟨⟩
+            (stmt2Cond env)  ⇒ ( Equal (varn env + vari env) c10 )
+          ≡⟨  cong ( \ x -> (stmt2Cond  {c10} env)  ⇒ ( Equal x c10 ) ) ( lemma23 {env} eq ) ⟩
+            (stmt2Cond env)  ⇒ (Equal c10 c10)
+          ≡⟨ cong ( \ x -> (stmt2Cond {c10} env) ⇒ x ) (≡→Equal refl )  ⟩
+            (stmt2Cond {c10} env)  ⇒  true
+          ≡⟨ ⇒t ⟩
+            true
+          ∎
+        ) (
+         λ ne → let open ≡-Reasoning  in
+          begin
+            (stmt2Cond env)  ⇒  (whileInv env)
+          ≡⟨ cong ( \ x -> x  ⇒  (whileInv env) ) ne ⟩
+             false  ⇒  (whileInv {c10} env)
+          ≡⟨ f⇒ {whileInv {c10} env} ⟩
+            true
+          ∎
+        )
+     lemma3 :   Axiom (λ e → whileInv e ∧ lt zero (varn e)) (λ env → record { varn = varn env ; vari = vari env + 1 }) whileInv'
+     lemma3 env = impl⇒ ( λ cond →  let open ≡-Reasoning  in
+          begin
+            whileInv' (record { varn = varn env ; vari = vari env + 1 })
+          ≡⟨⟩
+             Equal (varn env + (vari env + 1)) (suc c10) ∧ (lt 0 (varn env) )
+          ≡⟨ cong ( λ z → Equal (varn env + (vari env + 1)) (suc c10) ∧ z ) (∧-pi2 cond )  ⟩
+             Equal (varn env + (vari env + 1)) (suc c10) ∧ true
+          ≡⟨ ∧true ⟩
+            Equal (varn env + (vari env + 1)) (suc c10)
+          ≡⟨ cong ( \ x -> Equal x (suc c10) ) (sym (+-assoc (varn env) (vari env) 1)) ⟩
+            Equal ((varn env + vari env) + 1) (suc c10)
+          ≡⟨ cong ( \ x -> Equal x (suc c10) ) +1≡suc ⟩
+            Equal (suc (varn env + vari env)) (suc c10)
+          ≡⟨ sym Equal+1 ⟩
+            Equal ((varn env + vari env) ) c10
+          ≡⟨ ∧-pi1  cond ⟩
+            true
+          ∎ )
+     lemma41 : (env : Env ) → {c10 : ℕ} → (varn env + vari env) ≡ (suc c10) → lt 0 (varn env) ≡ true  → Equal ((varn env - 1) + vari env) c10 ≡ true
+     lemma41 env {c10} c1 c2 =  let open ≡-Reasoning  in
+          begin
+            Equal ((varn env - 1) + vari env) c10
+          ≡⟨ cong ( λ z → Equal ((z - 1 ) +  vari env ) c10 ) (sym (suc-predℕ=n c2) )  ⟩
+            Equal ((suc (predℕ {varn env} c2 ) - 1) + vari env) c10
+          ≡⟨⟩
+            Equal ((predℕ {varn env} c2 ) + vari env) c10
+          ≡⟨  Equal+1 ⟩
+            Equal ((suc (predℕ {varn env} c2 )) + vari env) (suc c10)
+          ≡⟨ cong ( λ z → Equal (z  +  vari env ) (suc c10) ) (suc-predℕ=n c2 )  ⟩
+            Equal (varn env + vari env) (suc c10)
+          ≡⟨ cong ( λ z → (Equal z (suc c10) )) c1 ⟩
+            Equal (suc c10) (suc c10)
+          ≡⟨ ≡→Equal refl ⟩
+            true
+          ∎
+     lemma4 :  {c10 : ℕ} → Axiom whileInv' (λ env → record { varn = varn env - 1 ; vari = vari env }) whileInv
+     lemma4 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning  in
+          begin
+            whileInv (record { varn = varn env - 1 ; vari = vari env })
+          ≡⟨⟩
+            Equal ((varn env - 1) + vari env) c10
+          ≡⟨ lemma41 env (Equal→≡ (∧-pi1  cond)) (∧-pi2  cond) ⟩
+            true
+          ∎
+        )
+     lemma51 : (z : Env ) → neg (λ z → lt zero (varn z)) z ≡ true → varn z ≡ zero
+     lemma51 z cond with varn z
+     lemma51 z refl | zero = refl
+     lemma51 z () | suc x
+     lemma5 : {c10 : ℕ} →  Tautology ((λ e → Equal (varn e + vari e) c10) and (neg (λ z → lt zero (varn z)))) termCond
+     lemma5 {c10} env = impl⇒ ( λ cond → let open ≡-Reasoning  in
+         begin
+            termCond env
+          ≡⟨⟩
+             Equal (vari env) c10
+          ≡⟨⟩
+             Equal (zero + vari env) c10
+          ≡⟨ cong ( λ z →  Equal (z + vari env) c10 )  (sym ( lemma51 env ( ∧-pi2  cond ) )) ⟩
+             Equal (varn env + vari env) c10
+          ≡⟨ ∧-pi1  cond  ⟩
+             true
+          ∎
+        )
+
+--- necessary definitions for Hoare.agda ( Soundness )
+
+State : Set
+State = Env
+
+open import RelOp
+module RelOpState = RelOp State
+
+open import Data.Product
+open import Relation.Binary
+
+NotP : {S : Set} -> Pred S -> Pred S
+NotP X s = ¬ X s
+
+_/\_ : Cond -> Cond -> Cond
+b1 /\ b2 = b1 and b2
+
+_\/_ : Cond -> Cond -> Cond
+b1 \/ b2 = neg (neg b1 /\ neg b2)
+
+SemCond : Cond -> State -> Set
+SemCond c p = c p ≡ true
+
+tautValid : (b1 b2 : Cond) -> Tautology b1 b2 ->
+                 (s : State) -> SemCond b1 s -> SemCond b2 s
+tautValid b1 b2 taut s cond with b1 s | b2 s | taut s
+tautValid b1 b2 taut s () | false | false | refl
+tautValid b1 b2 taut s _ | false | true | refl = refl
+tautValid b1 b2 taut s _ | true | false | ()
+tautValid b1 b2 taut s _ | true | true | refl = refl
+
+respNeg : (b : Cond) -> (s : State) ->
+               Iff (SemCond (neg b) s) (¬ SemCond b s)
+respNeg b s = ( left , right ) where
+    left : not (b s) ≡ true → (b s) ≡ true → ⊥
+    left ne with b s
+    left refl | false = λ ()
+    left () | true
+    right : ((b s) ≡ true → ⊥) → not (b s) ≡ true
+    right ne with b s
+    right ne | false = refl
+    right ne | true = ⊥-elim ( ne refl )
+
+respAnd : (b1 b2 : Cond) -> (s : State) ->
+               Iff (SemCond (b1 /\ b2) s)
+                   ((SemCond b1 s) × (SemCond b2 s))
+respAnd b1 b2 s = ( left , right ) where
+     left : b1 s ∧ b2 s ≡ true → (b1 s ≡ true)  ×  (b2 s ≡ true)
+     left and with b1 s | b2 s
+     left () | false | false
+     left () | false | true
+     left () | true | false
+     left refl | true | true = ( refl , refl )
+     right :  (b1 s ≡ true)  ×  (b2 s ≡ true) →  b1 s ∧ b2 s ≡ true
+     right ( x1 , x2 ) with b1 s | b2 s
+     right (() , ()) | false | false
+     right (() , _) | false | true
+     right (_ , ()) | true | false
+     right (refl , refl) | true | true = refl
+
+PrimSemComm : ∀ {l} -> PrimComm -> Rel State l
+PrimSemComm prim s1 s2 =  Id State (prim s1) s2
+
+
+
+axiomValid : ∀ {l} -> (bPre : Cond) -> (pcm : PrimComm) -> (bPost : Cond) ->
+                  (ax : Axiom bPre pcm bPost) -> (s1 s2 : State) ->
+                  SemCond bPre s1 -> PrimSemComm {l} pcm s1 s2 -> SemCond bPost s2
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref with bPre s1 | bPost (pcm s1) | ax s1
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) () ref | false | false | refl
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | false | true | refl = refl
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | true | false | ()
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | true | true | refl = refl
+
+open import HoareSoundness
+    Cond
+    PrimComm
+    neg
+    _and_
+    Tautology
+    State
+    SemCond
+    tautValid
+    respNeg
+    respAnd
+    PrimSemComm
+    Axiom
+    axiomValid
+
+PrimSoundness : {bPre : Cond} -> {cm : Comm} -> {bPost : Cond} ->
+            HTProof bPre cm bPost -> Satisfies bPre cm bPost
+PrimSoundness {bPre} {cm} {bPost} ht = Soundness ht
+
+
+proofOfProgram : (c10 : ℕ) → (input output : Env )
+  → initCond input ≡ true
+  → (SemComm (program c10) input output)
+  → termCond {c10} output ≡ true
+proofOfProgram c10 input output ic sem  = PrimSoundness (proof1 c10) input output ic sem
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestPrimProof.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,288 @@
+module whileTestPrimProof where
+
+open import Function
+open import Data.Nat
+open import Data.Bool hiding ( _@$\stackrel{?}{=}$@_ )
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Relation.Nullary using (@$\neg$@_; Dec; yes; no)
+open import Relation.Binary.PropositionalEquality
+
+open import utilities hiding ( _@$\wedge$@_ )
+open import whileTestPrim
+
+open import Hoare PrimComm Cond Axiom Tautology _and_ neg
+
+open Env
+
+initCond : Cond
+initCond env = true
+
+stmt1Cond : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
+stmt1Cond {c10} env = Equal (varn env) c10
+
+init-case : {c10 :  @$\mathbb{N}$@} @$\rightarrow$@ (env : Env) @$\rightarrow$@ (( @$\lambda$@ e @$\rightarrow$@ true  @$\Rightarrow$@ stmt1Cond {c10} e ) (record { varn = c10 ; vari = vari env }) ) @$\equiv$@ true
+init-case {c10} _ = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ @$\equiv$@@$\rightarrow$@Equal refl )
+
+init-type : {c10 :  @$\mathbb{N}$@} @$\rightarrow$@ Axiom (@$\lambda$@ env @$\rightarrow$@ true) (@$\lambda$@ env @$\rightarrow$@ record { varn = c10 ; vari = vari env }) (stmt1Cond {c10})
+init-type {c10} env = init-case env
+
+stmt2Cond : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
+stmt2Cond {c10} env = (Equal (varn env) c10) @$\wedge$@ (Equal (vari env) 0)
+
+lemma1 : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Axiom (stmt1Cond {c10}) (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env ; vari = 0 }) (stmt2Cond {c10})
+lemma1 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+  begin
+    (Equal (varn env) c10 ) @$\wedge$@ true
+  @$\equiv$@@$\langle$@ @$\wedge$@true @$\rangle$@
+    Equal (varn env) c10
+  @$\equiv$@@$\langle$@ cond @$\rangle$@
+    true
+  @$\blacksquare$@ )
+
+-- simple : @$\mathbb{N}$@ @$\rightarrow$@ Comm
+-- simple c10 =
+--     Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = c10}))
+--     $  PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0})
+
+proofs : (c10 : @$\mathbb{N}$@) @$\rightarrow$@ HTProof initCond (simple c10) (stmt2Cond {c10})
+proofs c10 =
+      SeqRule {initCond} ( PrimRule (init-case {c10} ))
+    $ PrimRule {stmt1Cond} {_} {stmt2Cond} (lemma1 {c10})
+
+open import Data.Empty
+
+open import Data.Nat.Properties
+
+whileInv : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
+whileInv {c10} env = Equal ((varn env) + (vari env)) c10
+
+whileInv' : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
+whileInv'{c10}  env = Equal ((varn env) + (vari env)) (suc c10) @$\wedge$@ lt zero (varn env)
+
+termCond : {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Cond
+termCond {c10} env = Equal (vari env) c10
+
+
+--  program : @$\mathbb{N}$@ @$\rightarrow$@ Comm
+--  program c10 =
+--      Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = c10}))
+--      $ Seq ( PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = 0}))
+--      $ While (@$\lambda$@ env @$\rightarrow$@ lt zero (varn env ) )
+--        (Seq (PComm (@$\lambda$@ env @$\rightarrow$@ record env {vari = ((vari env) + 1)} ))
+--          $ PComm (@$\lambda$@ env @$\rightarrow$@ record env {varn = ((varn env) - 1)} ))
+
+
+proof1 : (c10 : @$\mathbb{N}$@) @$\rightarrow$@ HTProof initCond (program c10 ) (termCond {c10})
+proof1 c10 =
+      SeqRule {@$\lambda$@ e @$\rightarrow$@ true} ( PrimRule (init-case {c10} ))
+    $ SeqRule {@$\lambda$@ e @$\rightarrow$@  Equal (varn e) c10} ( PrimRule lemma1   )
+    $ WeakeningRule {@$\lambda$@ e @$\rightarrow$@ (Equal (varn e) c10) @$\wedge$@ (Equal (vari e) 0)}  lemma2 (
+            WhileRule {_} {@$\lambda$@ e @$\rightarrow$@ Equal ((varn e) + (vari e)) c10}
+            $ SeqRule (PrimRule {@$\lambda$@ e @$\rightarrow$@  whileInv e  @$\wedge$@ lt zero (varn e) } lemma3 )
+                     $ PrimRule {whileInv'} {_} {whileInv}  lemma4 ) lemma5
+  where
+     lemma21 : {env : Env } @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ stmt2Cond env @$\equiv$@ true @$\rightarrow$@ varn env @$\equiv$@ c10
+     lemma21 eq = Equal@$\rightarrow$@@$\equiv$@ (@$\wedge$@-pi1 eq)
+     lemma22 : {env : Env } @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ stmt2Cond {c10} env @$\equiv$@ true @$\rightarrow$@ vari env @$\equiv$@ 0
+     lemma22 eq = Equal@$\rightarrow$@@$\equiv$@ (@$\wedge$@-pi2 eq)
+     lemma23 :  {env : Env } @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ stmt2Cond env @$\equiv$@ true @$\rightarrow$@ varn env + vari env @$\equiv$@ c10
+     lemma23 {env} {c10} eq = let open @$\equiv$@-Reasoning  in
+          begin
+            varn env + vari env
+          @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ x + vari env ) (lemma21 eq  ) @$\rangle$@
+            c10 + vari env
+          @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ c10 + x) (lemma22 {env} {c10} eq ) @$\rangle$@
+            c10 + 0
+          @$\equiv$@@$\langle$@ +-sym {c10} {0} @$\rangle$@
+            0 + c10
+          @$\equiv$@@$\langle$@@$\rangle$@
+            c10
+          @$\blacksquare$@
+     lemma2 :  {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Tautology stmt2Cond whileInv
+     lemma2 {c10} env = bool-case (stmt2Cond env) (
+        @$\lambda$@ eq @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+          begin
+            (stmt2Cond env)  @$\Rightarrow$@  (whileInv env)
+          @$\equiv$@@$\langle$@@$\rangle$@
+            (stmt2Cond env)  @$\Rightarrow$@ ( Equal (varn env + vari env) c10 )
+          @$\equiv$@@$\langle$@  cong ( \ x @$\rightarrow$@ (stmt2Cond  {c10} env)  @$\Rightarrow$@ ( Equal x c10 ) ) ( lemma23 {env} eq ) @$\rangle$@
+            (stmt2Cond env)  @$\Rightarrow$@ (Equal c10 c10)
+          @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ (stmt2Cond {c10} env) @$\Rightarrow$@ x ) (@$\equiv$@@$\rightarrow$@Equal refl )  @$\rangle$@
+            (stmt2Cond {c10} env)  @$\Rightarrow$@  true
+          @$\equiv$@@$\langle$@ @$\Rightarrow$@t @$\rangle$@
+            true
+          @$\blacksquare$@
+        ) (
+         @$\lambda$@ ne @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+          begin
+            (stmt2Cond env)  @$\Rightarrow$@  (whileInv env)
+          @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ x  @$\Rightarrow$@  (whileInv env) ) ne @$\rangle$@
+             false  @$\Rightarrow$@  (whileInv {c10} env)
+          @$\equiv$@@$\langle$@ f@$\Rightarrow$@ {whileInv {c10} env} @$\rangle$@
+            true
+          @$\blacksquare$@
+        )
+     lemma3 :   Axiom (@$\lambda$@ e @$\rightarrow$@ whileInv e @$\wedge$@ lt zero (varn e)) (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env ; vari = vari env + 1 }) whileInv'
+     lemma3 env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@  let open @$\equiv$@-Reasoning  in
+          begin
+            whileInv' (record { varn = varn env ; vari = vari env + 1 })
+          @$\equiv$@@$\langle$@@$\rangle$@
+             Equal (varn env + (vari env + 1)) (suc c10) @$\wedge$@ (lt 0 (varn env) )
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal (varn env + (vari env + 1)) (suc c10) @$\wedge$@ z ) (@$\wedge$@-pi2 cond )  @$\rangle$@
+             Equal (varn env + (vari env + 1)) (suc c10) @$\wedge$@ true
+          @$\equiv$@@$\langle$@ @$\wedge$@true @$\rangle$@
+            Equal (varn env + (vari env + 1)) (suc c10)
+          @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ Equal x (suc c10) ) (sym (+-assoc (varn env) (vari env) 1)) @$\rangle$@
+            Equal ((varn env + vari env) + 1) (suc c10)
+          @$\equiv$@@$\langle$@ cong ( \ x @$\rightarrow$@ Equal x (suc c10) ) +1@$\equiv$@suc @$\rangle$@
+            Equal (suc (varn env + vari env)) (suc c10)
+          @$\equiv$@@$\langle$@ sym Equal+1 @$\rangle$@
+            Equal ((varn env + vari env) ) c10
+          @$\equiv$@@$\langle$@ @$\wedge$@-pi1  cond @$\rangle$@
+            true
+          @$\blacksquare$@ )
+     lemma41 : (env : Env ) @$\rightarrow$@ {c10 : @$\mathbb{N}$@} @$\rightarrow$@ (varn env + vari env) @$\equiv$@ (suc c10) @$\rightarrow$@ lt 0 (varn env) @$\equiv$@ true  @$\rightarrow$@ Equal ((varn env - 1) + vari env) c10 @$\equiv$@ true
+     lemma41 env {c10} c1 c2 =  let open @$\equiv$@-Reasoning  in
+          begin
+            Equal ((varn env - 1) + vari env) c10
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal ((z - 1 ) +  vari env ) c10 ) (sym (suc-pred@$\mathbb{N}$@=n c2) )  @$\rangle$@
+            Equal ((suc (pred@$\mathbb{N}$@ {varn env} c2 ) - 1) + vari env) c10
+          @$\equiv$@@$\langle$@@$\rangle$@
+            Equal ((pred@$\mathbb{N}$@ {varn env} c2 ) + vari env) c10
+          @$\equiv$@@$\langle$@  Equal+1 @$\rangle$@
+            Equal ((suc (pred@$\mathbb{N}$@ {varn env} c2 )) + vari env) (suc c10)
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ Equal (z  +  vari env ) (suc c10) ) (suc-pred@$\mathbb{N}$@=n c2 )  @$\rangle$@
+            Equal (varn env + vari env) (suc c10)
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@ (Equal z (suc c10) )) c1 @$\rangle$@
+            Equal (suc c10) (suc c10)
+          @$\equiv$@@$\langle$@ @$\equiv$@@$\rightarrow$@Equal refl @$\rangle$@
+            true
+          @$\blacksquare$@
+     lemma4 :  {c10 : @$\mathbb{N}$@} @$\rightarrow$@ Axiom whileInv' (@$\lambda$@ env @$\rightarrow$@ record { varn = varn env - 1 ; vari = vari env }) whileInv
+     lemma4 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+          begin
+            whileInv (record { varn = varn env - 1 ; vari = vari env })
+          @$\equiv$@@$\langle$@@$\rangle$@
+            Equal ((varn env - 1) + vari env) c10
+          @$\equiv$@@$\langle$@ lemma41 env (Equal@$\rightarrow$@@$\equiv$@ (@$\wedge$@-pi1  cond)) (@$\wedge$@-pi2  cond) @$\rangle$@
+            true
+          @$\blacksquare$@
+        )
+     lemma51 : (z : Env ) @$\rightarrow$@ neg (@$\lambda$@ z @$\rightarrow$@ lt zero (varn z)) z @$\equiv$@ true @$\rightarrow$@ varn z @$\equiv$@ zero
+     lemma51 z cond with varn z
+     lemma51 z refl | zero = refl
+     lemma51 z () | suc x
+     lemma5 : {c10 : @$\mathbb{N}$@} @$\rightarrow$@  Tautology ((@$\lambda$@ e @$\rightarrow$@ Equal (varn e + vari e) c10) and (neg (@$\lambda$@ z @$\rightarrow$@ lt zero (varn z)))) termCond
+     lemma5 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond @$\rightarrow$@ let open @$\equiv$@-Reasoning  in
+         begin
+            termCond env
+          @$\equiv$@@$\langle$@@$\rangle$@
+             Equal (vari env) c10
+          @$\equiv$@@$\langle$@@$\rangle$@
+             Equal (zero + vari env) c10
+          @$\equiv$@@$\langle$@ cong ( @$\lambda$@ z @$\rightarrow$@  Equal (z + vari env) c10 )  (sym ( lemma51 env ( @$\wedge$@-pi2  cond ) )) @$\rangle$@
+             Equal (varn env + vari env) c10
+          @$\equiv$@@$\langle$@ @$\wedge$@-pi1  cond  @$\rangle$@
+             true
+          @$\blacksquare$@
+        )
+
+--- necessary definitions for Hoare.agda ( Soundness )
+
+State : Set
+State = Env
+
+open import RelOp
+module RelOpState = RelOp State
+
+open import Data.Product
+open import Relation.Binary
+
+NotP : {S : Set} @$\rightarrow$@ Pred S @$\rightarrow$@ Pred S
+NotP X s = @$\neg$@ X s
+
+_@$\wedge$@_ : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond
+b1 @$\wedge$@ b2 = b1 and b2
+
+_\/_ : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Cond
+b1 \/ b2 = neg (neg b1 @$\wedge$@ neg b2)
+
+SemCond : Cond @$\rightarrow$@ State @$\rightarrow$@ Set
+SemCond c p = c p @$\equiv$@ true
+
+tautValid : (b1 b2 : Cond) @$\rightarrow$@ Tautology b1 b2 @$\rightarrow$@
+                 (s : State) @$\rightarrow$@ SemCond b1 s @$\rightarrow$@ SemCond b2 s
+tautValid b1 b2 taut s cond with b1 s | b2 s | taut s
+tautValid b1 b2 taut s () | false | false | refl
+tautValid b1 b2 taut s _ | false | true | refl = refl
+tautValid b1 b2 taut s _ | true | false | ()
+tautValid b1 b2 taut s _ | true | true | refl = refl
+
+respNeg : (b : Cond) @$\rightarrow$@ (s : State) @$\rightarrow$@
+               Iff (SemCond (neg b) s) (@$\neg$@ SemCond b s)
+respNeg b s = ( left , right ) where
+    left : not (b s) @$\equiv$@ true @$\rightarrow$@ (b s) @$\equiv$@ true @$\rightarrow$@ @$\bot$@
+    left ne with b s
+    left refl | false = @$\lambda$@ ()
+    left () | true
+    right : ((b s) @$\equiv$@ true @$\rightarrow$@ @$\bot$@) @$\rightarrow$@ not (b s) @$\equiv$@ true
+    right ne with b s
+    right ne | false = refl
+    right ne | true = @$\bot$@-elim ( ne refl )
+
+respAnd : (b1 b2 : Cond) @$\rightarrow$@ (s : State) @$\rightarrow$@
+               Iff (SemCond (b1 @$\wedge$@ b2) s)
+                   ((SemCond b1 s) @$\times$@ (SemCond b2 s))
+respAnd b1 b2 s = ( left , right ) where
+     left : b1 s @$\wedge$@ b2 s @$\equiv$@ true @$\rightarrow$@ (b1 s @$\equiv$@ true)  @$\times$@  (b2 s @$\equiv$@ true)
+     left and with b1 s | b2 s
+     left () | false | false
+     left () | false | true
+     left () | true | false
+     left refl | true | true = ( refl , refl )
+     right :  (b1 s @$\equiv$@ true)  @$\times$@  (b2 s @$\equiv$@ true) @$\rightarrow$@  b1 s @$\wedge$@ b2 s @$\equiv$@ true
+     right ( x1 , x2 ) with b1 s | b2 s
+     right (() , ()) | false | false
+     right (() , _) | false | true
+     right (_ , ()) | true | false
+     right (refl , refl) | true | true = refl
+
+PrimSemComm : @$\forall$@ {l} @$\rightarrow$@ PrimComm @$\rightarrow$@ Rel State l
+PrimSemComm prim s1 s2 =  Id State (prim s1) s2
+
+
+
+axiomValid : @$\forall$@ {l} @$\rightarrow$@ (bPre : Cond) @$\rightarrow$@ (pcm : PrimComm) @$\rightarrow$@ (bPost : Cond) @$\rightarrow$@
+                  (ax : Axiom bPre pcm bPost) @$\rightarrow$@ (s1 s2 : State) @$\rightarrow$@
+                  SemCond bPre s1 @$\rightarrow$@ PrimSemComm {l} pcm s1 s2 @$\rightarrow$@ SemCond bPost s2
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref with bPre s1 | bPost (pcm s1) | ax s1
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) () ref | false | false | refl
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | false | true | refl = refl
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | true | false | ()
+axiomValid {l} bPre pcm bPost ax s1 .(pcm s1) semPre ref | true | true | refl = refl
+
+open import HoareSoundness
+    Cond
+    PrimComm
+    neg
+    _and_
+    Tautology
+    State
+    SemCond
+    tautValid
+    respNeg
+    respAnd
+    PrimSemComm
+    Axiom
+    axiomValid
+
+PrimSoundness : {bPre : Cond} @$\rightarrow$@ {cm : Comm} @$\rightarrow$@ {bPost : Cond} @$\rightarrow$@
+            HTProof bPre cm bPost @$\rightarrow$@ Satisfies bPre cm bPost
+PrimSoundness {bPre} {cm} {bPost} ht = Soundness ht
+
+
+proofOfProgram : (c10 : @$\mathbb{N}$@) @$\rightarrow$@ (input output : Env )
+  @$\rightarrow$@ initCond input @$\equiv$@ true
+  @$\rightarrow$@ (SemComm (program c10) input output)
+  @$\rightarrow$@ termCond {c10} output @$\equiv$@ true
+proofOfProgram c10 input output ic sem  = PrimSoundness (proof1 c10) input output ic sem
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestProof.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,65 @@
+module whileTestProof where
+--
+-- Using imply relation to make soundness explicit
+-- termination is shown by induction on varn
+--
+
+data _implies_  (A B : Set ) : Set (succ Zero) where
+    proof : ( A → B ) → A implies B
+
+implies2p : {A B : Set } → A implies B  → A → B
+implies2p (proof x) = x
+
+whileTestPSem :  (c : ℕ) → whileTestP c ( λ env → ⊤ implies (whileTestStateP s1 env) )
+whileTestPSem c = proof ( λ _ → record { pi1 = refl ; pi2 = refl } )
+
+SemGears : (f : {l : Level } {t : Set l } → (e0 : Envc ) → ((e : Envc) → t)  → t ) → Set (succ Zero)
+SemGears f = Envc → Envc → Set
+
+GearsUnitSound : (e0 e1 : Envc) {pre : Envc → Set} {post : Envc → Set}
+   → (f : {l : Level } {t : Set l } → (e0 : Envc ) → (Envc → t)  → t )
+   → (fsem : (e0 : Envc ) → f e0 ( λ e1 → (pre e0) implies (post e1)))
+   → f e0 (λ e1 → pre e0 implies post e1)
+GearsUnitSound e0 e1 f fsem = fsem e0
+
+whileTestPSemSound : (c : ℕ ) (output : Envc ) → output ≡ whileTestP c (λ e → e) → ⊤ implies ((vari output ≡ 0) /\ (varn output ≡ c))
+whileTestPSemSound c output refl = proof (λ x → record { pi1 = refl ; pi2 = refl })
+-- whileTestPSem c
+
+
+whileConvPSemSound : {l : Level} → (input : Envc) → (whileTestStateP s1 input ) implies (whileTestStateP s2 input)
+whileConvPSemSound input = proof λ x → (conv input x) 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
+
+loopPP : (n : ℕ) → (input : Envc ) → (n ≡ varn input) → Envc
+loopPP zero input refl = input
+loopPP (suc n) input refl =
+    loopPP n (record input { varn = pred (varn input) ; vari = suc (vari input)}) refl
+
+whileLoopPSem : {l : Level} {t : Set l}   → (input : Envc ) → whileTestStateP s2 input
+  → (next : (output : Envc ) → (whileTestStateP s2 input ) implies (whileTestStateP s2 output)  → t)
+  → (exit : (output : Envc ) → (whileTestStateP s2 input ) implies (whileTestStateP sf output)  → t) → t
+whileLoopPSem env s next exit with varn env | s
+... | zero | _ = exit env (proof (λ z → z))
+... | (suc varn ) | refl = next ( record env { varn = varn ; vari = suc (vari env) } ) (proof λ x → +-suc varn (vari env) )
+
+loopPPSem : (input output : Envc ) →  output ≡ loopPP (varn input)  input refl
+  → (whileTestStateP s2 input ) → (whileTestStateP s2 input ) implies (whileTestStateP sf output)
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : ℕ) → (env : Envc) → n + suc (vari env) ≡ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : ℕ) → (current : Envc) → (eq : n ≡ varn current) →  (loopeq : output ≡ loopPP n current eq)
+      → (whileTestStateP s2 current ) → (whileTestStateP s2 current ) implies (whileTestStateP sf output)
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (λ x → refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (λ output x → loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+
+whileLoopPSemSound : {l : Level} → (input output : Envc )
+   → whileTestStateP s2 input
+   →  output ≡ loopPP (varn input) input refl
+   → (whileTestStateP s2 input ) implies ( whileTestStateP sf output )
+whileLoopPSemSound {l} input output pre eq = loopPPSem input output eq pre
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestProof.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,65 @@
+module whileTestProof where
+--
+-- Using imply relation to make soundness explicit
+-- termination is shown by induction on varn
+--
+
+data _implies_  (A B : Set ) : Set (succ Zero) where
+    proof : ( A @$\rightarrow$@ B ) @$\rightarrow$@ A implies B
+
+implies2p : {A B : Set } @$\rightarrow$@ A implies B  @$\rightarrow$@ A @$\rightarrow$@ B
+implies2p (proof x) = x
+
+whileTestPSem :  (c : @$\mathbb{N}$@) @$\rightarrow$@ whileTestP c ( @$\lambda$@ env @$\rightarrow$@ ⊤ implies (whileTestStateP s1 env) )
+whileTestPSem c = proof ( @$\lambda$@ _ @$\rightarrow$@ record { pi1 = refl ; pi2 = refl } )
+
+SemGears : (f : {l : Level } {t : Set l } @$\rightarrow$@ (e0 : Envc ) @$\rightarrow$@ ((e : Envc) @$\rightarrow$@ t)  @$\rightarrow$@ t ) @$\rightarrow$@ Set (succ Zero)
+SemGears f = Envc @$\rightarrow$@ Envc @$\rightarrow$@ Set
+
+GearsUnitSound : (e0 e1 : Envc) {pre : Envc @$\rightarrow$@ Set} {post : Envc @$\rightarrow$@ Set}
+   @$\rightarrow$@ (f : {l : Level } {t : Set l } @$\rightarrow$@ (e0 : Envc ) @$\rightarrow$@ (Envc @$\rightarrow$@ t)  @$\rightarrow$@ t )
+   @$\rightarrow$@ (fsem : (e0 : Envc ) @$\rightarrow$@ f e0 ( @$\lambda$@ e1 @$\rightarrow$@ (pre e0) implies (post e1)))
+   @$\rightarrow$@ f e0 (@$\lambda$@ e1 @$\rightarrow$@ pre e0 implies post e1)
+GearsUnitSound e0 e1 f fsem = fsem e0
+
+whileTestPSemSound : (c : @$\mathbb{N}$@ ) (output : Envc ) @$\rightarrow$@ output @$\equiv$@ whileTestP c (@$\lambda$@ e @$\rightarrow$@ e) @$\rightarrow$@ ⊤ implies ((vari output @$\equiv$@ 0) @$\wedge$@ (varn output @$\equiv$@ c))
+whileTestPSemSound c output refl = proof (@$\lambda$@ x @$\rightarrow$@ record { pi1 = refl ; pi2 = refl })
+-- whileTestPSem c
+
+
+whileConvPSemSound : {l : Level} @$\rightarrow$@ (input : Envc) @$\rightarrow$@ (whileTestStateP s1 input ) implies (whileTestStateP s2 input)
+whileConvPSemSound input = proof @$\lambda$@ x @$\rightarrow$@ (conv input x) where
+  conv : (env : Envc ) @$\rightarrow$@ (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 env) @$\rightarrow$@ varn env + vari env @$\equiv$@ c10 env
+  conv e record { pi1 = refl ; pi2 = refl } = +zero
+
+loopPP : (n : @$\mathbb{N}$@) @$\rightarrow$@ (input : Envc ) @$\rightarrow$@ (n @$\equiv$@ varn input) @$\rightarrow$@ Envc
+loopPP zero input refl = input
+loopPP (suc n) input refl =
+    loopPP n (record input { varn = pred (varn input) ; vari = suc (vari input)}) refl
+
+whileLoopPSem : {l : Level} {t : Set l}   @$\rightarrow$@ (input : Envc ) @$\rightarrow$@ whileTestStateP s2 input
+  @$\rightarrow$@ (next : (output : Envc ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP s2 output)  @$\rightarrow$@ t)
+  @$\rightarrow$@ (exit : (output : Envc ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP sf output)  @$\rightarrow$@ t) @$\rightarrow$@ t
+whileLoopPSem env s next exit with varn env | s
+... | zero | _ = exit env (proof (@$\lambda$@ z @$\rightarrow$@ z))
+... | (suc varn ) | refl = next ( record env { varn = varn ; vari = suc (vari env) } ) (proof @$\lambda$@ x @$\rightarrow$@ +-suc varn (vari env) )
+
+loopPPSem : (input output : Envc ) @$\rightarrow$@  output @$\equiv$@ loopPP (varn input)  input refl
+  @$\rightarrow$@ (whileTestStateP s2 input ) @$\rightarrow$@ (whileTestStateP s2 input ) implies (whileTestStateP sf output)
+loopPPSem input output refl s2p = loopPPSemInduct (varn input) input  refl refl s2p
+  where
+    lem : (n : @$\mathbb{N}$@) @$\rightarrow$@ (env : Envc) @$\rightarrow$@ n + suc (vari env) @$\equiv$@ suc (n + vari env)
+    lem n env = +-suc (n) (vari env)
+    loopPPSemInduct : (n : @$\mathbb{N}$@) @$\rightarrow$@ (current : Envc) @$\rightarrow$@ (eq : n @$\equiv$@ varn current) @$\rightarrow$@  (loopeq : output @$\equiv$@ loopPP n current eq)
+      @$\rightarrow$@ (whileTestStateP s2 current ) @$\rightarrow$@ (whileTestStateP s2 current ) implies (whileTestStateP sf output)
+    loopPPSemInduct zero current refl loopeq refl rewrite loopeq = proof (@$\lambda$@ x @$\rightarrow$@ refl)
+    loopPPSemInduct (suc n) current refl loopeq refl rewrite (sym (lem n current)) =
+        whileLoopPSem current refl
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+            (@$\lambda$@ output x @$\rightarrow$@ loopPPSemInduct n (record { c10 = n + suc (vari current) ; varn = n ; vari = suc (vari current) }) refl loopeq refl)
+
+whileLoopPSemSound : {l : Level} @$\rightarrow$@ (input output : Envc )
+   @$\rightarrow$@ whileTestStateP s2 input
+   @$\rightarrow$@  output @$\equiv$@ loopPP (varn input) input refl
+   @$\rightarrow$@ (whileTestStateP s2 input ) implies ( whileTestStateP sf output )
+whileLoopPSemSound {l} input output pre eq = loopPPSem input output eq pre
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestSemSound.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+whileTestPSemSound : (c : ℕ ) (output : Envc )
+  → output ≡ whileTestP c (λ e → e)
+  → ⊤ implies ((vari output ≡ 0) ∧ (varn output ≡ c))
+  whileTestPSemSound c output refl = proof (λ _ → record { pi1 = refl ; pi2 = refl })
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/whileTestSemSound.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,4 @@
+whileTestPSemSound : (c : @$\mathbb{N}$@ ) (output : Envc )
+  @$\rightarrow$@ output @$\equiv$@ whileTestP c (@$\lambda$@ e @$\rightarrow$@ e)
+  @$\rightarrow$@ @$\top$@ implies ((vari output @$\equiv$@ 0) @$\wedge$@ (varn output @$\equiv$@ c))
+  whileTestPSemSound c output refl = proof (@$\lambda$@ _ @$\rightarrow$@ record { pi1 = refl ; pi2 = refl })
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/workerRun.cbc	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+__code getTaskCPUWorker(struct CPUWorker* cpuWorker, struct Context* task, struct Worker* worker) {
+    if (!task) {
+        goto worker->shutdown(); // end thread
+    }
+    task->worker = worker;
+    enum Code taskCg = task->next;
+    task->next = C_odgCommitCPUWorker; // commit outputDG after task exec
+    goto meta(task, taskCg); // switch task context
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/zero.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
++zero : { y : ℕ } → y + zero  ≡ y
++zero {zero} = refl
++zero {suc y} = cong suc ( +zero {y} )
+
+-- cong : ∀ (f : A → B) {x y} → x ≡ y → f x ≡ f y
+-- cong f refl = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/zero.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,6 @@
++zero : { y : @$\mathbb{N}$@ } @$\rightarrow$@ y + zero  @$\equiv$@ y
++zero {zero} = refl
++zero {suc y} = cong suc ( +zero {y} )
+
+-- cong : @$\forall$@ (f : A @$\rightarrow$@ B) {x y} @$\rightarrow$@ x @$\equiv$@ y @$\rightarrow$@ f x @$\equiv$@ f y
+-- cong f refl = refl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tex/abstract/abstract.tex	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,9 @@
+\begin{abstract}
+	当研究室にて Continuation based C (以下CbC) なるC言語の下位言語に当たる言語を開発している。
+	外間による先行研究にて Floyd-Hoare Logic(以下Hoare Logic)を用いてその検証を行なった。
+	本稿では、先行研究にて実施されなかった CbC における赤黒木の検証を Hoare Logic を用いて検証することを目指す。
+	\\ \\
+	We are developing a language called Continuation based C (CbC), which is a Subordinate language of the C.
+	M.Eng Hokama verified it by using Floyd-Hoare Logic (Hoare Logic) in a previous study.
+	In this paper, we aim to use Hoare Logic to validate the red-black tree in CbC, which was not performed in previous studies.
+\end{abstract}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tex/intro/intro.tex	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,15 @@
+\section{研究目的}
+	OS やアプリケーションの信頼性を高めることは重要な課題である。
+	信頼性を高める為には仕様を満たしたプログラムが実装されていることを検証する必要がある。
+	具体的には「モデル検査」や「定理証明」などが検証手法として挙げられる。
+
+	研究室で CbC という言語を開発している。
+	CbC とは、C言語からループ制御構造とサブルーチンコールを取り除き、継続を導入した C言語の下位言語である。
+	この言語の信用性を検証したい。
+
+	仕様に合った実装を実施していることの検証手法として Hoare Logic が知られている。
+	Hoare Logic は事前条件が成り立っているときにある計算(以下コマンド)を実行した後に、
+	に事後条件が成り立つことでコマンドの検証を行う。
+
+	CbC の実行を継続するという性質が Hoare Logic の事前条件と事後条件の定義から検証を行うことと非常に相性が良い。
+	これらのことから、本稿では Hoare Logic を用いて CbC を検証することを目指す。
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tex/spec/spec.tex	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,22 @@
+\subsection{CbC記法で書くagda}
+	CbCプログラムの検証をするに当たり、agdaコードもCbC記法で記述を行う。つまり継続渡しを用いて記述する必要がある。
+	以下が例となるコードである。
+	前述した加算を行うコードと比較すると、不定の型 (t) により継続を行なっている部分が見える。
+	これがAgdaで表現された CodeGear となる。
+
+\subsection{agda による Meta Gears}
+	通常の Meta Gears はノーマルレベルの CodeGear、 DataGear では扱えないメタレベルの計算を扱う単位である。
+	Meta DataGear はメタ計算で使われる DataGear で、実行するメタ計算によって異なる。
+	今回はその Meta Gears をagdaによる検証の為に用いる。
+	検証での Meta Gears は DataGear が持つ同値関係や、
+	大小関係などの関係を表す DataGear がそれに当たると考えられる。
+	Agda 上で Meta DataGear を持つことでデータ構造自体が関係を持つデータを作ることができる。
+	以下が While Program での制約条件をまとめたものになる。
+	Agdaにおける Meta DataGear のコードを載せる。
+	\lstinputlisting[label=pg:sample]{./src/agda-mdg.agda}
+	whileTestState で Meta DataGear を識別するためのデータを分け、
+	whileTestStatePでそれぞれの Meta DataGear を返している。
+	ここでは = の後ろの (vari env ≡ 0) (varn env ≡
+	c10 env)/ などのデータを Meta DataGear として扱う。
+	aa
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tex/spec/src/agda-mcg.agda	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+whileTestPwP : {l : Level} {t : Set l} → (c10 : ℕ) →
+             ((env : Envc ) → (mdg : (vari env ≡ 0) /\ (varn env ≡ c10 env)) → t) → t
+whileTestPwP c10 next = next env record { pi1 = refl ; pi2 = refl } where
+  env : Envc
+  env = whileTestP c10 ( λ env → env )
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tex/spec/src/agda-mcg.agda.replaced	Tue Sep 08 18:38:08 2020 +0900
@@ -0,0 +1,5 @@
+whileTestPwP : {l : Level} {t : Set l} @$\rightarrow$@ (c10 : @$\mathbb{N}$@) @$\rightarrow$@
+             ((env : Envc ) @$\rightarrow$@ (mdg : (vari env @$\equiv$@ 0) @$\wedge$@ (varn env @$\equiv$@ c10 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 )