# HG changeset patch # User ryokka # Date 1580125296 -32400 # Node ID c7acb9211784352d3e1aaa70c22191c1a4073b84 # Parent ee44dbda6bd39fd9c9a6237e03adf087ed8f1c5b add code, figure. and paper fix content diff -r ee44dbda6bd3 -r c7acb9211784 paper/Makefile --- a/paper/Makefile Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/Makefile Mon Jan 27 20:41:36 2020 +0900 @@ -24,15 +24,16 @@ %.xbb: %.pdf $(BB) $< -%.agda.replaced: %.agda - ruby escape_agda.rb $< +# %.agda.replaced: %.agda +# ruby escape_agda.rb $< # commands .PHONY : clean all open remake clean: - rm -f *.dvi *.aux *.log *.ps *.gz *.bbl *.blg *.toc *~ *.core *.cpt *.lof *.lot *.lol *.bbl *.blg *.idx src/*.replaced + rm -f *.dvi *.aux *.log *.ps *.gz *.bbl *.blg *.toc *~ *.core *.cpt *.lof *.lot *.lol *.bbl *.blg *.idx +# src/*.replaced all: $(TARGET).pdf diff -r ee44dbda6bd3 -r c7acb9211784 paper/abstract.tex --- a/paper/abstract.tex Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/abstract.tex Mon Jan 27 20:41:36 2020 +0900 @@ -1,11 +1,11 @@ \chapter*{要旨} + OS やアプリケーションの信頼性は重要である。 信頼性を上げるにはプログラムが仕様を満たしていることを検証する必要がある。 プログラムの検証手法として、Floyd–Hoare logic (以下 Hoare Logic)が存在している。 HoareLogic は事前条件が成り立っているときにある -関数を実行して、それが停止する際に事後条件を満た -すことを確認することで、検証を行う。 -HoareLogic はシンプルなアプローチであるが通常のプログラミング言語で使用することができず、 +関数を実行して、それが停止する際に事後条件を満たすことを確認することで、検証を行う。 +しかし、 HoareLogic はシンプルなアプローチであるが通常のプログラミング言語で使用することができず、 広まっているとはいえない。 当研究室では信頼性の高い OS として GearsOS を開発している。 @@ -22,5 +22,6 @@ 本研究では Agda 上での HoareLogic の記述を使い、簡単な while Loop のプログラムの作成、証明を行った。 また、GearsOS の仕様確認のために CodeGear、DataGear という単位を用いた記述で Hoare Logic をベースと -したwhile Loop プログラムを記述、その証明を行なった。 +した while Loop プログラムを記述、その証明を行なった。 + \chapter*{Abstract} diff -r ee44dbda6bd3 -r c7acb9211784 paper/agda.tex --- a/paper/agda.tex Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/agda.tex Mon Jan 27 20:41:36 2020 +0900 @@ -1,49 +1,37 @@ \chapter{Agda} -Adga \cite{agda} とは証明支援系の関数型言語である。 -Agda は依存型という型システムを持つ。依存型とは型も第一級オブジェクトとする型シ -ステムで、依存型を持っている言語では型を基本的な操作に制限なしに使用できる -。 -型システムは Curry-Howard 同型対応により命題と型付きラムダ計算が一対一で対応する。 +Adga \cite{agda} とは定理証明支援器であり、関数型言語である。 +Agda は依存型という型システムを持っており、型を第一級オブジェクトとして扱うことができる。 +また、型システムは Curry-Howard 同型対応により命題と型付きラムダ計算が一対一で対応ため +Agda では記述したプログラムを証明することができる。 本章では Agda で証明をするために必要な要素について説明を行う。 また、定理証明支援器としての Agda について解説する。 \section{Agda の文法} -Agda はインデントに意味を持つため、きちんと揃える必要がある。 -また、スペースの有無は厳格にチェックされる。 -なお、 \verb/--/ の後はコメントである。 +Agda はインデントが意味を持ち、スペースの有無もチェックされる。 +コメントは \verb/-- comment/ や \verb/{-- comment --}/ のように記述される。 -Agda のプログラムでは全てモジュール内部に記述されるため、まずはトップレベルにモ -ジュールを定義する必要がある。トップレベルのモジュールはファイル名と同一になる。 +Agda のプログラムは全てモジュール内部に記述されるため、各ファイルのトップレベルにモ +ジュールを定義する必要がある。トップレベルのモジュールはファイル名と同一である。 通常のモジュールをインポートする時は \verb/import/ キーワードを指定する。 -また、インポートを行なう際に名前を別名に変更することもでき、その際は \verb/as/ キーワードを用いる。 -モジュールから特定の関数のみをインポートする場合は \verb/using/ キーワードの後に +インポートを行なう際、モジュール内部の関数を別名に変更するには \verb/as/ キーワードを用いる。 +他にも、モジュールから特定の関数のみをインポートする場合は \verb/using/ キーワード、 関数名を、関数の名前を変える時は \verb/renaming/キーワードを、特定の関数のみを隠 す場合は \verb/hiding/ キーワードを用いる。 -なお、モジュールに存在する関数をトップレベルで用いる場合は \verb/opestack に対する操作を定義しており、n/ キーワードを使うことで展開できる。 +なお、モジュールに存在する関数をトップレベルで用いる場合は \verb/open import/ キーワードを使うことで展開できる。 モジュールをインポートする例をリスト~\ref{src:agda-import}に示す。 \lstinputlisting[label=src:agda-import, caption=Agdaにおけるモジュールのインポート] {src/AgdaImport.agda} -Agda における型指定は $:$ を用いて行う。 - -例えば、変数xが型Aを持つ、ということを表すには \verb/x : A/ と記述する。 - \section{Agda のデータ} -Agdaにおける型指定は : を用いて行う。例えば、 変数 x が型 A を持つ、ということを表すには x : A と記述する。 +Agda における型指定は : を用いて行う。 変数 x が型 A を持つ、ということを表すには x : A と記述する。 データ型は、代数的なデータ構造で、その定義には data キーワードを用いる。 -data キーワードの後に data の名前と、型、 where 句を書きインデントを深 くした後、 +data キーワードの後に data の名前と、型、 where 句を書きインデントを深くした後、 値にコンストラクタとその型を列挙する。 -Agda には C における構造体に相当するレコード型というデータも存在する、 -record キーワード後の内部に field キーワードを記述し、その下に Name = value の形で値を列挙していく。 -複数の値を列挙する際は ; で区切る必要がある。 - -データ型は、代数的なデータ構造で、その定義には \verb/data/ キーワードを用いる。 -\verb/data/キーワードの後に \verb/data/ の名前と、型、 \verb/where/ 句を書きインデントを深くした後、値にコンストラクタとその型を列挙する。 例えば Bool 型を定義するとリスト~\ref{src:agda-bool}のようになる。 Bool はコンストラクタ \verb/true/ と \verb/false/ を持つデータ型である。 Bool 自身の型は \verb/Set/ であり、これは Agda が組み込みで持つ「型集合の型」である。 @@ -52,16 +40,20 @@ \lstinputlisting[label=src:agda-bool, caption=Agdaにおけるデータ型 Bool の定義] {src/AgdaBool.agda} -\section{Agda の関数} -%% 関数の定義は、関数名と型を記述した後に関数の本体を = の後に記述する。関数の型には → 、または$->$ を用いる。 -%% 例えば引数が型 A で返り値が型 B の関数は A $->$ B のように書ける。また、複数の引数を取る関数の型は A $->$ A $->$ B のように書ける。この時の型は A $->$ (A $->$ B) のように考えられる。 +Agda には C における構造体に相当するレコード型というデータも存在する、 +例えば x と y の二つの自然数からなるレコード \verb/Point/ を定義するとリスト~\ref{src:agda-record}のようになる。 +レコードを構築する際は \verb/record/ キーワードの後の \verb/{}/ の内部に \verb/fieldName = value/ の形で値を列挙していく。 +複数の値を列挙する際は \verb/;/ で区切る。 + +\lstinputlisting[label=src:agda-record, caption=Agdaにおけるレコード型の定義] {src/AgdaRecord.agda} -関数の定義は、関数名と型を記述した後に関数の本体を \verb/=/ の後に記述する。 +\section{Agda の関数} + +Agda での関数の定義は、関数名と型を記述した後に関数の本体を \verb/=/ の後に記述する。 関数の型には $ \rightarrow $ 、 または\verb/->/ を用いる。 -例えば引数が型 \verb/A/ で返り値が型 \verb/B/ の関数は \verb/A -> B/ のように書 -ける。 +例えば引数が型 \verb/A/ で返り値が型 \verb/B/ の関数は \verb/A -> B/ のように書くことができる。 また、複数の引数を取る関数の型は \verb/A -> A -> B/ のように書ける。この 時の型は \verb/A -> (A -> B)/のように考えられる。 Bool 変数 \verb/x/ を取って true を返す関数 \verb/f/はリスト~\ref{src:agda-function}のようになる。 @@ -171,5 +163,3 @@ %% \end{lstlisting} -\section{定理証明とプログラミング検証} -たぶん Curry-Howard isomorphism の話 diff -r ee44dbda6bd3 -r c7acb9211784 paper/cbc.tex --- a/paper/cbc.tex Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/cbc.tex Mon Jan 27 20:41:36 2020 +0900 @@ -3,23 +3,28 @@ \chapter{Continuation based C} Continuation based C\cite{cbc} (以下 CbC) は CodeGear を処理の単位、 DataGear をデータの単位として記述するプログラミング言語である。 CbC は C 言語とほぼ同じ構文を持つが、よりアセンブラに近いプログラムを記述することになる。 CbC でのプログラミングは DataGear を CodeGear で変更し、その変更を次の CodeGear に渡して処理を実行する。 -現在 CbC の処理系には llvm/clang による実装\cite{llvm}と gcc\cite{gcc} による実装が存在している。 +現在 CbC の処理系には llvm/clang による実装\cite{llvm}と gcc\cite{gcc} による実装が存在する。 -本章は CbC について説明する。 +本章は CbC についての説明を行う。 \section{Code GearとData Gear} -本研究室では検証しやすいプログラムの単位として CodeGear と DataGear という +当研究室では検証しやすいプログラムの単位として DataGear と CodeGear という 単位を用いるプログラミングスタイルを提案している。 -CodeGear　とは処理を行う単位である。 - DataGear は CodeGear で扱うデータの単位であり、処理に必要なデータである。 CodeGear の入力となる DataGear を Input DataGear と呼び、 出力は Output DataGear と呼ぶ。 +CodeGear はプログラムの処理そのもので、図 Code \ref{fig:cgdg}で示しているように任意の数の +Input DataGear を参照し、処理が完了すると任意の数の Output DataGear に書き込む。 + +CodeGear 間の移動は継続を用いて行われる。継続は関数呼び出しとは異なり、呼び出し +た後に元のコードに戻らず、次の CodeGear へ継続を行う。 +これは、関数型プログラミングでは末尾関数呼び出しを行うことに相当する。 + 図\ref{fig:csds}のように Input DataGear を受け取り、 CodeGear で処理を行い、 Output DataGear に変更を加え、プログラム全体を記述する。 -% CS,DSの図 + \begin{figure}[htpb] \begin{center} \scalebox{0.55}{\includegraphics{fig/csds.pdf}} @@ -29,32 +34,12 @@ \end{figure} - -%% Gears OS ではプログラムとデータの単位として CodeGear、 DataGear を用いる。 Gear -%% は並列実行の単位、データ分割、 Gear 間の接続等になる。 -%% CodeGear はプログラムの処理そのもので、図 Code \ref{fig:cgdg}で示しているように任意の数の -%% Input DataGear を参照し、処理が完了すると任意の数の Output DataGear に書き込む。 - -%% CodeGear 間の移動は継続を用いて行われる。継続は関数呼び出しとは異なり、呼び出し -%% た後に元のコードに戻らず、次の CodeGear へ継続を行う。 -%% これは、関数型プログラミングでは末尾関数呼び出しを行うことに相当する。 - -%% \begin{figure}[htpb] -%% \begin{center} -%% \scalebox{0.425}{\includegraphics{pic/meta_cg_dg.pdf}} -%% \end{center} -%% \caption{CodeGear と DataGear の関係} -%% \label{fig:cgdg} -%% \end{figure} - - - \section{メタ計算} %% プログラムの記述する際は、ノーマルレベルの計算の他に、メモリ管理、スレッド管理、CPUがGPUの資源管理等を記述しなければならない処理が存在する。 %% これらの計算はノーマルレベルの計算と区別してメタ計算と呼ぶ。 メタ計算(自己反映計算)\cite{weko_5056_1} とはプログラムを記述する際に通常の処理 -と分離し、他に記述しなければならない処理である。例えばプログラム実行時のメモリ管 +と分離し、他に記述しなければならない処理である。例えば、プログラム実行時のメモリ管 理やスレッド管理、資源管理等の計算がこれに当たる。 メタ計算は関数型言語では Monad\cite{moggi-monad} を用いて表現される\cite{kkb-sigos}。 @@ -64,17 +49,16 @@ 実行時にメタ計算の変更を行う場合には OS 内部のパラメータの変更を使用し、実行されるユーザープログラム自体への変更は限定的である。 しかし、メタ計算は性能測定あるいはプログラム検証、さらに並列分散計算のチューニングなど細かい処理が必要で実際のシステムコール単位では不十分である。 例えば、モデル検査ではアセンブラあるいは バイトコード、インタプリタレベルでのメタ計算が必要になる。 -しかし、バイトコードレベルでは 粒度が細かすぎて扱いが困難になっている。具体的にはメタ計算の実行時間が大きくなってしまう。 +しかし、バイトコードレベルでは粒度が細かすぎて扱いが困難になっている。具体的にはメタ計算の実行時間が大きくなってしまう。 \section{Context} -CbC では、接続可能な CodeGear、 DataGear のリスト、Temporal DataGear のためのメモリ空間などを +CbC では、接続可能な全ての CodeGear、 DataGear のリスト、Temporal DataGear のためのメモリ空間などを Context として保持している。 -CbC で必要な CodeGear 、 DataGear を参照する際は Context を通してアクセスする。 - +CbC で必要な CodeGear 、 DataGear を参照する際は Context を通してアクセスする必要がある。 \section{Meta Gears} -Meta Gear は CbC 上でのメタ計算である。 -CodeGear を実行する際、必要な DataGear を Context から取得する必要がある。 -しかし、 ユーザーが Context から直接データを扱える状態は信頼性を欠く。 -そのため、 CbC では Meta CodeGear を用いて Context から必要な DataGear を取り出し、 CodeGear に接続する stub CodeGear という Meta Gear を定義している。 +Meta Gear は CbC 上でのメタ計算で、通常の CodeGear を実行する際に必要なメタ計算を分離するための CodeGear である。 +例えば、 CodeGear を実行する際、必要な DataGear を Context を通して取得する必要があるが、ユーザーが Context から直接データを扱える状態は信頼性が高いとは言えない。 +そのために、 CbC では Meta CodeGear を用いて Context から必要な DataGear を取り出し、 CodeGear に接続する stub CodeGear という Meta CodeGear を定義している。 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/cbc_agda.tex --- a/paper/cbc_agda.tex Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/cbc_agda.tex Mon Jan 27 20:41:36 2020 +0900 @@ -1,14 +1,55 @@ \chapter{Continuation based C と Agda} -対応のお話 -\section{DataGear の対応} -agda での datagear +本章では当研究室で推奨している単位での検証を行うため、 +Agda 上で CodeGear、 DataGear の表現を示す。 +また、Gear の単位と Hoare Logic を対応させ、 +CbC 上での Hoare Logic について説明を行う。 + + +\section{DataGear と Agda} +Agda での DataGear は CodeGear で扱うすべてのデータである。 + + -\section{CodeGear} -agda での codegear +\section{CodeGear と Agda} +CodeGear は DataGear を受け取って処理を行い DataGear を返す。 +また、CodeGear 間の移動は継続を用いて行われる。 +継続は関数呼び出しとは異なり、呼び出した後に元のコードに戻らず、 +次の CodeGear へ継続を行う。 +これは、関数型プログラミングでは末尾関数呼び出しを行うことに相当するため、 +継続渡し(Continuation Passing Style) で書かれた Agda の関数と対応する。 +継続は不定の型 (\verb+t+) を返す関数で表される。 +CodeGear は次に実行する関数の型を引数として受け取り不定の型\verb+t+を返す関数として記述され、 +CodeGear 自体も同じ型 \verb+t+ を返す関数となる。 +コード \ref{agda-cg} は Agda で記述した CodeGear の例である。 -\section{Meta部分の話} -あんまりでなさそうだけどとりあえず +\lstinputlisting[caption= whileTest の型,label=agda-cg]{src/while-test.agda.replaced} +%% Agda のとこで Level の話を…！ +ここでは \verb+c10+ と名付けた自然数を受け取った後、 +\varb+Env+ を受け取って不定の型\verb+t+を返す関数を受け取り、 +\verb+t+を返す CodeGear を定義している。 + + + +\section{Meta CodeGear の表現} +Meta CodeGear は 通常の CodeGear では扱えないメタレベルの計算を扱う CodeGear である。 +Agda での Meta CodeGear は通常の CodeGear を引数に取りそれらの関係などの上位概念を返す CodeGear である。 +これは(図を入れる)のような Code Gear となる。 + +% \lstinputlisting[label=src:agda-cs, caption= Agda における CodeGear 型の定義] {src/CodeSegment.agda.replaced} + \section{CbC 上での HoareLogic の実現} -研究の主な部分 +CbC 上の Hoare Logic は引数として事前条件、次の CodeGear に渡す値に事後条件を含めることで記述する。 +その際に事前条件が CodeGear で変更され、事後条件を導く形になる。 +例として while プログラムの CbC 記述についてみる。 + +%% コード +ここでは~ + +Hoare Logic の記述としてはこれで良く、部分整合性は示せているが、 +全体の検証を行うためには接続されているすべての CodeGear が実行されたときの健全性(Soundness)が担保される必要がある。 +そのため、検証用の Meta CodeGear を記述する。 +例として while プログラムの健全性を担保するプログラムをみる。 +%% コード +このコードでは CodeGear をつなげて終了状態まで実行したとき最後の事後条件が成り立っているため、これらの実行が正しく終了することを示すことができる。 diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/WorkerRun.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/WorkerRun.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/workerRun.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 824 309 +%%HiResBoundingBox: 0.000000 0.000000 824.000000 309.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Tue Feb 13 05:26:03 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/bitonicNetwork.pdf Binary file paper/fig/bitonicNetwork.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/bitonicNetwork.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/bitonicNetwork.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/bitonicNetwork.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 591 422 +%%HiResBoundingBox: 0.000000 0.000000 591.000000 422.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Sat Feb 3 19:57:43 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/bitonicSort.pdf Binary file paper/fig/bitonicSort.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/bitonicSort.svg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/bitonicSort.svg Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,204 @@ + + + +Gnuplot +Produced by GNUPLOT 5.2 patchlevel 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 0 + + + + + 5 + + + + + 10 + + + + + 15 + + + + + 20 + + + + + 25 + + + + + 30 + + + + + 35 + + + + + 40 + + + + + 45 + + + + + 1 cpu + + + + + 2 cpus + + + + + 4 cpus + + + + + 8 cpus + + + + + 16 cpus + + + + + 32 cpus + + + + + gpu + + + + + gpu(kernel only) + + + + + + + + + time(s) + + + + + bitonicSort benchmark + + + gnuplot_plot_1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/bitonicSort.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/bitonicSort.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/bitonicSort.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 600 480 +%%HiResBoundingBox: 0.000000 0.000000 600.000000 480.000000 +%%PDFVersion: 1.5 +%%Pages: 1 +%%CreationDate: Sat Feb 3 22:27:55 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cbc-hoare.graffle Binary file paper/fig/cbc-hoare.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cbc-hoare.pdf Binary file paper/fig/cbc-hoare.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cbc-hoare.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/cbc-hoare.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/cbc-hoare.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 580 175 +%%HiResBoundingBox: 0.000000 0.000000 580.000000 175.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:03 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cbc-subtype.graffle Binary file paper/fig/cbc-subtype.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cbc-subtype.pdf Binary file paper/fig/cbc-subtype.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cbc-subtype.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/cbc-subtype.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/cbc-subtype.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 1084 281 +%%HiResBoundingBox: 0.000000 0.000000 1084.000000 281.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:03 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codegear-datagear.graffle Binary file paper/fig/codegear-datagear.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codegear-datagear.pdf Binary file paper/fig/codegear-datagear.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codegear-datagear.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/codegear-datagear.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/codegear-datagear.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 535 427 +%%HiResBoundingBox: 0.000000 0.000000 535.000000 427.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Tue Feb 13 00:39:37 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codesegment.pdf Binary file paper/fig/codesegment.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codesegment.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/codesegment.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/codesegment.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 305 85 +%%HiResBoundingBox: 0.000000 0.000000 305.000000 85.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:03 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codesegment2.pdf Binary file paper/fig/codesegment2.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/codesegment2.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/codesegment2.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/codesegment2.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 393 201 +%%HiResBoundingBox: 0.000000 0.000000 393.000000 201.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:03 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/csds.graffle Binary file paper/fig/csds.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/csds.pdf Binary file paper/fig/csds.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/csds.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/csds.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/csds.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 580 76 +%%HiResBoundingBox: 0.000000 0.000000 580.000000 76.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:04 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cudaArchitecture.graffle Binary file paper/fig/cudaArchitecture.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cudaArchitecture.pdf Binary file paper/fig/cudaArchitecture.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cudaArchitecture.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/cudaArchitecture.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/cudaArchitecture.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 446 488 +%%HiResBoundingBox: 0.000000 0.000000 446.000000 488.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Thu Feb 1 07:03:30 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cudaDataArchitecture.graffle Binary file paper/fig/cudaDataArchitecture.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cudaDataArchitecture.pdf Binary file paper/fig/cudaDataArchitecture.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/cudaDataArchitecture.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/cudaDataArchitecture.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/cudaDataArchitecture.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 448 598 +%%HiResBoundingBox: 0.000000 0.000000 448.000000 598.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Tue Feb 13 04:47:33 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/dependency.graffle Binary file paper/fig/dependency.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/dependency.pdf Binary file paper/fig/dependency.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/dependency.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/dependency.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/dependency.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 573 273 +%%HiResBoundingBox: 0.000000 0.000000 573.000000 273.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Tue Feb 13 05:27:27 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/factorial.graffle --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/factorial.graffle Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,580 @@ + + + + + ActiveLayerIndex + 0 + ApplicationVersion + + com.omnigroup.OmniGraffle6 + 169.23.0.276662 + + AutoAdjust + + BackgroundGraphic + + Bounds + {{0, 0}, {559, 783}} + Class + SolidGraphic + ID + 2 + Style + + stroke + + Draws + NO + + + + BaseZoom + 0 + CanvasOrigin + {0, 0} + ColumnAlign + 1 + ColumnSpacing + 36 + CreationDate + 2011-11-12 11:03:25 +0000 + Creator + Nobuyasu Oshiro + DisplayScale + 1 in = 1.00000 in + GraphDocumentVersion + 12 + GraphicsList + + + Bounds + {{337.67999245226383, 177.89999766647816}, {103, 24}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + FontInfo + + Size + 11 + + ID + 44 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs22 \cf0 goto print_factorial} + + Wrap + NO + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + Head + + ID + 42 + + ID + 43 + Points + + {325.49999356269836, 144} + {325.49999356269836, 235.79999533295631} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + Tail + + ID + 33 + + + + Bounds + {{287.99999356269836, 208.79999533295631}, {75, 54}} + Class + ShapedGraphic + ID + 42 + Shape + Circle + Style + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\qc\partightenfactor0 + +\f0\fs24 \cf0 print_\ +factorial} + VerticalPad + 0.0 + + + + Bounds + {{284.99999356269836, 45.359998986124992}, {81, 24}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + FontInfo + + Size + 11 + + ID + 37 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs22 \cf0 goto factorial0} + + Wrap + NO + + + Bounds + {{208.49999356269836, 106.55999761819839}, {81, 24}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + FontInfo + + Size + 11 + + ID + 36 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs22 \cf0 goto factorial0} + + Wrap + NO + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + Head + + ID + 33 + + ID + 35 + Points + + {325.49999356269836, 144} + {294.49999356269836, 93.08203125} + {351.578125, 84.4765625} + {325.49999356269836, 144} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + Tail + + ID + 33 + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + Head + + ID + 33 + + ID + 34 + Points + + {183, 144} + {325.49999356269836, 144} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + Tail + + ID + 3 + + + + Bounds + {{287.99999356269836, 117}, {75, 54}} + Class + ShapedGraphic + ID + 33 + Shape + Circle + Style + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\qc\partightenfactor0 + +\f0\fs24 \cf0 factorial 0} + VerticalPad + 0.0 + + + + Bounds + {{147, 117}, {72, 54}} + Class + ShapedGraphic + ID + 3 + Shape + Circle + Style + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\qc\partightenfactor0 + +\f0\fs24 \cf0 factorial} + VerticalPad + 0.0 + + + + GridInfo + + GuidesLocked + NO + GuidesVisible + YES + HPages + 1 + ImageCounter + 1 + KeepToScale + + Layers + + + Lock + NO + Name + Layer 1 + Print + YES + Slices + NO + View + YES + + + LayoutInfo + + Animate + NO + circoMinDist + 18 + circoSeparation + 0.0 + layoutEngine + dot + neatoLineLength + 0.20000000298023224 + neatoSeparation + 0.0 + twopiSeparation + 0.0 + + LinksVisible + NO + MagnetsVisible + NO + MasterSheets + + ModificationDate + 2017-02-09 07:19:20 +0000 + Modifier + atton + NotesVisible + NO + Orientation + 2 + OriginVisible + NO + PageBreaks + YES + PrintInfo + + NSBottomMargin + + float + 41 + + NSHorizonalPagination + + coded + BAtzdHJlYW10eXBlZIHoA4QBQISEhAhOU051bWJlcgCEhAdOU1ZhbHVlAISECE5TT2JqZWN0AIWEASqEhAFxlwCG + + NSLeftMargin + + float + 18 + + NSPaperSize + + size + {595, 842} + + NSPrintReverseOrientation + + coded + BAtzdHJlYW10eXBlZIHoA4QBQISEhAhOU051bWJlcgCEhAdOU1ZhbHVlAISECE5TT2JqZWN0AIWEASqEhAFxlwCG + + NSRightMargin + + float + 18 + + NSTopMargin + + float + 18 + + + PrintOnePage + + ReadOnly + NO + RowAlign + 1 + RowSpacing + 36 + SheetTitle + Canvas 1 + SmartAlignmentGuidesActive + YES + SmartDistanceGuidesActive + YES + UniqueID + 1 + UseEntirePage + + VPages + 1 + WindowInfo + + CurrentSheet + 0 + Expanded_Canvases + + Frame + {{87, 100}, {989, 938}} + ShowInfo + + ShowRuler + + Sidebar + + SidebarWidth + 200 + TopSlabHeight + 250 + VisibleRegion + {{0, 0}, {475, 780}} + Zoom + 1 + ZoomValues + + + Canvas 1 + 1 + 1 + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/factorial.pdf Binary file paper/fig/factorial.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/factorial.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/factorial.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/factorial.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 296 220 +%%HiResBoundingBox: 0.000000 0.000000 296.000000 220.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:04 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/gears-meta.graffle --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/gears-meta.graffle Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,974 @@ + + + + + ActiveLayerIndex + 0 + ApplicationVersion + + com.omnigroup.OmniGraffle6 + 169.5.0.253125 + + AutoAdjust + + BackgroundGraphic + + Bounds + {{0, 0}, {1118.4000244140625, 782.79998779296875}} + Class + SolidGraphic + ID + 2 + Style + + stroke + + Draws + NO + + + + BaseZoom + 0 + CanvasOrigin + {0, 0} + ColumnAlign + 1 + ColumnSpacing + 36 + CreationDate + 2014-02-10 06:36:22 +0000 + Creator + utah + DisplayScale + 1 in = 1 in + GraphDocumentVersion + 12 + GraphicsList + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 34 + Points + + {414, 72} + {468, 72} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + 0 + Legacy + + LineType + 1 + Pattern + 1 + TailArrow + 0 + + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + Head + + ID + 29 + Info + 2 + + ID + 33 + Points + + {189, 72} + {243, 72} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + 0 + Legacy + + LineType + 1 + Pattern + 1 + TailArrow + 0 + + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 32 + Points + + {585, 99} + {585, 135} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 31 + OrthogonalBarAutomatic + + OrthogonalBarPoint + {0, 0} + OrthogonalBarPosition + -1 + Points + + {414, 162} + {468, 162} + {468, 72} + {531, 72} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 2 + TailArrow + 0 + + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 30 + Points + + {360, 99} + {360, 135} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 29 + OrthogonalBarAutomatic + + OrthogonalBarPoint + {0, 0} + OrthogonalBarPosition + -1 + Points + + {189, 162} + {243, 162} + {243, 72} + {306, 72} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 2 + TailArrow + 0 + + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 27 + Points + + {135, 99} + {135, 135} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + + + Bounds + {{60.5, 198}, {83, 30}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + ID + 26 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs32 \cf0 meta level} + + Wrap + NO + + + Bounds + {{51.0625, 3}, {96, 30}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + ID + 25 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs32 \cf0 normal level} + + Wrap + NO + + + Bounds + {{531, 135}, {108, 54}} + Class + ShapedGraphic + FontInfo + + Font + Helvetica + Size + 9 + + HFlip + YES + ID + 24 + Magnets + + {1, 0.5} + {1, -0.5} + {-1, 0.5} + {-1, -0.5} + {0.5, 1} + {-0.5, 1} + {0.5, -1} + {-0.5, -1} + + Style + + fill + + Color + + b + 0.99999099999999996 + g + 0.99997400000000003 + r + 1 + + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural\qc\partightenfactor0 + +\f0\fs28 \cf0 meta3} + VerticalPad + 0.0 + + + + Bounds + {{306, 135}, {108, 54}} + Class + ShapedGraphic + FontInfo + + Font + Helvetica + Size + 9 + + HFlip + YES + ID + 23 + Magnets + + {1, 0.5} + {1, -0.5} + {-1, 0.5} + {-1, -0.5} + {0.5, 1} + {-0.5, 1} + {0.5, -1} + {-0.5, -1} + + Style + + fill + + Color + + b + 0.99999099999999996 + g + 0.99997400000000003 + r + 1 + + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural\qc\partightenfactor0 + +\f0\fs28 \cf0 meta2} + VerticalPad + 0.0 + + + + Bounds + {{81, 135}, {108, 54}} + Class + ShapedGraphic + FontInfo + + Font + Helvetica + Size + 9 + + HFlip + YES + ID + 22 + Magnets + + {1, 0.5} + {1, -0.5} + {-1, 0.5} + {-1, -0.5} + {0.5, 1} + {-0.5, 1} + {0.5, -1} + {-0.5, -1} + + Style + + fill + + Color + + b + 0.99999099999999996 + g + 0.99997400000000003 + r + 1 + + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural\qc\partightenfactor0 + +\f0\fs28 \cf0 meta1} + VerticalPad + 0.0 + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 21 + Points + + {684, 117} + {54, 117} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + 0 + Legacy + + LineType + 1 + Pattern + 2 + TailArrow + 0 + + + + + Bounds + {{531, 45}, {108, 54}} + Class + ShapedGraphic + FontInfo + + Font + Helvetica + Size + 9 + + HFlip + YES + ID + 19 + Magnets + + {1, 0.5} + {1, -0.5} + {-1, 0.5} + {-1, -0.5} + {0.5, 1} + {-0.5, 1} + {0.5, -1} + {-0.5, -1} + + Style + + fill + + Color + + b + 0.99999099999999996 + g + 0.99997400000000003 + r + 1 + + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural\qc\partightenfactor0 + +\f0\fs28 \cf0 code3} + VerticalPad + 0.0 + + + + Bounds + {{306, 45}, {108, 54}} + Class + ShapedGraphic + FontInfo + + Font + Helvetica + Size + 9 + + HFlip + YES + ID + 5 + Magnets + + {1, 0.5} + {1, -0.5} + {-1, 0.5} + {-1, -0.5} + {0.5, 1} + {-0.5, 1} + {0.5, -1} + {-0.5, -1} + + Style + + fill + + Color + + b + 0.99999099999999996 + g + 0.99997400000000003 + r + 1 + + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural\qc\partightenfactor0 + +\f0\fs28 \cf0 code2} + VerticalPad + 0.0 + + + + Bounds + {{81, 45}, {108, 54}} + Class + ShapedGraphic + FontInfo + + Font + Helvetica + Size + 9 + + HFlip + YES + ID + 4 + Magnets + + {1, 0.5} + {1, -0.5} + {-1, 0.5} + {-1, -0.5} + {0.5, 1} + {-0.5, 1} + {0.5, -1} + {-0.5, -1} + + Style + + fill + + Color + + b + 0.99999099999999996 + g + 0.99997400000000003 + r + 1 + + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\pardirnatural\qc\partightenfactor0 + +\f0\fs28 \cf0 code1} + VerticalPad + 0.0 + + + + GridInfo + + SnapsToGrid + YES + + GuidesLocked + NO + GuidesVisible + YES + HPages + 2 + ImageCounter + 1 + KeepToScale + + Layers + + + Lock + NO + Name + Layer 1 + Print + YES + View + YES + + + LayoutInfo + + Animate + NO + circoMinDist + 18 + circoSeparation + 0.0 + layoutEngine + dot + neatoLineLength + 0.20000000298023224 + neatoSeparation + 0.0 + twopiSeparation + 0.0 + + LinksVisible + NO + MagnetsVisible + NO + MasterSheets + + ModificationDate + 2016-02-09 02:10:43 +0000 + Modifier + utah + NotesVisible + NO + Orientation + 2 + OriginVisible + NO + PageBreaks + YES + PrintInfo + + NSBottomMargin + + float + 41 + + NSHorizonalPagination + + coded + BAtzdHJlYW10eXBlZIHoA4QBQISEhAhOU051bWJlcgCEhAdOU1ZhbHVlAISECE5TT2JqZWN0AIWEASqEhAFxlwCG + + NSLeftMargin + + float + 18 + + NSPaperSize + + size + {595.20001220703125, 841.79998779296875} + + NSPrintReverseOrientation + + coded + BAtzdHJlYW10eXBlZIHoA4QBQISEhAhOU051bWJlcgCEhAdOU1ZhbHVlAISECE5TT2JqZWN0AIWEASqEhAFxlwCG + + NSRightMargin + + float + 18 + + NSTopMargin + + float + 18 + + + PrintOnePage + + ReadOnly + NO + RowAlign + 1 + RowSpacing + 36 + SheetTitle + Canvas 1 + SmartAlignmentGuidesActive + YES + SmartDistanceGuidesActive + YES + UniqueID + 1 + UseEntirePage + + VPages + 1 + WindowInfo + + CurrentSheet + 0 + Expanded_Canvases + + Frame + {{252, -73}, {1263, 938}} + ShowInfo + + ShowRuler + + Sidebar + + SidebarWidth + 200 + TopSlabHeight + 250 + VisibleRegion + {{0, 0}, {749, 780}} + Zoom + 1 + ZoomValues + + + Canvas 1 + 1 + 1 + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/gears-meta.pdf Binary file paper/fig/gears-meta.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/gears-meta.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/gears-meta.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/gears-meta.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 653 243 +%%HiResBoundingBox: 0.000000 0.000000 653.000000 243.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:04 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/goto.graffle --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/goto.graffle Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,445 @@ + + + + + ActiveLayerIndex + 0 + ApplicationVersion + + com.omnigroup.OmniGraffle6 + 169.5.0.253125 + + AutoAdjust + + BackgroundGraphic + + Bounds + {{0, 0}, {559.20001220703125, 782.79998779296875}} + Class + SolidGraphic + ID + 2 + Style + + stroke + + Draws + NO + + + + BaseZoom + 0 + CanvasOrigin + {0, 0} + ColumnAlign + 1 + ColumnSpacing + 36 + CreationDate + 2011-11-12 11:03:25 +0000 + Creator + Nobuyasu Oshiro + DisplayScale + 1 in = 1.00000 in + GraphDocumentVersion + 12 + GraphicsList + + + Bounds + {{366.49999356269836, 106.55999761819839}, {65, 24}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + FontInfo + + Size + 11 + + ID + 37 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs22 \cf0 goto cs2(c)} + + Wrap + NO + + + Bounds + {{209.99999356269836, 106.55999761819839}, {78, 24}} + Class + ShapedGraphic + FitText + YES + Flow + Resize + FontInfo + + Size + 11 + + ID + 36 + Style + + fill + + Draws + NO + + shadow + + Draws + NO + + stroke + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fnil\fcharset0 HelveticaNeue;} +{\colortbl;\red255\green255\blue255;} +\deftab720 +\pard\pardeftab720\qc\partightenfactor0 + +\f0\fs22 \cf0 goto cs1(a+b)} + + Wrap + NO + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + ID + 35 + Points + + {323.99999356269836, 144} + {426.68373636901379, 143.8290591686964} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + Tail + + ID + 33 + + + + Class + LineGraphic + FontInfo + + Font + Helvetica + Size + 12 + + Head + + ID + 33 + + ID + 34 + Points + + {183, 144} + {323.99999356269836, 144} + + Style + + shadow + + Draws + NO + + stroke + + HeadArrow + FilledArrow + Legacy + + LineType + 1 + TailArrow + 0 + + + Tail + + ID + 3 + + + + Bounds + {{287.99999356269836, 117}, {72, 54}} + Class + ShapedGraphic + ID + 33 + Shape + Circle + Style + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\qc\partightenfactor0 + +\f0\fs24 \cf0 cs1} + VerticalPad + 0.0 + + + + Bounds + {{147, 117}, {72, 54}} + Class + ShapedGraphic + ID + 3 + Shape + Circle + Style + + shadow + + Draws + NO + + + Text + + Text + {\rtf1\ansi\ansicpg1252\cocoartf1404\cocoasubrtf340 +{\fonttbl\f0\fswiss\fcharset0 Helvetica;} +{\colortbl;\red255\green255\blue255;} +\pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\qc\partightenfactor0 + +\f0\fs24 \cf0 cs0} + VerticalPad + 0.0 + + + + GridInfo + + GuidesLocked + NO + GuidesVisible + YES + HPages + 1 + ImageCounter + 1 + KeepToScale + + Layers + + + Lock + NO + Name + Layer 1 + Print + YES + View + YES + + + LayoutInfo + + Animate + NO + circoMinDist + 18 + circoSeparation + 0.0 + layoutEngine + dot + neatoLineLength + 0.20000000298023224 + neatoSeparation + 0.0 + twopiSeparation + 0.0 + + LinksVisible + NO + MagnetsVisible + NO + MasterSheets + + ModificationDate + 2016-02-14 19:41:55 +0000 + Modifier + utah + NotesVisible + NO + Orientation + 2 + OriginVisible + NO + PageBreaks + YES + PrintInfo + + NSBottomMargin + + float + 41 + + NSHorizonalPagination + + coded + BAtzdHJlYW10eXBlZIHoA4QBQISEhAhOU051bWJlcgCEhAdOU1ZhbHVlAISECE5TT2JqZWN0AIWEASqEhAFxlwCG + + NSLeftMargin + + float + 18 + + NSPaperSize + + size + {595.20001220703125, 841.79998779296875} + + NSPrintReverseOrientation + + coded + BAtzdHJlYW10eXBlZIHoA4QBQISEhAhOU051bWJlcgCEhAdOU1ZhbHVlAISECE5TT2JqZWN0AIWEASqEhAFxlwCG + + NSRightMargin + + float + 18 + + NSTopMargin + + float + 18 + + + PrintOnePage + + ReadOnly + NO + RowAlign + 1 + RowSpacing + 36 + SheetTitle + Canvas 1 + SmartAlignmentGuidesActive + YES + SmartDistanceGuidesActive + YES + UniqueID + 1 + UseEntirePage + + VPages + 1 + WindowInfo + + CurrentSheet + 0 + Expanded_Canvases + + Frame + {{507, -237}, {989, 938}} + ShowInfo + + ShowRuler + + Sidebar + + SidebarWidth + 200 + TopSlabHeight + 250 + VisibleRegion + {{0, 0}, {475, 780}} + Zoom + 1 + ZoomValues + + + Canvas 1 + 1 + 1 + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/goto.pdf Binary file paper/fig/goto.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/goto.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/goto.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/goto.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 305 85 +%%HiResBoundingBox: 0.000000 0.000000 305.000000 85.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:04 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/gotoInterface.graffle Binary file paper/fig/gotoInterface.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/gotoInterface.pdf Binary file paper/fig/gotoInterface.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/gotoInterface.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/gotoInterface.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/gotoInterface.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 793 724 +%%HiResBoundingBox: 0.000000 0.000000 793.000000 724.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Sun Feb 4 21:45:54 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/hoare-logic.graffle Binary file paper/fig/hoare-logic.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/hoare-logic.pdf Binary file paper/fig/hoare-logic.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/hoare-logic.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/hoare-logic.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/hoare-logic.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 580 76 +%%HiResBoundingBox: 0.000000 0.000000 580.000000 76.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:04 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/iterateTaskExec.graffle Binary file paper/fig/iterateTaskExec.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/iterateTaskExec.pdf Binary file paper/fig/iterateTaskExec.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/iterateTaskExec.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/iterateTaskExec.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/iterateTaskExec.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 749 310 +%%HiResBoundingBox: 0.000000 0.000000 749.000000 310.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Wed Jan 31 20:11:02 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta-hierarchy.graffle Binary file paper/fig/meta-hierarchy.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta-hierarchy.pdf Binary file paper/fig/meta-hierarchy.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta-hierarchy.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/meta-hierarchy.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/meta-hierarchy.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 832 283 +%%HiResBoundingBox: 0.000000 0.000000 832.000000 283.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:04 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta.graffle Binary file paper/fig/meta.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta.pdf Binary file paper/fig/meta.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/meta.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/meta.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 958 148 +%%HiResBoundingBox: 0.000000 0.000000 958.000000 148.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:05 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta_cg_dg.graffle Binary file paper/fig/meta_cg_dg.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta_cg_dg.pdf Binary file paper/fig/meta_cg_dg.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/meta_cg_dg.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/meta_cg_dg.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/meta_cg_dg.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 608 202 +%%HiResBoundingBox: 0.000000 0.000000 608.000000 202.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Tue Feb 13 00:36:02 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/metameta.graffle Binary file paper/fig/metameta.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/metameta.pdf Binary file paper/fig/metameta.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/metameta.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/metameta.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/metameta.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 472 184 +%%HiResBoundingBox: 0.000000 0.000000 472.000000 184.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:05 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/non-destructive-rbtree.pdf Binary file paper/fig/non-destructive-rbtree.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/non-destructive-rbtree.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/non-destructive-rbtree.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/non-destructive-rbtree.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 559 248 +%%HiResBoundingBox: 0.000000 0.000000 559.000000 248.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:05 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/put.graffle Binary file paper/fig/put.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/put.pdf Binary file paper/fig/put.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/put.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/put.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/put.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 868 130 +%%HiResBoundingBox: 0.000000 0.000000 868.000000 130.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:05 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/putSynchronizedQueue1.graffle Binary file paper/fig/putSynchronizedQueue1.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/putSynchronizedQueue1.pdf Binary file paper/fig/putSynchronizedQueue1.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/putSynchronizedQueue1.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/putSynchronizedQueue1.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/putSynchronizedQueue1.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 746 301 +%%HiResBoundingBox: 0.000000 0.000000 746.000000 301.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Wed Jan 24 02:45:08 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/putSynchronizedQueue2.graffle Binary file paper/fig/putSynchronizedQueue2.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/putSynchronizedQueue2.pdf Binary file paper/fig/putSynchronizedQueue2.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/putSynchronizedQueue2.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/putSynchronizedQueue2.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/putSynchronizedQueue2.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 825 391 +%%HiResBoundingBox: 0.000000 0.000000 825.000000 391.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 29 20:29:39 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/rbtree.graffle Binary file paper/fig/rbtree.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/rbtree.pdf Binary file paper/fig/rbtree.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/rbtree.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/rbtree.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/rbtree.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 562 274 +%%HiResBoundingBox: 0.000000 0.000000 562.000000 274.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:05 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/ryukyu.pdf Binary file paper/fig/ryukyu.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/ryukyu.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/ryukyu.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/ryukyu.pdf +%%Creator: extractbb 20160307 +%%BoundingBox: 0 0 595 842 +%%HiResBoundingBox: 0.000000 0.000000 595.000000 842.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Sun Jan 28 19:06:39 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/semaphoreSequence.graffle Binary file paper/fig/semaphoreSequence.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/semaphoreSequence.pdf Binary file paper/fig/semaphoreSequence.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/semaphoreSequence.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/semaphoreSequence.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/semaphoreSequence.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 1120 869 +%%HiResBoundingBox: 0.000000 0.000000 1120.000000 869.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Sun Feb 4 15:57:13 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/sendTask.graffle Binary file paper/fig/sendTask.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/sendTask.pdf Binary file paper/fig/sendTask.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/sendTask.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/sendTask.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/sendTask.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 722 374 +%%HiResBoundingBox: 0.000000 0.000000 722.000000 374.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Tue Feb 13 05:26:03 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/subtype-arg.graffle Binary file paper/fig/subtype-arg.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/subtype-arg.pdf Binary file paper/fig/subtype-arg.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/subtype-arg.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/subtype-arg.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/subtype-arg.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 1084 281 +%%HiResBoundingBox: 0.000000 0.000000 1084.000000 281.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:05 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/subtype-return.graffle Binary file paper/fig/subtype-return.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/subtype-return.pdf Binary file paper/fig/subtype-return.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/subtype-return.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/subtype-return.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/subtype-return.pdf +%%Creator: extractbb 20190225 +%%BoundingBox: 0 0 1084 281 +%%HiResBoundingBox: 0.000000 0.000000 1084.000000 281.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Mon Jan 20 14:41:06 2020 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/takeSynchronizedQueue1.graffle Binary file paper/fig/takeSynchronizedQueue1.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/takeSynchronizedQueue1.pdf Binary file paper/fig/takeSynchronizedQueue1.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/takeSynchronizedQueue1.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/takeSynchronizedQueue1.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/takeSynchronizedQueue1.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 571 202 +%%HiResBoundingBox: 0.000000 0.000000 571.000000 202.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Wed Jan 24 02:45:08 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/takeSynchronizedQueue2.graffle Binary file paper/fig/takeSynchronizedQueue2.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/takeSynchronizedQueue2.pdf Binary file paper/fig/takeSynchronizedQueue2.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/takeSynchronizedQueue2.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/takeSynchronizedQueue2.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/takeSynchronizedQueue2.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 561 202 +%%HiResBoundingBox: 0.000000 0.000000 561.000000 202.000000 +%%PDFVersion: 1.3 +%%Pages: 1 +%%CreationDate: Wed Jan 24 02:45:08 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/twice.pdf Binary file paper/fig/twice.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/twice.svg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/twice.svg Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,189 @@ + + + +Gnuplot +Produced by GNUPLOT 5.2 patchlevel 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 0 + + + + + 200 + + + + + 400 + + + + + 600 + + + + + 800 + + + + + 1000 + + + + + 1200 + + + + + 1 cpu + + + + + 2 cpus + + + + + 4 cpus + + + + + 8 cpus + + + + + 16 cpus + + + + + 32 cpus + + + + + gpu + + + + + gpu(kernel only) + + + + + + + + + time(ms) + + + + + twice benchmark + + + gnuplot_plot_1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/twice.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/twice.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/twice.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 600 480 +%%HiResBoundingBox: 0.000000 0.000000 600.000000 480.000000 +%%PDFVersion: 1.5 +%%Pages: 1 +%%CreationDate: Tue Feb 6 04:08:41 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/vsgo.pdf Binary file paper/fig/vsgo.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/vsgo.svg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/vsgo.svg Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,174 @@ + + + +Gnuplot +Produced by GNUPLOT 5.2 patchlevel 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 0 + + + + + 200 + + + + + 400 + + + + + 600 + + + + + 800 + + + + + 1000 + + + + + 1200 + + + + + 1 + + + + + 2 + + + + + 4 + + + + + 8 + + + + + 16 + + + + + 32 + + + + + + + + + time(ms) + + + + + CPUs + + + + + twice + + + "gears_poweredge" + + + "gears_poweredge" + + + + + + + + + + + + + "go_poweredge" + + + "go_poweredge" + + + + + + + + + + + + + + + + + + + + + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/vsgo.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/vsgo.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/vsgo.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 600 480 +%%HiResBoundingBox: 0.000000 0.000000 600.000000 480.000000 +%%PDFVersion: 1.5 +%%Pages: 1 +%%CreationDate: Wed Feb 28 23:36:32 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/vsopenmp.pdf Binary file paper/fig/vsopenmp.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/vsopenmp.svg --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/vsopenmp.svg Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,174 @@ + + + +Gnuplot +Produced by GNUPLOT 5.2 patchlevel 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 0 + + + + + 200 + + + + + 400 + + + + + 600 + + + + + 800 + + + + + 1000 + + + + + 1200 + + + + + 1 + + + + + 2 + + + + + 4 + + + + + 8 + + + + + 16 + + + + + 32 + + + + + + + + + time(ms) + + + + + CPUs + + + + + twice + + + "gears_poweredge" + + + "gears_poweredge" + + + + + + + + + + + + + "openmp_poweredge" + + + "openmp_poweredge" + + + + + + + + + + + + + + + + + + + + + + + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/vsopenmp.xbb --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/fig/vsopenmp.xbb Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +%%Title: fig/vsopenmp.pdf +%%Creator: extractbb 20170318 +%%BoundingBox: 0 0 600 480 +%%HiResBoundingBox: 0.000000 0.000000 600.000000 480.000000 +%%PDFVersion: 1.5 +%%Pages: 1 +%%CreationDate: Wed Feb 28 23:36:32 2018 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/workerRun.graffle Binary file paper/fig/workerRun.graffle has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/fig/workerRun.pdf Binary file paper/fig/workerRun.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/master_paper.pdf Binary file paper/master_paper.pdf has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/master_paper.tex --- a/paper/master_paper.tex Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/master_paper.tex Mon Jan 27 20:41:36 2020 +0900 @@ -4,11 +4,14 @@ \usepackage{ascmac} \usepackage[dvipdfmx]{graphicx} \usepackage{here} -\usepackage{listings} \usepackage{comment} \usepackage{url} +%% \usepackage{cite} \usepackage[deluxe, multi]{otf} - +\usepackage[utf8]{inputenc} +\usepackage{listings} +\usepackage{amssymb} +\usepackage{amsmath} %\input{dummy.tex} %% font \jtitle{GearsOS での HoareLogic を用いた実装と検証} @@ -72,7 +75,8 @@ \newpage -%要旨 +% +要旨 \input{abstract.tex} %発表履歴 diff -r ee44dbda6bd3 -r c7acb9211784 paper/reference.bib --- a/paper/reference.bib Thu Jan 16 19:21:45 2020 +0900 +++ b/paper/reference.bib Mon Jan 27 20:41:36 2020 +0900 @@ -72,17 +72,17 @@ month = "may" } -@misc{agda, +@misc{agda-wiki, title = {The Agda wiki}, howpublished = {\url{http://wiki.portal.chalmers.se/agda/pmwiki.php}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } @misc{agda-documentation, title = {Welcome to Agda’s documentation! — Agda latest documentation}, howpublished = {\url{http://agda.readthedocs.io/en/latest/}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } @book{Stump:2016:VFP:2841316, @@ -98,31 +98,31 @@ @misc{agda-alpa, title = {Example - Hoare Logic}, howpublished = {\url{http://ocvs.cfv.jp/Agda/readmehoare.html}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } @misc{agda2-hoare, title = {Hoare Logic in Agda2}, howpublished = {\url{https://github.com/IKEGAMIDaisuke/HoareLogic}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } @misc{coq, title = {Welcome! | The Coq Proof Assistant}, howpublished = {\url{https://coq.inria.fr/}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } @misc{ats2, title = {ATS-PL-SYS}, howpublished = {\url{http://www.ats-lang.org/}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } @misc{rust, title = {Rust programming language}, howpublished = {\url{https://www.rust-lang.org/}}, - note = {Accessed: 2018/12/17(Mon)} + note = {Accessed: 2018/12/17(Mon)}, } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaBasics.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaBasics.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,1 @@ +module AgdaBasics where diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaBasics.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaBasics.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,1 @@ +module AgdaBasics where diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaBool.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaBool.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +data Bool : Set where + true : Bool + false : Bool diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaBool.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaBool.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +data Bool : Set where + true : Bool + false : Bool diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaDebug.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaDebug.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaDebug.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaDebug.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaElem.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaElem.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaElem.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaElem.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +elem : {A : Set} {{eqA : Eq A}} → A → List A → Bool +elem {{eqA}} x (y @$\text{::}$@ xs) = (Eq._==_ eqA x y) || (elem {{eqA}} x xs) +elem x [] = false diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaElemApply.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaElemApply.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +listHas4 : Bool +listHas4 = elem 4 (3 ∷ 2 ∷ 5 ∷ 4 ∷ []) -- true + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaElemApply.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaElemApply.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +listHas4 : Bool +listHas4 = elem 4 (3 @$\text{::}$@ 2 @$\text{::}$@ 5 @$\text{::}$@ 4 @$\text{::}$@ []) -- true + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaFunction.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaFunction.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,2 @@ +f : Bool -> Bool +f x = true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaFunction.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaFunction.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,2 @@ +f : Bool @$\rightarrow$@ Bool +f x = true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaId.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaId.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,5 @@ +identity : (A : Set) -> A -> A +identity A x = x + +identity-zero : Nat +identity-zero = identity Nat zero diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaId.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaId.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaImplicitId.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaImplicitId.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaImplicitId.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaImplicitId.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaImport.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaImport.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaImport.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaImport.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaInstance.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaInstance.agda Mon Jan 27 20:41:36 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_} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaInstance.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaInstance.agda.replaced Mon Jan 27 20:41:36 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_} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaInterface.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaInterface.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaInterface.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaInterface.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaLambda.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaLambda.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,5 @@ +not-apply : Bool -> Bool +not-apply = (\b -> not b) -- use lambda + +not-apply : Bool -> Bool +not-appy b = not b -- not use lambda diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaLambda.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaLambda.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,5 @@ +not-apply : Bool @$\rightarrow$@ Bool +not-apply = (\b @$\rightarrow$@ not b) -- use lambda + +not-apply : Bool @$\rightarrow$@ Bool +not-appy b = not b -- not use lambda diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaModusPonens.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaModusPonens.agda Mon Jan 27 20:41:36 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) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaModusPonens.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaModusPonens.agda.replaced Mon Jan 27 20:41:36 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) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNPushNPop.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNPushNPop.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNPushNPop.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNPushNPop.agda.replaced Mon Jan 27 20:41:36 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@$\text{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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNPushNPopProof.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNPushNPopProof.agda Mon Jan 27 20:41:36 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 + ∎ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNPushNPopProof.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNPushNPopProof.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,58 @@ +pop-n-push-type : @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ @$\mathbb{N}$@ @$\rightarrow$@ SingleLinkedStack @$\mathbb{N}$@ @$\rightarrow$@ Set@$\text{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@$\text{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$@ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNat.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNat.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +data Nat : Set where + zero : Nat + suc : Nat -> Nat diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNat.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNat.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +data Nat : Set where + zero : Nat + suc : Nat @$\rightarrow$@ Nat diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNot.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNot.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +not : Bool -> Bool +not true = false +not false = true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaNot.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaNot.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +not : Bool @$\rightarrow$@ Bool +not true = false +not false = true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaParameterizedModule.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaParameterizedModule.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaParameterizedModule.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaParameterizedModule.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPattern.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPattern.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +not : Bool -> Bool +not false = true +not x = false diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPattern.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPattern.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +not : Bool @$\rightarrow$@ Bool +not false = true +not x = false diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPlus.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPlus.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +_+_ : Nat -> Nat -> Nat +zero + m = m +suc n + m = suc (n + m) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPlus.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPlus.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +_+_ : Nat @$\rightarrow$@ Nat @$\rightarrow$@ Nat +zero + m = m +suc n + m = suc (n + m) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaProduct.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaProduct.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaProduct.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaProduct.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaProp.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaProp.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,2 @@ +prop : Bool +prop = true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaProp.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaProp.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,2 @@ +prop : Bool +prop = true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPushPop.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPushPop.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPushPop.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPushPop.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPushPopProof.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPushPopProof.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaPushPopProof.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaPushPopProof.agda.replaced Mon Jan 27 20:41:36 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@$\text{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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaRecord.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaRecord.agda Mon Jan 27 20:41:36 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 } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaRecord.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaRecord.agda.replaced Mon Jan 27 20:41:36 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 } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaRecordProj.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaRecordProj.agda Mon Jan 27 20:41:36 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} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaRecordProj.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaRecordProj.agda.replaced Mon Jan 27 20:41:36 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} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaSingleLinkedStack.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaSingleLinkedStack.agda Mon Jan 27 20:41:36 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}) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaSingleLinkedStack.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaSingleLinkedStack.agda.replaced Mon Jan 27 20:41:36 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}) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStack.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStack.agda Mon Jan 27 20:41:36 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) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStack.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStack.agda.replaced Mon Jan 27 20:41:36 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) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackDS.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackDS.agda Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackDS.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackDS.agda.replaced Mon Jan 27 20:41:36 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@$\text{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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackImpl.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackImpl.agda Mon Jan 27 20:41:36 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 + } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackImpl.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackImpl.agda.replaced Mon Jan 27 20:41:36 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 + } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackSomeState.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackSomeState.agda Mon Jan 27 20:41:36 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} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackSomeState.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackSomeState.agda.replaced Mon Jan 27 20:41:36 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} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackTest.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackTest.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaStackTest.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaStackTest.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTree.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTree.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTree.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTree.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeDebug.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeDebug.agda Mon Jan 27 20:41:36 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 +-- }) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeDebug.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeDebug.agda.replaced Mon Jan 27 20:41:36 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 +-- }) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeDebugReturnNode4.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeDebugReturnNode4.agda Mon Jan 27 20:41:36 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 + -- }) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeDebugReturnNode4.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeDebugReturnNode4.agda.replaced Mon Jan 27 20:41:36 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 + -- }) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeImpl.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeImpl.agda Mon Jan 27 20:41:36 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 ) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeImpl.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeImpl.agda.replaced Mon Jan 27 20:41:36 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 ) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeProof.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeProof.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeProof.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeProof.agda.replaced Mon Jan 27 20:41:36 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 → + GetRedBlackTree.checkNode t k (@$\lambda$@ t@$\text{1}$@ x1 → 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@$\text{1}$@ y → compare2 x@$\text{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@$\text{1}$@ y → compare2 x@$\text{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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeTest.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeTest.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTreeTest.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTreeTest.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTypeClass.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTypeClass.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +record Eq (A : Set) : Set where + field + _==_ : A -> A -> Bool diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaTypeClass.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaTypeClass.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +record Eq (A : Set) : Set where + field + _==_ : A @$\rightarrow$@ A @$\rightarrow$@ Bool diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaWhere.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaWhere.agda Mon Jan 27 20:41:36 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) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/AgdaWhere.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/AgdaWhere.agda.replaced Mon Jan 27 20:41:36 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) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/CodeSegment.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/CodeSegment.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/CodeSegment.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/CodeSegment.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/CodeSegments.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/CodeSegments.agda Mon Jan 27 20:41:36 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}) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/CodeSegments.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/CodeSegments.agda.replaced Mon Jan 27 20:41:36 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}) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/DataSegment.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/DataSegment.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +record ds0 : Set where + field + a : Int + b : Int + +record ds1 : Set where + field + c : Int diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/DataSegment.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/DataSegment.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,8 @@ +record ds0 : Set where + field + a : Int + b : Int + +record ds1 : Set where + field + c : Int diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Equiv.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Equiv.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Equiv.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Equiv.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,1 @@ +data _@$\equiv$@_ {a} {A : Set a} (x : A) : A → Set a where refl : x @$\equiv$@ x \ No newline at end of file diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Exec.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Exec.agda Mon Jan 27 20:41:36 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)) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Exec.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Exec.agda.replaced Mon Jan 27 20:41:36 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)) + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Goto.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Goto.agda Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Goto.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Goto.agda.replaced Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Maybe.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Maybe.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +data Maybe {a} (A : Set a) : Set a where + just : (x : A) -> Maybe A + nothing : Maybe A diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Maybe.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Maybe.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ +data Maybe {a} (A : Set a) : Set a where + just : (x : A) @$\rightarrow$@ Maybe A + nothing : Maybe A diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaCodeSegment.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaCodeSegment.agda Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaCodeSegment.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaCodeSegment.agda.replaced Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaDataSegment.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaDataSegment.agda Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaDataSegment.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaDataSegment.agda.replaced Mon Jan 27 20:41:36 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 + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaMetaCodeSegment.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaMetaCodeSegment.agda Mon Jan 27 20:41:36 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)} + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaMetaCodeSegment.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaMetaCodeSegment.agda.replaced Mon Jan 27 20:41:36 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)} + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaMetaDataSegment.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaMetaDataSegment.agda Mon Jan 27 20:41:36 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 +-- 以下よりメタメタレベルのプログラムを記述できる diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/MetaMetaDataSegment.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/MetaMetaDataSegment.agda.replaced Mon Jan 27 20:41:36 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 +-- 以下よりメタメタレベルのプログラムを記述できる diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Nat.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Nat.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,5 @@ +module nat where + +data Nat : Set where + O : Nat + S : Nat -> Nat \ No newline at end of file diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Nat.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Nat.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,5 @@ +module nat where + +data Nat : Set where + O : Nat + S : Nat @$\rightarrow$@ Nat \ No newline at end of file diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/NatAdd.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/NatAdd.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/NatAdd.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/NatAdd.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/NatAddSym.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/NatAddSym.agda Mon Jan 27 20:41:36 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) = {!!} -- 後述 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/NatAddSym.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/NatAddSym.agda.replaced Mon Jan 27 20:41:36 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) = {!!} -- 後述 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/PushPopType.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/PushPopType.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/PushPopType.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/PushPopType.agda.replaced Mon Jan 27 20:41:36 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@$\text{1}$@ +push-pop-type meta = + M.exec (M.csComp (M.cs popOnce) (M.cs pushOnce)) meta @$\equiv$@ meta diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Reasoning.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Reasoning.agda Mon Jan 27 20:41:36 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) ∎ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Reasoning.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Reasoning.agda.replaced Mon Jan 27 20:41:36 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$@ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/RedBlackTree.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/RedBlackTree.agda Mon Jan 27 20:41:36 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 + } + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/RedBlackTree.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/RedBlackTree.agda.replaced Mon Jan 27 20:41:36 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}$@ → @$\mathbb{N}$@ → 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 + } + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/SingleLinkedStack.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/SingleLinkedStack.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,110 @@ +#include "../context.h" +#include "../origin_cs.h" +#include + +// 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(...); +} + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/Stack.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/Stack.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,14 @@ +typedef struct Stack{ + 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; diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/ThreePlusOne.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/ThreePlusOne.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/ThreePlusOne.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/ThreePlusOne.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/atomicImpl.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/atomicImpl.cbc Mon Jan 27 20:41:36 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(...); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/atton-master-meta-sample.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/atton-master-meta-sample.agda Mon Jan 27 20:41:36 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)} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/atton-master-meta-sample.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/atton-master-meta-sample.agda.replaced Mon Jan 27 20:41:36 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)} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/atton-master-sample.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/atton-master-sample.agda Mon Jan 27 20:41:36 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}) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/atton-master-sample.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/atton-master-sample.agda.replaced Mon Jan 27 20:41:36 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}) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/axiom-taut.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/axiom-taut.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/axiom-taut.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/axiom-taut.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,10 @@ +_@$\Rightarrow$@_ : Bool → Bool → Bool +false @$\Rightarrow$@ _ = true +true @$\Rightarrow$@ true = true +true @$\Rightarrow$@ false = false + +Axiom : Cond @$\rightarrow$@ PrimComm @$\rightarrow$@ Cond @$\rightarrow$@ Set +Axiom pre comm post = ∀ (env : Env) → (pre env) @$\Rightarrow$@ ( post (comm env)) @$\equiv$@ true + +Tautology : Cond @$\rightarrow$@ Cond @$\rightarrow$@ Set +Tautology pre post = ∀ (env : Env) → (pre env) @$\Rightarrow$@ (post env) @$\equiv$@ true diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/cg1.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/cg1.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,7 @@ +__code cg0(int a, int b) { + goto cg1(a+b); +} + +__code cg1(int c) { + goto cg2(c); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/codeGearExample.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/codeGearExample.cbc Mon Jan 27 20:41:36 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, ...); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/contextContinuation.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/contextContinuation.cbc Mon Jan 27 20:41:36 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); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/createCPUWorker.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/createCPUWorker.cbc Mon Jan 27 20:41:36 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); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/createTaskManager.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/createTaskManager.cbc Mon Jan 27 20:41:36 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 (;igpu;i++) { + Queue* queue = createSynchronizedQueue(context); + taskManager->workers[i] = (Worker*)createCPUWorker(context, i, queue); + } + for (;icpu;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 (;imaxCPU;i++) { + Queue* queue = createSynchronizedQueue(context); + taskManager->workers[i] = (Worker*)createCPUWorker(context, i, queue); + } +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/cuLaunchKernel.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/cuLaunchKernel.cbc Mon Jan 27 20:41:36 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)); + } + ... +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/ex_stack.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/ex_stack.cbc Mon Jan 27 20:41:36 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(...); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/excbc.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/excbc.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,7 @@ +__code cs0(int a, int b) { + goto cs1(a+b); +} + +__code cs1(int c) { + goto cs2(c); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/factrial.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/factrial.cbc Mon Jan 27 20:41:36 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); +} + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/function.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/function.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,4 @@ +_-_ :ℕ →ℕ →ℕ +x - zero = x +zero - _ = zero +(suc x) - (suc y) = x - y diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/function.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/function.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,4 @@ +_-_ :@$\mathbb{N}$@ →@$\mathbb{N}$@ →@$\mathbb{N}$@ +x - zero = x +zero - _ = zero +(suc x) - (suc y) = x - y diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/gears-while.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/gears-while.agda Mon Jan 27 20:41:36 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 + ∎ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/gears-while.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/gears-while.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,51 @@ +whileTest : {l : Level} {t : Set l} @$\rightarrow$@ {c10 : @$\mathbb{N}$@ } → (Code : (env : Env) @$\rightarrow$@ + ((vari env) @$\equiv$@ 0) /\ ((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) /\ ((varn env) @$\equiv$@ c10) + proof2 = record {pi1 = refl ; pi2 = refl} + +conversion1 : {l : Level} {t : Set l } → (env : Env) @$\rightarrow$@ {c10 : @$\mathbb{N}$@ } → ((vari env) @$\equiv$@ 0) /\ ((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 → n + vari env ) (pi2 p1 ) @$\rangle$@ + c10 + vari env + @$\equiv$@@$\langle$@ cong ( @$\lambda$@ n → 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}$@ } → ((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 → @$\bot$@ + 1<0 () + proof3 : (suc zero @$\leq$@ (varn env)) → 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 → 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 → z + vari env ) +1@$\equiv$@suc @$\rangle$@ + (suc n' ) + vari env + @$\equiv$@@$\langle$@@$\rangle$@ + varn env + vari env + @$\equiv$@@$\langle$@ proof @$\rangle$@ + c10 + @$\blacksquare$@ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/gears.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/gears.agda Mon Jan 27 20:41:36 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 )))) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/gears.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/gears.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,2 @@ +proofGears : {c10 : @$\mathbb{N}$@ } → Set +proofGears {c10} = whileTest {_} {_} {c10} (@$\lambda$@ n p1 → conversion1 n p1 (@$\lambda$@ n1 p2 → whileLoop' n1 p2 (@$\lambda$@ n2 → ( vari n2 @$\equiv$@ c10 )))) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/goto.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/goto.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,7 @@ +__code cs0(int a, int b){ + goto cs1(a+b); +} + +__code cs1(int c){ + goto cs2(c); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/interface.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/interface.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,12 @@ +typedef struct Stack{ + 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; diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/iterateCall.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/iterateCall.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,96 @@ +#include "../context.h" +#interface "Iterator.h" +#interface "TaskManager.h" +#include + +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(...); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/iteratePargoto.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/iteratePargoto.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,4 @@ +__code code1() { + par goto printIterator(input, output, iterate(2), __exit); + goto code2(); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/metaCodeGearExample.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/metaCodeGearExample.cbc Mon Jan 27 20:41:36 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); +} + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/metaCreateTask.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/metaCreateTask.cbc Mon Jan 27 20:41:36 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, ...)) { + .... +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/parGotoCreateTask.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/parGotoCreateTask.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,4 @@ +__code code1(Integer *integer1, Integer * integer2, Integer *output) { + par goto add(integer1, integer2, output, __exit); + goto code2(); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/putSynchronizedQueue.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/putSynchronizedQueue.cbc Mon Jan 27 20:41:36 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); + } +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/record.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/record.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,4 @@ +record Env : Set where + field + varn : ℕ + vari : ℕ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/record.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/record.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,4 @@ +record Env : Set where + field + varn : @$\mathbb{N}$@ + vari : @$\mathbb{N}$@ diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/redBlackTreeTest.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/redBlackTreeTest.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/redBlackTreeTest.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/redBlackTreeTest.agda.replaced Mon Jan 27 20:41:36 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 → + GetRedBlackTree.checkNode t k (@$\lambda$@ t@$\text{1}$@ x1 → 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@$\text{1}$@ y → compare2 x@$\text{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@$\text{1}$@ y → compare2 x@$\text{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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/sendTask.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/sendTask.cbc Mon Jan 27 20:41:36 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(...)); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/singleLinkedQueue.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/singleLinkedQueue.cbc Mon Jan 27 20:41:36 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(...); +} + +..... diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/singleLinkedQueueTest.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/singleLinkedQueueTest.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,6 @@ +__code code1() { + Queue* queue = createSingleLinkedQueue(context); + Node* node = new Node(); + node->color = Red; + goto queue->put(node, queueTest2); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/singleLinkedQueueTest_script.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/singleLinkedQueueTest_script.cbc Mon Jan 27 20:41:36 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); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/singleLinkedStackInterface.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/singleLinkedStackInterface.cbc Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack-product.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack-product.agda Mon Jan 27 20:41:36 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 +-} + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack-product.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack-product.agda.replaced Mon Jan 27 20:41:36 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 +-} + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack-subtype-sample.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack-subtype-sample.agda Mon Jan 27 20:41:36 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 + ∎ + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack-subtype-sample.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack-subtype-sample.agda.replaced Mon Jan 27 20:41:36 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@$\text{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@$\text{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@$\text{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$@ + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack-subtype.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack-subtype.agda Mon Jan 27 20:41:36 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)) + } + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack-subtype.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack-subtype.agda.replaced Mon Jan 27 20:41:36 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@$\text{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)) + } + + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack.agda Mon Jan 27 20:41:36 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 + } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stack.agda.replaced Mon Jan 27 20:41:36 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 + } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stack.agdai Binary file paper/src/stack.agdai has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stackImpl.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stackImpl.agda Mon Jan 27 20:41:36 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 + } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stackImpl.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stackImpl.agda.replaced Mon Jan 27 20:41:36 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 + } diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stackTest.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stackTest.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stackTest.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stackTest.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stackTest.agdai Binary file paper/src/stackTest.agdai has changed diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stackimpl.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stackimpl.cbc Mon Jan 27 20:41:36 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(...); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stub.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stub.cbc Mon Jan 27 20:41:36 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); +} + + diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/stubCodeGear.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/stubCodeGear.cbc Mon Jan 27 20:41:36 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); +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/subtype.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/subtype.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/subtype.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/subtype.agda.replaced Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/taskManagerInterface.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/taskManagerInterface.cbc Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,13 @@ +typedef struct TaskManager{ + 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; diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/term1.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/term1.agda Mon Jan 27 20:41:36 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 {c\ +10}) +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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/term1.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/term1.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,15 @@ +stmt2Cond : {c10 :@$\mathbb{N}$@} → Cond +stmt2Cond {c10} env = (Equal (varn env) c10) @$\wedge$@ (Equal (vari env) 0) + +lemma1 : {c10 :@$\mathbb{N}$@} → Axiom (stmt1Cond {c10}) (@$\lambda$@ env → record { varn = varn env ; vari = 0 }) (stmt2Cond {c\ +10}) +lemma1 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond → 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/term2.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/term2.agda Mon Jan 27 20:41:36 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 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/term2.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/term2.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,7 @@ +@$\wedge$@true : { x : Bool } → x @$\wedge$@ true @$\equiv$@ x +@$\wedge$@true {x} with x +@$\wedge$@true {x} | false = refl +@$\wedge$@true {x} | true = refl + +stmt1Cond : {c10 :@$\mathbb{N}$@} → Cond +stmt1Cond {c10} env = Equal (varn env) c10 diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/term3.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/term3.agda Mon Jan 27 20:41:36 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 +∎ ) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/term3.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/term3.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,10 @@ +lemma1 : {c10 :@$\mathbb{N}$@} → Axiom (stmt1Cond {c10}) (@$\lambda$@ env → record { varn = varn env ; vari = 0 }) (stmt2Cond {c\ +10}) +lemma1 {c10} env = impl@$\Rightarrow$@ ( @$\lambda$@ cond → 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$@ ) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/while-test.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/while-test.agda Mon Jan 27 20:41:36 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} ) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/while-test.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/while-test.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,2 @@ +whileTest : {l : Level} {t : Set l} @$\rightarrow$@ (c10 : @$\mathbb{N}$@) → (Code : Env @$\rightarrow$@ t) @$\rightarrow$@ t +whileTest c10 next = next (record {varn = c10 ; vari = 0} ) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/workerRun.cbc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/workerRun.cbc Mon Jan 27 20:41:36 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 +} diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/zero.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/zero.agda Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ ++zero : { y : ℕ } → y + zero ≡ y ++zero {zero} = refl ++zero {suc y} = cong ( λ x → suc x ) ( +zero {y} ) diff -r ee44dbda6bd3 -r c7acb9211784 paper/src/zero.agda.replaced --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/paper/src/zero.agda.replaced Mon Jan 27 20:41:36 2020 +0900 @@ -0,0 +1,3 @@ ++zero : { y : @$\mathbb{N}$@ } → y + zero @$\equiv$@ y ++zero {zero} = refl ++zero {suc y} = cong ( @$\lambda$@ x → suc x ) ( +zero {y} )