ナビゲーション

- 索引

- 次へ |

- ソフトウェアの基礎 1.0.2 documentation »

ソフトウェアの基礎(beta)

本ドキュメントは実験中のものです。 安定板は http://proofcafe.org/sf/ を参照してください。

epub版: http://proofcafe.org/sf-beta/software_foundation_1.0.2.epub

mobi版: http://proofcafe.org/sf-beta/software_foundation_1.0.2.mobi

Contents:

- 前書き

- 概要

- 実際の学習について

- Coqについて

- 練習問題について

- 推奨書籍

- 教育関係者へ

- Basics_J: 関数プログラミングとプログラムの証明

- 列挙型

- 簡約を用いた証明

- introsタクティック

- 書き換え（Rewriting）による証明

- Case分析

- Caseへのネーミング

- 帰納法

- 形式的証明と非形式的証明

- 証明の中で行う証明

- さらなる練習問題

- Lists_J: 直積、リスト、オプション

- 数のペア

- 数のリスト

- リストに関する推論

- オプション

- applyタクティック

- 帰納法の仮定を変更する

- 練習問題: 辞書

- Poly_J:多相性と高階関数

- ポリモルフィズム（多相性）

- データとしての関数

- さらにCoqについて

- まとめ

- さらなる練習問題

- Gen_J: 帰納法の仮定の一般化

- 練習問題: ★★★ (gen_dep_practice)

- 練習問題: ★★★, optional (index_after_last_informal)

- 練習問題: ★★★, optional (gen_dep_practice_opt)

- 練習問題: ★★★, optional (app_length_cons)

- 練習問題: ★★★★, optional (app_length_twice)

- Prop_J: 命題と根拠

- 命題によるプログラミング

- 根拠

- 全体像: Coqの2つの空間

- 非形式的な証明

- 選択課題

- 追加練習問題

- Logic_J: Coqにおける論理

- 全称記号 と ならば

- 論理積、連言（Conjunction、AND）

- 論理和、選言（Disjunction、OR）

- 偽であるということ

- 否定

- 存在量化子

- 等しいということ（同値性）

- 命題としての関係

- 選択課題

- Rel_J:関係の性質

- 関係の基本性質

- 反射推移閉包

- SfLib_J: Software Foundations ライブラリ

- Coq スタンダードライブラリから

- Basics.vから

- Props.vから

- Logic.vから

- 使い勝手のいいタクティックをいくつか

- Imp_J: 単純な命令型プログラム

- Sflib

- tryタクティカル

- ;タクティカル

- 場合分けを万全にする

- ImpParser_J: Coqでの字句解析と構文解析

- 内部処理

- 例

- Equiv_J: プログラムの同値性

- 宿題割当てについての一般的アドバイス

- (0 + n)の消去の健全性、再び

- ImpList_J: Imp のリスト拡張

- リストを持つ Imp プログラム

- Hoare_J: ホーア論理

- ホーア論理

- ホーア論理によるプログラムについての推論

- 修飾付きプログラムの形式化

- HoareAsLogic_J: 論理としてのホーア論理

- 練習問題: ★★

- Smallstep_J: スモールステップ操作的意味論

- おもちゃの言語

- マルチステップ簡約

- スモールステップ Imp

- 並列実行 Imp

- Types_J: 型システム

- さらに自動化

- 型付きの算術式

- Stlc_J: 単純型付きラムダ計算

- 単純型付きラムダ計算

- 練習問題: 算術を持つSTLC

- Typechecking_J: STLCの型チェッカ

- 型を比較する

- 型チェッカ

- 性質

- MoreStlc_J: 単純型付きラムダ計算についてさらに

- STLCの単純な拡張

- 拡張を形式化する

- Records_J: STLCにレコードを追加する

- レコードを追加する

- レコードを形式化する

- References_J: 変更可能な参照の型付け

- 定義

- 構文

- 副作用と順次処理

- 参照と別名付け

- 共有状態

- オブジェクト

- 参照と合成型

- null参照

- ガベージコレクション

- 場所(Locations)

- 記憶(Stores)

- 簡約

- 記憶の型付け

- 型付け関係

- 型付けできる記憶

- 記憶型付けを拡張する

- 保存、最終的に

- 置換補題

- 代入は記憶型付けを保存する

- 記憶についての弱化

- 保存!

- 進行

- Subtyping_J :サブタイプ

- 概念

- 中核部の定義

- サブタイプ

- 型付け

- 性質

- 練習問題: 直積の追加

- RecordSub_J: レコードのサブタイプ

- 中核部の定義

- サブタイプ

- 型付け

- Norm_J: STLCの正規化

- 練習問題: ★

- UseTactics_J:Coq用タクティックライブラリのご紹介

- 導入と場合分けについてのタクティック

- n-引数論理演算のためのタクティック

- 等式を扱うタクティック

- 注記:asserts_rewrite (E1 = E2) in Hと書いた場合、

- 便利な略記法をいくつか

- 高度な補題具体化のためのタクティック

- UseAuto_J: Coqの証明自動化の理論と実際

- 証明探索の基本性質

- 証明探索はどのようにはたらくか

- 自動化の使用例

- 証明探索の進んだ話題

- 決定手続き

- LibTactics_J: 使いやすい汎用タクティックのコレクション

- Coqのための追加の記法

- Ltacによるプログラミングのための道具類

- 後方/前方連鎖

- 導入と一般化

- 書き換え

- 反転(Inversion)

- 帰納法(Induction)

- 決定可能な等式

- 同値(Equivalence)

- N個の連言と選言

- タイプクラスのインスタンスを証明するためのタクティック

- 自動化起動のタクティック

- 証明コンテキストを整理するためのタクティック

- 開発目的のタクティック

- 標準ライブラリとのコンパチビリティ

- PE_J: 部分評価

- 定数畳み込みを一般化する

- ループ以外のコマンドの部分評価

- ループの部分評価

- フローチャートプログラムの部分評価

- Postscript_J: あとがき

- ふりかえり...

- さらなる読み物

Indices and tables

- 索引

- モジュール索引

- 検索ページ

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

前書き

この電子文章は「ソフトウェアの基礎（プログラミングとプログラミング言語の数学的理論）」という、大学後半～院生向けの1学期分の講義のために書かれたものです。この講義では、Coq上で関数プログラミング、論理学、演算の意味論、ラムダ計算、静的型システムの基礎を学ぶことができます。

このコースの主な特徴は、教材のテキストがCoqのスクリプトファイルそのものとなっており、学習の進み具合を「形式的」かつ「機械的」にチェックしながら学んでいくことができる、ということです。このコースでは、Coqのインタラクティブモードを使って、ソースを1行1行追いながら動きを理解していきます。講義のほとんどはCoqで組み立てられ、Coq上で作業し演習するようデザインされています。

このファイルは章立てされ整理されており、1学期ぶんの教材として十分で、順番に学習していけるよう、筋道立てて作成されています。さらに加えて、いくつかのトピックについて追加項目があります。

概要

このコースは、いくつかの基礎的なテーマから成っています。

- ソフトウェア工学のための、数学に根ざした論理学

論理学                       微積分学
--------------------   =   ----------------------------
ソフトウェア工学                機械/土木工学

特に、帰納的に定義された集合や関係とその帰納的な証明は、コンピュータサイエンスのいたるところで見られます。このコースでは、帰納法をあらゆる角度から分析します。

- 関数プログラミング：ソフトウェア開発者が持つべき道具のうち、重要性が特に増している

- ソフトウェア開発のメインストリームでの方法論での、先進的なプログラミング手法は、関数プログラミングの影響を日増しに強く受けるようになっています。

- 特に永続的なデータ構造を用い、状態の変化を避けることで、並列プログラミングをシンプルなものとすることができます。

- プログラミング言語の基礎（このコースの２番目のパート）

- 表記法　　厳格に表現するテクニック：新しいプログラム言語や、その特色のストレステスト（これは驚くほど普通に行われていることです！）巨大なソフトウェアシステムの多くは基本的なプログラム言語をサブシステムとして持っています（例：正規表現、コマンドラインフォーマット、設定ファイル、SQL、Flash,PDFなどなど）

- 毎日ソフトウェア作成に使用しているツールに対して、さらに理解を深める。あなたのお気に入りのプログラミング言語が、動作の裏で何を行っているか。

- Coq　実用に十分な証明支援器

- 証明支援器は、ソフトウェアやハードウェア開発の両方でますます一般的になりつつあります。Coqはそういったツールであるだけでなく、それを徹底的に学ぶことで、他のツールの理解にも大幅に有利になるようなものです。

実際の学習について

章間の依存関係

章と章の間の依存関係をまとめた図と、学習教材へのパスを、deps.htmlにまとめてあります。

学習者に要求される知識的前提

この資料は、学部生から博士課程、研究者までの幅広い読者に読んでもらえることを想定しています。プログラミング言語や論理学について前提としている知識はさほど大きくありませんが、数学の十分な学位があると理解は早まるでしょう。

Coqについて

我々のこのコースでの「研究所」は、Coq証明支援器です。Coqは以下の二つの機能を併せ持っています。

- シンプルでいささか風変わりな（しかしそのぶん表現力がある）プログラミング言語で、しかも

- 論理学で言うところの仮定（プログラムの動作に関する仮定も含む）からスタートし、その正当性の証拠を導き出すためのツールです。

我々は、この両面を同時に研究していきます。

学習に必要なもの

Coqは、Windowsと多くのUNIX変種（LinuxやMacOSを含む）で動きます。具体的には

- Coqホームページにある最新版のCoq。（全てのサンプルソースはバージョン8.3でコンパイルできることが確認されていますが、8.2でもおそらく動きます）

- Coqを対話的に操作するIDE。現在、以下の二つから選択できます。 - ProofGeneralは、Emacs上に作られたIDEです。すでにEmacsに慣れている人向けのものです。Coqとは別にインストールする必要があります。（詳しくはgoogleで”ProofGeneral”を検索してください）

- CoqIDEは、スタンドアロンで動作するシンプルなIDEです。Coqと一緒に配布されています。しかしいくつかのプラットホームではGUIライブラリなどの追加パッケージをインストールする必要があります。

教材となるCoqファイルの入手方法

この教材のリリース版のソース（CoqスクリプトとHTMLファイル）をtarで固めたものが、以下のURLで取得できます。

http://www.cis.upenn.edu/~bcpierce/sf

この資料の一部だけを使用したい場合は、tarファイルとなっているリリース版を展開して使用してください。

練習問題について

この資料の各章には、たくさんの練習問題がついています。”optional（任意）”と記されたり”recommended（推奨）”とされているものもあります。”任意”とされていない問題までやることで、その章で学ぶべきことを6～8時間（長い章でも）の学習で理解できるようになっています。

練習問題についている”スターレーティング”には、以下のような意味があります。

- ★：多くの読者が1～2分でできる簡単な問題。”推奨”と明示しているものはありませんが、どちらかというと全て”推奨”とされるべきものです。読者は、この問題に取り組んで、このレベルの問題に慣れておくべきです。

- ★★：　素直で簡単な問題（5～10分でできるでしょう）

- ★★★：　少し考えないといけない問題（15～30分ほどかかるでしょう）

- ★★★★：　さらに難しい問題（1～2時間）

推奨書籍

「あとがき （Postscript）」の章に、読んでおいて損はない本、テキストをあげておきました。

教育関係者へ

この資料を自分のコースで使おうと思った場合、ほぼまちがいなくあなたは書き直したり、追加したりしたいところが出てくるでしょう。そういった貢献は大歓迎です。

ぜひBenjamin Pierceまでemailをください。そうすれば、あなた用のsubversionのリポジトリとメーリングリストのアカウントを用意します。リポジトリには、READMEファイルがありますので、次にどうすべきかはそれを参照してください。

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Basics_J: 関数プログラミングとプログラムの証明

列挙型

プログラミング言語Coqには、ほとんど何も（ブール型や数値型すら）ビルトインされていません。その代わりCoqには、新しい型やそれを処理するための強力なツールが用意されています。

曜日の表し方

まず最初はとても簡単なサンプルから始めましょう。次の定義は、Coqに対して、新しいデータ型のセット（集合）である’型’を定義しています。その型はdayで、要素はmonday、tuesday...などです。その定義の1行は以下のようにも読めます。”mondayはday。tuesdayはday“といった具合です。

Inductive day : Type :=
| monday : day
| tuesday : day
| wednesday : day
| thursday : day
| friday : day
| saturday : day
| sunday : day.

“day“が何かを定義できれば、それを利用して関数を書くこともできるでしょう。

Definition next_weekday (d:day) : day :=
match d with
| monday => tuesday
| tuesday => wednesday
| wednesday => thursday
| thursday => friday
| friday => monday
| saturday => monday
| sunday => monday
end.

一つ注意しておかなければならないことがあります。この関数の定義では、引数の型と戻り値の型が明示されていることです。他の多くの関数型プログラミング言語と同様、Coqはこのように型を明示的に書かずともちゃんと動くようになっています。それはいわゆる「型推論」という機構によって実現されていますが、型を明示した方がプログラムを読みやすくできると判断するなら、いつでもそうしてかまいません。

関数の定義ができたら、いくつかの例を挙げてそれが正しいものであることをチェックしなければなりません。それを実現するために、Coqには三つの方法が用意されています。一つ目は「Eval Simpl」コマンドを使って、関数next_weekdayを含んだ式を評価させることです。次のコマンドをよく見て、何をしているかを考えてみてください。

Eval simpl in (next_weekday friday).
Eval simpl in (next_weekday (next_weekday saturday)).

もし今手元にコンピュータがあるなら、CoqのIDEのうち好きなもの（CoqIDEやProofGeneralなどから）を選んで起動し、実際に上のコマンドを入力し動かしてみるといいでしょう。付録の「Basic.v」ファイルから上のサンプルを探してCoqに読み込ませ、結果を観察してください。

「simpl（simplify）」というキーワードは、Coqに対して「我々が与えた式を正確に評価せよ」という命令です。しばらくの間、「simpl」コマンドは我々にとって必要な唯一のコマンドになるでしょう。この後でもう少し使い出のある別のコマンドを覚えるまでの間ですが。

二番目の方法は、評価の結果として我々が期待しているものをCoqに対してあらかじめ以下のような形で例示しておくというものです。

Example test_next_weekday:
(next_weekday (next_weekday saturday)) = tuesday.

この宣言は二つのことを行っています。ひとつは、saturdayの次の次にあたる平日が、tuesdayであるということを確認する必要があるということを示すこと。もう一つは、後で参照しやすいように、その確認事項にtest_next_weekdayという名前を与えていることです。この確認事項を定義すれば、次のようなコマンドを流すだけで、Coqによって正しさを検証できます。

Proof. simpl. reflexivity.  Qed.

この文について細かいことは今は置いておきますが（じきに戻ってきます）、本質的には以下のような意味になります「我々が作成した確認事項は簡約後の同値チェックによって証明されました。」

三番目の方法は、Coqで定義したものから、他のより一般的な言語（OcamlやScheme、Haskellといった）のプログラムを抽出してしまうことです。この機能は今主流の言語で完全に確認されたプログラムを実現できる道を開いたという意味でとても興味深いものです。ここではこの件について深入りすることはしませんが、もしより深く知りたいという場合はCoq’Art book（Bertot and Casteran著）か、Coqリファレンスマニュアルを参照してください。

ブール型

同様にして、trueとfalseを値としてとる「bool型」を定義することができます。

Inductive bool : Type :=
| true : bool
| false : bool.

このようにして、我々は独自のbool型を一から作りあげることもできるのですが、もちろんCoqには標準ライブラリとしてbool型が多くの有用な関数、補助定理と一緒に用意されています。（もし興味があるなら、CoqライブラリドキュメントのCoq.Init.Datatypesを参照してください。）ここでは可能な限り標準ライブラリと正確に同じ機能を、我々独自の名前で定義していくことにしましょう。

ブール型を使用する関数は、Day型と同じように定義することができます。

Definition negb (b:bool) : bool :=
match b with
| true => false
| false => true
end.

Definition andb (b1:bool) (b2:bool) : bool :=
match b1 with
| true => b2
| false => false
end.

Definition orb (b1:bool) (b2:bool) : bool :=
match b1 with
| true => true
| false => b2
end.

後半の二つは、引数を複数持つ関数を定義する方法を示しています。

次の四つの単体テストは、関数orbが取り得るすべての引数についての完全な仕様（真理値表）となっています。

Example test_orb1:  (orb true  false) = true.
Proof. simpl. reflexivity.  Qed.
Example test_orb2:  (orb false false) = false.
Proof. simpl. reflexivity.  Qed.
Example test_orb3:  (orb false true ) = true.
Proof. simpl. reflexivity.  Qed.
Example test_orb4:  (orb true  true ) = true.
Proof. simpl. reflexivity.  Qed.

記述方法について: Coqのコード中にコメントを含める場合には、大括弧を使用してコードと区切ります。この慣習はcoqdocというドキュメント作成ツールでも利用されているのですが、ソース中のコメントをコードから視覚的に分離することができます。CoqソースのHTML版では、コメントはソースとは別のフォントで表示されます。

次にCoqでのちょっとトリッキーな定義（admit）を紹介しましょう。このadmitは、定義や証明にある不完全な部分を「とりあえず今は無いこと」にしてくれるものです。これを次のnandbでの練習問題に使ってみることにしましょう。ここからしばらく、練習問題を解くということはadmitやAdmittedと書かれた部分をちゃんとした定義や証明に書き直す作業になります。

Definition admit {T: Type} : T.  Admitted.

練習問題: ★ (nandb)

次の定義を完成させ、Exampleで記述された確認内容がCoqのチェックをすべて通過することを確認しなさい。

この関数はどちらか、もしくは両方がfalseになったときにtrueを返すものである。

Definition nandb (b1:bool) (b2:bool) : bool :=
(* FILL IN HERE *) admit.

下の定義からAdmitted.を取り去り、代わりに”Proof. simpl. reflexivity. Qed.“で検証できるようなコードを記述しなさい。

Example test_nandb1:               (nandb true false) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb2:               (nandb false false) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb3:               (nandb false true) = true.
(* FILL IN HERE *) Admitted.
Example test_nandb4:               (nandb true true) = false.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (andb3)

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
(* FILL IN HERE *) admit.

Example test_andb31:                 (andb3 true true true) = true.
(* FILL IN HERE *) Admitted.
Example test_andb32:                 (andb3 false true true) = false.
(* FILL IN HERE *) Admitted.
Example test_andb33:                 (andb3 true false true) = false.
(* FILL IN HERE *) Admitted.
Example test_andb34:                 (andb3 true true false) = false.
(* FILL IN HERE *) Admitted.

☐

関数の型

Checkコマンドを使うと、Coqに、指定した式の型を表示させることができます。例えば、（negb true）という式の全体の型はboolである、という具合です。

Check (negb true).

negbのような関数は、それ自身がtrueやfalseと同じように値であると考えることもできます。そのようにとらえた場合の値の型を「関数型」と呼び、以下のように矢印を使った型として表します。

Check negb.

negbの型はbool->boolと書き、「boolからbool」と読み、bool型の引数をとってbool型の戻り値を返す関数と理解することができます。同様に、andbの型はbool -> bool -> boolと書き、「二つのbool型の値を引数としてbool型の値を作成して戻す」と解釈します。

数値

ちょっと技術的な話：Coqは大規模な開発を支援するためにちょっと大げさにも見えるモジュールシステムを提供しています。このコースではこれらはほとんど必要のないものですが、一つだけ有用なものがあります。プログラムの中のいくつかの要素をModule XとEnd Xで囲んでおくと、End X以降の部分から、囲まれた中の定義をX.fooという風に呼び出すことができます。このことは、新しくfooという名前で関数を定義しても問題ないということです。逆に、同じスコープの中では、同じ名前での定義はエラーとなります。という訳で、今回我々はこの機能を使ってnatという型を内部モジュールとして定義します。そうすることで、標準ライブラリの同じ名前の定義を覆い隠してしまわずに済みます。

Module Playground1.

我々がここまでで定義してきた型は「列挙型」の型定義でした。このような型は、有限の要素をすべて列挙することによって定義されます。型を定義するもう一つの方法は、「帰納的な記述」を並べることで要素を記述する方法です。例えば、自然数は（全て並べるわけにはいきませんが）以下のような方法で定義できます。

Inductive nat : Type :=
| O : nat
| S : nat -> nat.

この定義の各句は、以下のように解釈できます。

- Oは自然数である（0（ゼロ）ではなく”O“（オー）であることに注意）

- Sは自然数を引数にとり、別の自然数を生成する「コンストラクタ」である。このことは、nが自然数ならS nも自然数であることを示している。

この定義にして、もう少し詳しく見ていきましょう。

これまでに定義してきた帰納的な型（weekday、nat、boolなど）は、実際には式の集合とでも言うべきものです。natの定義は、natの要素となる式がどのように構築されるかを表しています。

- 式O（オー）は、natに属する。

- もしnがnatに属するならば、S nもまたnatに属する。

- これら二つの方法で表された式のみがnatに属するものの全てである。

これら三つの条件によって、natが帰納的(Inductive)な方法で厳格に定義されています。この定義によって、式O、式S O、式S (S O)、式S (S (S O))...が全てnatに属する式であることが表されています。また同時に、trueやandb true false、S (S false)がnatに属さないことも明確にされています。

こうして定義された自然数natをマターンマッチにかけることで、簡単な関数を書いてみましょう。例えば、一つ前のnatを返す関数は以下のよう書けます。

Definition pred (n : nat) : nat :=
match n with
| O => O
| S n' => n'
end.

この２番目の句は「もしnが何らかのn'を用いてS n'と表せるなら、n'を返す」と読めます。

End Playground1.

Definition minustwo (n : nat) : nat :=
match n with
| O => O
| S O => O
| S (S n') => n'
end.

自然数というのは非常に一般的な型なので、Coqは自然数を扱ったり表したりするときに若干特別な扱いをします。SやOを使った式の代わりに一般的に使われるアラビア数字を使うことができます。実際、Coqは数値を表示する際、デフォルトではアラビア数字を用います。

Check (S (S (S (S O)))).
Eval simpl in (minustwo 4).

natのコンストラクタSは、nat -> nat型の関数でminustwoやpredも同様です。

Check S.
Check pred.
Check minustwo.

これらが表しているのは、いずれの関数も数を引数にとって数を生成できる、ということです。しかしながらこれらの関数には根本的な違いがあります。predやminustwoといった関数には「計算ルール」というものが定義されています。predの定義は、pred nがmatch n with | O => O | S m' => m' endのように簡約されることを記述したものですが、一方Sにはそのような定義がありません。しかし両方とも関数には違いなく、引数を元に評価されるということについては同じで、それ以上のものではないのです。

数値を扱う多くの関数は、単なるパターンマッチだけでは記述できず、再帰的な定義が必要になってきます。例えば、nが偶数かどうかを調べて返す関数evenbは、n-2が偶数であるかどうかを調べる、という再帰的な定義を必要とします。そういう関数を定義する場合、Fixpointというキーワードを使用します。

Fixpoint evenb (n:nat) : bool :=
match n with
| O        => true
| S O      => false
| S (S n') => evenb n'
end.

Coqがこの定義をチェックする際、evenbが再帰的に呼ばれるとき、最初の引数が減少しているかに注目します。これは、ここでいう再帰がnについて構造的再帰（もしくは原始的再帰）であること、つまりnについて常により少ない値で再帰呼び出しを行っているか、ということです。これはevenbが最終的に停止するということを意味しています。CoqはFixpointキーワードで定義される関数が常にこの「減少性」を持つことを要求します。

同じようにFixpointを使って関数oddbを定義することもできますが、ここでは次のようにもっとシンプルな用法で簡単に作ってみましょう。

Definition oddb (n:nat) : bool   :=   negb (evenb n).

Example test_oddb1:    (oddb (S O)) = true.
Proof. simpl. reflexivity.  Qed.
Example test_oddb2:    (oddb (S (S (S (S O))))) = false.
Proof. simpl. reflexivity.  Qed.

当然ながら、引数を複数持つ関数も再帰的に定義することができます。

ネームスペースを汚さないようにするため、別のモジュールに定義することにしましょう。

Module Playground2.

Fixpoint plus (n : nat) (m : nat) : nat :=
match n with
| O => m
| S n' => S (plus n' m)
end.

3に2を加えた結果は、5になるべきですね。

Eval simpl in (plus (S (S (S O))) (S (S O))).

Coqがこの計算をどう進めて（簡約して）結論を導くかは以下のように表現できます。

plus (S (S (S O))) (S (S O))

==>S (plus (S (S O)) (S (S O)))by the second clause of thematch

==>S (S (plus (S O) (S (S O))))by the second clause of thematch

==>S (S (S (plus O (S (S O)))))by the second clause of thematch

==>S (S (S (S (S O))))by the first clause of thematch

表記を簡便にするため、複数の引数が同じ型を持つときは、型の記述をまとめることができます。(n m : nat)は(n : nat) (m : nat)と書いたのとまったく同じ意味になります。

Fixpoint mult (n m : nat) : nat :=
match n with
| O => O
| S n' => plus m (mult n' m)
end.

matchに引数を与える際、複数の引数を次のようにカンマで区切って一度に渡すことができます。

Fixpoint minus (n m:nat) : nat :=
match n, m with
| O   , _    => O
| S _ , O    => n
| S n', S m' => minus n' m'
end.

minusのmatchの行に現れる( _ )は、ワイルドカードパターンと呼ばれるものです。パターンの中に _ を書くと、それはその部分が何であってもマッチし、その値が使用されないことを意味します。この _ は、このような場合に無意味な名前をつける必要をなくしてくれます。

End Playground2.

Fixpoint exp (base power : nat) : nat :=
match power with
| O => S O
| S p => mult base (exp base p)
end.

Example test_mult1:             (mult 3 3) = 9.
Proof. simpl. reflexivity.  Qed.

演習問題: ★ (factorial)

再帰を使用した、一般的なfactorical（階乗）の定義を思い出してください :

factorial(0)  =  1
factorial(n)  =  n * factorial(n-1)     (if n>0)

これをCoqでの定義に書き直しなさい。

Fixpoint factorial (n:nat) : nat :=
(* FILL IN HERE *) admit.

Example test_factorial1:          (factorial 3) = 6.
(* FILL IN HERE *) Admitted.
Example test_factorial2:          (factorial 5) = (mult 10 12).
(* FILL IN HERE *) Admitted.

☐

ここで紹介する”notation”（表記法）という機能を使うことで、加算、減算、乗算のような数値を扱う式をずっと読みやすく、書きやすくすることができます。

Notation "x + y" := (plus x y)  (at level 50, left associativity) : nat_scope.
Notation "x - y" := (minus x y)  (at level 50, left associativity) : nat_scope.
Notation "x * y" := (mult x y)  (at level 40, left associativity) : nat_scope.

Check ((0 + 1) + 1).

これらは、これまで我々が定義してきたものを何ら変えるわけではありません。NotationはCoqのパーサに対してx + yをplus x yと解釈させたり、逆にplus x yをx + yと表記させたりするためのものです。

各表記法のシンボルは、表記法のスコープ内でのみ有効です。Coqはどのスコープであるかを推測しようとします。S(O*O)と書かれていた場合は、それをnat_scopeであると推測しますし、ソースにデカルト積（タプル）型bool*boolと書かれていたら、type_scopeであると推測します。時には(x*y)%natといった風に、%表記を使ってスコープを明示する必要があるでしょうし、どの表記スコープで解釈したかが%natというような形でCoqからフィードバックされてくることもあります。

表記のスコープは、多くの場合数値に適用されます。ですので0%natという表記をO（オー）や0%Z（数値のゼロ）という意味で見ることがあります。

最初の方で、Coqにはほとんど何も用意されていない、という話をしましたが、本当のところ、数値を比較する関数すら自分で作らなければならないのです！!

beq_nat関数は自然数を比較してbool値を返すものです。入れ子になったmatchに気をつけて、以下のソースを読んでください。（二つの変数を一度にmatchさせる場合の書き方は、minusのところですでに登場しています）

Fixpoint beq_nat (n m : nat) : bool :=
match n with
| O => match m with
| O => true
| S m' => false
end
| S n' => match m with
| O => false
| S m' => beq_nat n' m'
end
end.

同様に、ble_nat関数は自然数を比較して小さいか等しい、ということを調べてbool値を生成し返します。

Fixpoint ble_nat (n m : nat) : bool :=
match n with
| O => true
| S n' =>
match m with
| O => false
| S m' => ble_nat n' m'
end
end.

Example test_ble_nat1:             (ble_nat 2 2) = true.
Proof. simpl. reflexivity.  Qed.
Example test_ble_nat2:             (ble_nat 2 4) = true.
Proof. simpl. reflexivity.  Qed.
Example test_ble_nat3:             (ble_nat 4 2) = false.
Proof. simpl. reflexivity.  Qed.

練習問題: ★★ (blt_nat)

blt_nat関数は、自然数を比較して小さい、ということを調べてbool値を生成します（natural numbers forless-than）。Fixpointを使用して１から作成するのではなく、すでにこれまで定義した関数を利用して定義しなさい。

注：simplタクティックを使ってうまくいかない場合は、代わりにcomputeを試してください。それはよりうまく作られたsimplと言えるものですが、そもそもシンプルでエレガントな解が書けていれば、simplで十分に評価できるはずです。

Definition blt_nat (n m : nat) : bool :=
(* FILL IN HERE *) admit.

Example test_blt_nat1:             (blt_nat 2 2) = false.
(* FILL IN HERE *) Admitted.
Example test_blt_nat2:             (blt_nat 2 4) = true.
(* FILL IN HERE *) Admitted.
Example test_blt_nat3:             (blt_nat 4 2) = false.
(* FILL IN HERE *) Admitted.

☐

簡約を用いた証明

ここまでに、いくつかの型や関数を定義してきました。が、ここからは少し目先を変えて、こういった型や関数の特性や振る舞いをどうやって知り、証明していくかを考えてみることにしましょう。実際には、すでにこれまでやってきたことでも、その一部に触れています。。例えば、前のセクションのExampleは、ある関数にある特定の値を入力した時の振る舞いについて、あらかじめ想定していたものと正確に一致していると主張してくれます。それらの主張が証明しているものは、以下のものと同じです。

=の両側の式を定義に基づいて簡約した結果は、一致している。

このような「簡約を用いた証明」は、関数のさらに興味深い性質をうまく証明することができます。例えば、0が自然数の加算における左単位元（0が、左から加えても値が変わらない値であること）であることの証明は、nが何であっても0 + nを注意深く縮小(簡約)したものがnになることを、+という関数が「最初の引数を引き継いで再帰的に定義されている」ということを考慮した上で示せればいいということです。

Theorem plus_O_n : forall n:nat, 0 + n = n.
Proof.
simpl. reflexivity.  Qed.

reflexivityコマンドは暗黙的に＝の両辺を簡約してから等しいかどうかを調べてくれます。そのため、上の証明はもう少し短くすることができます。

実際、reflexivityはsimplよりいくぶん多くのことをやってくれるので、覚えておくと後々便利でしょう。例えば、reflexivityは定義された句を展開したり、右辺と置き換えるといったことを試みます。この違いから、reflexivityが向いているのは、「reflexivityによって全てのゴールが自動的に証明され、reflexivityが見つけて展開した式をあえて見なくてもよい」という場合で、逆にsimplは、我々自身が新しいゴールを読んで理解すべき時（勝手に定義を展開し解釈して欲しくない時）に向いているということになります。

Theorem plus_O_n' : forall n:nat, 0 + n = n.
Proof.
reflexivity.  Qed.

この定理と証明の様式は、以前示した例とほとんど同じですが、唯一の違いは、量化子が加えられている（forall n:nat）ことと、Exampleの代わりにTheoremキーワードが使用されていることです。後者の違いは単なるスタイルの違いで、ExampleとTheorem（他にもLemma、Fact、Remarkなど）はCoqから見るとすべて同じ意味を持ちます。

simplやreflexivityはタクティックの例です。タクティックは、ProofとQedの間に記述され、Coqに対して、我々がしようとしている主張の正当性をどのようにチェックすべきかを指示するためのコマンドです。この講義の残りでは、まだ出てきていないタクティックのうちのいくつかを紹介していきましょう。さらにその後の講義ではもっと色々出てくるのですが。

この問い合わせの結果、Coqが返す応答はなにか？

Eval simpl in (forall n:nat, n + 0 = n).

また次のものの場合はどうか？

Eval simpl in (forall n:nat, 0 + n = n).

この二つの違いを示せ。☐

introsタクティック

単体テストの際には対象の関数に対して特定の引数を渡すわけですが、プログラムの証明を行う上で注意を払うべきポイントは、それが量化子（任意のnについて、など）や仮定（m=nと仮定すると）で始まるか、ということです。そのような状況で求められるのは「仮定をたてて証明できる」ことです。例えば「よし、nを任意の数値としよう」「よし、仮にm=nと仮定してみよう」といった具合です。

introsタクティックは、このようなことを量化子や仮定をゴールから前提条件にき上げることで実現してくれます。

例えば、以下は同じ定理を少し異なるやり方で証明したものです。

Theorem plus_O_n'' : forall n:nat, 0 + n = n.
Proof.
intros n. reflexivity.  Qed.

次の証明をCoq上で逐次実行し、どのように状況が変化してゴールが導かれるのかをよく観察してください。

Theorem plus_1_l : forall n:nat, 1 + n = S n.
Proof.
intros n. reflexivity.  Qed.

Theorem mult_0_l : forall n:nat, 0 * n = 0.
Proof.
intros n. reflexivity.  Qed.

定理の名前についている_lという接尾辞は、「左の」と読みます。

書き換え（Rewriting）による証明

少しばかり興味深い定理を見てみましょう。

Theorem plus_id_example : forall n m:nat,
n = m ->
n + n = m + m.

この定理は、あらゆるnやmについて完全に成り立つと言っているわけではなく、n = mが成り立つときに限って成立する、というもので、この矢印は”ならば”と一般的に読みます。

nとmが両方とも任意の数なのですから、これをこれまでの証明でやってきたように簡約することはできません。その代わりに、n = mならば、イコールの両側のnやmを互いに書き換えても等しさは変わらない、というところに注目します。このような書き換えをしてくれるのがrewriteタクティックです。

Proof.
intros n m.
intros H.
rewrite -> H.
reflexivity.  Qed.

証明の1行目は、∀（forall）がついた、つまり「あらゆるn,mについて」の部分をコンテキストに移しています。2行目は、n = mならば、という仮定をコンテキストに写し、Hという名前をこれに与えています。3行目は、ゴールになっている式(n + n = m + m)に仮定Hの左側を右側にするような書き換えを施しています。

（rewriteの矢印は特に論理に関与していません。単に左側を右側に置き換えているだけです。逆に右側を左側に置き換えたい場合は、rewrite <-と書くこともできます。この逆の置き換えも上の証明で試して、Coqの振る舞いがどのように変わるかを観察してください。）

Admitted.を削除し、証明を完成させなさい。

Theorem plus_id_exercise : forall n m o : nat,
n = m -> m = o -> n + m = m + o.
Proof.
(* FILL IN HERE *) Admitted.

☐

Admittedコマンドは、Coqに対して「この証明はあきらめたので、この定理はこれでいいことにしてください」と指示するものです。この機能は、より長い証明をする際に便利です。何か大きな論証をしようとする時、今のところ信用している補足的な命題を示したい時があります。そんな時、Admittedを使用すると、その命題を一時的に信用できることにして、それを踏み台にしてより大きな論証を進めることができるのです。そしてそれが完成したのち、あらためて保留していた命題の証明を埋めればいいのです。ただし注意して下さい。admitやAdmittedを使用することは、一時的にドアを開けて、「全て形式的なチェックを受け証明済みの、信用するに足るCoqの世界」から、信用に値しない下界へ足を踏み出していることに他なりません。いつかは戻ってドアを閉めることがお約束です。

仮定の代わりに、前もって証明された定理を使ってもrewriteタクティックは同じように利用することができます。

Theorem mult_0_plus : forall n m : nat,
(0 + n) * m = n * m.
Proof.
intros n m.
rewrite -> plus_O_n.
reflexivity.  Qed.

Theorem mult_1_plus : forall n m : nat,
(1 + n) * m = m + (n * m).
Proof.
(* FILL IN HERE *) Admitted.

☐

Case分析

もちろん、どんな命題でも簡単な計算だけで証明できるという訳ではありません。一般に、未知だったり仮定の（任意のbool、自然数、リストなど）値は、我々が検証しようとしている関数の先頭に記述され、それが簡約の邪魔をしてくれます。例えば、下のような命題をsimplタクティックだけで証明しようとすると、すぐに行き詰まってしまうでしょう。

Theorem plus_1_neq_0_firsttry : forall n : nat,
beq_nat (n + 1) 0 = false.
Proof.
intros n. simpl.
Admitted.

その原因は、beq_natと+の定義で、共に最初の引数がmatchに渡されていることです。つまり、+に渡す最初の引数はnという未知数な上に、beq_natの引数はn + 1という複合式になっているため、そのまま簡約できないのです。

今求められていることは、nを何らかの条件に分割し、先に進めそうな形にすることができないかを検討することです。もしnがOなら、beq_nat (n + 1) 0の結果を得ることはできます。もちろん結果はfalseです。しかしもしnが何かのn'を使ってn = S n'と表せると考えても、我々はn + 1の値を得ることはできません。ただ、その式が一つのSで始まる（始まらないものはOにマッチする）ことに着目すると、beq_natの結果を計算して値を求めることができます。その結果結果beq_nat (n + 1) 0は、やはりfalseになるでしょう。

このことから、求められるタクティックはCoqにn = Oの場合とn = S n'の場合に分けて考えるように求めるようなもので、これを実現するのがdestructタクティックです。

Theorem plus_1_neq_0 : forall n : nat,
beq_nat (n + 1) 0 = false.
Proof.
intros n. destruct n as [| n'].
reflexivity.
reflexivity.  Qed.

destructタクティックは二つのサブゴールを作ります。その両方を別々に、Coqを使って定理として証明していくことになります。一つのサブゴールからもう一つへ移動するための特別なコマンドは必要ありません。一つ目のサブゴールが証明されれば、それは消えて自動的にもう一つのサブゴールにフォーカスが移ります。この証明では、二つに分かれたサブゴールのいずれもreflexivityを1回使うだけで簡単に証明できます。

destructについている注釈”as [| n']”は、”イントロパターン”と呼ばれるものです。これはCoqに対して、両方のサブゴールに元nだった変数をどのような変数名を使って取り入れるかを指示するものです。一般的に[]の間にあるものは”名前のリスト”で、”|“によって区切られます。このリストの最初の要素は空ですが、これはnatの最初のコンストラクタであるOが引数をとらないからです。二つ目のコンストラクタSは引数を一つ取りますので、リストの二つ目の要素であるn'を名前に使用します。

destructタクティックは帰納的に定義された型に対して使用できます。例えば、bool値の否定が反射的であること・・・つまり否定の否定が元と同じになることを証明してみましょう。

Theorem negb_involutive : forall b : bool,
negb (negb b) = b.
Proof.
intros b. destruct b.
reflexivity.
reflexivity.  Qed.

ここで使われているdestructにはas句がありませんが、ここで展開しているbの型boolの二つのコンストラクタが両方とも引数をとらないため、名前を指定する必要がないのです。このような場合、”as [|]”や”as []”のように書くこともできます。実際のところほとんどの場合destructのas句は省略可能です。その際はCoqの側で自動的に変数名をつけてくれます。これは確かに便利なのですが、よくない書き方とも言えます。Coqはしばしば名前付けに混乱して望ましくない結果を出す場合があります。

Theorem zero_nbeq_plus_1 : forall n : nat,
beq_nat 0 (n + 1) = false.
Proof.
(* FILL IN HERE *) Admitted.

☐

Caseへのネーミング

caseのサブゴールからサブゴールへ明示的に移動するためのコマンドがないことは、証明の過程と結果を表すスクリプトを読みにくくしていることも事実です。さらに大掛かりな証明では、caseの分析も階層化し、Coqを使って証明を進めていくことが苦痛に感じられるかもしれません（あるCaseが五つのサブゴールを持ち、残りの七つのCaseも他のCaseの内部にあるような状況を想像してみてください･･･）。インデントやコメントを上手に使うと多少は改善しますが、最もよい解決方法は”Case“タクティックを定義して使用することです。

CaseタクティックはCoqにビルトインされていませんので、自分で定義する必要があります。それがどのような仕組みで動いているかを理解する必要はありませんので、ここでは定義は跳ばして使用例から見ていくことにします。このサンプルは、Coqの機能のうちまだ解説していないstringライブラリとLtacコマンドを使用します。これらはカスタムタクティックを定義するときに使うもので、Aaron Bohannon の業績によるものです。

Require String. Open Scope string_scope.

Ltac move_to_top x :=
match reverse goal with
| H : _ |- _ => try move x after H
end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
let H := fresh in
assert (x = v) as H by reflexivity;
clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
first [
set (x := name); move_to_top x
| assert_eq x name; move_to_top x
| fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

以下はCaseをどのように使うかのサンプルです。証明を順次実行して、コンテキストがどのように変わっていくかを観察しなさい。

Theorem andb_true_elim1 : forall b c : bool,
andb b c = true -> b = true.
Proof.
intros b c H.
destruct b.
Case "b = true".
reflexivity.
Case "b = false".
rewrite <- H. reflexivity.  Qed.

Caseが行っていることは実はとても簡単です。Caseは、続けて指定されたタグ名を、今証明しようとしているゴールへのコンテキストに文字列として追加しているだけなのです。証明がサブゴールに到達し、証明されると、次のトップレベル（今しがた解決したゴールと兄弟関係にある）ゴールがアクティブになります。するとさっきCaseで指定した文字列がすでに証明を終えたcaseとしてコンテキストに現れます。これは健全性のチェックにもなります。もし今の証明が完了しておらず、コンテキストに残ったまま次のCaseタックティクを実行すると、エラーメッセージが表示されます。

ネストしたcaseの分析（今destructで解決しようとしているゴール自体が、他のdestructの産物であるような場合）のために、SCase(“subcase”)が用意されています。

destructを使い、case（もしくはsubcase）を作成して、以下の証明andb_true_elim2を完成させなさい。

Theorem andb_true_elim2 : forall b c : bool,
andb b c = true -> c = true.
Proof.
(* FILL IN HERE *) Admitted.

☐

Coq上に証明の経過を記述する際、それをどのようにフォーマットするべきか、ということについてちゃんとしたルールというものはありません。行が分割され、証明の各段階が階層を持ち、それをインデントで表現するような場合は特にそうです。しかしながら、複数のサブゴールが作成された部分が明示的にCaseタクティックでマークされた場合は、それを行頭から記述することにします。そうしておけば、証明は読みやすくなり、それ以外でどんな方針のレイアウトが選ばれても、あまり問題になりません。

ここで、１行の長さをどれくらいにしておくべきか、ということにも触れておきましょう。始めたばかりのCoqユーザーは、証明全体を１行に収めようと、複数のタクティックを同じ行に書き、非常に長い行を書いてしまいがちです。よいスタイルというものは「ほどほど」のところにあります。特にあげるなら、一連の流れを１行に書くにしても1行80字程度にとどめておくべきでしょう。これ以上長くなると読むのも大変になりますし、印刷や画面表示もうまくいかない場合が多くなります。多くのエディタがこのような制限をかける機能を持っていますのでそれを使ってもいいでしょう。

帰納法

我々は以前、0が加法+の左単位元（左から加えても値が値が変わらない値）であることを引数を分解し評価することで証明しました。右から加える場合でも同じように証明できるのでしょうか？

Theorem plus_0_r_firsttry : forall n:nat,
n + 0 = n.

･･･同じぐらい簡単、というわけにはいかないようです。reflexivityを使ってみても同じです。n + 0のnは任意の未知数であり、+の定義にあるmatchのせいで簡約できません。destruct nを使い、caseごとに推論するのも難しそうです。caseごとに考えるとn = 0のときはうまくいきますが、n = S n'のほうではn'で同じように詰まってしまいます。destruct n'でさらに一歩踏み込んでみたところで、nは任意の大きい数のまま動きません。どうやらまだ来たことがないところに迷い込んでしまったようです。

Proof.
intros n.
simpl.
Admitted.

Caseによる解析は少しだけうまくいきそうに思えますが、やはり行き詰まります。

Theorem plus_0_r_secondtry : forall n:nat,
n + 0 = n.
Proof.
intros n. destruct n as [| n'].
Case "n = 0".
reflexivity.
Case "n = S n'".
simpl.
Admitted.

このような命題を証明する場合 － 実際、数値やリストや、その他の帰納的な定義を持つ型にまつわる証明の多くはそうなのですが － もっとずっと強力な推論規則が必要になります。それが「帰納法」です。

高校で習った帰納法の仕組みを思い出して、自然数を考えてみましょう。もしP(n)が自然数nに対する命題であるとすると、Pがどんなnに対しても成り立つことは、以下のような方法で証明できます。

- P(O)が成り立つことを示す;

- どんなn'に対しても、もしP(n')が成り立つならP(S n')も成り立つことを示す;

- これによって、P(n)がどんなnでも成り立つと結論される

Coqでは、それぞれのステップは同じですが順序は逆向きに考えます。まず、ゴールの証明である「任意のnについてP(n)が成り立つ」からはじめ、それを二つの独立したサブゴールに分割します（ここでinductionタクティックを使います）。その結果、一つ目のサブゴールはP(O)、二つ目はP(n') -> P(S n')となるはずです。以下は、実際にinductionタクティックが先ほど証明しようとしていた定理にどう作用するかを示したものです。

Theorem plus_0_r : forall n:nat, n + 0 = n.
Proof.
intros n. induction n as [| n'].
Case "n = 0".     reflexivity.
Case "n = S n'".  simpl. rewrite -> IHn'. reflexivity.  Qed.

destructのように、inductionタクティックもas...句を取り、サブゴールに導入する際の変数の名前を指定することができます。最初のブランチではnは0に置き換えられ、ゴールは0 + 0 = 0となり、簡約できる状態になります。二つ目のブランチでは、nはS n'に置き換えられ、n' + 0 = n'が前提としてコンテキストに付け加えられます。（この際、仮定にIHn'という名前がつけられます。これは「Induction Hypothesys forn'（n’についての帰納法の仮定）」というような意味です。二番目のゴールは(S n') + 0 = S n'となり、S (n' + 0) = S n'に簡約されます。ここから、帰納法の仮定n' + 0 = n'を使って証明の残りを完成させます。

Theorem minus_diag : forall n,
minus n n = 0.
Proof.

intros n. induction n as [| n'].
Case "n = 0".
simpl. reflexivity.
Case "n = S n'".
simpl. rewrite -> IHn'. reflexivity.  Qed.

Theorem mult_0_r : forall n:nat,
n * 0 = 0.
Proof.
(* FILL IN HERE *) Admitted.

Theorem plus_n_Sm : forall n m : nat,
S (n + m) = n + (S m).
Proof.
(* FILL IN HERE *) Admitted.

Theorem plus_comm : forall n m : nat,
n + m = m + n.
Proof.
(* FILL IN HERE *) Admitted.

☐

Fixpoint double (n:nat) :=
match n with
| O => O
| S n' => S (S (double n'))
end.

Lemma double_plus : forall n, double n = n + n .
Proof.
(* FILL IN HERE *) Admitted.

FILL IN HERE ☐

destructとinductionの違いを短く説明しなさい。

(* FILL IN HERE *)

☐

形式的証明と非形式的証明

“非形式的な証明はアルゴリズムであり、形式的な証明はコードである”

数学的に厳格な証明を構成するとはどういうことなのか、という問題は、千年もの間哲学者を悩ませてきました。しかし少々雑な定義でよければ次のように書くこともができます。数学的な命題Pの証明とは、それを読む（あるいは聞く）人をして、Pがtrueであることを納得せしめる文章を書く（語る）ことである、と。このことから、証明はコミュニケーション行為であると言えるでしょう。

さて、このコミュニケーションの相手は、二種類に分けることができます。一方は、Coqのプログラムのように振る舞うような場合で、このケースでの「信用に値する」というのは、Pが形式的論理のルールに基づく確実な論理から導かれたもので、その証明が、このチェックを行うプログラムをガイドする秘訣になっているようなものです。そんな秘訣が「形式的証明」です。

一方、読者が人間的な存在で、証明が英語などの自然言語で書かれているようなケースは「非形式的証明」であると言えます。こんなケースでの成功の条件は「あまりきちんと明示しないこと」です。とにかく、読んでいる人に納得させてしまえる証明こそが「よい証明」なのです。しかしひとつの証明を複数の読者が見るような場合、ある論点について、ある人は特定の言い回しによって核心に至るかもしれませんが、人によってはそうではないかもしれません。もっと極端な人は、ただ知ったかぶりをする割りに経験は浅い、単なる「頭でっかち」であるかもしれません。そういった人たちを押しなべて納得させる唯一の方法は、ただ骨身を惜しまず細かいところまで論じることなのです。逆にある読者はこういったことに精通しているあまり、細かいことにこだわりすぎて全体的な流れを見失う、ということもあります。多くの人が望んでいることは総論としてどうなのか、ということを知ることで、細かいことを考えていくことは面倒なものです。結局のところ、非形式的な証明でみんなを納得させる標準的な方法はなさそうです。なぜなら、非形式的な書き方で想定される読者全員を納得させる方法はないからです。しかし実際のところ、数学者は複雑な数学的事柄についてたくさんの表記規則のおかげで、証明が正しいか否かを判断するための標準的かつ公正な方法がもたらされたのです。

我々はこのコースでCoqを使用しているのですから、それだけできちんと形式化された証明に乗っていると言えます。しかしこのことは、非形式的な表現を無視していい、ということではありません。形式的証明は多くの場合有効ですが、人と人との間で考えを伝えあう際には必ずしも効率的とは言えないものです。

例えば、下の例は加法が結合的であることを示すものです。

Theorem plus_assoc' : forall n m p : nat,
n + (m + p) = (n + m) + p.
Proof. intros n m p. induction n as [| n']. reflexivity.
simpl. rewrite -> IHn'. reflexivity.  Qed.

Coqはこのような証明を完璧にこなしてくれますが、上の証明は人間にとってはいささかのみこみにくいと言わざるを得ません。もしあなたがCoqに十分慣れていて、タクティックを次々と適用しながら証明を進めていき、コンテキストやゴールがどう変化していくかを頭の中だけでイメージしていくことができるようなレベルの人でも、上の証明はかなり複雑で、ほとんど理解不能に思えるかもしれません。それを横目に、数学者はサラサラとこんな風に書くでしょう。

- 定理：任意のn,m,pについて、以下が成り立つ

n + (m + p) = (n + m) + p.

証明：nについて帰納法を適用する。

- まずn = 0と置くと、以下のようになる

0 + (m + p) = (0 + m) + p.

これは、+の定義から直接導くことができる。

- 次にn = S n'と置き、帰納法の仮定を

n' + (m + p) = (n' + m) + p.

とすると、以下のような式が立つ。

(S n') + (m + p) = ((S n') + m) + p.

ここで、+の定義より、以下のように変形できる。

S (n' + (m + p)) = S ((n' + m) + p),

これは、直後の値について帰納法の仮定が成り立つことを示している。☐

どちらの表現も、やっていることは基本的に同じことです。これはもちろん偶然ではなく、Coqのinductionタクティックが、数学者が考えるのと同じ目標を、同じサブゴールとして、同じ順番で作成するように作られているだけです。しかしこの二つをよく見ると、重要な違いがあります。形式的証明は、ある部分（reflexivityを使っている部分など）ではより明示的ですが、それ以外のところはあまり明示的ではありません。特にあるポイントにおける証明の状態が、Coqの証明では明示されていません。一方、非形式的証明は、途中で何度も「今どのあたりで、どのようになっているか」を思い出させてくれるような書き方になっています。

形式的証明も、以下のように書けば構造が分かりすくなります。

Theorem plus_assoc : forall n m p : nat,
n + (m + p) = (n + m) + p.
Proof.
intros n m p. induction n as [| n'].
Case "n = 0".
reflexivity.
Case "n = S n'".
simpl. rewrite -> IHn'. reflexivity.   Qed.

FILL IN HERE FILL IN HERE ##### 練習問題: ★★ (plus_comm_informal)

plus_commの証明を、非形式的な証明に書き換えなさい。

定理：加法は可換である。

Proof:(* FILL IN HERE *)☐

次の証明を、plus_assocの非形式的な証明を参考に書き換えなさい。Coqのタクティックを単に言い換えただけにならないように！

定理：true=beq_nat n n forany n.（任意のnについて、nはnと等しいという命題がtrueとなる）

Proof:(* FILL IN HERE *)☐

Theorem beq_nat_refl : forall n : nat,
true = beq_nat n n.
Proof.
(* FILL IN HERE *) Admitted.

☐

証明の中で行う証明

Coqでは（非形式的な数学と同様に）大きな証明は高い頻度で、後に出てきた証明が前に出ている証明を参照するような定理の列に分割されます。しかし時折、証明がいくつかの自明で雑他な事実を必要とし、それがまたトップレベルの名前をつけるほどでもなかったりします。こういう場合、状態を単純化し、すでに使われている定理の右に出現するサブ定理を証明することができれば便利です。assertタクティックはこれを可能にしてくれます。例えば、最初の方でやった証明mult_0_plusは、plus_O_nと名付けられた定理の証明から参照されています。assertを使うとplus_O_nの証明をこんな風に行うことができます。

Theorem mult_0_plus' : forall n m : nat,
(0 + n) * m = n * m.
Proof.
intros n m.
assert (H: 0 + n = n).
Case "Proof of assertion". reflexivity.
rewrite -> H.
reflexivity.  Qed.

assertタクティックは、二つのサブゴールを取り込みます。最初のものはH:という接頭辞をつけているように、それ自身を主張するもので、AssertionHと呼びます。（まず注意が必要なのは、上で使用したdestructやinductionにas句をつけることで、assert (0 + n = n) as Hというようにassertionに名前をつけられることです。もう一つ、証明に出てくるassertionに、Caseを使ってマーキングしている事も注目です。その理由は、読みやすさのため、というだけでなく、例えばCoqをインタラクティブに使っているとき、証明を進めている間にコンテキストから"Proof of assertion"という文字列が消える瞬間を観察することで、証明の完了を知ることができます。）二つ目のゴールは、assertを呼び出した場合と、コンテキストに0 + n = n:Hという仮定が得られることを除けば同じです。このことから、assertは、我々が証明しなければならない事実そのものとなるサブゴールと、その最初のサブゴールの証明がどのような値でも成り立つことを使って証明される事実となる二つ目のサブゴールを作成することが分かります。

実際assertは多くのシチュエーションで便利に使えるでしょう。例えば、[(n + m)+ (p + q) = (m + n) + (p + q)]であることを証明するとしましょう。=の両側で異なるのは最初のカッコの中の+の両側のnとmが入れ替わっているだけで、このことは加法の交換法則(plus_comm）があるものを別のものに書き換えることに使用できることを示しています。しかしながら、rewriteタクティックは「どこに適用するか」を考える必要がある場合には少々おばかさんです。ここでは+が3箇所で使われていますがrewrite -> plus_commは一番外側（つまり中央）の+にしか適用されません。

Theorem plus_rearrange_firsttry : forall n m p q : nat,
(n + m) + (p + q) = (m + n) + (p + q).
Proof.
intros n m p q.

rewrite -> plus_comm.

Admitted.

plus_commを、適用したいポイントに対して使用するには、まずn + m = m + nで始まるような補助定理（ここでは何とかしようとしているmとnを特定するため）を導き、それを望むrewriteに使用します。

Theorem plus_rearrange : forall n m p q : nat,
(n + m) + (p + q) = (m + n) + (p + q).
Proof.
intros n m p q.
assert (H: n + m = m + n).
Case "Proof of assertion".
rewrite -> plus_comm. reflexivity.
rewrite -> H. reflexivity.  Qed.

assertを使用して以下の証明を完成させなさい。ただしinduction（帰納法）を使用しないこと。

Theorem plus_swap : forall n m p : nat,
n + (m + p) = m + (n + p).
Proof.
(* FILL IN HERE *) Admitted.

では、乗法が可換であることを証明しましょう。おそらく、補助的な定理を定義し、それを使って全体を証明することになると思います。先ほど証明したplus_swapが便利に使えるでしょう。

Theorem mult_comm : forall m n : nat,
m * n = n * m.
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem evenb_n__oddb_Sn : forall n : nat,
evenb n = negb (evenb (S n)).
Proof.
(* FILL IN HERE *) Admitted.

☐

さらなる練習問題

紙を何枚か用意して、下に続く定理が(a)簡約と書き換えだけで証明可能か、(b)destructを使ったcase分割が必要になるか、(c)帰納法が必要となるか、のいずれに属すかを、紙の上だけで考えなさい。予測を紙に書いたら、実際に証明を完成させなさい。証明にはCoqを用いてかまいません。最初に紙を使ったのは「初心忘れるべからず」といった理由です。

Theorem ble_nat_refl : forall n:nat,
true = ble_nat n n.
Proof.
(* FILL IN HERE *) Admitted.

Theorem zero_nbeq_S : forall n:nat,
beq_nat 0 (S n) = false.
Proof.
(* FILL IN HERE *) Admitted.

Theorem andb_false_r : forall b : bool,
andb b false = false.
Proof.
(* FILL IN HERE *) Admitted.

Theorem plus_ble_compat_l : forall n m p : nat,
ble_nat n m = true -> ble_nat (p + n) (p + m) = true.
Proof.
(* FILL IN HERE *) Admitted.

Theorem S_nbeq_0 : forall n:nat,
beq_nat (S n) 0 = false.
Proof.
(* FILL IN HERE *) Admitted.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
(* FILL IN HERE *) Admitted.

Theorem all3_spec : forall b c : bool,
orb
(andb b c)
(orb (negb b)
(negb c))
= true.
Proof.
(* FILL IN HERE *) Admitted.

Theorem mult_plus_distr_r : forall n m p : nat,
(n + m) * p = (n * p) + (m * p).
Proof.
(* FILL IN HERE *) Admitted.

Theorem mult_assoc : forall n m p : nat,
n * (m * p) = (n * m) * p.
Proof.
(* FILL IN HERE *) Admitted.

☐

replaceタクティックは、特定のサブタームを置き換えたいものと置き換えることができます。もう少し正確に言うと、replace (t) with (u)は、ゴールにあるtという式を全てuにかきかえ、t = uというサブゴールを追加します。この機能は、通常のrewriteがゴールの思い通りの場所に作用してくれない場合に有効です。

replaceタクティックを使用してplus_swap'の証明をしなさい。ただしplus_swapのようにassert (n + m = m + n)を使用しないで証明を完成させなさい。

Theorem plus_swap' : forall n m p : nat,
n + (m + p) = m + (n + p).
Proof.
(* FILL IN HERE *) Admitted.

☐

これまでとは異なる、通常表記の自然数ではなく2進のシステムで、自然数のより効率的な表現を考えなさい。それは自然数をゼロとゼロに1を加える加算器からなるものを定義する代わりに、以下のような2進の形で表すものです。2進数とは、

- ゼロであるか,

- 2進数を2倍したものか,

- 2進数を2倍したものに1を加えたもの.

1. まず、以下のnatの定義に対応するような2進型binの帰納的な定義を完成させなさい。(ヒント:nat型の定義を思い出してください。

Inductive nat : Type :=
| O : nat
| S : nat -> nat.

nat型の定義OやSの意味が何かを語るものではなく、（Oが実際に何であろうが）Oがnatであって、nがnatならSが何であろうとS nはnatである、ということを示しているだけです。「Oがゼロで、Sは1を加える」という実装がそれを自然数としてみて実際に関数を書き、実行したり証明したりしてみてはじめて実際に意識されます。ここで定義するbinも同様で、次に書く関数が書かれてはじめて型binに実際の数学的な意味が与えられます。)

2. 先に定義したbin型の値をインクリメントする関数を作成しなさい。また、bin型をnat型に変換する関数も作成しなさい。

3. 最後にbで作成したインクリメント関数と、2進→自然数関数が可換であることを証明しなさい。これを証明するには、bin値をまずインクリメントしたものを自然数に変換したものが、先に自然数変換した後にインクリメントしたものの値と等しいことを証明すればよい。

(* FILL IN HERE *)

☐

この練習問題は前の問題の続きで、2進数に関するものである。前の問題で作成された定義や定理をここで用いてもよい。

1. まず自然数を2進数に変換する関数を書きなさい。そして「任意の自然数からスタートし、それを2進数にコンバートし、それをさらに自然数にコンバートすると、スタート時の自然数に戻ることを証明しなさい。

2. あなたはきっと、逆方向についての証明をしたほうがいいのでは、と考えているでしょう。それは、任意の2進数から始まり、それを自然数にコンバートしてから、また2進数にコンバートし直したものが、元の自然数と一致する、という証明です。しかしながら、この結果はtrueにはなりません。！！その原因を説明しなさい。

3. 2進数を引数として取り、それを一度自然数に変換した後、また2進数に変換したものを返すnormalize関数を作成し、証明しなさい。

(* FILL IN HERE *)

各関数の引数のいくつかが”減少的”でなければならない、という要求仕様は、Coqのデザインにおいて基礎となっているものです。特に、そのことによって、Coq上で作成された関数が、どんな入力を与えられても必ずいつか終了する、ということが保障されています。しかし、Coqの”減少的な解析”が「とても洗練されているとまではいえない」ため、時には不自然な書き方で関数を定義しなければならない、ということもあります。

これを具体的に感じるため、Fixpointで定義された、より「微妙な」関数の書き方を考えてみましょう（自然数に関する簡単な関数でかまいません）。それが全ての入力で停止することと、Coqがそれを、この制限のため受け入れてくれないことを確認しなさい。

(* FILL IN HERE *)

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Lists_J: 直積、リスト、オプション

次の行を実行すると、前章の定義を一度にインポートすることができます。

Require Export Basics_J.

ただしこれを使うには、coqcを使ってBasics_J.vをコンパイルし、Basics_J.voを作成しておく必要があります。（これは、 .java ファイルから .class ファイルを作ったり、 .c ファイルから .o ファイルを作ったりするのと同じことです。）

コードをコンパイルする方法はふたつあります。

- CoqIDE:Basics_J.v を開き、 “Compile” メニューの “Compile Buffer” をクリックする。

- コマンドライン:coqc Basics_J.vを実行する。

このファイルでもModule機能を使って数のリストやペアの定義を囲んでおきます。こうしておくことで、同じ操作を改良した（一般化した）ものに同じ名前をつけることができます。

Module NatList.

数のペア

Inductiveによる型定義では、各構成子は任意の個数の引数を取ることができました。trueやOのように引数のないもの、Sのようにひとつのもの、また、ふたつ以上の取るものも以下のように定義することができます。

Inductive natprod : Type :=
pair : nat -> nat -> natprod.

この定義は以下のように読めます。すなわち、「数のペアを構成する方法がただひとつある。それは、構成子pairをnat型のふたつの引数に適用することである」。

次に示すのは二引数の構成子に対してパターンマッチをする簡単な関数の定義です。

Definition fst (p : natprod) : nat :=
match p with
| pair x y => x
end.
Definition snd (p : natprod) : nat :=
match p with
| pair x y => y
end.

ペアはよく使うものなので、pair x yではなく、数学の標準的な記法で(x, y)と書けるとよいでしょう。このような記法を使うためにはNotation宣言を使います。

Notation "( x , y )" := (pair x y).

こうして定義した新しい記法（notation）は、式だけでなくパターンマッチに使うこともできます。（実際には、前章でも見たように、この記法は標準ライブラリの一部として提供されています。）

Eval simpl in (fst (3,4)).

Definition fst' (p : natprod) : nat :=
match p with
| (x,y) => x
end.
Definition snd' (p : natprod) : nat :=
match p with
| (x,y) => y
end.

Definition swap_pair (p : natprod) : natprod :=
match p with
| (x,y) => (y,x)
end.

それでは、数のペアに関する簡単な事実をいくつか証明してみましょう。補題を一定の（一種独特な）形式で書いておけば、単に reflexivity（と組み込みの簡約）だけで証明することができます。

Theorem surjective_pairing' : forall (n m : nat),
(n,m) = (fst (n,m), snd (n,m)).
Proof.
reflexivity.  Qed.

しかし、補題を以下のようにより自然な書き方をした場合は、反射律では足りません。

Theorem surjective_pairing_stuck : forall (p : natprod),
p = (fst p, snd p).
Proof.
simpl.
Admitted.

simplでfstやsndの中のパターンマッチを実行できるよう、pの構造を明らかにする必要があります。これにはdestructを使います。

natの場合と異なり、destructでサブゴールが増えることはありません。これは、natprodの構成法がひとつしかないからです。

Theorem surjective_pairing : forall (p : natprod),
p = (fst p, snd p).
Proof.
intros p.  destruct p as (n,m).  simpl.  reflexivity.  Qed.

先ほど宣言した記法を “as...” パターンで束縛する変数を指定するために使っています。

練習問題: ★ (snd_fst_is_swap)

Theorem snd_fst_is_swap : forall (p : natprod),
(snd p, fst p) = swap_pair p.
Proof.
(* FILL IN HERE *) Admitted.

☐

数のリスト

ペアの定義を少し一般化すると、数のリストは次のように表すことができます。すなわち、「リストは、空のリストであるか、または数と他のリストをペアにしたものである」。

Inductive natlist : Type :=
| nil : natlist
| cons : nat -> natlist -> natlist.

たとえば、次の定義は要素が三つのリストです

Definition l_123 := cons 1 (cons 2 (cons 3 nil)).

ペアの場合と同じく、リストをプログラミング言語で馴染んだ記法で書くことができると便利でしょう。次のふたつの宣言では::を中置のcons演算子として使えるようにし、角括弧をリストを構成するための外置（outfix）記法として使えるようにしています。

Notation "x :: l" := (cons x l) (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y nil) ..).

この宣言を完全に理解する必要はありませんが、興味のある読者のために簡単に説明しておきます。

right associativityアノテーションは複数の::を使った式にどのように括弧を付けるか指示するものです。例えば、次のみっつの宣言はすべて同じ意味に解釈されます。

Definition l_123'   := 1 :: (2 :: (3 :: nil)).
Definition l_123''  := 1 :: 2 :: 3 :: nil.
Definition l_123''' := [1,2,3].

at level 60の部分は::を他の中置演算子といっしょに使っている式にどのように括弧を付けるかを指示するものです。例えば、+をplusに対する level 50 の中置記法として定義したので、

Notation "x + y" := (plus x y)
(at level 50, left associativity).

+は::よりも強く結合し、1 + 2 :: [3] は期待通り、1 + (2 :: [3)] ではなく(1 + 2) :: [3] と構文解析されます。

（ところで、 .v ファイルを読んでいるときには “1 + 2 :: [3]” のような書き方は少し読みにくいように感じるでしょう。内側の 3 の左右の角括弧はリストを表すものですが、外側の括弧は coqdoc 用の命令で、角括弧内の部分をそのままのテキストではなく Coq のコードとして表示するよう指示するものです。この角括弧は生成された HTML には現れません。）

上の二番目と三番目のNotation宣言は標準的なリストの記法を導入するためのものです。三番目のNotationの右辺は、 n 引数の記法を二項構成子の入れ子に変換する記法を定義するための Coq の構文の例です。

リストを操作するために便利な関数がいくつかあります。例えば、repeat関数は数nとcountを取り、各要素がnで長さcountのリストを返します。

Fixpoint repeat (n count : nat) : natlist :=
match count with
| O => nil
| S count' => n :: (repeat n count')
end.

length関数はリストの長さを計算します。

Fixpoint length (l:natlist) : nat :=
match l with
| nil => O
| h :: t => S (length t)
end.

app（”append”）関数はふたつのリストを連結します。

Fixpoint app (l1 l2 : natlist) : natlist :=
match l1 with
| nil    => l2
| h :: t => h :: (app t l2)
end.

appはこの後でよく使うので、中置演算子を用意しておくと便利でしょう。

Notation "x ++ y" := (app x y)
(right associativity, at level 60).

Example test_app1:             [1,2,3] ++ [4,5] = [1,2,3,4,5].
Proof. reflexivity.  Qed.
Example test_app2:             nil ++ [4,5] = [4,5].
Proof. reflexivity.  Qed.
Example test_app3:             [1,2,3] ++ nil = [1,2,3].
Proof. reflexivity.  Qed.

もうふたつリストを使った例を見てみましょう。hd関数はリストの最初の要素（先頭—— head）を返し、tailは最初の要素を除いたものを返します。空のリストには最初の要素はありませんから、その場合に返す値を引数として渡しておかなければなりません。

Definition hd (default:nat) (l:natlist) : nat :=
match l with
| nil => default
| h :: t => h
end.

Definition tail (l:natlist) : natlist :=
match l with
| nil => nil
| h :: t => t
end.

Example test_hd1:             hd 0 [1,2,3] = 1.
Proof. reflexivity.  Qed.
Example test_hd2:             hd 0 [] = 0.
Proof. reflexivity.  Qed.
Example test_tail:            tail [1,2,3] = [2,3].
Proof. reflexivity.  Qed.

練習問題: ★★, recommended (list_funs)

以下のnonzeros、oddmembers、countoddmembersの定義を完成させなさい。

Fixpoint nonzeros (l:natlist) : natlist :=
(* FILL IN HERE *) admit.

Example test_nonzeros:            nonzeros [0,1,0,2,3,0,0] = [1,2,3].
(* FILL IN HERE *) Admitted.

Fixpoint oddmembers (l:natlist) : natlist :=
(* FILL IN HERE *) admit.

Example test_oddmembers:            oddmembers [0,1,0,2,3,0,0] = [1,3].
(* FILL IN HERE *) Admitted.

Fixpoint countoddmembers (l:natlist) : nat :=
(* FILL IN HERE *) admit.

Example test_countoddmembers1:    countoddmembers [1,0,3,1,4,5] = 4.
(* FILL IN HERE *) Admitted.
Example test_countoddmembers2:    countoddmembers [0,2,4] = 0.
(* FILL IN HERE *) Admitted.
Example test_countoddmembers3:    countoddmembers nil = 0.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★ (alternate)

alternateの定義を完成させなさい。この関数は、ふたつのリストから交互に要素を取り出しひとつに「綴じ合わせる」関数です。具体的な例は下のテストを見てください。

注意:alternateの自然な定義のひとつは、 「Fixpointによる定義は『明らかに停止する』ものでなければならない」という Coq の要求を満たすことができません。このパターンにはまってしまったようであれば、両方のリストの要素を同時に見ていくような少し冗長な方法を探してみてください。

Fixpoint alternate (l1 l2 : natlist) : natlist :=
(* FILL IN HERE *) admit.

Example test_alternate1:        alternate [1,2,3] [4,5,6] = [1,4,2,5,3,6].
(* FILL IN HERE *) Admitted.
Example test_alternate2:        alternate [1] [4,5,6] = [1,4,5,6].
(* FILL IN HERE *) Admitted.
Example test_alternate3:        alternate [1,2,3] [4] = [1,4,2,3].
(* FILL IN HERE *) Admitted.
Example test_alternate4:        alternate [] [20,30] = [20,30].
(* FILL IN HERE *) Admitted.

☐

リストを使ったバッグ

バッグ（bag。または多重集合——multiset）は集合のようなものですが、それぞれの要素が一度ではなく複数回現れることのできるようなものを言います。バッグの実装としてありうるのは数のバッグをリストで表現するというものでしょう。

Definition bag := natlist.

練習問題: ★★★ (bag_functions)

バッグに対するcount、sum、add、member関数の定義を完成させなさい。

Fixpoint count (v:nat) (s:bag) : nat :=
(* FILL IN HERE *) admit.

下の証明はすべてreflexivityだけでできます。

Example test_count1:              count 1 [1,2,3,1,4,1] = 3.
(* FILL IN HERE *) Admitted.
Example test_count2:              count 6 [1,2,3,1,4,1] = 0.
(* FILL IN HERE *) Admitted.

多重集合のsum（直和。または非交和）は集合のunion（和）と同じようなものです。sum a bはaとbの両方の要素を持つ多重集合です。（数学者は通常、多重集合のunionにもう少し異なる定義を与えます。それが、この関数の名前をunionにしなかった理由です。）sumのヘッダには引数の名前を与えませんでした。さらに、FixpointではなくDefinitionを使っています。ですから、引数に名前がついていたとしても再帰的な処理はできません。問題をこのように設定したのは、sumを（定義済みの関数を使うといった）別の方法で定義できないか考えさせるためです。

Definition sum : bag -> bag -> bag :=
(* FILL IN HERE *) admit.

Example test_sum1:              count 1 (sum [1,2,3] [1,4,1]) = 3.
(* FILL IN HERE *) Admitted.

Definition add (v:nat) (s:bag) : bag :=
(* FILL IN HERE *) admit.

Example test_add1:                count 1 (add 1 [1,4,1]) = 3.
(* FILL IN HERE *) Admitted.
Example test_add2:                count 5 (add 1 [1,4,1]) = 0.
(* FILL IN HERE *) Admitted.

Definition member (v:nat) (s:bag) : bool :=
(* FILL IN HERE *) admit.

Example test_member1:             member 1 [1,4,1] = true.
(* FILL IN HERE *) Admitted.
Example test_member2:             member 2 [1,4,1] = false.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (bag_more_functions)

練習として、さらにいくつかの関数を作成してください。

Fixpoint remove_one (v:nat) (s:bag) : bag :=

(* FILL IN HERE *) admit.

Example test_remove_one1:         count 5 (remove_one 5 [2,1,5,4,1]) = 0.
(* FILL IN HERE *) Admitted.
Example test_remove_one2:         count 5 (remove_one 5 [2,1,4,1]) = 0.
(* FILL IN HERE *) Admitted.
Example test_remove_one3:         count 4 (remove_one 5 [2,1,4,5,1,4]) = 2.
(* FILL IN HERE *) Admitted.
Example test_remove_one4:
count 5 (remove_one 5 [2,1,5,4,5,1,4]) = 1.
(* FILL IN HERE *) Admitted.

Fixpoint remove_all (v:nat) (s:bag) : bag :=
(* FILL IN HERE *) admit.

Example test_remove_all1:          count 5 (remove_all 5 [2,1,5,4,1]) = 0.
(* FILL IN HERE *) Admitted.
Example test_remove_all2:          count 5 (remove_all 5 [2,1,4,1]) = 0.
(* FILL IN HERE *) Admitted.
Example test_remove_all3:          count 4 (remove_all 5 [2,1,4,5,1,4]) = 2.
(* FILL IN HERE *) Admitted.
Example test_remove_all4:          count 5 (remove_all 5 [2,1,5,4,5,1,4,5,1,4]) = 0.
(* FILL IN HERE *) Admitted.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
(* FILL IN HERE *) admit.

Example test_subset1:              subset [1,2] [2,1,4,1] = true.
(* FILL IN HERE *) Admitted.
Example test_subset2:              subset [1,2,2] [2,1,4,1] = false.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, recommended (bag_theorem)

[]
*)

FILL IN HERE countやaddを使ったバッグに関する面白い定理書き、それを証明しなさい。この問題はいわゆる自由課題で、真になることがわかっていても、証明にはまだ習っていない技を使わなければならない定理を思いついてしまうこともあります。証明に行き詰まってしまったら気軽に質問してください。

(* FILL IN HERE *)☐

リストに関する推論

数の場合と同じく、リスト処理関数についての簡単な事実はもっぱら簡約のみで証明できることがあります。たとえば、次の定理はreflexivityで行われる簡約だけで証明できます。

Theorem nil_app : forall l:natlist,
[] ++ l = l.
Proof.
reflexivity.  Qed.

これは、[] がappの定義のパターンマッチ部分に代入され、パターンマッチ自体が簡約できるようになるからです。

またこれも数の場合と同じように、未知のリストの形（空であるかどうか）に応じた場合分けも有効です。

Theorem tl_length_pred : forall l:natlist,
pred (length l) = length (tail l).
Proof.
intros l. destruct l as [| n l'].
Case "l = nil".
reflexivity.
Case "l = cons n l'".
reflexivity.  Qed.

ここで、nilの場合がうまく行くのは、tl nil = nilと定義したからです。ここでは、destructタクティックのasでnとl'のふたつの名前を導入しました。これは、リストのcons構成子が引数をふたつ（構成するリストの頭部と尾部）取ることに対応しています。

ただし、リストに関する興味深い定理の証明には、帰納法が必要になるのが普通です。

単に例題の証明を読んでいるだけでは大きな進歩は望めません！ 各証明を実際に Coq で動かし、各ステップがその証明にどのようにかかわっているか考え、道筋をていねいになぞっていくことがとても大切です。そうしなければ、演習には何の意味もありません。

natlistのようなデータ型に対して帰納法で証明をするのは、普通の自然数に対する帰納法よりも馴染みにくさを感じたことでしょう。しかし、基本的な考え方は同じくらい簡単です。Inductive宣言では、宣言した構成子から構築できるデータ方の集合を定義しています。例えば、ブール値ではtrueとfalseのいずれかであり、数ではOか数に対するSのいずれか、リストであればnilか数とリストに対するconsのいずれかです。

さらに言えば、帰納的に定義された集合の要素になるのは、宣言した構成子を互いに適用したものだけです。このことがそのまま帰納的に定義された集合に関する推論の方法になります。すなわち、数はOであるか、より小さい数にSを適用したものであるかのいずれかです。リストはnilであるか、何らかの数とより小さいリストにconsを適用したものです。他のものも同様です。ですから、あるリストlに関する命題Pがあり、Pがすべてのリストに対して成り立つことを示したい場合には、次のように推論します。

- まず、lがnilのときPがlについて成り立つことを示す。

- それから、lがcons n l'であるとき、ある数nとより小さいリストl'に対して、Pがl'について成り立つと仮定すればPがlについても成り立つことを示す。

大きなリストはそれより小さなリストから作り出され、少しずつnilに近付いて行きます。よって、このふたつのことからすべてのリストlに関してPが真であることが言えます。具体的な例で説明しましょう。

Theorem app_ass : forall l1 l2 l3 : natlist,
(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof.
intros l1 l2 l3. induction l1 as [| n l1'].
Case "l1 = nil".
reflexivity.
Case "l1 = cons n l1'".
simpl. rewrite -> IHl1'. reflexivity.  Qed.

蒸し返すようですが、この Coq の証明はこうして単に静的なテキストとして読んでいる限り、さほど明白で分かりやすいものではありません。 Coq の証明は、 Coq を対話的に動かしながらポイントごとに「現在のゴールは何か」「コンテキストに何が出ているか」を見て、証明が今どうなっているかを読み下していくことで理解されるようになっています。しかし、このような証明の途中経過は、全てが証明結果として書き出されるわけではありません。だからこそ、人間向けの自然言語での証明には証明の筋道がわかるように証明の指針を書いておく必要があるのです。特に、読者が流れを見失わないよう、ふたつめの場合分けで使う帰納法の仮定が何だったのかわかるようにしておくのは有益なはずです。

定理: 任意のリストl1、l2、l3について、(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3)が成り立つ。

証明:l1についての帰納法で証明する

- まず、l1 = [] と仮定して

([] ++ l2) ++ l3 = [] ++ (l2 ++ l3)

を示す。これは++の定義から自明である。

- 次にl1 = n::l1'かつ

(l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3)

（帰納法の仮定）と仮定して

((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3)

を示す。++の定義から、この式は以下のように変形できる。

n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3))

これは帰納法の仮定から直接導かれる。☐

下の練習問題は授業中に解きましょう。

Theorem app_length : forall l1 l2 : natlist,
length (l1 ++ l2) = (length l1) + (length l2).
Proof.

intros l1 l2. induction l1 as [| n l1'].
Case "l1 = nil".
reflexivity.
Case "l1 = cons".
simpl. rewrite -> IHl1'. reflexivity.  Qed.

リストに対する帰納的証明のもう少し入り組んだ例を見てみましょう。リストの右側にconsする関数snocを定義したとしましょう。

Fixpoint snoc (l:natlist) (v:nat) : natlist :=
match l with
| nil    => [v]
| h :: t => h :: (snoc t v)
end.

この関数を使ってリストの反転関数revを定義します。

Fixpoint rev (l:natlist) : natlist :=
match l with
| nil    => nil
| h :: t => snoc (rev t) h
end.

Example test_rev1:            rev [1,2,3] = [3,2,1].
Proof. reflexivity.  Qed.
Example test_rev2:            rev nil = nil.
Proof. reflexivity.  Qed.

新しく定義したsnocとrevに関する定理を証明してみましょう。ここまでの帰納的証明よりも難易度の高いものですが、リストを反転しても長さの変わらないことを証明します。下の方法では、ふたつめの場合分けで行き詰まってしまいます。

Theorem rev_length_firsttry : forall l : natlist,
length (rev l) = length l.
Proof.
intros l. induction l as [| n l'].
Case "l = []".
reflexivity.
Case "l = n :: l'".
simpl.

Admitted.

このsnocに関する等式が成り立つことを示せれば証明が先に進むはずです。この式を取り出して別個の補題として証明してみましょう。

Theorem length_snoc : forall n : nat, forall l : natlist,
length (snoc l n) = S (length l).
Proof.
intros n l. induction l as [| n' l'].
Case "l = nil".
reflexivity.
Case "l = cons n' l'".
simpl. rewrite -> IHl'. reflexivity.  Qed.

これで、元々の証明ができるようになりました。

Theorem rev_length : forall l : natlist,
length (rev l) = length l.
Proof.
intros l. induction l as [| n l'].
Case "l = nil".
reflexivity.
Case "l = cons".
simpl. rewrite -> length_snoc.
rewrite -> IHl'. reflexivity.  Qed.

対比として、この二つの定理の非形式的な証明を見てみましょう

定理: 任意の数nとリストlについてlength (snoc l n) = S (length l)が成り立つ。

証明:lについての帰納法で証明する。

- まず、l = [] と仮定して

length (snoc [] n) = S (length [])

を示す。これはlengthとsnocの定義から直接導かれる。

- 次に、l = n'::l'かつ

length (snoc l' n) = S (length l')

と仮定して、

length (snoc (n' :: l') n) = S (length (n' :: l'))

を示す。lengthとsnocの定義から次のように変形できる。

S (length (snoc l' n)) = S (S (length l'))

これは帰納法の仮定から明らかである。☐

定理: 任意のリストlについてlength (rev l) = length lが成り立つ。

証明:lについての帰納法で証明する。

- まず、l = [] と仮定して

length (rev []) = length []

を示す。これはlengthとrevの定義から直接導かれる

- 次に、l = n::l'かつ

length (rev l') = length l'

と仮定して、

length (rev (n :: l')) = length (n :: l')

を示す。revの定義から次のように変形できる。

length (snoc (rev l') n) = S (length l')

これは、先程の補題から、次のものと同じである。

S (length (rev l')) = S (length l')

これは、帰納法の仮定から明らかである。☐

こういった証明のスタイルは、どう見ても長ったらしく杓子定規な感じがします。最初の何回かは別にして、それ以後は、細かいところは省略してしまって（必要であれば、頭の中や紙の上で追うのは簡単です）、自明でないところにだけ注目した方がわかりやすいでしょう。そのように省略がちに書けば、上の証明は次のようになります。

定理:任意のリストlについてlength (rev l) = length lが成り立つ。

証明: まず、任意のlについて

length (snoc l n) = S (length l)

であることに注目する。これはlについての帰納法から自明である。このとき、もとの性質についてもlについての帰納法から自明である。l = n'::l'の場合については、上の性質と帰納法の仮定から導かれる。☐

どちらのスタイルの方が好ましいかは、読み手の証明への馴れや、彼らが今まで触れてきた証明がどちらに近いかに依ります。本書の目的としては冗長なスタイルの方が無難でしょう。

これまで見てきたように、定理を証明するには既に証明した定理を使うことができます。以降ではrewrite以外にも、証明済みの定理を使う方法があることを紹介します。ところで、定理を使うためにはその名前を知らなければなりませんが、使えそうな定理の名前をすべて覚えておくのはとても大変です。今まで証明した定理を覚えておくだけでも大変なのに、その名前となったら尚更です。

Coq のSearchAboutコマンドはこのような場合にとても便利です。SearchAbout fooとすると、fooに関する証明がすべて表示されます。例えば、次の部分のコメントを外せば、これまでrevに関して証明した定理が表示されます。

続く練習問題やコースに取り組む際には、常にSearchAboutコマンドのことを頭の隅に置いておくといいでしょう。そうすることでずいぶん時間の節約ができるはずです。

もし ProofGeneral を使っているのなら、C-c C-fとキー入力をすることでSearchAboutコマンドを使うことができます。その結果をエディタに貼り付けるにはC-c C-;を使うことができます。

練習問題: ★★★, recommended (list_exercises)

リストについてさらに練習しましょう。

Theorem app_nil_end : forall l : natlist,
l ++ [] = l.
Proof.
(* FILL IN HERE *) Admitted.

Theorem rev_involutive : forall l : natlist,
rev (rev l) = l.
Proof.
(* FILL IN HERE *) Admitted.

Theorem distr_rev : forall l1 l2 : natlist,
rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof.
(* FILL IN HERE *) Admitted.

次の問題には簡単な解法があります。こんがらがってしまったようであれば、少し戻って単純な方法を探してみましょう。

Theorem app_ass4 : forall l1 l2 l3 l4 : natlist,
l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
(* FILL IN HERE *) Admitted.

Theorem snoc_append : forall (l:natlist) (n:nat),
snoc l n = l ++ [n].
Proof.
(* FILL IN HERE *) Admitted.

前に書いたnonzeros関数に関する練習問題です。

Lemma nonzeros_length : forall l1 l2 : natlist,
nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
(* FILL IN HERE *) Admitted.

☐

リストについての練習問題 (2)

練習問題: ★★, recommended (list_design)

自分で問題を考えましょう。

- cons（::）、snoc、append（++） に関する、自明でない定理を考えて書きなさい。

- それを証明しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★, optional (bag_proofs)

前のバッグについての optional な練習問題に挑戦したのであれば、その定義について、以下の定理を証明しなさい。

Theorem count_member_nonzero : forall (s : bag),
ble_nat 1 (count 1 (1 :: s)) = true.
Proof.
(* FILL IN HERE *) Admitted.

以下のble_natに関する補題は、この次の証明に使えるかもしれません。

Theorem ble_n_Sn : forall n,
ble_nat n (S n) = true.
Proof.
intros n. induction n as [| n'].
Case "0".
simpl.  reflexivity.
Case "S n'".
simpl.  rewrite IHn'.  reflexivity.  Qed.

Theorem remove_decreases_count: forall (s : bag),
ble_nat (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof.
(* FILL IN HERE *) Admitted.

☐

(* Write down an interesting theorem about bags involving the
functions [count] and [sum], and prove it.

練習問題: ★★★, optional (bag_count_sum)

バッグについてcountとsumを使った定理を考え、それを証明しなさい。

(* FILL IN HERE *)
[]
*)

練習問題: ★★★★, optional (rev_injective)

rev関数が単射である、すなわち

forall X (l1 l2 : list X), rev l1 = rev l2 -> l1 = l2

であることを証明しなさい。

この練習問題には簡単な解法と難しい解法があります。

(* FILL IN HERE *)

☐

オプション

次に、日々のプログラミングでも役に立つような型の定義を見てみましょう。

Inductive natoption : Type :=
| Some : nat -> natoption
| None : natoption.

natoption型の使い途のひとつは、関数からエラーコードを返すことです。例えば、リストのn番目の要素を返す関数を書きたいとしましょう。型をnat -> natlist -> natとしてしまったら、リストが短かすぎた場合でも何か適当な数を返さなければなりません！

Fixpoint index_bad (n:nat) (l:natlist) : nat :=
match l with
| nil => 42
| a :: l' => match beq_nat n O with
| true => a
| false => index_bad (pred n) l'
end
end.

これに対して、型をnat -> natlist -> natoptionとすれば、リストが短かすぎた場合にはNoneを返し、リストが十分に長く、n番目の要素がaであった場合にはSome aを返すことができます。

Fixpoint index (n:nat) (l:natlist) : natoption :=
match l with
| nil => None
| a :: l' => match beq_nat n O with
| true => Some a
| false => index (pred n) l'
end
end.

Example test_index1 :    index 0 [4,5,6,7]  = Some 4.
Proof. reflexivity.  Qed.
Example test_index2 :    index 3 [4,5,6,7]  = Some 7.
Proof. reflexivity.  Qed.
Example test_index3 :    index 10 [4,5,6,7] = None.
Proof. reflexivity.  Qed.

この機会に、 Coq のプログラミング言語としての機能として、条件式を紹介しておきましょう。

Fixpoint index' (n:nat) (l:natlist) : natoption :=
match l with
| nil => None
| a :: l' => if beq_nat n O then Some a else index (pred n) l'
end.

Coq の条件式(if式)は他の言語に見られるものとほとんど同じですが、少しだけ一般化されています。 Coq には 組み込みのブーリアン型がないため、 Coq の条件式では、実際には、構成子のふたつある任意の帰納型に対して分岐をすることができます。条件部の式がInductiveの定義の最初の構成子に評価された場合には真、ふたつめの構成子に評価された場合には偽と見做されます。

次の関数は、natoption型からnatの値を取り出し、Noneの場合には与えられたデフォルト値を返します。

Definition option_elim (o : natoption) (d : nat) : nat :=
match o with
| Some n' => n'
| None => d
end.

練習問題: ★★ (hd_opt)

同じ考え方を使って、以前定義したhd関数を修正し、nilの場合に返す値を渡さなくて済むようにしなさい。

Definition hd_opt (l : natlist) : natoption :=
(* FILL IN HERE *) admit.

Example test_hd_opt1 : hd_opt [] = None.
(* FILL IN HERE *) Admitted.

Example test_hd_opt2 : hd_opt [1] = Some 1.
(* FILL IN HERE *) Admitted.

Example test_hd_opt3 : hd_opt [5,6] = Some 5.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (option_elim_hd)

新しいhd_optと古いhdの関係についての練習問題です。

Theorem option_elim_hd : forall (l:natlist) (default:nat),
hd default l = option_elim (hd_opt l) default.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, recommended (beq_natlist)

数のリストふたつを比較し等価性を判定する関数beq_natlistの定義を完成させなさい。そして、beq_natlist l lが任意のリストlでtrueとなることを証明しなさい。

Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
(* FILL IN HERE *) admit.

Example test_beq_natlist1 :   (beq_natlist nil nil = true).
(* FILL IN HERE *) Admitted.
Example test_beq_natlist2 :   beq_natlist [1,2,3] [1,2,3] = true.
(* FILL IN HERE *) Admitted.
Example test_beq_natlist3 :   beq_natlist [1,2,3] [1,2,4] = false.
(* FILL IN HERE *) Admitted.

Theorem beq_natlist_refl : forall l:natlist,
true = beq_natlist l l.
Proof.
(* FILL IN HERE *) Admitted.

☐

applyタクティック

証明をしていると、証明すべきゴールがコンテキスト中の仮定と同じであったり以前証明した補題と同じであることがしばしばあります。

Theorem silly1 : forall (n m o p : nat),
n = m  ->
[n,o] = [n,p] ->
[n,o] = [m,p].
Proof.
intros n m o p eq1 eq2.
rewrite <- eq1.

apply eq2.  Qed.

また、applyタクティックは、条件付きの仮定や補題にも使うことができます。適用するものに含意が含まれていれば、含意の前提部分が証明すべきサブゴールに加えられます。

Theorem silly2 : forall (n m o p : nat),
n = m  ->
(forall (q r : nat), q = r -> [q,o] = [r,p]) ->
[n,o] = [m,p].
Proof.
intros n m o p eq1 eq2.
apply eq2. apply eq1.  Qed.

この証明で、applyの代わりにrewriteを使って証明を終えられるか試してみると有益でしょう。

apply Hを使う典型的な例は、Hがforallで始まり、何らかの全称限量された変数を束縛している場合です。現在のゴールがHの帰結部と一致した場合には、変数に対応する適当な値を見つけてくれます。例えば、次の証明でapply eq2すると、eq2内の変数qはnに、rはmに具体化されます。

Theorem silly2a : forall (n m : nat),
(n,n) = (m,m)  ->
(forall (q r : nat), (q,q) = (r,r) -> [q] = [r]) ->
[n] = [m].
Proof.
intros n m eq1 eq2.
apply eq2. apply eq1.  Qed.

練習問題: ★★, optional (silly_ex)

次の証明をsimplを使わずに完成させなさい。

Theorem silly_ex :
(forall n, evenb n = true -> oddb (S n) = true) ->
evenb 3 = true ->
oddb 4 = true.
Proof.
(* FILL IN HERE *) Admitted.

☐

applyタクティックを使う場合には、適用する事実（の帰結部）が、ゴールと完全に一致していなければなりません。例えは、等式の左辺と右辺が入れ替わっているだけでもapplyタクティックは使えません。

Theorem silly3_firsttry : forall (n : nat),
true = beq_nat n 5  ->
beq_nat (S (S n)) 7 = true.
Proof.
intros n H.
simpl.

Admitted.

そのような場合にはsymmetryタクティックを使って、ゴールの等式の左辺と右辺を入れ替えることができます。

Theorem silly3 : forall (n : nat),
true = beq_nat n 5  ->
beq_nat (S (S n)) 7 = true.
Proof.
intros n H.
symmetry.
simpl.

apply H.  Qed.

練習問題: ★★★, recommended (apply_exercise1)

Theorem rev_exercise1 : forall (l l' : natlist),
l = rev l' ->
l' = rev l.
Proof.

(* FILL IN HERE *) Admitted.

FILL IN HERE ☐

練習問題: ★ (apply_rewrite)

applyとrewriteの違いを簡単に説明しなさい。どちらもうまく使えるような場面はありますか？

(* FILL IN HERE *)

☐

帰納法の仮定を変更する

帰納法による証明の微妙さについては説明しておく価値があるでしょう。例えば、以前証明したapp_assを見てみましょう。帰納法の仮定（inductionタクティックで生成されたふたつめのサブゴール）は以下のようなものでした。

(l1' ++ l2) ++ l3 = l1' ++ l2 ++ l3

（++を右結合と定義したので、=の右辺はl1' ++ (l2 ++ l3)と同じです。）

この仮定は、l1'と、特定のリストl2、l3に関するものです。l2とl3はこの証明の初めにintrosタクティックで導入したもので、この仮定中で「一定」です。証明の方法を少し変えて、最初にnだけをコンテキストにintrosするようにしたら、帰納法の仮定は次のようにもっと強いものになります。

forall l2 l3,  (l1' ++ l2) ++ l3 = l1' ++ l2 ++ l3

Coq を使って実際に違いを確認してください。

今回の場合では、ふたつの証明の違いはささいものです。これは、++関数の定義が最初の引数だけを見て、ふたつめの引数には特に何もしないからです。しかし、遠からずわかることですが、帰納法の仮定をどちらにするかで証明の成否が分かれることもあるのです。

練習問題: ★★, optional (app_ass’)

++の結合則をより一般的な仮定のもとで証明しなさい。（最初の行を変更せずに）次の証明を完成させること。

Theorem app_ass' : forall l1 l2 l3 : natlist,
(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof.
intros l1. induction l1 as [ | n l1'].
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★ (apply_exercise2)

inductionの前にmをintrosしていないことに注意してください。これによって仮定が一般化され、帰納法の仮定が特定のmに縛られることがなくなり、より使いやすくなりました。

Theorem beq_nat_sym : forall (n m : nat),
beq_nat n m = beq_nat m n.
Proof.
intros n. induction n as [| n'].
(* FILL IN HERE *) Admitted.

☐

[]
*)

FILL IN HERE ##### 練習問題: ★★★, recommended (beq_nat_sym_informal)

以下の補題について上の証明と対応する非形式的な証明を書きなさい。

定理: 任意のnat``n``mについて、beq_nat n m = beq_nat m n。

証明:(* FILL IN HERE *)☐

End NatList.

練習問題: 辞書

Module Dictionary.

Inductive dictionary : Type :=
| empty  : dictionary
| record : nat -> nat -> dictionary -> dictionary.

この宣言は次のように読めます。「dictionaryを構成する方法はふたつある。構成子emptyで空の辞書を表現するか、構成子recordをキーと値と既存のdictionaryに適用してキーと値の対応を追加したdictionaryを構成するかのいずれかである」。

Definition insert (key value : nat) (d : dictionary) : dictionary :=
(record key value d).

下のfind関数は、dictionaryから与えられたキーに対応する値を探し出すものです。 キーが見つからなかった場合にはNoneに評価され、キーがvalに結び付けられていた場合にはSome valに評価されます。同じキーが複数の値に結び付けられている場合には、最初に見つかったほうの値を返します。

Fixpoint find (key : nat) (d : dictionary) : option nat :=
match d with
| empty         => None
| record k v d' => if (beq_nat key k) then (Some v) else (find key d')
end.

練習問題: ★ (dictionary_invariant1)

Theorem dictionary_invariant1 : forall (d : dictionary) (k v: nat),
(find k (insert k v d)) = Some v.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (dictionary_invariant2)

Theorem dictionary_invariant2 : forall (d : dictionary) (m n o: nat),
(beq_nat m n) = false -> (find m d) = (find m (insert n o d)).
Proof.
(* FILL IN HERE *) Admitted.

☐

End Dictionary.

次の宣言で、beq_nat_symの定義をトップレベルの名前空間に置いておきます。こうすることで、後でbeq_nat_symを使うのにNatList.beq_nat_symと書かずに済みます。

Definition beq_nat_sym := NatList.beq_nat_sym.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Poly_J:多相性と高階関数

Require Export Lists_J.

ポリモルフィズム（多相性）

多相的なリスト

ここまでは、数値のリストについて学んできました。もちろん、数値以外の、文字列、ブール値、リストといったものを要素として持つリストを扱えるプログラムは、より興味深いものとなるでしょう。これまで学んできたことだけでも、実は新しい帰納的なデータ型を作ることはできるのです。例えば次のように...

Inductive boollist : Type :=
| bool_nil : boollist
| bool_cons : bool -> boollist -> boollist.

... しかし、こんなことをやっていると、すぐに嫌になってしまうでしょう。その理由の一つは、データ型ごとに違ったコンストラクタの名前をつけなければならないことですが、もっと大変なのは、こういったリストを扱う関数（length、revなど）を、新しく対応した型ごとに作る必要が出てくることです。

この無駄な繰り返し作業を無くすため、Coqは多相的な帰納的データ型の定義をサポートしています。これを使うと、多相的なリストは以下のように書くことができます。

Inductive list (X:Type) : Type :=
| nil : list X
| cons : X -> list X -> list X.

これは、前の章にあるnatlistの定義とほとんどそっくりですが、コンストラクタconsの引数の型がnatであったのに対し、任意の型を表すXがそれに変わっています。このXはヘッダに加えられたXと結びつけられ、さらにnatlistであったものがlist Xに置き換わっています（ここで、コンストラクタにnilやconsといった名前を付けられるのは、最初に定義したnatlistがModuleの中で定義されていて、ここからはスコープの外になっているからです）。

それでは、listとはいったい何なのか、ということを正確に考えて見ましょう。これを考える一つの手がかりは、リストが「型を引数にとり、帰納的な定義を返す関数である」と考えることです。あるいは「型を引数にとり、型を返す関数」と考えてもいいかもしれません。任意の型Xについて、list Xという型は、帰納的に定義されたリストの集合で、その要素の型がXとなっているものと考えることもできます。

この定義の下で、コンストラクタnilやconsを使う際には、今作ろうとしているリストの要素の型を指定してやる必要があります。なぜなら、今やnilもconsも多相的なコンストラクタとなっているからです。

Check nil.

Check cons.

ここで出てきた”forall X“というのは、コンストラクタに追加された引数で、後に続く引数で型を特定させるものです。nilやconsが使われる際、例えば2と1を要素に持つリストは、以下のように表されます。

Check (cons nat 2 (cons nat 1 (nil nat))).

（ここではnilやconsを明示的に記述していますが、それは我々がまだ[]や::の表記法（Notation）をまだ記述していないからです。この後でやります）

それでは少し話を戻して、以前書いたリスト処理関数を多相版に作り直していきましょう。length関数は以下のようになります。

Fixpoint length (X:Type) (l:list X) : nat :=
match l with
| nil      => 0
| cons h t => S (length X t)
end.

ここで、matchに使われているnilやconsに型修飾がついていないことに注意してください。我々はすでにリストlが型Xの要素を持っていることを知っていますが、それはパターンマッチにXを含める理由になりません。さらに形式的には、Xはリスト定義全体での型であって、個々のコンストラクタの型ではないのです。

nilやconsと同様に、lengthも与えるリストと同じ型を最初に適用すれば使えます。

Example test_length1 :
length nat (cons nat 1 (cons nat 2 (nil nat))) = 2.
Proof. reflexivity.  Qed.

このlengthを別の型のリストに使いたい場合は、適切な型を与えるだけで済みます。

Example test_length2 :
length bool (cons bool true (nil bool)) = 1.
Proof. reflexivity.  Qed.

では、このサブセクションの終わりに、他の標準的なリスト処理関数を多相的に書き直しましょう。

Fixpoint app (X : Type) (l1 l2 : list X)
: (list X) :=
match l1 with
| nil      => l2
| cons h t => cons X h (app X t l2)
end.

Fixpoint snoc (X:Type) (l:list X) (v:X) : (list X) :=
match l with
| nil      => cons X v (nil X)
| cons h t => cons X h (snoc X t v)
end.

Fixpoint rev (X:Type) (l:list X) : list X :=
match l with
| nil      => nil X
| cons h t => snoc X (rev X t) h
end.

Example test_rev1 :
rev nat (cons nat 1 (cons nat 2 (nil nat)))
= (cons nat 2 (cons nat 1 (nil nat))).
Proof. reflexivity.  Qed.

Example test_rev2:
rev bool (nil bool) = nil bool.
Proof. reflexivity.  Qed.

型推論

それでは、app関数の定義をもう一度書いてみましょう。ただし今回は、引数の型を指定しないでおきます。Coqはこれを受け入れてくれるでしょうか？

Fixpoint app' X l1 l2 : list X :=
match l1 with
| nil      => l2
| cons h t => cons X h (app' X t l2)
end.

うまくいったようです。Coqがapp'にどのような型を設定したのか確認してみましょう。

Check app'.
Check app.

両者は全く同じ型であることが分かります。Coqは型推論という機構を持っていて、これを使い、Xとl1とl2の型が何であるべきかを、その使われ方から導き出します。例えば、Xがconsの引数として使われたことがあれば、それは型に違いなく、さらにconsの最初に引数で型が指定されていて、l1がnilやconsとマッチされているなら、それはlistに違いなかろう、といった具合です。

このパワフルな機構の存在は、型情報を常にそこら中に書かなければならないわけではない、ということを意味します。とはいえ、型を明示的に書くことは、ドキュメント作成やプログラムの健全性をチェックする際に大いに意味はあるのですが。とにかく、これからは自分の書くコードで、型指定を書くところ、書かないところのバランスを考えていく必要があります（多すぎれば、コードが目障りな型指定で読みにくくなりますし、少なすぎると、プログラムを読む人に型推論の結果をいちいち推測させなければならなくなります）。

引数の同化（Synthesis）

多相的な関数を使うときはいつも、通常の引数に加えて型を一つ以上渡さなければなりません。例えば、length関数で自分を再帰している部分には、型Xとして渡されたものをそのまま渡すことになります。しかしこのように、そこらじゅうに明示的に型を書かなければならないとなると、これはとても面倒で冗長な作業です。lengthの二つ目の引数がX型のリストなら、最初の引数はX以外になり得ないのは明らかなのではないか・・・・ならなぜわざわざそれを書く必要があるのでしょう。

幸いなことに、Coqではこの種の冗長性を避けることができます。型を引数に渡すところではどこでも同化した引数”_“を書くことができるのです。これは「ここをあるべき型に解釈してください」という意味です。もう少し正確に言うと、Coqが_を見つけると、手近に集められる情報を集めます。それは、適用されている関数の型や、その適用が現れている文脈から予想される型などですが、それを使って_と置き換えるべき具体的な型を決定するのです。

これを聞くと、型推論と同じじゃないかと思われるかもしれません。実際、この二つの機能は水面下にあるメカニズムではつながっています。次のように単に引数の型を省略する代わりに

app' X l1 l2 : list X :=

このように、型を_で書くことができるということです。

app' (X : _) (l1 l2 : _) : list X :=

いずれも、Coqに、欠落している情報を推論させるもので、これを引数の同化といいます。

引数の同化を使うと、length関数は以下のように書けます。

Fixpoint length' (X:Type) (l:list X) : nat :=
match l with
| nil      => 0
| cons h t => S (length' _ t)
end.

この例では、Xを_に省略することをあまりしていません。しかし多くの場合、この違いは重要です。例えば、1,2,3といった数値を保持するリストを書きたい場合、以下のように書く代わりに...

Definition list123 :=
cons nat 1 (cons nat 2 (cons nat 3 (nil nat))).

...引数同化を使って以下のように書くこともできます。

Definition list123' := cons _ 1 (cons _ 2 (cons _ 3 (nil _))).

暗黙の引数

さらに先に進みましょう。プログラム全体が_まみれになることを避けるため、特定の関数の引数については常に型推論するよう指定できます。

Implicit Arguments nil [[X]].
Implicit Arguments cons [[X]].
Implicit Arguments length [[X]].
Implicit Arguments app [[X]].
Implicit Arguments rev [[X]].
Implicit Arguments snoc [[X]].

Definition list123'' := cons 1 (cons 2 (cons 3 nil)).
Check (length list123'').

また、関数定義の中で、引数を暗黙のものにすることもできます。その際は、次のように引数を中カッコで囲みます。

Fixpoint length'' {X:Type} (l:list X) : nat :=
match l with
| nil      => 0
| cons h t => S (length'' t)
end.

（ここで注意してほしいのは、再帰呼び出しのlength''ではもうすでに型を引数で指定していない、ということです）これからは、この書き方をできるだけ使っていくことにします。ただし、Inductive宣言のコンストラクタではImplicit Argumentsを明示的に書くようにします。

引数を暗黙的に宣言することには、小さな問題が一つあります。時折、Coqが型を特定するために必要な情報を十分に集められない時があるのです。そういう場合には、その時だけ明示してやります。たとえそれがグローバルにはImplicitと宣言されていたとしてもです。例えば、もし次のように書きたかったとします。

この定義のコメントをはずすと、Coqはエラーを出します。nilが何の型のnilなのか分からないからです。このようなときは、型宣言を明示的に行うことができます（これによってnilを何に適用できるか、という情報が与えられます）。

Definition mynil : list nat := nil.

それとは別に、関数名の前に@を付けることで暗黙的に宣言された関数に対して型を明示的に与えることができます。

Check @nil.

Definition mynil' := @nil nat.

引数同化と暗黙的な引数をつかうことで、リストのノーテーション（表記法）をより便利に記述できます。コンストラクタの型引数を暗黙的に記述すれば、Coqはその表記法を使ったときに型を自動的に推論してくれます。

Notation "x :: y" := (cons x y)
(at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
(at level 60, right associativity).

これで、我々の望む書き方ができるようになりました。

Definition list123''' := [1, 2, 3].

練習問題:多相的なリスト

練習問題: ★★, optional (poly_exercises)

ここにあるいくつかの練習問題は、List_J.vにあったものと同じですが、多相性の練習になります。以下の定義を行い、証明を完成させなさい。

Fixpoint repeat (X : Type) (n : X) (count : nat) : list X :=
(* FILL IN HERE *) admit.

Example test_repeat1:
repeat bool true 2 = cons true (cons true nil).
(* FILL IN HERE *) Admitted.

Theorem nil_app : forall X:Type, forall l:list X,
app [] l = l.
Proof.
(* FILL IN HERE *) Admitted.

Theorem rev_snoc : forall X : Type,
forall v : X,
forall s : list X,
rev (snoc s v) = v :: (rev s).
Proof.
(* FILL IN HERE *) Admitted.

Theorem snoc_with_append : forall X : Type,
forall l1 l2 : list X,
forall v : X,
snoc (l1 ++ l2) v = l1 ++ (snoc l2 v).
Proof.
(* FILL IN HERE *) Admitted.

☐

多相的なペア

次も同様に、前の章で作った数値のペアを多相的にすることを考えます。

Inductive prod (X Y : Type) : Type :=
pair : X -> Y -> prod X Y.

Implicit Arguments pair [[X] [Y]].

リストと同様、型引数を暗黙にし、その表記法を定義します。

Notation "( x , y )" := (pair x y).

また、「ペア型」の、より標準的な表記法も登録しておきます。

Notation "X * Y" := (prod X Y) : type_scope.

（type_scopeというアノテーションは、この省略形が、型を解析する際に使われるものであることを示しています。これによって、*が乗算の演算子と衝突することを避けています。

注意：最初のうちは、(x,y)とX*Yの違いに混乱するかもしれません。覚えてほしいのは、(x,y)が値のペアを構成するもので、X*Yは型のペアを構成するものだということです。値xがX型で、値yがY型なら、値(x,y)はX*Y型となります。

ペアの最初の要素、２番目の要素を返す射影関数は他のプログラミング言語で書いたものと比べると若干長くなります。

Definition fst {X Y : Type} (p : X * Y) : X :=
match p with (x,y) => x end.

Definition snd {X Y : Type} (p : X * Y) : Y :=
match p with (x,y) => y end.

次の関数は二つのリストを引数にとり、一つの”ペアのリスト”を作成します。多くの関数型言語でzip関数と呼ばれているものです。Coqの標準ライブラリとぶつからないよう、ここではcombineと呼ぶことにします。

ペアの表記法は、式だけではなくパターンマッチにも使えることに注目してください。

Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
: list (X*Y) :=
match (lx,ly) with
| ([],_) => []
| (_,[]) => []
| (x::tx, y::ty) => (x,y) :: (combine tx ty)
end.

また、あいまいさがない場合は、matchを囲む括弧を取る事もできます。

Fixpoint combine' {X Y : Type} (lx : list X) (ly : list Y)
: list (X*Y) :=
match lx,ly with
| [],_ => []
| _,[] => []
| x::tx, y::ty => (x,y) :: (combine' tx ty)
end.

次の質問の答えを紙に書いた後で、Coqの出した答えと同じかチェックしなさい。

- 関数combineの型は何でしょう (Check @combineの出力結果は？

- それでは

Eval simpl in (combine [1,2] [false,false,true,true]).

は何を出力する？☐

split関数はcombineと全く逆で、ペアのリストを引数に受け取り、リストのペアを返します。多くの関数型言語とでunzipと呼ばれているものです。次の段落のコメントをはずし、split関数の定義を完成させなさい。続くテストを通過することも確認しなさい。

Example test_split:
split [(1,false),(2,false)] = ([1,2],[false,false]).
Proof. reflexivity.  Qed.
*)

☐

多相的なオプション

最後に、多相的なオプションに取り組みます。この型は、前の章のnatoptionを多相化して定義することにします。

Inductive option (X:Type) : Type :=
| Some : X -> option X
| None : option X.

Implicit Arguments Some [[X]].
Implicit Arguments None [[X]].

また、index関数も、色々な型のリストで使えるように定義し直しましょう。

Fixpoint index {X : Type} (n : nat)
(l : list X) : option X :=
match l with
| [] => None
| a :: l' => if beq_nat n O then Some a else index (pred n) l'
end.

Example test_index1 :    index 0 [4,5,6,7]  = Some 4.
Proof. reflexivity.  Qed.
Example test_index2 :    index  1 [[1],[2]]  = Some [2].
Proof. reflexivity.  Qed.
Example test_index3 :    index  2 [true]  = None.
Proof. reflexivity.  Qed.

前の章に出てきたhd_opt関数の多相版を定義しなさい。。次の単体テストでの確認も忘れずに。

Definition hd_opt {X : Type} (l : list X)  : option X :=
(* FILL IN HERE *) admit.

再び、暗黙的に定義された引数を明示的に指定してみましょう。関数名の前に@をつければいいのでしたね。

Check @hd_opt.

Example test_hd_opt1 :  hd_opt [1,2] = Some 1.
(* FILL IN HERE *) Admitted.
Example test_hd_opt2 :   hd_opt  [[1],[2]]  = Some [1].
(* FILL IN HERE *) Admitted.

☐

データとしての関数

高階関数

他の多くの近代的なプログラミング言語（全ての関数型言語を含む）同様、Coqは関数をファーストクラスに属するものとして取り扱います。つまりそれは、関数を他の関数の引数として渡したり、結果として関数を返したり、データ構造の中に関数を含めたりすることができるということです。

関数を操作する関数を、一般に「高階関数」と呼びます。例えば次のようなものです。

Definition doit3times {X:Type} (f:X->X) (n:X) : X :=
f (f (f n)).

ここで引数fは関数です。doit3timesの内容は、値nに対して関数fを3回適用するものです。

Check @doit3times.

Example test_doit3times: doit3times minustwo 9 = 3.
Proof. reflexivity.  Qed.

Example test_doit3times': doit3times negb true = false.
Proof. reflexivity.  Qed.

部分適用

実は、我々がすでに見た、複数の引数を持つ関数は、関数を引数に渡すサンプルになっているのです。どういうことかは、plus関数の型を思い出せば分かります。それはnat -> nat -> natでした。

Check plus.

->は、型同士の二項演算子ですが、このことはCoqが基本的に引数一つの関数しかサポートしていないことを意味します。さらに、この演算子は右結合であるため、plus関数の型はnat -> (nat -> nat)の省略であると言えます。これをよく読むと”plusはnat型の引数を一つ取り、引数がnat型一つでnat型を返す関数を返す”と読むことができます。以前の例ではplusに二つの引数を一緒に与えていましたが、もし望むなら最初の一つだけを与えることもできます。これを部分適用といいます。

Definition plus3 := plus 3.
Check plus3.

Example test_plus3 :    plus3 4 = 7.
Proof. reflexivity.  Qed.
Example test_plus3' :   doit3times plus3 0 = 9.
Proof. reflexivity.  Qed.
Example test_plus3'' :  doit3times (plus 3) 0 = 9.
Proof. reflexivity.  Qed.

余談： カリー化

Coqでは、f : A -> B -> Cという型の関数はA -> (B -> C)型と同じです。このことは、もし上の関数fに値Aを与えると、f' : B -> Cという型の関数が戻り値として返ってくるということです。これは部分適用のplus3でやりましたが、このように、複数の引数から戻り値の型のリストを、関数を返す関数として捉えなおすことを、論理学者ハスケル・カリーにちなんでカリー化、と呼んでいます。

逆に、A -> B -> C型の関数を(A * B) -> C型の関数に変換することもできます。これをアンカリー化（非カリー化）といいます。アンカリー化された二項演算は、二つの引数を同時にペアの形で与える必要があり、部分適用はできません。

カリー化は以下のように定義できます。

Definition prod_curry {X Y Z : Type}
(f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y).

練習問題として、その逆のprod_uncurryを定義し、二つの関数が互いに逆関数であることを証明しなさい。

Definition prod_uncurry {X Y Z : Type}
(f : X -> Y -> Z) (p : X * Y) : Z :=
(* FILL IN HERE *) admit.

(考える練習: 次のコマンドを実行する前に、prod_curryとprod_uncurryの型を考えなさい。)

Check @prod_curry.
Check @prod_uncurry.

Theorem uncurry_curry : forall (X Y Z : Type) (f : X -> Y -> Z) x y,
prod_curry (prod_uncurry f) x y = f x y.
Proof.
(* FILL IN HERE *) Admitted.

Theorem curry_uncurry : forall (X Y Z : Type)
(f : (X * Y) -> Z) (p : X * Y),
prod_uncurry (prod_curry f) p = f p.
Proof.
(* FILL IN HERE *) Admitted.

☐

フィルター (Filter)関数

次に紹介するのは、とても有用な高階関数です。これは、X型のリストと、Xについての述語（Xを引数にとり、boolを返す関数）を引数にとり、リストの要素にフィルターをかけて、述語として与えられた関数の結果がtrueとなった要素だけのリストを返す関数です。

Fixpoint filter {X:Type} (test: X->bool) (l:list X)
: (list X) :=
match l with
| []     => []
| h :: t => if test h then h :: (filter test t)
else       filter test t
end.

例えば、このfilter関数に述語としてevenbと数値のリストlを与えると、リストlの要素の中で偶数の要素だけがリストとなって帰ります。

Example test_filter1: filter evenb [1,2,3,4] = [2,4].
Proof. reflexivity.  Qed.

Definition length_is_1 {X : Type} (l : list X) : bool :=
beq_nat (length l) 1.

Example test_filter2:
filter length_is_1
[ [1, 2], [3], [4], [5,6,7], [], [8] ]
= [ [3], [4], [8] ].
Proof. reflexivity.  Qed.

このfilterを使うことで、Lists.vにあるcountoddmembers関数をもっと簡潔に書くことができます。

Definition countoddmembers' (l:list nat) : nat :=
length (filter oddb l).

Example test_countoddmembers'1:   countoddmembers' [1,0,3,1,4,5] = 4.
Proof. reflexivity.  Qed.
Example test_countoddmembers'2:   countoddmembers' [0,2,4] = 0.
Proof. reflexivity.  Qed.
Example test_countoddmembers'3:   countoddmembers' nil = 0.
Proof. reflexivity.  Qed.

無名（匿名）関数

filter関数に渡すためだけに、二度と使われないlength_is_1といった関数を定義して、それにわざわざ名前を付けるというのは、少しわずらわしく感じます。このようなことは、この例だけの問題ではありません。高階関数を使うときは、引数として”一度しか使わない関数”を渡すことがよくあります。こういう関数にいちいち名前を考えるのは、退屈以外の何物でもありません。

幸いなことに、いい方法があります。一時的な関数を、名前を付けることも、トップレベルで宣言することもなく作成することができるのです。これは定数のリストや、数値定数と同じようなものだと考えられます。

Example test_anon_fun':
doit3times (fun n => n * n) 2 = 256.
Proof. reflexivity.  Qed.

次は無名関数を使った書き換えのもう少しいい例です。

Example test_filter2':
filter (fun l => beq_nat (length l) 1)
[ [1, 2], [3], [4], [5,6,7], [], [8] ]
= [ [3], [4], [8] ].
Proof. reflexivity.  Qed.

filter関数を使い、数値のリストを入力すると、そのうち偶数でなおかつ7より大きい要素だけを取り出すfilter_even_gt7関数を書きなさい。

Definition filter_even_gt7 (l : list nat) : list nat :=
(* FILL IN HERE *) admit.

Example test_filter_even_gt7_1 :
filter_even_gt7 [1,2,6,9,10,3,12,8] = [10,12,8].
(* FILL IN HERE *) Admitted.

Example test_filter_even_gt7_2 :
filter_even_gt7 [5,2,6,19,129] = [].
(* FILL IN HERE *) Admitted.

☐

filter関数を使って、partition関数を書きなさい。:

partition : forall X : Type,
(X -> bool) -> list X -> list X * list X

型Xについて、X型の値がある条件を満たすかを調べる述語X -> boolとXのリストlist Xを引数に与えると、partition関数はリストのペアを返します。ペアの最初の要素は、与えられたリストのうち、条件を満たす要素だけのリストで、二番目の要素は、条件を満たさないもののリストです。二つのリストの要素の順番は、元のリストの順と同じでなければなりません。

Definition partition {X : Type} (test : X -> bool) (l : list X)
: list X * list X :=
(* FILL IN HERE *) admit.

Example test_partition1: partition oddb [1,2,3,4,5] = ([1,3,5], [2,4]).
(* FILL IN HERE *) Admitted.
Example test_partition2: partition (fun x => false) [5,9,0] = ([], [5,9,0]).
(* FILL IN HERE *) Admitted.

☐

マップ（Map）関数

もう一つ、便利な高階関数としてmapを挙げます。

Fixpoint map {X Y:Type} (f:X->Y) (l:list X)
: (list Y) :=
match l with
| []     => []
| h :: t => (f h) :: (map f t)
end.

これは、関数fとリストl = [n1, n2, n3, ...]を引数にとり、関数fをlの各要素に適用した[f n1, f n2, f n3,...]というリストを返します。例えばこのようなものです。

Example test_map1: map (plus 3) [2,0,2] = [5,3,5].
Proof. reflexivity.  Qed.

入力されるリストの要素の型と、出力されるリストの要素の型は同じである必要はありません（mapは、XとY二種類の型変数を取ります）。次の例は、数値のリストと、数値を受け取りbool値を返す関数から、bool型のリストを返します。

Example test_map2: map oddb [2,1,2,5] = [false,true,false,true].
Proof. reflexivity.  Qed.

同じ関数が、数値のリストと、「数値からbool型のリストへの関数」を引数にとり、「bool型のリストのリスト」を返すような関数にも使えます。

Example test_map3:
map (fun n => [evenb n,oddb n]) [2,1,2,5]
= [[true,false],[false,true],[true,false],[false,true]].
Proof. reflexivity.  Qed.

mapとrevが可換であることを示しなさい。証明には補題をたてて証明する必要があるでしょう。

Theorem map_rev : forall (X Y : Type) (f : X -> Y) (l : list X),
map f (rev l) = rev (map f l).
Proof.
(* FILL IN HERE *) Admitted.

☐

map関数は、list Xからlist Yへのマップを、型X -> Yの関数を使って実現しています。同じような関数flat_mapを定義しましょう。これはlist Xからlist Yへのマップですが、X -> list Yとなる関数fを使用できます。このため、次のように要素ごとの関数fの結果を平坦化してやる必要があります。

flat_map (fun n => [n,n+1,n+2]) [1,5,10]
= [1, 2, 3, 5, 6, 7, 10, 11, 12].

Fixpoint flat_map {X Y:Type} (f:X -> list Y) (l:list X)
: (list Y) :=
(* FILL IN HERE *) admit.

Example test_flat_map1:
flat_map (fun n => [n,n,n]) [1,5,4]
= [1, 1, 1, 5, 5, 5, 4, 4, 4].
(* FILL IN HERE *) Admitted.

☐

リストは、map関数のような関数に渡すことができる、帰納的に定義された唯一の型、というわけではありません。次の定義は、option型のためにmap関数を定義したものです。

Definition option_map {X Y : Type} (f : X -> Y) (xo : option X)
: option Y :=
match xo with
| None => None
| Some x => Some (f x)
end.

filterやmap関数を定義したり使ったりするケースでは、多くの場合暗黙的な型引数が使われます。暗黙の型引数定義に使われている中括弧を普通の括弧に置き換え、必要なところに型引数を明示的に書くようにして、それが正しいかどうかをCoqでチェックしなさい。☐

畳み込み（Fold）関数

さらにパワフルな高階関数foldに話を移します。この関数はGoogleの分散フレームワーク”map/reduce”でいうところの”reduce”オペレーションに根ざしています。

Fixpoint fold {X Y:Type} (f: X->Y->Y) (l:list X) (b:Y) : Y :=
match l with
| nil => b
| h :: t => f h (fold f t b)
end.

直感的にfoldは、与えられたリストの各要素の間に、与えられた二項演算子fを挟み込むように挿入していくような操作です。 例えば、fold plus [1,2,3,4]は、直感的に1+2+3+4と同じ意味です。ただし正確には、二番めの引数に、fに最初に与える”初期値”が必要になります。例えば

fold plus [1,2,3,4] 0

は、次のように解釈されます。

1 + (2 + (3 + (4 + 0))).

もう少しサンプルを見てください。

Check (fold plus).
Eval simpl in (fold plus [1,2,3,4] 0).

Example fold_example1 : fold mult [1,2,3,4] 1 = 24.
Proof. reflexivity. Qed.

Example fold_example2 : fold andb [true,true,false,true] true = false.
Proof. reflexivity. Qed.

Example fold_example3 : fold app  [[1],[],[2,3],[4]] [] = [1,2,3,4].
Proof. reflexivity. Qed.

fold関数がXとY二つの型引数をとっていて、関数fが型Xを引数にとり型Yを返すようになっていることに注目してください。XとYが別々の型となっていることで、どのような場合に便利であるかを考えてください。

関数を作成する関数

これまで見てきた高階関数は、ほとんどが関数を引数にとるものでした。ここでは、関数が別の関数の戻り値になるような例を見ていきましょう。

まず、値x（型X）を引数としてとり、「nat型の引数からX型の戻り値を返す関数」を返す関数を考えます。戻る関数は、引数に関係なく、生成時に与えられた値｢x｣を常に返すものです。

Definition constfun {X: Type} (x: X) : nat->X :=
fun (k:nat) => x.

Definition ftrue := constfun true.

Example constfun_example1 : ftrue 0 = true.
Proof. reflexivity. Qed.

Example constfun_example2 : (constfun 5) 99 = 5.
Proof. reflexivity. Qed.

もう少し面白い例を挙げます。次の関数は、数値から型Xを戻す関数fと、数値k、型Xの値xを引数にとり、fにkと同じ引数が与えられた場合だけ値xを返し、それ以外のときはfにkを渡した戻り値を返します。

Definition override {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:=
fun (k':nat) => if beq_nat k k' then x else f k'.

たとえば、このoverride関数を数値からbool型への関数に以下のように２回適用すると、値が1と3のときだけfalseを返し、それ以外はtrueを返すようにすることができます。

Definition fmostlytrue := override (override ftrue 1 false) 3 false.

Example override_example1 : fmostlytrue 0 = true.
Proof. reflexivity. Qed.

Example override_example2 : fmostlytrue 1 = false.
Proof. reflexivity. Qed.

Example override_example3 : fmostlytrue 2 = true.
Proof. reflexivity. Qed.

Example override_example4 : fmostlytrue 3 = false.
Proof. reflexivity. Qed.

次の証明にとりかかる前に、あなたがこの証明の意味することを理解しているか確認するため、証明内容を別の言葉で言い換えてください。証明自体は単純なものです。

Theorem override_example : forall (b:bool),
(override (constfun b) 3 true) 2 = b.
Proof.
(* FILL IN HERE *) Admitted.

☐

このコースでこれ以降、関数のオーバーライド（上書き）がよく登場しますが、この性質について多くを知る必要はありません。しかし、これらの性質を証明するには、さらにいくつかのCoqのタクティックを知らなければなりません。それが、この章の残りの部分の主なトピックになります。

さらにCoqについて

unfoldタクティック

時折、Coqが関数を自動的に展開してくれないために証明が行き詰まってしまうことがあります（これは仕様であって、バグではありません。Coqがもし可能な展開を全て自動でやってしまったら、証明のゴールはたちまち巨大化して、読むこともCoqで操作することもできなくなってしまいます）。

Theorem unfold_example_bad : forall m n,
3 + n = m ->
plus3 n + 1 = m + 1.
Proof.
intros m n H.

Admitted.

unfoldタクティックは、定義された名前を、その定義の右側の記述に置き換えてくれるものです。

Theorem unfold_example : forall m n,
3 + n = m ->
plus3 n + 1 = m + 1.
Proof.
intros m n H.
unfold plus3.
rewrite -> H.
reflexivity.  Qed.

今我々は、overrideの最初の性質を証明することができるようになりました。もしある関数の引数のある値kをオーバーライドしてから引数kを与えると、オーバーライドされた値が帰る、というものです。

Theorem override_eq : forall {X:Type} x k (f:nat->X),
(override f k x) k = x.
Proof.
intros X x k f.
unfold override.
rewrite <- beq_nat_refl.
reflexivity.  Qed.

この証明はストレートなものですが、override関数の展開にunfoldを必要としている点だけ注意してください。

Theorem override_neq : forall {X:Type} x1 x2 k1 k2 (f : nat->X),
f k1 = x1 ->
beq_nat k2 k1 = false ->
(override f k2 x2) k1 = x1.
Proof.
(* FILL IN HERE *) Admitted.

☐

unfoldの逆の機能として、Coqにはfoldというタクティックも用意されています。これは、展開された定義を元に戻してくれますが、あまり使われることはありません。

反転（Inversion）

自然数の定義を思い出してください。

Inductive nat : Type :=
| O : nat
| S : nat -> nat.

この定義から、全ての数は二つの形式、コンストラクタOで作られたか、コンストラクタSに他の数値を与えて作られたかのどちらかであることは明白です。しかし両目を見開いてよく見ると、この定義（と、他のプログラミング言語で、データ型の定義がどのように働くか、という非形式的な理解）から、二つの暗黙的な事実が見つかります。

- コンストラクタSが単射であること。つまり、S n = S mとなるためのただ一つの方法はn = mであること。

- コンストラクタOとコンストラクタSは、互いに素であること。つまり、OはどんなnについてもS nと等しくないということ。

同じ原理が、全ての帰納的に定義された型にあてはまります。全てのコンストラクタは単射で、コンストラクタが違えば同じ値は生まれません。リストについて言えばconsコンストラクタは単射で、nilは全ての空でないリストと異なっています。bool型では、trueとfalseは異なるものです（ただ、trueもfalseも引数を取らないため、単射かどうか、という議論には意味がありません）。

Coqには、この性質を証明に利用するinversionというタクティックが用意されています。

inversionタクティックは、次のような場合に使います。コンテキストに以下のような形の仮定H（や過去に定義された補助定理）がある場合、

c a1 a2 ... an = d b1 b2 ... bm

これは、あるコンストラクタcとdに、ある引数a1 ... anとb1 ... bmを与えて評価したものが等しいことを示していますが、このような時、inversion Hとすることで、この等式を”反転”し、そこに含まれている情報を以下のようなやり方で引き出します。

- もしcとdが同じコンストラクタの場合、すでに分かっているように、コンストラクタの単射性から、a1 = b1,a2 = b2をが導かれます。 また、inversion Hはこの事実をコンテキストに追加し、ゴールの置き換えに使えないかを試します。

- もしcとdが違うコンストラクタの場合、仮定Hは矛盾していることになります。つまり、偽である前提がコンテキストに紛れ込んでいるということになり、これはどんなゴールも証明できてしまうことを意味します。このような場合、inversion Hは現在のゴールが解決されたものとして、ゴールの一覧から取り除きます。

inversionタクティックは、このような一般的な説明を読むより、その動きを実際に見てもらったほうが簡単に理解できるでしょう。以下はinversionの使い方を見てもらい、理解するための練習を兼ねた定理の例です。

Theorem eq_add_S : forall (n m : nat),
S n = S m ->
n = m.
Proof.
intros n m eq. inversion eq. reflexivity.  Qed.

Theorem silly4 : forall (n m : nat),
[n] = [m] ->
n = m.
Proof.
intros n o eq. inversion eq. reflexivity.  Qed.

便利なように、inversionタクティックは、等式でつながった複合値を展開して、それぞれを対応する相手に結び付けてくれます。

Theorem silly5 : forall (n m o : nat),
[n,m] = [o,o] ->
[n] = [m].
Proof.
intros n m o eq. inversion eq. reflexivity. Qed.

Example sillyex1 : forall (X : Type) (x y z : X) (l j : list X),
x :: y :: l = z :: j ->
y :: l = x :: j ->
x = y.
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem silly6 : forall (n : nat),
S n = O ->
2 + 2 = 5.
Proof.
intros n contra. inversion contra. Qed.

Theorem silly7 : forall (n m : nat),
false = true ->
[n] = [m].
Proof.
intros n m contra. inversion contra.  Qed.

Example sillyex2 : forall (X : Type) (x y z : X) (l j : list X),
x :: y :: l = [] ->
y :: l = z :: j ->
x = z.
Proof.
(* FILL IN HERE *) Admitted.

☐

コンストラクタの単射性が、forall (n m : nat), S n = S m -> n = mを示している一方で、これを逆に適用することで、普通の等式の証明をすることができれば、これまで出てきたいくつかのケースにも使えるでしょう。

Lemma eq_remove_S : forall n m,
n = m -> S n = S m.
Proof. intros n m eq. rewrite -> eq. reflexivity. Qed.

これはinversionの、もっと現実的な使い方です。ここで示された性質は、この後でもよく使うことになります。

Theorem beq_nat_eq : forall n m,
true = beq_nat n m -> n = m.
Proof.
intros n. induction n as [| n'].
Case "n = 0".
intros m. destruct m as [| m'].
SCase "m = 0". reflexivity.
SCase "m = S m'". simpl. intros contra. inversion contra.
Case "n = S n'".
intros m. destruct m as [| m'].
SCase "m = 0". simpl. intros contra. inversion contra.
SCase "m = S m'". simpl. intros H.
apply eq_remove_S. apply IHn'. apply H. Qed.

beq_nat_eqの、非形式的な証明を示しなさい。

(* FILL IN HERE *)

☐

beq_nat_eqは、mについて帰納法をつかうことで証明することができました。しかし我々は、もう少し変数を導入する順序に注意を払うべきです。なぜなら、我々は一般に、十分な帰納法の仮定を得ているからです。このことを次に示します。次の証明を完成させなさい。この練習問題の効果を最大にするため、とりあえずは先にやった証明を見ないで取り組んでください。

Theorem beq_nat_eq' : forall m n,
beq_nat n m = true -> n = m.
Proof.
intros m. induction m as [| m'].
(* FILL IN HERE *) Admitted.

☐

inversionのもう一つの側面を見てみましょう。以前にすでに証明済みのものですが、少し遠回りな書き方になっています。新しく追加された等号のせいで、少し等式に関する証明を追加する必要がありますし、これまでに出てきたタクティックを使う練習にもなります。

Theorem length_snoc' : forall (X : Type) (v : X)
(l : list X) (n : nat),
length l = n ->
length (snoc l v) = S n.
Proof.
intros X v l. induction l as [| v' l'].
Case "l = []". intros n eq. rewrite <- eq. reflexivity.
Case "l = v' :: l'". intros n eq. simpl. destruct n as [| n'].
SCase "n = 0". inversion eq.
SCase "n = S n'".
apply eq_remove_S. apply IHl'. inversion eq. reflexivity. Qed.

練習問題

練習問題: ★★, optional (practice)

同じところに分類され、相互に関連するような、自明でもないが複雑というほどでもない証明をいくつか練習問題としましょう。このうち、いくつかは過去のレクチャーや練習問題に出てきた補題を使用します。

Theorem beq_nat_0_l : forall n,
true = beq_nat 0 n -> 0 = n.
Proof.
(* FILL IN HERE *) Admitted.

Theorem beq_nat_0_r : forall n,
true = beq_nat n 0 -> 0 = n.
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem double_injective : forall n m,
double n = double m ->
n = m.
Proof.
intros n. induction n as [| n'].

Case "n = 0". simpl. intros m eq. destruct m as [| m'].
SCase "m = 0". reflexivity.
SCase "m = S m'". inversion eq.
Case "n = S n'". intros m eq. destruct m as [| m'].
SCase "m = 0". inversion eq.
SCase "m = S m'".
apply eq_remove_S. apply IHn'. inversion eq. reflexivity. Qed.

タクティックを仮定に使用する

デフォルトでは、ほとんどのタクティックはゴールの式に作用するだけで、コンテキストの内容には手を付けません。しかしながら、ほとんどのタクティックは変数を付けることで同じ操作をコンテキストの式に行うことができます。

例えば、simpl in Hというタクティックは、コンテキストの中のHと名前のついた仮定に対して簡約をします。

Theorem S_inj : forall (n m : nat) (b : bool),
beq_nat (S n) (S m) = b  ->
beq_nat n m = b.
Proof.
intros n m b H. simpl in H. apply H.  Qed.

同様に、apply L in Hというタクティックは、ある条件式L(L1 -> L2といった形の)を、コンテキストにある仮定Hに適用します。しかし普通のapplyと異なるのは、apply L in Hが、HがL1とマッチすることを調べ、それに成功したらそれをL2に書き換えることです。

言い換えると、apply L in Hは、”前向きの証明”の形をとっているといえます。それは、L1 -> L2が与えられ、仮定とL1がマッチしたら、仮定はL2と同じと考えてよい、ということです。逆に、apply Lは”逆向きの証明”であると言えます。それは、L1->L2であることが分かっていて、今証明しようとしているものがL2なら、L1を証明すればよいとすることです。

以前やった証明の変種を挙げておきます。逆向きの証明ではなく、前向きの証明を進めましょう。

Theorem silly3' : forall (n : nat),
(beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
true = beq_nat n 5  ->
true = beq_nat (S (S n)) 7.
Proof.
intros n eq H.
symmetry in H. apply eq in H. symmetry in H.
apply H.  Qed.

前向きの証明は、与えられたもの（前提や、すでに証明された定理）からスタートして、そのゴールを次々につなげていき、ゴールに達するまでそれを続けます。逆向きの証明は、ゴールからスタートし、そのゴールが結論となる前提を調べ、それを前提や証明済みの定理にたどりつくまで繰り返します。皆さんがこれまで（数学やコンピュータサイエンスの分野で）見てきた非形式的な証明は、おそらく前向きの証明であったのではないかと思います。一般にCoqでの証明は逆向きの証明となる傾向があります。しかし、状況によっては前向きの証明のほうが簡単で考えやすい、ということもあります。

先に述べた”in”を使って次の証明をしなさい。

Theorem plus_n_n_injective : forall n m,
n + n = m + m ->
n = m.
Proof.
intros n. induction n as [| n'].

(* FILL IN HERE *) Admitted.

☐

destructを複合式で使う

ここまでdestructタクティックがいくつかの変数の値についてケース分析を行う例をたくさん見てきました。しかし時には、ある式の結果についてケース分析をすることで証明を行う必要があります。このような場合にもdestructタクティックが使えます。.

例を見てください。

Definition sillyfun (n : nat) : bool :=
if beq_nat n 3 then false
else if beq_nat n 5 then false
else false.

Theorem sillyfun_false : forall (n : nat),
sillyfun n = false.
Proof.
intros n. unfold sillyfun.
destruct (beq_nat n 3).
Case "beq_nat n 3 = true". reflexivity.
Case "beq_nat n 3 = false". destruct (beq_nat n 5).
SCase "beq_nat n 5 = true". reflexivity.
SCase "beq_nat n 5 = false". reflexivity.  Qed.

上の証明でsillyfunを展開すると、if (beq_nat n 3) then ... else ...で行き詰まることがわかります。そこで、nが3である場合とそうでない場合とにdestruct (beq_nat n 3)を使って二つのケースに分け、証明を行います。

Theorem override_shadow : forall {X:Type} x1 x2 k1 k2 (f : nat->X),
(override (override f k1 x2) k1 x1) k2 = (override f k1 x1) k2.
Proof.
(* FILL IN HERE *) Admitted.

☐

Admitted.
*)

☐

思考練習: 我々はすでに、全ての型のリストのペアでcombineがsplitの逆関数であることを証明しました。ではその逆の「splitはcombineの逆関数である」を示すことはできるでしょうか？

ヒント:split combine l1 l2 = (l1,l2)がtrueとなるl1、l2の条件は何でしょう？

この定理をCoqで証明しなさい（なるべくintrosを使うタイミングを遅らせ、帰納法の仮定を一般化させておくといいでしょう。

(* FILL IN HERE *)

☐

rememberタクティック

(注:rememberタクティックは、今必ず読んでおかないといけないほどのものではありません。必要になるまでこの項はとばしておいて、必要になってから読んでもいいでしょう。 )

前の項では、destructを使えば任意の演算対象の評価結果についてケース分析できることを見てきました。eが何らかの帰納的な型Tであれば、destruct eは型Tのコンストラクタそれぞれにサブゴールを作成し、起こりえる全ての（ゴールやコンテキストにある）eの状態をコンストラクタcで網羅的に置き換えます。

しかし時折、この置き換えのプロセスで、証明に必要な情報が失われてしまうことがあります。例えば、関数sillyfun1を次のように定義したとします。

Definition sillyfun1 (n : nat) : bool :=
if beq_nat n 3 then true
else if beq_nat n 5 then true
else false.

そしてCoqを使いよく観察することで、sillyfun1 nが、nが奇数のときだけtrueとなりうることを示したいとします。先ほどsillyfunでやった証明を参考に類推すると、証明はこんな風に始まるのが自然に思えます。

Theorem sillyfun1_odd_FAILED : forall (n : nat),
sillyfun1 n = true ->
oddb n = true.
Proof.
intros n eq. unfold sillyfun1 in eq.
destruct (beq_nat n 3).

Admitted.

しかし証明はここで手詰まりになってしまいます。なぜなら、destructを使ったことで、コンテキストからゴールまでたどりつくのに必要な情報がなくなってしまったからです。destructはbeq_nat n 3の結果起こる事象を全て投げ捨ててしまいますが、我々はそのうち少なくとも一つは残してもらわないと証明が進みません。このケースで必要なのはbeq_nat n 3 = trueで、ここからn = 3は明らかで、ここからnが奇数であることが導かれます。

実際のところやりたいことはdestructをbeq_nat n 3に直接使ってこの式の結果起こることを全て置き換えてしまうことではなく、destructをbeq_nat n 3と同じような何か別のものに適用することです。例えばbeq_nat n 3と同じ値になる変数が分かっているなら、代わりにその値に対してdestructする、といったことです。

rememberタクティックは、そういう変数を導きたいときに使えます。

Theorem sillyfun1_odd : forall (n : nat),
sillyfun1 n = true ->
oddb n = true.
Proof.
intros n eq. unfold sillyfun1 in eq.
remember (beq_nat n 3) as e3.

destruct e3.

Case "e3 = true". apply beq_nat_eq in Heqe3.
rewrite -> Heqe3. reflexivity.
Case "e3 = false".

remember (beq_nat n 5) as e5. destruct e5.
SCase "e5 = true".
apply beq_nat_eq in Heqe5.
rewrite -> Heqe5. reflexivity.
SCase "e5 = false". inversion eq.  Qed.

Theorem override_same : forall {X:Type} x1 k1 k2 (f : nat->X),
f k1 = x1 ->
(override f k1 x1) k2 = f k2.
Proof.
(* FILL IN HERE *) Admitted.

☐

この問題はやや難しいかもしれません。最初にintrosを使うと、帰納法を適用するための変数まで上に上げてしまうので気をつけてください。

Theorem filter_exercise : forall (X : Type) (test : X -> bool)
(x : X) (l lf : list X),
filter test l = x :: lf ->
test x = true.
Proof.
(* FILL IN HERE *) Admitted.

☐

apply ... with ...タクティック

次の例は、[a,b]から[e,f]を得るためにrewriteを二回も使っており、少し要領が悪く思われます。

Example trans_eq_example : forall (a b c d e f : nat),
[a,b] = [c,d] ->
[c,d] = [e,f] ->
[a,b] = [e,f].
Proof.
intros a b c d e f eq1 eq2.
rewrite -> eq1. rewrite -> eq2. reflexivity.  Qed.

このようなことがよくあるため、等式が推移的である事実を補題としておきます。

Theorem trans_eq : forall {X:Type} (n m o : X),
n = m -> m = o -> n = o.
Proof.
intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2.
reflexivity.  Qed.

そして、trans_eqをさきほどの証明に使ってみます。しかし、実際にやってみるとapplyタクティックに多少細工が必要なことがわかります。

Example trans_eq_example' : forall (a b c d e f : nat),
[a,b] = [c,d] ->
[c,d] = [e,f] ->
[a,b] = [e,f].
Proof.
intros a b c d e f eq1 eq2.

apply trans_eq with (m:=[c,d]). apply eq1. apply eq2.   Qed.

実際には、このように名前mをwithに与えるということはそれほど多くありません。Coqは多くの場合賢く振舞って、我々の要求を実現してくれます。ちなみにこの上のapplyはapply trans_eq withc,dと書くこともできます。

Example trans_eq_exercise : forall (n m o p : nat),
m = (minustwo o) ->
(n + p) = m ->
(n + p) = (minustwo o).
Proof.
(* FILL IN HERE *) Admitted.

Theorem beq_nat_trans : forall n m p,
true = beq_nat n m ->
true = beq_nat m p ->
true = beq_nat n p.
Proof.
(* FILL IN HERE *) Admitted.

Theorem override_permute : forall {X:Type} x1 x2 k1 k2 k3 (f : nat->X),
false = beq_nat k2 k1 ->
(override (override f k2 x2) k1 x1) k3 = (override (override f k1 x1) k2 x2) k3.
Proof.
(* FILL IN HERE *) Admitted.

☐

まとめ

ここまでに、たくさんの基本的なタクティックを見てきました。これだけあればしばらくの間は困らずに済むはずです。この先数回のレクチャーで2～3新しいものが出てきますが、その先ではさらに強力な「自動化されたタクティック」を紹介していきます。それを使うと、多くの低レベルな作業をCoqに処理してもらうことができます。しかし基本的に、皆さんはもう必要なことを知っていると考えていいでしょう。

ここまでに出てきたタクティックの一覧です

- intros: 仮定や変数をゴールからコンテキストに移す

- reflexivity: 証明を完了させる（ゴールがe = eという形になっている場合）

- apply: 仮定、補助定理、コンストラクタを使ってゴールを証明する

- apply... in H: 仮定、補助定理、コンストラクタを使ってゴールを証明する（前向きの証明）

- apply... with...: パターンマッチだけで決定できなかった変数を、特定の値に明示的に結びつける

- simpl: ゴールの式を簡約する

- simpl in H: ゴール、もしくは仮定Hの式を簡約する

- rewrite: 等式の形をした仮定（もしくは定理）を使い、ゴールを書き換える

- rewrite ... in H: 等式の形をした仮定（もしくは定理）を使い、ゴールや仮定を書き換える

- unfold: 定義された定数を、ゴールの右側の式で置き換える

- unfold... in H: 定義された定数を、ゴールや仮定の右側の式で置き換える

- destruct... as...: 帰納的に定義された型の値について、ケースごとに解析する

- induction... as...: 機能的に定義された型の値に帰納法を適用する

- inversion: コンストラクタの単射性と独立性を利用して証明を行う

- remember (e) as x: destructxとすることで式を失わないようにするため、式(e)に名前(x)を与える

- assert (e) as H: 定義した補助定理(e)をHという名前でコンテキストに導入する

さらなる練習問題

リストに関する多くの一般的な関数はfoldを使って書きなおすることができます。例えば、次に示すのはlengthの別な実装です。

Definition fold_length {X : Type} (l : list X) : nat :=
fold (fun _ n => S n) l 0.

Example test_fold_length1 : fold_length [4,7,0] = 3.
Proof. reflexivity. Qed.

fold_lengthが正しいことを証明しなさい。

Theorem fold_length_correct : forall X (l : list X),
fold_length l = length l.
(* FILL IN HERE *) Admitted.

☐

map関数もfoldを使って書くことができます。以下のfold_mapを完成させなさい。

Definition fold_map {X Y:Type} (f : X -> Y) (l : list X) : list Y :=
(* FILL IN HERE *) admit.

fold_mapの正しさを示す定理をCoqで書き、証明しなさい

(* FILL IN HERE *)

☐

Module MumbleBaz.

つぎの、機能的に定義された二つの型をよく観察してください。

Inductive mumble : Type :=
| a : mumble
| b : mumble -> nat -> mumble
| c : mumble.
Inductive grumble (X:Type) : Type :=
| d : mumble -> grumble X
| e : X -> grumble X.

FILL IN HERE 次の式のうち、ある型Xについてgrumble Xの要素として正しく定義されているものはどれでしょうか。

- d (b a 5)

- d mumble (b a 5)

- d bool (b a 5)

- e bool true

- e mumble (b c 0)

- e bool (b c 0)

- c

(* FILL IN HERE *)☐

次の、機能的に定義された型をよく観察してください。

Inductive baz : Type :=
| x : baz -> baz
| y : baz -> bool -> baz.

FILL IN HERE 型bazはいくつの要素を持つことができるでしょうか？(* FILL IN HERE *)☐

End MumbleBaz.

チャレンジ問題: 二つの再帰関数forallb、existsbを定義しなさい。forallbは、リストの全ての要素が与えられた条件を満たしているかどうかを返します。

forallb oddb [1,3,5,7,9] = true

forallb negb [false,false] = true

forallb evenb [0,2,4,5] = false

forallb (beq_nat 5) [] = true

existsbは、リストの中に、与えられた条件を満たす要素が一つ以上あるかを返します。

existsb (beq_nat 5) [0,2,3,6] = false

existsb (andb true) [true,true,false] = true

existsb oddb [1,0,0,0,0,3] = true

existsb evenb [] = false

次にexistsb'を再帰関数としてではなく、forallbとnegbを使って定義しなさい。.

そして、existsb'とexistsbが同じ振る舞いをすることを証明しなさい。

(* FILL IN HERE *)

FILL IN HERE ☐

index関数の定義を思い出してください。

Fixpoint index {X : Type} (n : nat) (l : list X) : option X :=
match l with
| [] => None
| a :: l' => if beq_nat n O then Some a else index (pred n) l'
end.

次の定理の、非形式的な証明を書きなさい。

forall X n l, length l = n -> @index X (S n) l = None.

(* FILL IN HERE *)

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Gen_J: 帰納法の仮定の一般化

Require Export Poly_J.

前章ではdouble関数が単射であることの証明をしました。この証明を始める方法は少々デリケートです。

intros n. induction n.

で始めればうまくいきます。 しかし

intros n m. induction n.

で始めてしまうと、帰納段階の途中でつまってしまいます...

Theorem double_injective_FAILED : forall n m,
double n = double m ->
n = m.
Proof.
intros n m. induction n as [| n'].
Case "n = O". simpl. intros eq. destruct m as [| m'].
SCase "m = O". reflexivity.
SCase "m = S m'". inversion eq.
Case "n = S n'". intros eq. destruct m as [| m'].
SCase "m = O". inversion eq.
SCase "m = S m'".
assert (n' = m') as H.
SSCase "Proof of assertion".

Admitted.

何がいけなかったのでしょうか?

帰納法の仮定を導入した時点でmをコンテキストに導入してしまっていることが問題です。直感的に言うと、これはCoqに「ある特定のnとmについて考えよう」と教えるようなものです。そのため、この特定のnとmについてdouble n = double mならばn = mを証明しなければなりません。

次のタクティックスinduction nはCoqに「このゴールのnに関する帰納法で示します」と伝えます。 なので、命題

- P n= “double n = double mならばn = m“

がすべてのnについて成り立つことを

- P O(すなわち、”double O = double mならばO = m”)

- P n -> P (S n)(すなわち、 “double n = double mならばn = m” が成り立つならば “double (S n) = double mならばS n = m”).

2つめの文を見ると、これは奇妙なことを言っています。 それによると特定のmについて

- “double n = double mならばn = m“

が成り立つならば

- “double (S n) = double mならばS n = m”.

が証明できることになります。

これがどう奇妙かを説明するために、特定のm、例えば5について考えてみましょう。 するとこの文は

- Q= “double n = 10ならばn = 5“

が成り立つならば

- R= “double (S n) = 10ならばS n = 5”.

が証明できると言っています。

しかしQを知っていても、Rを証明するのには何の役にたちません! (もしQからRを示そうとすると「double (S n) = 10...を仮定すると...」のようなことを言わないといけませんが、これは途中でつまってしまいます。double (S n)が10があることは、double nが10であるかどうかについては何も教えてくれません。なのでQはここでは役にたちません。)

まとめると、mがすでにコンテキストにある状態でnに関する帰納法による証明がうまくいかないのは、すべてのnと単一のmの関係を示そうとしてしまうかからです。

double_injectiveのいい証明では、inductionをnに対して使う時点ではmをゴールに残しています。

Theorem double_injective' : forall n m,
double n = double m ->
n = m.
Proof.
intros n. induction n as [| n'].
Case "n = O". simpl. intros m eq. destruct m as [| m'].
SCase "m = O". reflexivity.
SCase "m = S m'". inversion eq.
Case "n = S n'".

intros m eq.

destruct m as [| m'].
SCase "m = O". inversion eq.
SCase "m = S m'".

assert (n' = m') as H.
SSCase "Proof of assertion". apply IHn'.
inversion eq. reflexivity.
rewrite -> H. reflexivity.  Qed.

帰納法によって証明しようとしていることが、限定的すぎないかに注意する必要があることを学びました。もしnとmの性質に関する証明をnに関する帰納法で行ないたい場合は、mを一般的なままにしておく必要があるかもしれません。

しかし、この戦略がいつもそのまま使えるわけではありません。ときには、ちょっとした工夫が必要です。 例えば、double_injectiveをnではなくmに関する帰納法で示したいとします。

Theorem double_injective_take2_FAILED : forall n m,
double n = double m ->
n = m.
Proof.
intros n m. induction m as [| m'].
Case "m = O". simpl. intros eq. destruct n as [| n'].
SCase "n = O". reflexivity.
SCase "n = S n'". inversion eq.
Case "m = S m'". intros eq. destruct n as [| n'].
SCase "n = O". inversion eq.
SCase "n = S n'".
assert (n' = m') as H.
SSCase "Proof of assertion".

Admitted.

mに関する帰納法の問題点は、最初にnをintroしなければいけないことです。 (もし何も導入せずにinduction mをしても、Coqは自動的にnをintroします!) どうしたらいいでしょうか?

1つめの方法は、補題の文を書き換えてnより先にmがくるようにします。これはうまくいきますが、いい方法ではありません。特定の証明戦略のために補題の文をめちゃくちゃにしたくありません。補題の文はできるかぎり明確かつ自然な形であるべきです。

その代わりに、いったんすべての限量変数を導入し、そのうちいくつかをコンテキストから取りゴールの先頭に置くことで、再び一般化します。これはgeneralize dependentタクティックスによって実現できます。

Theorem double_injective_take2 : forall n m,
double n = double m ->
n = m.
Proof.
intros n m.

generalize dependent n.

induction m as [| m'].
Case "m = O". simpl. intros n eq. destruct n as [| n'].
SCase "n = O". reflexivity.
SCase "n = S n'". inversion eq.
Case "m = S m'". intros n eq. destruct n as [| n'].
SCase "n = O". inversion eq.
SCase "n = S n'".
assert (n' = m') as H.
SSCase "Proof of assertion".
apply IHm'. inversion eq. reflexivity.
rewrite -> H. reflexivity.  Qed.

この定理の非形式な証明を見てみましょう。なおnを限量化したまま帰納法によって命題を証明する箇所は、形式的な証明ではgeneralize dependentを使う箇所に対応します。

Theorem: すべての自然数nとmについて、double n = double mならばn = m。

Proof:mをnatとする。mに関する帰納法によって、 すべてのnに対してdouble n = double mならばn = mを示す。

- 最初にm = 0と仮定し、nをdouble n = double mをみたす数とし、n = 0を示す。m = 0なので、doubleの定義よりdouble n = 0。nについて2つの場合分けが考えれる。n = 0ならば、それが示したいことなので、すでに終了している。そうでなくてn = S n'となるn'が存在する場合、矛盾を導くことで証明する。doubleの定義によりn = S (S (double n'))だが、これは仮定dobule n = 0と矛盾する。

- そうでない場合、m = S m'と仮定し、nは再びdouble n = double mをみたす数とする。n = S m'を示すために、 帰納法の仮定「 すべての数sに対してdouble s = double m'ならばs = m'」を用いる。m = S m'とdoubleの定義により、double n = S (S (double m'))。nに関して2つの場合分けが考えられる。 n = 0ならば、定義によりdouble n = 0となり、矛盾を導ける。なので、n = S n'となるn'があると仮定すると、再びdoubleの定義により、S (S (double n')) = S (S (double m'))。 ここでinversionによりdouble n' = dobule m'。 帰納法の仮定をn'をあてはめることで、n' = m'という結論を導ける。S n' = nかつS m' = mなので、これにより示せる。☐

練習問題: ★★★ (gen_dep_practice)

mに関する帰納法で以下を示しなさい。

Theorem plus_n_n_injective_take2 : forall n m,
n + n = m + m ->
n = m.
Proof.
(* FILL IN HERE *) Admitted.

lに関する帰納法で示しなさい。

Theorem index_after_last: forall (n : nat) (X : Type) (l : list X),
length l = n ->
index (S n) l = None.
Proof.
(* FILL IN HERE *) Admitted.

FILL IN HERE ☐

練習問題: ★★★, optional (index_after_last_informal)

index_after_lastのCoqによる証明に対応する非形式的な証明を書きなさい。

Theorem: すべてのSetX, リストl : list X, 自然数nに対して、length l = nならばindex (S n) l = None。

Proof:(* FILL IN HERE *)☐

練習問題: ★★★, optional (gen_dep_practice_opt)

lに関する帰納法で示しなさい。

Theorem length_snoc''' : forall (n : nat) (X : Type)
(v : X) (l : list X),
length l = n ->
length (snoc l v) = S n.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (app_length_cons)

app_lengthを使わずにl1に関する帰納法で示しなさい。

Theorem app_length_cons : forall (X : Type) (l1 l2 : list X)
(x : X) (n : nat),
length (l1 ++ (x :: l2)) = n ->
S (length (l1 ++ l2)) = n.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★★, optional (app_length_twice)

app_lengthを使わずにl1に関する帰納法で示しなさい。

Theorem app_length_twice : forall (X:Type) (n:nat) (l:list X),
length l = n ->
length (l ++ l) = n + n.
Proof.
(* FILL IN HERE *) Admitted.

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Prop_J: 命題と根拠

“アルゴリズムは計算可能な証明である。”(Robert Harper)

Require Export Poly_J.

命題によるプログラミング

読者への注意: この章で紹介するコンセプトは、初めて見た時には抽象的すぎるように感じられるかもしれません。たくさんの練習問題を用意しておいたので、テキストの詳細を理解する途中であっても大部分は解けるはずです。できるかぎり多くの問題、特に★の問題には重点的に挑戦するようにしてください。

これまで宣言したり証明した文は等式の形をしたものだけでした。しかし、数学で用いられる文や証明にはもっと豊かな表現力があります。この章では Coq で作れる数学的な文（命題; proposition ）の種類と、その証明を「根拠（ evidence ）を与えること」でどのように進めていくか、もう少し詳しく、基本的な部分から見ていきましょう。

命題（ proposition ）は、”2足す2は4と等しい”のような事実に基づく主張を表現するための文です。Coq において命題はProp型の式として書かれます。これまであまりそれについて明示的に触れてはきませんでしたが、皆さんはすでに多くの例を見てきています。

Check (2 + 2 = 4).

Check (ble_nat 3 2 = false).

証明可能な主張も証明不能な主張も、どちらも完全な命題であると言えます。しかし単に命題であるということと、証明可能であるということは別ものです！

Check (2 + 2 = 5).

2 + 2 = 4も2 + 2 = 5もPropの型をもった妥当な式です。

これまで Coq の中で命題を使う方法は1つしか見ていません。Theorem（あるいはLemma、Example）の宣言の中でだけです。

Theorem plus_2_2_is_4 :
2 + 2 = 4.
Proof. reflexivity.  Qed.

しかし命題にはもっといろいろな使い方があります。例えば、他の種類の式（数字、関数、型、型関数など）と同様に、Definitionを使うことで命題に名前を与えることができます。

Definition plus_fact : Prop  :=  2 + 2 = 4.
Check plus_fact.

こうすることで、命題が使える場所ならどこでも、例えば、Theorem宣言内の主張などとして使うことができます。

Theorem plus_fact_is_true :
plus_fact.
Proof. reflexivity.  Qed.

ここまでに登場したすべての命題は等式の形をした命題でした。それ以外にも新しい命題の形を作ることができます。例えば、命題PとQが与えられば、”PならばQ“という命題を作れます。

Definition strange_prop1 : Prop :=
(2 + 2 = 5) -> (99 + 26 = 42).

また、自由変数nを含む命題Pが与えられれば、forall n, Pという形の命題を作れます。

Definition strange_prop2 :=
forall n, (ble_nat n 17 = true) -> (ble_nat n 99 = true).

最後に、パラメータ化された命題（parameterized proposition ）の定義を紹介します。例えば、”数nが偶数である”という主張はどのようになるでしょうか？偶数を判定する関数は書いてあるので、偶数であるという定義は”nが偶数であることとevenb n = trueは同値である”が考えられます。

Definition even (n:nat) : Prop :=
evenb n = true.

これはevenを関数として定義します。この関数は数nを適用されると、nが偶数であることを示す命題を返します。

Check even.

Check (even 4).

Check (even 3).

evenの型nat -> Propは3つの意味を持っています。(1) “evenは数から命題への関数である。”(2) “evenは数nでインデックスされた命題の集りである”。(3) “evenは数の性質(property)である。”

命題（パラメータ化された命題も含む）はCoqにおける第一級（first-class）市民です。このため、ほかの定義の中でこれらの命題を使うことができます。

Definition even_n__even_SSn (n:nat) : Prop :=
(even n) -> (even (S (S n))).

複数の引数を受け取るように定義することや..

Definition between (n m o: nat) : Prop :=
andb (ble_nat n o) (ble_nat o m) = true.

...部分適用もできます。

Definition teen : nat->Prop := between 13 19.

他の関数に、引数として命題（パラーメータ化された命題も含む）を渡すことすらできます。

Definition true_for_zero (P:nat->Prop) : Prop :=
P 0.

Definition true_for_n__true_for_Sn (P:nat->Prop) (n:nat) : Prop :=
P n -> P (S n).

2つのアンダースコアを続けたx__yという形式の名前は、”xならばyである”と読みます。

パラメータ化された命題を引数として渡す関数をさらに2つ紹介します。1つ目の関数は、ある自然数n'についてPが真ならば常にn'の次の数でもPが真であることを述べています。

Definition preserved_by_S (P:nat->Prop) : Prop :=
forall n', P n' -> P (S n').

そして次の関数は、すべての自然数について与えられた命題が真であることを述べています。

Definition true_for_all_numbers (P:nat->Prop) : Prop :=
forall n, P n.

これらを一つにまとめることで、自然数に関する帰納法の原理を自分で再宣言できます。パラメータ化された命題Pが与えられた場合、0についてPが真であり、P n'が真のときP (S n')が真であるならば、すべての自然数についてPは真である。

Definition our_nat_induction (P:nat->Prop) : Prop :=
(true_for_zero P) ->
(preserved_by_S P) ->
(true_for_all_numbers P).

根拠

Prop型として妥当な式には証明可能な命題と証明不能な命題の両方があることは既にお話ししました。当然、証明可能なものの方に興味が向かいます。Pが命題でありeがPの証明である場合、すなわちeが「Pが真である」ということの根拠となっている場合、それを”e : P“と書くことができます。”型を持っている”や”属している”を表わす記法と同じなのは決して偶然ではありません。型に属する値と命題に”属する”根拠の間には根本的で有益な類似性があるのです。

次の疑問は”証明とはなにか？”です。すなわち、ある命題が真であるという根拠として使えるものは、どようなものでしょうか？

帰納的に定義された命題

もちろん、その答は命題の形に依存します。例えば、含意の命題P->Qに対する根拠と連言の命題P/\Qに対する根拠は異なります。この章では以後、たくさんの具体的な例を示します。

まずは、不可分（ atomic ）な命題を考えましょう。それは私達が使っている論理にあらかじめ組み込まれているものはなく、特定のドメイン（領域）に有用な概念を導入するものです。例えば、Basic_J.v でday型を定義したので、saturdayとsundayは”良い”日であるといったような、特定の日に対して何らかの概念を考えてみましょう。良い日に関する定理を宣言し証明したい場合はまず、”良い”とはどういう意味かをCoqに教えなければなりません。ある日dが良い（すなわちdがsaturdayかsundayである）とする根拠として何を使うかを決める必要があります。このためには次のように宣言します。

Inductive good_day : day -> Prop :=
| gd_sat : good_day saturday
| gd_sun : good_day sunday.

Inductiveキーワードは、「データ値の集合を定義する場合(Typeの世界)」であっても「根拠の集合を定義する場合(Propの世界)」であってもまったく同じ意味で使われます。上記の定義の意味はそれぞれ次のようになっています:

- 最初の行は「good_dayは日によってインデックスされた命題であること」を宣言しています。

- 二行目はgd_satコンストラクタを宣言しています。このコンストラクタはgood_day saturdayという主張の根拠として使えます。

- 三行目はgd_sunコンストラクタを宣言しています。このコンストラクタはgood_day sundayという主張の根拠として使えます。

言い換えると、ある日が良いということを”土曜日は良い、日曜日は良い、それだけだ”と言うことで定義しています。これによって、日曜日が良いということを証明したいときは、good_dayの意味を定義したときにそう言っていたかを調べるだけで済みます。

Theorem gds : good_day sunday.
Proof. apply gd_sun. Qed.

コンストラクタgd_sunは、日曜日が良いという主張を正当化する”原始的（primitive）な根拠”、つまり公理です。

同様に、月曜日は火曜日の前に来て、火曜日は水曜日の前に来て、...、ということを宣言する公理を、2つの日をパラメータとして取る命題day_beforeとして定義できます。

Inductive day_before : day -> day -> Prop :=
| db_tue : day_before tuesday monday
| db_wed : day_before wednesday tuesday
| db_thu : day_before thursday wednesday
| db_fri : day_before friday thursday
| db_sat : day_before saturday friday
| db_sun : day_before sunday saturday
| db_mon : day_before monday sunday.

帰納的な定義による命題で導入される公理では全称記号を使うこともできます。例えば、「どの日だって歌いだしたくなるほど素敵な日だ」という事実については、わざわざ説明する必要もないでしょう

Inductive fine_day_for_singing : day -> Prop :=
| fdfs_any : forall d:day, fine_day_for_singing d.

この行は、もしdが日ならば、fdfs_any dはfine_day_for_singing dの根拠として使えるということを宣言してます。言い換えると、dがfine_day_for_singingであるという根拠をfdfs_anyをdに適用することで作ることができます。

要するに、水曜日は「歌いだしたくなるほど素敵な日」だということです。

Theorem fdfs_wed : fine_day_for_singing wednesday.
Proof. apply fdfs_any. Qed.

これも同じように、最初の行は”私は命題fine_day_for_singing wednesdayに対する根拠を示し、その根拠をあとで参照するためにfdfs_wedという名前を導入しようと思っている”と解釈できます。二行目は、Coqにその根拠をどのように組み立てるかを示しています。

証明オブジェクト

同じことができる、もっと原始的な方法もあります。Definitonの左辺を導入しようとしている名前にし、右辺を根拠の構築方法ではなく、根拠そのものにすればいいのです。

Definition fdfs_wed' : fine_day_for_singing wednesday :=
fdfs_any wednesday.

Check fdfs_wed.
Check fdfs_wed'.

式fdfs_any wednesdayは、パラメータを受け取る公理fdfs_anyを 特定の引数wednesdayによって具体化したものととらえることができます。別の見方をすれば、fdfs_anyを原始的な”根拠コンストラクタ”として捉えることもできます。この根拠コンストラクタは、特定の日を適用されると、その日が「歌わずにはいられないほどよい日」である根拠を表します。型forall d:day, fine_day_for_singing dはこの機能を表しています。これは、前章で登場した多相型forall X, list Xにおいてnilコンストラクタが型からその型を持つ空リストを返す関数であったことと同様です。

もうちょっと面白い例を見てみましょう。”OK”な日とは(1)良い日であるか(2)OKな日の前日であるとしましょう。

Inductive ok_day : day -> Prop :=
| okd_gd : forall d,
good_day d ->
ok_day d
| okd_before : forall d1 d2,
ok_day d2 ->
day_before d2 d1 ->
ok_day d1.

最初のコンストラクタは”dがOKな日であることを示す一つ目の方法は、dが良い日であるという根拠を示すことである”と読めます。二番目のは”d1がOKであることを示す別の方法は、その日が別の日d2の前日であり、d2がOKであるという根拠を示すことである”と読めます。

ここでwednesdayがOKであることを証明したいとしましょう。証明するには2つの方法があります1つめは原始的な方法であり、コンストラクタの適用を何度もネストすることで、正しい型を持つ式を書き下します。

Definition okdw : ok_day wednesday :=
okd_before wednesday thursday
(okd_before thursday friday
(okd_before friday saturday
(okd_gd saturday gd_sat)
db_sat)
db_fri)
db_thu.

2つめの方法は、機械に支援してもらう方法です。証明モードに入り、最終的に満たされるまでゴールやサブゴールを通してCoqに案内してもらいます。

Theorem okdw' : ok_day wednesday.
Proof.

apply okd_before with (d2:=thursday).

apply okd_before with (d2:=friday).

apply okd_before with (d2:=saturday).

apply okd_gd. apply gd_sat.

apply db_sat.

apply db_fri.

apply db_thu. Qed.

しかし、根本的なところでこの2つの証明方法は同じです。証明スクリプト内のコマンドを実行するときにCoqが実際にやっていることは、目的の型を持つ式を構築することと全く同じです。

Print okdw'.

この式は一般的に証明オブジェクト（Proof object）と呼ばれます。

証明オジェクトはCoqの根本を支えています。タクティックによる証明は、自分で証明オブジェクトを書く代わりに、証明オブジェクトを構築する方法をCoqに指示する基本的なプログラムです。もちろん、この例では証明オブジェクトはタクティックによる証明よりも短くなっています。しかし、もっと興味深い証明では証明オブジェクトを手で構築することが苦痛に思えるほど大きく複雑になります。この後の章では、各ステップを書くことなく複雑な証明オブジェクトを構築できる自動化されたタクティックをたくさん紹介します。

カリー・ハワード対応

この

命題          ~  集合 / 型
証明          ~  元、要素 / データ値

という類似性は、カリー・ハワード対応（もしくはカリー・ハワード同型, Curry-Howard correspondence, Curry-Howard isomorphism）と呼ばれます。これにより多くのおもしろい性質が導けます。

集合に空集合、単集合、有限集合、無限集合があり、それぞれが0個、1個、多数の元を持っているように、命題も0個、1個、多数、無限の証明を持ちえます。命題Pの各要素は、それぞれ異なるPの根拠です。もし要素がないならば、Pは証明不能です。もしたくさんの要素があるならば、Pには多数の異なった証明があります。

含意

これまで->演算子(含意)を小さい命題から大きな命題を作るために使ってきました。このような命題に対する根拠はどのようになるでしょうか?次の文を考えてみてください。

Definition okd_before2 := forall d1 d2 d3,
ok_day d3 ->
day_before d2 d1 ->
day_before d3 d2 ->
ok_day d1.

これを日本語で書くと、もし3つの日があるとして、d1がd2の前日であり、d2がd3の前日であり、かつd3がOKであるということがわかっているならば、d1もOKである、という意味になります。

okd_before2をタクティッックを使って証明するのは簡単なはずです...

練習問題: ★, optional (okd_before2_valid)

Theorem okd_before2_valid : okd_before2.
Proof.
(* FILL IN HERE *) Admitted.

☐

ところで、これに対応する証明オブジェクトはどんな感じでしょうか?

答: 含意としての->と、関数の型の->の記法はそっくりです。これをそのまま解釈すると、forall d1 d2 d3, ok_day d3 -> day_before d2 d1 -> day_before d3 d2 -> ok_day d1という型をもった式を見付ける必要があります。なので探すものは6個の引数(3個の日と、3個の根拠)を受け取り、1個の根拠を返す関数です!それはこんな感じです。

Definition okd_before2_valid' : okd_before2 :=
fun (d1 d2 d3 : day) =>
fun (H : ok_day d3) =>
fun (H0 : day_before d2 d1) =>
fun (H1 : day_before d3 d2) =>
okd_before d1 d2 (okd_before d2 d3 H H1) H0.

練習問題: ★, optional (okd_before2_valid_defn)

下記の結果としてCoqが出力するものを予測しなさい。

Print okd_before2_valid.

帰納的に定義された型に対する帰納法の原理

Inductiveでデータ型を新たに定義するたびに、Coqは帰納法の原理に対応する公理を自動生成します。

型tに対応する帰納法の原理はt_indという名前になります。ここでは自然数に対するものを示します。

Check nat_ind.

これは先ほど定義したour_nat_inductionの性質とまったく同じであることに注意してください。

inductionタクティックは、基本的にはapply t_indの単純なラッパーです。もっとわかりやすくするために、inductionタクティックのかわりにapply nat_indを使っていくつかの証明をしてみる実験をしてみましょう。例えば、Basics_Jの章で見た定理の別の証明を見てみましょう。

Theorem mult_0_r' : forall n:nat,
n * 0 = 0.
Proof.
apply nat_ind.
Case "O". reflexivity.
Case "S". simpl. intros n IHn. rewrite -> IHn.
reflexivity.  Qed.

この証明は基本的には前述のものと同じですが、細かい点で特筆すべき違いがあります。1つめは、帰納段階の証明（"S"の場合）において、inductionが自動でやってくれること（intros）を手作業で行なう必要があることです。

2つめは、nat_indを適用する前にコンテキストにnを導入していないことです。nat_indの結論は限量子を含む式であり、applyで使うためにはこの結論と限量子を含んだゴールの形とぴったりと一致する必要があります。inductionタクティックはコンテキストにある変数にもゴール内の量子化された変数のどちらにでも使えます。

3つめは、applyタクティックは変数名（この場合はサブゴール内で使われる変数名）を自動で選びますが、inductionは（as ...節によって）使う名前を指定できることです。実際には、この自動選択にはちょっと不都合な点があります。元の定理のnとは別の変数としてnを再利用してしまいます。これはCase注釈がただのSだからです。ほかの証明で使ってきたように省略しない形で書くと、これはn = S nという意味のなさない形になってしまいます。このようなことがあるため、実際にはnat_indのような帰納法の原理を直接適用するよりも、素直にinductionを使ったほうがよいでしょう。しかし、ちょっとした例外を除けば実際にやりたいのはnat_indの適用であるということを知っておくことは重要です。

練習問題: ★★ (plus_one_r’)

inductionタクティックを使わずに、下記の証明を完成させなさい。

Theorem plus_one_r' : forall n:nat,
n + 1 = S n.
Proof.
(* FILL IN HERE *) Admitted.

☐

ほかのInductiveによって定義されたデータ型に対しても、Coqは似た形の帰納法の原理を生成します。コンストラクタc1...cnを持った型tを定義すると、Coqは次の形の定理を生成します。

t_ind :
forall P : t -> Prop,
... c1の場合 ... ->
... c2の場合 ... ->
...                 ->
... cnの場合 ... ->
forall n : t, P n

各場合分けの形は、対応するコンストラクタの引数の数によって決まります。一般的な規則を紹介する前に、もっと例を見てみましょう。最初は、コンストラクタが引数を取らない場合です。

Inductive yesno : Type :=
| yes : yesno
| no : yesno.

Check yesno_ind.

練習問題: ★ (rgb)

次のデータ型に対してCoqが生成する帰納法の原理を予測しなさい。紙に答えを書いたのち、Coqの出力と比較しなさい。

Inductive rgb : Type :=
| red : rgb
| green : rgb
| blue : rgb.
Check rgb_ind.

☐

別の例を見てみましょう。引数を受け取るコンストラクタがある場合です。

Inductive natlist : Type :=
| nnil : natlist
| ncons : nat -> natlist -> natlist.

Check natlist_ind.

練習問題: ★ (natlist1)

上記の定義をすこし変えたとしましょう。

Inductive natlist1 : Type :=
| nnil1 : natlist1
| nsnoc1 : natlist1 -> nat -> natlist1.

このとき、帰納法の原理はどのようになるでしょうか？

☐

これらの例より、一般的な規則を導くことができます。

- 型宣言は複数のコンストラクタを持ち、各コンストラクタが帰納法の原理の各節に対応する。

- 各コンストラクタcは引数a1..anを取る。

- aiはt（定義しようとしているデータ型）、もしくは別の型sかのどちらかである。

- 帰納法の原理において各節は以下のことを述べている。 - “型a1...anのすべての値x1...xnについて、各xについてPが成り立つならば、c x1 ... xnについてもPが成り立つ”

練習問題: ★ (ExSet)

帰納的に定義された集合に対する帰納法の原理が次のようなものだとします。

ExSet_ind :
forall P : ExSet -> Prop,
(forall b : bool, P (con1 b)) ->
(forall (n : nat) (e : ExSet), P e -> P (con2 n e)) ->
forall e : ExSet, P e

ExSetの帰納的な定義を示しなさい。

Inductive ExSet : Type :=
(* FILL IN HERE *)
.

☐

多相的なデータ型ではどのようになるでしょうか？

多相的なリストの帰納的定義はnatlistによく似ています。

Inductive list (X:Type) : Type :=
| nil : list X
| cons : X -> list X -> list X.

ここでの主な違いは、定義全体が集合Xによってパラメータ化されていることです。つまり、それぞれのXごとに帰納型list Xを定義していることになります。(定義本体でlistが登場するときは、常にパラメータXに適用されていることに注意してください。)帰納法の原理も同様にXによってパラメータ化されます。

list_ind :
forall (X : Type) (P : list X -> Prop),
P [] ->
(forall (x : X) (l : list X), P l -> P (x :: l)) ->
forall l : list X, P l

この表現（とlist_indの全体的な形）に注目してください。帰納法の原理全体がXによってパラメータ化されています。別の見方をすると、list_indは多相関数と考えることができます。この関数は、型Xが適用されると、list Xに特化した帰納法の原理を返します。

練習問題: ★ (tree)

次のデータ型に対してCoqが生成する帰納法の原理を予測しなさい。答えが書けたら、それをCoqの出力と比較しなさい。

Inductive tree (X:Type) : Type :=
| leaf : X -> tree X
| node : tree X -> tree X -> tree X.
Check tree_ind.

☐

練習問題: ★ (mytype)

以下の帰納法の原理を生成する帰納的定義を探しなさい。

mytype_ind :
forall (X : Type) (P : mytype X -> Prop),
(forall x : X, P (constr1 X x)) ->
(forall n : nat, P (constr2 X n)) ->
(forall m : mytype X, P m ->
forall n : nat, P (constr3 X m n)) ->
forall m : mytype X, P m

☐

練習問題: ★, optional (foo)

以下の帰納法の原理を生成する帰納的定義を探しなさい。

foo_ind :
forall (X Y : Type) (P : foo X Y -> Prop),
(forall x : X, P (bar X Y x)) ->
(forall y : Y, P (baz X Y y)) ->
(forall f1 : nat -> foo X Y,
(forall n : nat, P (f1 n)) -> P (quux X Y f1)) ->
forall f2 : foo X Y, P f2

☐

練習問題: ★, optional (foo’)

次のような帰納的定義があるとします。

Inductive foo' (X:Type) : Type :=
| C1 : list X -> foo' X -> foo' X
| C2 : foo' X.

foo'に対してCoqはどのような帰納法の原理を生成するでしょうか?空欄を埋め、Coqの結果と比較しなさい

foo'_ind :
forall (X : Type) (P : foo' X -> Prop),
(forall (l : list X) (f : foo' X),
_______________________ ->
_______________________   ) ->
___________________________________________ ->
forall f : foo' X, ________________________

☐

帰納法の仮定

この概念において”帰納法の仮定”はどこにあてはまるでしょうか?

数に関する帰納法の原理

forall P : nat -> Prop,
P 0  ->
(forall n : nat, P n -> P (S n))  ->
forall n : nat, P n

は、すべての命題P（より正確には数値 n を引数にとる命題P）について成り立つ一般的な文です。この原理を使うときはいつも、nat->Propという型を持つ式をPとして選びます。

この式に名前を与えることで、証明をもっと明確にできます。例えば、mult_0_rを”forall n, n * 0 = 0“と宣言するかわりに、”forall n, P_m0r n“と宣言します。なお、ここでP_m0rは次のように定義されています。

Definition P_m0r (n:nat) : Prop :=
n * 0 = 0.

あるいは

Definition P_m0r' : nat->Prop :=
fun n => n * 0 = 0.

でも同じ意味です。

これで、証明する際にP_m0rがどこに表われるかが分かりやすくなります。

Theorem mult_0_r'' : forall n:nat,
P_m0r n.
Proof.
apply nat_ind.
Case "n = O". reflexivity.
Case "n = S n'".

unfold P_m0r. simpl. intros n' IHn'.
apply IHn'.  Qed.

このように名前をつける手順は通常の証明では不要です。しかし、1つ2つ試してみると、帰納法の仮定がどのようなものなのかが分かりやすくなります。forall n, P_m0r nをnによる帰納法（inductionかapply nat_indを使う）によって証明しようとすると、最初のサブゴールではP_m0r 0（”Pが0に対して成り立つ”）を証明しなければならず、2つめのサブゴールではforall n', P_m0r n' -> P_m0r (S n')（”Pがn'について成り立つならば、PがS n'についても成り立つ”あるいは”PがSによって保存される”）を証明しなければなりません。帰納法の仮定は、2つめの推論の基礎になっています –Pがn'について成り立つことを仮定することにより、それによってPがS n'について成り立つことを示すことができます。

偶数について再び

最初の方で命題に関して議論してきた例のいくつかは、偶数の概念に結びついてきます。これまでは偶数を判定するためにevenb nを計算することから始め、真偽値を返していました。つぎに、nが偶数であることを主張する命題even nを(evenbを使うことで）作りました。つまり、”nが偶数である”を”evenbがnを適用されたときにtrueを返す”と定義していました。

偶数性の概念をそのまま定義する別の方法があります。evenb関数（”ある計算がtrueを返すなら、その数は偶数である”）を使って間接的に定義するのではなく、「偶数とは何を意味するか」を根拠を使って直接定義することができるのです。

Inductive ev : nat -> Prop :=
| ev_0 : ev O
| ev_SS : forall n:nat, ev n -> ev (S (S n)).

この定義は、数mが偶数であるという根拠を与える方法が2つあることを示しています。第一に、0は偶数であり、ev_0がこれに対する根拠です。次に、任意のnに対してm = S (S n)とし、nが偶数であるという根拠eを与えることができるならば、mも偶数であると言え、ev_SS n eがその根拠となります。

練習問題: ★, optional (four_ev)

4が偶数であることをタクティックによる証明と証明オブジェクトによる証明で示しなさい。

Theorem four_ev' :
ev 4.
Proof.
(* FILL IN HERE *) Admitted.
Definition four_ev : ev 4 :=
(* FILL IN HERE *) admit.

☐

練習問題: ★★ (ev_plus4)

nが偶数ならば4+nも偶数であることをタクティックによる証明と証明オブジェクトによる証明で示しなさい。

Definition ev_plus4 : forall n, ev n -> ev (4 + n) :=
(* FILL IN HERE *) admit.
Theorem ev_plus4' : forall n,
ev n -> ev (4 + n).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★ (double_even)

次の命題をタクティックによって証明しなさい。

Theorem double_even : forall n,
ev (double n).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★★, optional (double_even_pfobj)

上記のタクティックによる証明でどのような証明オブジェクトが構築されるかを予想しなさい。(答を確かめる前に、Caseを除去しましょう。 これがあると証明オブジェクトが少し見づらくなります。)

☐

根拠に対する帰納法の推論

Coqの設計は非常に直交しているので、素朴な命題を根拠と共に定義するためにInductiveキーワードを使った場合、その定義と関連する帰納法の原理が使えるはずです。実際、関連する帰納法の原理は存在しており、この節ではそれをどう使うかについて見ていきます。ウォーミングアップとして、単純なdestructが帰納的に定義された根拠に対してどのように働くかを見てみましょう。

偶数であるという根拠を作るだけでなく、偶数であるという根拠に対して推論を行います。帰納的な宣言によってevを導入したことにより、「ev_0とev_SSが、偶数であるという根拠を作る唯一の方法である」ということが分かるだけでなく、「この2つのコンストラクタによってのみ偶数であるという根拠が構築される」ということが分かります。

言い換えると、ev nという根拠Eがあった場合、Eは2つの形式のどちらか片方であることが分かります : 「Eがev_0(かつnが0)である」か、「Eがev_SS n' E'(かつnがS (S n')) かつE'がn'が偶数であるということの根拠である」かのどちらかです。

なので、これまで見てきたように帰納的に定義されたデータに対してだけでなく、帰納的に定義された根拠に対しても、destructタクティックを使うことは有用です。

一例として、ev nならばev (n-2)を示すために、nが偶数であるという根拠に対してdestructタクティックを使ってみましょう。

Theorem ev_minus2: forall n,
ev n -> ev (pred (pred n)).
Proof.
intros n E.
destruct E as [| n' E'].
Case "E = ev_0". simpl. apply ev_0.
Case "E = ev_SS n' E'". simpl. apply E'.  Qed.

練習問題: ★ (ev_minus2_n)

Eの代わりにnに対してdestructするとどうなるでしょうか?

☐

nが偶数であるという根拠に対してinductionを実行することもできます。evを満たすnに対して、先に定義したevenb関数がtrueを返すことを示すために使ってみましょう。

Theorem ev_even : forall n,
ev n -> even n.
Proof.
intros n E. induction E as [| n' E'].
Case "E = ev_0".
unfold even. reflexivity.
Case "E = ev_SS n' E'".
unfold even. apply IHE'.  Qed.

(もちろん、even n -> ev nも成り立つはずです。 どのように証明するかは次の章で説明します。)

練習問題: ★ (ev_even_n)

この証明をEでなくnに対する帰納法として実施できますか?

☐

帰納的に定義された命題に対する帰納法の原理は、帰納的に定義された集合のそれとまったく同じ形をしているわけではありません。今の段階では、根拠ev nに対する帰納法はnに対する帰納法に似ているが、ev nが成立する数についてのみ着目することができると直感的に理解しておいて問題ありません。evの帰納法の原理をもっと深く見て行き、実際に何を起こっているかを説明します。

練習問題: ★ (l_fails)

*)

FILL IN HERE 次の証明はうまくいきません。 [[

Theorem l : forall n,ev n.Proof.intros n. induction n.Case “O”. simpl. apply ev_0.Case “S”....]]理由を簡潔に説明しない。

(* FILL IN HERE *)

☐

練習問題: ★★ (ev_sum)

帰納法が必要な別の練習問題をやってみましょう。

Theorem ev_sum : forall n m,
ev n -> ev m -> ev (n+m).
Proof.
(* FILL IN HERE *) Admitted.

☐

「n+2が偶数ならばnも偶数である」という偶数に関する根拠を分析したいとします。この種の場合分けにdestructを使ってみたくなるかもしれません。

Theorem SSev_ev_firsttry : forall n,
ev (S (S n)) -> ev n.
Proof.
intros n E.
destruct E as [| n' E'].

Admitted.

しかし、これはうまくいきません。 例えば、最初のサブゴールにおいて、nが0であるという情報が失われてしまいます。ここで使うべきは、inversionです。

Theorem SSev_even : forall n,
ev (S (S n)) -> ev n.
Proof.
intros n E. inversion E as [| n' E']. apply E'.  Qed.

このようなinversionの使い方は最初はちょっと謎めいて思えるかもしれません。これまでは、inversionは等号に関する命題に対して使い、コンストラクタから元のデータを取り出すためか、別のコンストラクタを区別するためににしか使っていませんでした。しかし、ここではinversionが 帰納的に定義された命題に対する根拠を分析するためにも使えることを紹介しました。

ここで、inversionが一般にはどのように動作するかを説明します。Iが現在のコンテキストにおいて帰納的に宣言された仮定Pを参照しているとします。ここで、inversion Iは、Pのコンストラクタごとにサブゴールを生成します。 各サブゴールにおいて、 コンストラクタがPを証明するのに必要な条件によってIが置き換えられます。サブゴールのうちいくつかは矛盾が存在するので、inversionはそれらを除外します。残っているのは、元のゴールが成り立つことを示すのに必要なサブゴールです。

先ほどの例で、inversionはev (S (S n))の分析に用いられ、 これはコンストラクタev_SSを使って構築されていることを判定し、そのコンストラクタの引数を仮定に追加した新しいサブゴールを生成しました。(今回は使いませんでしたが、補助的な等式も生成しています。)このあとの例では、inversion のより一般的な振る舞いについて調べていきましょう。

練習問題: ★ (inversion_practice)

Theorem SSSSev_even : forall n,
ev (S (S (S (S n)))) -> ev n.
Proof.
(* FILL IN HERE *) Admitted.

inversionタクティックは、仮定が矛盾していることを示し、ゴールを達成するためにも使えます。

Theorem even5_nonsense :
ev 5 -> 2 + 2 = 9.
Proof.
(* FILL IN HERE *) Admitted.

☐

一般に、帰納的な命題にはdestructの代わりにinversionを使えます。このことは一般的に、コンストラクタごとに場合分けができることを示しています。加えて、いくつかの補助的な等式も得ることができます。なお、ゴールはその等式によって書き換えられていますが、その他の仮定は書き換えられていません。

Theorem ev_minus2': forall n,
ev n -> ev (pred (pred n)).
Proof.
intros n E. inversion E as [| n' E'].
Case "E = ev_0". simpl. apply ev_0.
Case "E = ev_SS n' E'". simpl. apply E'.  Qed.

練習問題: ★★★ (ev_ev_even)

何に対して帰納法を行えばいいかを探しなさい。(ちょっとトリッキーですが)

Theorem ev_ev_even : forall n m,
ev (n+m) -> ev n -> ev m.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (ev_plus_plus)

既存の補題を適用する必要のある練習問題です。帰納法も場合分けも不要ですが、書き換えのうちいくつかはちょっと大変です。Basics_J.v のplus_swap'で使ったreplaceタクティックを使うとよいかもしれません。

Theorem ev_plus_plus : forall n m p,
ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
(* FILL IN HERE *) Admitted.

☐

なぜ命題を帰納的に定義するのか?

ここまで見てきたように “ある数が偶数である” というのは次の2通りの方法で解釈されます。間接的には「テスト用のevenb関数」によって、直接的には「偶数であることの根拠の構築方法を帰納的に記述すること」によってです。これら2つの偶数の定義は、ほぼ同じくらい楽に宣言できますし、同じように動きます。どちらを選ぶかは基本的に好みの問題です。

しかし、興味深いほかの性質、例えば「テスト用の関数を書くのが難しかったり不可能だったりする」ようなことがあることを考えると、直接的な帰納的な定義のほうが好ましいと言えます。例えば以下のように定義されるMyPropという性質について考えてみましょう。

- 4は性質MyPropを満たす

- nが性質MyPropを満たすならば、4+nも満たす

- もし2+nが性質MyPropを満たすならば、nも満たす

- その他の数は、性質MyPropを満たさない

これは数の集合の定義としてはなんの問題もありませんが、この定義をそのままCoqのFixPointに変換することはできません。(それだけでなく他の言語の再帰関数に変換することもできません。)Fixpointを用いてこの性質をテストするうまい方法を見つけられるかもしれません。(実際のところ、この場合はそれほど難しいことではありません)しかし、一般的にこういうことをしようとすると、かなりあれこれ考える必要があるでしょう。実際、CoqのFixpointは停止する計算しか定義できないので、定義しようとする性質が計算不能なものだった場合、どれだけがんばってもFixpointでは定義できません。

一方、性質MyPropがどのようなものかの根拠を与える帰納的な定義を書くことは、非常に簡単です。

Inductive MyProp : nat -> Prop :=
| MyProp1 : MyProp 4
| MyProp2 : forall n:nat, MyProp n -> MyProp (4 + n)
| MyProp3 : forall n:nat, MyProp (2 + n) -> MyProp n.

MyPropの非形式的な定義の最初の3つの節は、帰納的な定義の最初の3つの節に反映されています。4つ目の節は、Inductiveキーワードによって強制されます。

これで、偶数のときにやったように、ある数がMyPropを満たすことの根拠を作ることができます。

Theorem MyProp_ten : MyProp 10.
Proof.
apply MyProp3. simpl.
assert (12 = 4 + 8) as H12.
Case "Proof of assertion". reflexivity.
rewrite -> H12.
apply MyProp2.
assert (8 = 4 + 4) as H8.
Case "Proof of assertion". reflexivity.
rewrite -> H8.
apply MyProp2.
apply MyProp1.   Qed.

練習問題: ★★ (MyProp)

MyPropに関する便利な2つの事実があります。証明はあなたのために残してあります。

Theorem MyProp_0 : MyProp 0.
Proof.
(* FILL IN HERE *) Admitted.

Theorem MyProp_plustwo : forall n:nat, MyProp n -> MyProp (S (S n)).
Proof.
(* FILL IN HERE *) Admitted.

☐

これらを使って、MyPropは全ての奇数について成り立つことと、その逆も成り立つをことを示せます。

Theorem MyProp_ev : forall n:nat,
ev n -> MyProp n.
Proof.
intros n E.
induction E as [| n' E'].
Case "E = ev_0".
apply MyProp_0.
Case "E = ev_SS n' E'".
apply MyProp_plustwo. apply IHE'.  Qed.

この定理の非形式的な証明は次のようになります。

Theorem : 任意の自然数nにおいて、もしev nならばMyProp nが成り立つ。

Proof :nをnatとし、ev nの導出をEとします。MyProp nの導出を示さなければなりません。Eの帰納法について証明を行うので、以下の2つの場合について考えなければなりません。

- Eの最後のステップがev_0だった場合、nは0となる。 その場合、MyProp 0が成り立つをことを示さなければならない;補題MyProp_0よりこれは真である。

- Eの最後のステップがev_SSだった場合、n = S (S n')となるn'が存在し、ev n'の導出が存在する。MyProp n'が成り立つという帰納法の仮定を用いて、MyProp (S (S n'))を示さなければなりません。しかし、補題MyProp_plustwoにより、MyProp n'を示せば十分であることがわかり、さらにそれは帰納法の仮定そのものです。

練習問題: ★★★ (ev_MyProp)

Theorem ev_MyProp : forall n:nat,
MyProp n -> ev n.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (ev_MyProp_informal)

[] *)

ev_MyPropの 形式的な証明に対応する非形式的な証明を書きなさい。

定理: すべての自然数nに対して、MyProp nならばev n。

証明: (ここを埋める)☐

全体像: Coqの2つの空間

これまで Coq の基本的な構造についていくつか触れてきたので、ここでは一歩引いてそれらがどのように組み合わさっているか少しだけ見てみましょう。

Coq の式は2つの異なる空間のどちらかに属しています。

- Typeは計算とデータの空間です。

- Propは論理的表明と根拠の空間です。

2つの空間には深い類似性がありますが（それぞれについて値、帰納的な定義、限量子などについて言及できます）、数学的構造の定義や推論において、これらはまったく異なる役割を果たします。

値

どちらのの空間もコンストラクタの無限集合をスタート地点とします。コンストラクタは内部構造を全く持っておらず、ただのアトミックなシンボルです。例えば、true,false,O,S,nil,cons,ev_0,ev_SS, ... などです。

最も単純な値は、コンストラクタの適用だけによって構成されます。例えば:

- true

- O

- S (S (S O))

- ev_0

- ev_SS (S (S O)) ev_0

- ev_SS (S (S (S (S O)))) (ev_SS (S (S O)) ev_0)

そのような式は木として考えることもできます。葉は0引数のコンストラクタ（引数なしで適用された）であり、内部ノードは1個以上の値に対して適用されたコンストラクタです。Type空間において、値はデータとして捉えます。Propにおいて、値を根拠として捉えます。Propにおける値は、導出木と呼ばれることもあります。

関数もまた値です。例えば、

- fun x => true

- fun b => negb b

- fun n => S (S (S n))

- fun n => fun (P : ev n) => ev_SS (S (S n)) P

Type空間の値を返す関数は、計算を表します: 入力値を受け取り、入力から計算した出力値を返します。Propの値を返す関数は、全量子化された根拠と呼ばれます。 すなわち、ある命題に対する根拠を作るのに入力も用います。（作られる命題も入力を使うかもしれません。）

帰納的定義

帰納的（Inductive）な定義をするということは、全ての値の集合の「特定の部分集合に名前を与える」ということです。例えば、帰納的な型natの定義は、要素の全てが自然数を表しているような集合を表します。つまり、 帰納的な定義が「全ての値の集合」から以下のような属性を持つ要素だけを抜き出して部分集合natを作っていると考えられます。

- 値Oはこの集合の要素である。

- この集合は、Sの適用に対し閉じている（つまり、値nがこの集合の要素ならS nもまたこの集合の要素である）。

- これらの条件を満たす最小の集合がこの集合である。（つまり集合natの要素だけが上の二つの条件を満たしていて、それ以外のものはこの集合に入っていない）。

帰納的に定義された集合は、それ自身が複合的な値のコンストラクタの引数となることもあります。例えば、以下のようなものです。

- nat

- nil nat

- cons nat O (cons nat (S O) (nil nat))

また、引数や戻り値が集合となっているような関数を書くこともできます。例えば、listは集合Xを引数にとり、list Xの集合を返す関数です（この集合の要素は、集合Xの要素を持つリストです）。

同様に、帰納的な型evの定義は、その数字が偶数であるという根拠となる命題を集めたものの定義です。このことは、全てのnについて、この定義が全ての値の集合から以下の条件を満たす値を全て集めて部分集合ev nを抜き出してくるような定義、ということです。

- 値ev_0は集合ev Oの要素である。

- この集合はev_SSの型が正しい（well-typed な）適用に関して閉じている。 – つまり、もし値eが集合ev nの要素なら、値ev_SS n eは集合ev (S (S n))の要素である。;

- これらの条件を満たす最小の集合がこの集合である。 (つまり集合ev nの要素だけが上の二つの条件を満たしていて、それ以外のものはこの集合に入っていない）。

型と種類 (kinds)

ざっくり言うと、Coqにおける「型」は、「式の分類に使われる式」です。例えば、bool,nat,list bool,list nat,nat->natなどは全て「型」です。boolという型は、trueやfalseを他の値と区別しますし、nat型はO,S O,S (S O)など、nat->nat型はfun n => S nのように数を引数にとって数を返す関数値を他の値と区別します。

TypeやProp、そしてそれらの複合式（Type -> Typeなど）には、「ひとつ上位の」分類 – それは, 「型（もしくは命題）の型を表す式」のようなものと考えてもらっていいですが – が可能です。それを、単なる「型」と混同しないために「種類 (kinds)」と呼ぶことにします。例えば、natやnat->nat、list natなどは全てTypeという「種類」ですし、listはType -> Type、evはnat -> Propという種類です。

命題 vs. ブール値

命題とブール値は、一見とてもよく似ているように見えます。しかしこの二つは根本的に違うものです！

- ブール値は、「計算の世界における値」です。bool型の式は全て、（自由変数を持っていない限り）必ずtrueかfalseのどちらかに簡約することができます。

- 命題は「論理の世界にいおける型」です。これらは「証明可能（この型の式を書くことができる）」か、「証明不能（そのような式は存在しない）」かのいずれかです。従って「命題がtrueである」というような言い方は意味を持ちません。我々は時折、命題に対してそれが “true” か “false” というようなことを言ってしまいがちですが、厳格に言えばこれは間違っています。命題は「証明可能かそうでないか」のどちらかです。

関数 vs. 限量子

A->Bという型もforall x:A, Bという型も、どちらも型Aから型Bへの関数である、という点については同じです。この二つの唯一の違いは、後者の場合戻り値の型Bが引数xを参照できるということです。たとえば、

- 関数fun x:nat => x + xは型nat->natを持っていますが、このことは任意の数nを別の数に対応させるもの、ということです。

- 対して、関数fun X : Type => nil (list X)はforall X : Type, list (list X)という型になります。これは、任意の集合Xを、X型のリストのリストに対応させるもの、ということになります。（もちろん、nilは通常nil Xと書く代わりに[] と書くのが普通ですが。）

実際、関数を記述するためのこれら二つの書き方はほぼ同じですが、 Coq ではA->Bの書き方は、xがBの定義の中に変数として現れない限り、fun x:nat => x + xのただの省略形と考えていいでしょう。例えば、好みならばこれをforall x:nat, natと書いてもいいのです。

関数 vs. 含意

TypeにしろPropにしろ、我々はその値を別の値に変換する関数を書くことができます。 また、関数はそれ自身が値です。このことは、我々が、次のようなことが出来ることを意味しています。

- 関数を引数にしたり、関数を戻り値にしたりする高階関数を書くこと。

- 関数をコンストラクタに適用し、関数を保持したさらに複雑な値を作り出すこと。

Prop型を扱うP->Qという型の関数は、根拠Pを引数にとり、新たな根拠Qを結果として生成するものです。このような関数はそれ自身が「PならばQである」ということの根拠であると見なせます。そのことから、Pが真であるという根拠があるなら、それを関数に適用してQが真であるという根拠を得ることができます。含意に根拠を与えるということは、関数に根拠を与えるということと同じです。このことが、我々が Coq で関数と論理学の「含意」に同じ表記を与えている理由です。これらは全く同じものなのです。

非形式的な証明

Q: 命題Pの形式的な証明と、同じ命題Pの非形式的な証明の間にはどのような関係があるのでしょうか？

A: 後者は、読む人に「どのように非形式的な証明を導くか」を示すようなものとなっているべきです。

Q: どの程度細かく書く必要があるのですか？

A: この問いに唯一と言えるような解答はありません。回答には選択の幅があります。

その範囲の片方の端は、読み手にただ形式的な証明全体を与えればよいという考えです。つまり非形式的な証明は、形式的な証明をただ単に普通の言葉で書き換えただけ 、ということです。この方法は、読み手に形式的な証明を書かせるための能力を与えることはできますが、それについて何かも「教えてくれる」訳ではありません。

これに対しもう一方の端は、「その定理は真で、なぜあなたがそう考えたかが事細かに示されている」ような記述です。この方法も、「教える」ということに関してはあまりいいやり方とはいえません。なぜなら、証明を記述するときはいつも、今証明しようとしているものの奥深くにまで目を向け考えることが必要とされますが、細かく書きすぎると証明を読む側の人の多くは自分自身の力で同じ思考にたどり着くことなく、あきらめて証明の記述に頼ってしまうでしょう。

一番の答えはその中間にあります。全ての要点をかいつまんだ証明というのは、「かつてあなたが証明をしたときに非常に苦労した部分について、読む人が同じ苦労をしなくて済むようになっている」ようなものです。そしてまた、読み手が同じような苦労を何時間もかけてする必要がないよう、証明の中で使える部品などを高度に示唆するものでなければなりません（例えば、仮定 IH が何を言っているかや、帰納的な証明のどの部分に現れるかなど）。しかし、詳細が少なすぎると、証明の主要なアイデアがうまく伝わりません。

もう一つのキーポイント：もし我々が命題 P の形式的な証明と非形式的な証明について話しているならば、命題 P 自体は何も変わりません。このことは、形式的な証明も非形式的な証明も、同じ「世界」について話をしていて、同じルールに基づいていなければならない、と言うことを意味しています。

帰納法による非形式的な証明

ここまで、我々は「帰納法を使った形式的な証明の舞台裏」を覗くことにずいぶん章を割いてきました。そろそろ「帰納法を使った非形式的な証明」に話を向けてみましょう。

現実世界の数学的な事柄をやりとりするた記述された証明を見てみると、極端に風呂敷が広く衒学的なものから、逆に短く簡潔すぎるものまで様々です。理想的なものはその間のとこかにあります。もちろん、じぶんなりのスタイルを見つけるまでは、衒学的なスタイルから始めてみるほうがいいでしょう。また、学習中には、標準的なテンプレートと比較してみることも、学習の一助になるでしょう。このような考えから、我々は以下の二つのテンプレートを用意しました。一つは「データ」に対して（「型」に潜む帰納法な構造について）帰納法を適用したもの、もう一つは「命題」に対して（命題に潜む機能的な定義について）帰納法を適用したものです。このコースが終わるまでに、あなたが行った帰納的な証明の全てに、どちらかの方法を適用してみましょう。

Template:

- 定理: < “For alln:S,P(n),”の形で全量子化された命題。ただしSは帰納的に定義された集合。>証明:nについての帰納法で証明する。

- n = c a1 ... akと仮定して、<...もし必要ならSのそれぞれの要素aについてIHであることをを示す。>ならば <...ここで再びP(c a1 ... ak)を示す> である。 <P(n)を証明してこのケースを終わらせる...>

- ☐

Example:

- Theorem: 任意の集合X、リストl : list X、 自然数nについて、 もしlength l = nが成り立つなら、index (S n) l = Noneも成り立つ。 Proof:lについての帰納法で証明する。

- まず、l = [] と仮定して、任意のnでこれが成り立つことを示す。もし length[= n] ならばindex (S n) [= None] 。 これは index の定義から直接導かれる 。

- 次に、xとl'においてl = x :: l'と仮定して、任意のn'についてlength l' = n'ならばindex (S n') l' = Noneである時、任意のnについて、もしlength (x::l') = nならばindex (S n) (x::l') = Noneを示す。 nをlength l = nとなるような数とすると、

length l = length (x::l') = S (length l'),

これは以下の十分条件である。

index (S (length l')) l' = None.

しかしこれは仮定法の仮定から直接導かれる。l'の length となるようなn'を選択すればよい。☐

帰納的に定義された証明オブジェクトは、しばしば”導出木”と呼ばれるため、この形の証明は「導出による帰納法（ induction on derivations ）」として知られています。

Template :

- Theorem : <”Q -> P,” という形を持った命題。ただしQは帰納的に定義された命題（さらに一般的には、”For allx``y``z,Q x y z -> P x y z” という形の命題）>Proof :Qの導出による帰納法で証明する。

- Qがcであることを示した最後のルールを仮定して、 <...ここでaの全ての型をコンストラクタの定義にある等式と共に示し、型Qを持つaがIHであることをそれぞれ示す。>ならば <...ここで再びPを示す> である。

- ☐

Example

- Theorem :<=という関係は推移的である – すなわち、任意の 数値n,m,oについて、もしn <= mとm <= oが成り立つならばn <= oである。 Proof :m <= oについての帰納法で証明する。

- m <= oがle_nであることを示した最後のルールを仮定する。 それによりm = oであることとその結果が直接導かれる。

- m <= oがle_Sであることを示した最後のルールを仮定する。 それによりm <= o'を満たすo'についてo = S o'が成り立つ。帰納法の仮定法よりn <= o'である。 従ってle_Sよりn <= oである。☐

選択課題

この項では、Coq において帰納法がどのように機能しているか、もう少し詳しく示していきたいと思います。最初にこの項を読むときは、全体を読み流す感じでもかまいません（完全に読み飛ばすのではなく、概要だけでも眺めてください。ここに書いてあることは、多くの Coq ユーザーにとって、概要だけでも頭に入れておくことで、いつか直面する問題に対する回答となりえるものです。）

inductionタクティックについてもう少し

inductionタクティックは、実はこれまで見てきたような、いささか低レベルな作業をこなすだけのものではありません。

自然数に関する機能的な公理の非形式的な記述を思い出してみてください。:

- もしP nが数値 n を意味する何かの命題だとして、命題 P が全ての数値 n に ついて成り立つことを示したい場合は、このような推論をすることができます。:

- P Oが成り立つことを示す

- もしP n'が成り立つなら,P (S n')が成り立つことを示す。

- 任意の n についてP nが成り立つと結論する。

我々が証明をintros nで始め、次にinduction nとすると、これはCoqに「特定の」nについて（それを仮定取り込むことで）考えてから、その後でそれを帰納法を使って任意の数値にまで推し進めるよう示していることになります。

このようなときに Coq が内部的に行っていることは、帰納法を適用した変数を「再一般化（ re-generalize ）」することです。例えば、plusの結合則を証明するケースでは、

Theorem plus_assoc' : forall n m p : nat,
n + (m + p) = (n + m) + p.
Proof.

...最初に 3個の変数を全てコンテキストに導入しています。これはつまり”任意のn,m,pについて考える”という意味になっています...

intros n m p.

...ここで、inductionタクティックを使いP n（任意のnについてn + (m + p) = (n + m) + p）を証明し、すぐに、コンテキストにある特定のnについても証明します。

induction n as [| n'].
Case "n = O". reflexivity.
Case "n = S n'".

inductionが作成した（帰納法の手順とも言うべき）二つ目のゴールでは、P n'ならば任意のn'でP (S n')が成り立つことを証明する必要があります。 この時にinductionタクティックはP (S n')をゴールにしたまま、自動的にn'とP n'をコンテキストに導入してくれます。

simpl. rewrite -> IHn'. reflexivity.  Qed.

inductionをゴールにある量化された変数に適用してもかまいません。

Theorem plus_comm' : forall n m : nat,
n + m = m + n.
Proof.
induction n as [| n'].
Case "n = O". intros m. rewrite -> plus_0_r. reflexivity.
Case "n = S n'". intros m. simpl. rewrite -> IHn'.
rewrite <- plus_n_Sm. reflexivity.  Qed.

induction nがmをゴールに残したままにしていることに注目してください。つまり、今証明しようとしている帰納的な性質は、forall mで表されているということです。

もしinductionをゴールにおいて量化された変数に対して他の量化子の後に適用すると、inductionタクティックは自動的に変数をその量化子に基づいてコンテキストに導入します。

Theorem plus_comm'' : forall n m : nat,
n + m = m + n.
Proof.

ここでnの代わりにmを induction しましょう。...

induction m as [| m'].
Case "m = O". simpl. rewrite -> plus_0_r. reflexivity.
Case "m = S m'". simpl. rewrite <- IHm'.
rewrite <- plus_n_Sm. reflexivity.  Qed.

練習問題: ★, optional (plus_explicit_prop)

plus_assoc'とplus_comm'を、その証明とともに上のmult_0_r''と同じスタイルになるよう書き直しなさい。このことは、それぞれの定理が帰納法で証明された命題に明確な定義を与え、この定義された命題から定理と証明を示しています。

(* FILL IN HERE *)

☐

冒険心を満足させるために、もう少し脱線してみましょう。Definitionでパラメータ化された命題を定義できるなら、Fixpointでも定義できていいのではないでしょうか？もちろんできます！しかし、この種の「再帰的なパラメータ化」は、日常的に使われる数学の分野と必ずしも調和するわけではありません。そんなわけで次の練習問題は、例としてはいささか不自然かもしれません。

練習問題: ★★★★, optional (true_upto_n__true_everywhere)

true_upto_n_exampleを満たすような再帰関数true_upto_n__true_everywhereを定義しなさい。

Example true_upto_n_example :
(true_upto_n__true_everywhere 3 (fun n => even n))
= (even 3 -> even 2 -> even 1 -> forall m : nat, even m).
Proof. reflexivity.  Qed.
*)

☐

Propにおける帰納法の原理

最初のほうで、我々は帰納的に定義された「集合」に対して、Coqが生成する帰納法の原理をつぶさに見てきました。evのように、帰納的に定義された「命題」の帰納法の原理は、やや複雑でした。これらに共通して言えることですが、これらをevの証明に使おうとする際、帰納的な発想のもとでevが持ちうるものの中から使えそうな形になっているものを探します。それは0が偶数であることの根拠であったり、あるnについてS (S n)は偶数であるという根拠（もちろん、これにはn自身が偶数であるということの根拠も含まれていなければなりませんが）だったりするでしょう。しかしながら直観的な言い方をすると、我々が証明したいものは根拠についての事柄ではなく、数値についての事柄です。つまり、我々は根拠をベースに数値の属性を証明できるような帰納法の原理を必要としているわけです。例えば、ずいぶん前にお話ししたように、evの帰納的な定義は、こんな感じで...

Inductive ev : nat -> Prop :=
| ev_0 : ev O
| ev_SS : forall n:nat, ev n -> ev (S (S n)).

... ここから生成される帰納法の原理はこんな風になります ...

ev_ind_max :
forall P : (forall n : nat, ev n -> Prop),
P O ev_0 ->
(forall (n : nat) (e : ev n),
P n e -> P (S (S n)) (ev_SS n e)) ->
forall (n : nat) (e : ev n), P n e

... なぜなら：

- evは数値nでインデックスされている（evに属するオブジェクトeは、いずれも特定の数nが偶数であることの根拠となっている）ため、この命題Pはnとeの両方でパラメータ化されている。– つまり、この帰納法の原理は一つの偶数と、それが偶数であることの根拠が揃っているような主張の証明に使われる。

- 偶数であることに根拠を与える方法は二つある（evのコンストラクタは二つある）ので、帰納法の原理を適用すると、二つのゴールが生成されます。:

- PがOとev_0で成り立つことを証明する必要があるもの。

- nが偶数でeがその偶数性の根拠であるときはいつでも、もしPがnとeのもとで成り立つなら、S (S n)とev_SS n eのもとで成り立つことを証明する必要があるもの。

- もしこれらのサブゴールが証明できれば、この帰納法の原理によってPが全ての偶数nとその偶数性の根拠eのもとでtrueであることが示される。

しかしこれは、私たちが求めたり必要としているものより少しだけ柔軟にできていて、偶数性の根拠の断片を属性として含むような論理的主張を証明する方法を与えてくれます。我々の興味の対象は「数値の属性が偶数である」ことの証明なのですから、その興味の対象も数値に関する主張であって、根拠に対するものではないはずです。これにより、単にnだけでパラメータ化されていて、Pがすべての偶数nで成り立つことを示せるような命題Pを証明する際に帰納法の原理を得ることがより楽になります。

forall P : nat -> Prop,
... ->
forall n : nat, ev n -> P n

このような理由で、Coqは実際にはevのために次のような帰納法の原理を生成します。:

Check ev_ind.

Coqが根拠の式eを、命題Pのパラメータから取り去っていることに注目してください。その結果として、仮定forall (n:nat) (e:ev n), ...を [forall (n:nat), evn -> ...] に書き換えています。すなわち、我々はすでにev nから証明可能であることの明白な根拠を求められていないのです。

ev_indを自然言語で書き直すと、

- Pが自然数の属性である（つまり、Pが全てのnについての命題である）と仮定し、P nが偶数の場合常に成り立つことを示す。これは、以下を示すのに十分である。:

- Pが0において成り立つ。

- 全てのnにおいて、もしnが偶数でPがnにおいて成り立つなら、PはS (S n)においても成り立つ。

inductionとする代わりにev_indを直接 apply することもできます。以下は、これと同じパターンです。

Theorem ev_even' : forall n,
ev n -> even n.
Proof.
apply ev_ind.
Case "ev_0". unfold even. reflexivity.
Case "ev_SS". intros n' E' IHE'. unfold even. apply IHE'.  Qed.

練習問題: ★★★, optional (prop_ind)

帰納的に定義されたlistとMyPropに対し、Coq がどのような帰納法の原理を生成するか、予想して書き出し、次の行を実行した結果と比較しなさい。

Check list_ind.
Check MyProp_ind.

☐

練習問題: ★★★, optional (ev_MyProp’)

もう一度ev_MyPropを証明しなさい。ただし、今度はinductionタクティックの代わりにapply MyProp_indを使いなさい。

Theorem ev_MyProp' : forall n:nat,
MyProp n -> ev n.
Proof.
apply MyProp_ind.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★★, optional (MyProp_pfobj)

もう一度MyProp_evとev_MyPropを証明しなさい。ただし今度は、明確な証明オブジェクトを手作業で構築（上のev_plus4でやったように）することで証明しなさい。

(* FILL IN HERE *)

☐

Module P.

練習問題: ★★★, optional (p_provability)

次の、帰納的に定義された命題について考えてみてください。：

Inductive p : (tree nat) -> nat -> Prop :=
| c1 : forall n, p (leaf _ n) 1
| c2 : forall t1 t2 n1 n2,
p t1 n1 -> p t2 n2 -> p (node _ t1 t2) (n1 + n2)
| c3 : forall t n, p t n -> p t (S n).

*)

FILL IN HERE これについて、どのような時にp t nが証明可能であるか、その条件をを自然言語で説明しなさい。

(* FILL IN HERE *)

☐

End P.

追加練習問題

palindrome（回文）は、最初から読んでも逆から読んでも同じになるようなシーケンスです。

- list Xでパラメータ化され、それが palindrome であることを示すような帰納的

命題palを定義しなさい。（ヒント：これには三つのケースが必要です。この定義は、リストの構造に基いたものとなるはずです。まず一つのコンストラクタ、

c : forall l, l = rev l -> pal l

は明らかですが、これはあまりうまくいきません。）

- 以下を証明しなさい。

forall l, pal (l ++ rev l).

- 以下を証明しなさい。

forall l, pal l -> l = rev l.

(* FILL IN HERE *)

☐

一つ前の練習問題で定義したpalを使って、これを証明しなさい。

forall l, l = rev l -> pal l.

(* FILL IN HERE *)

☐

あるリストが、別のリストのサブシーケンス（ subsequence ）であるとは、最初のリストの要素が全て二つ目のリストに同じ順序で現れるということです。ただし、その間に何か別の要素が入ってもかまいません。例えば、

[1,2,3]

は、次のいずれのリストのサブシーケンスでもあります。

[1,2,3]
[1,1,1,2,2,3]
[1,2,7,3]
[5,6,1,9,9,2,7,3,8]

しかし、次のいずれのリストのサブシーケンスでもありません。

[1,2]
[1,3]
[5,6,2,1,7,3,8]

- list nat上に、そのリストがサブシーケンスであることを意味するような命題subseqを定義しなさい。（ヒント：三つのケースが必要になります）

- サブシーケンスである、という関係が「反射的」であることを証明しなさい。つまり、どのようなリストも、それ自身のサブシーケンスであるということです。

- 任意のリストl1、l2、l3について、もしl1がl2のサブシーケンスならば、l1はl2 ++ l3のサブシーケンスでもある、ということを証明しなさい。.

- （これは少し難しいですので、任意とします）サブシーケンスという関係は推移的である、つまり、l1がl2のサブシーケンスであり、l2がl3のサブシーケンスであるなら、l1はl3のサブシーケンスである、というような関係であることを証明しなさい。（ヒント：何について帰納法を適用するか、よくよく注意して下さい。）

(* FILL IN HERE *)

☐

次のような、帰納的な定義をしたとします：

Inductive foo (X : Set) (Y : Set) : Set :=
| foo1 : X -> foo X Y
| foo2 : Y -> foo X Y
| foo3 : foo X Y -> foo X Y.

次の空欄を埋め、この定義のために Coq が生成する帰納法の原理を完成させなさい。

foo_ind
: forall (X Y : Set) (P : foo X Y -> Prop),
(forall x : X, __________________________________) ->
(forall y : Y, __________________________________) ->
(________________________________________________) ->
________________________________________________

☐

次に挙げた帰納法の原理について考えてみましょう：

bar_ind
: forall P : bar -> Prop,
(forall n : nat, P (bar1 n)) ->
(forall b : bar, P b -> P (bar2 b)) ->
(forall (b : bool) (b0 : bar), P b0 -> P (bar3 b b0)) ->
forall b : bar, P b

これに対応する帰納的な集合の定義を書きなさい。

Inductive bar : Set :=
| bar1 : ________________________________________
| bar2 : ________________________________________
| bar3 : ________________________________________.

☐

次のような、帰納的に定義された命題が与えられたとします：

Inductive no_longer_than (X : Set) : (list X) -> nat -> Prop :=
| nlt_nil  : forall n, no_longer_than X [] n
| nlt_cons : forall x l n, no_longer_than X l n ->
no_longer_than X (x::l) (S n)
| nlt_succ : forall l n, no_longer_than X l n ->
no_longer_than X l (S n).

この命題のために Coq が生成する帰納法の原理を完成させなさい。

no_longer_than_ind
: forall (X : Set) (P : list X -> nat -> Prop),
(forall n : nat, ____________________) ->
(forall (x : X) (l : list X) (n : nat),
no_longer_than X l n -> ____________________ ->
_____________________________ ->
(forall (l : list X) (n : nat),
no_longer_than X l n -> ____________________ ->
_____________________________ ->
forall (l : list X) (n : nat), no_longer_than X l n ->
____________________

☐

Coq に次のような定義を与えたとします：

Inductive R : nat -> list nat -> Prop :=
| c1 : R 0 []
| c2 : forall n l, R n l -> R (S n) (n :: l)
| c3 : forall n l, R (S n) l -> R n l.

次のうち、証明可能なのはどの命題でしょうか？

- R 2 [1,0]

- R 1 [1,2,1,0]

- R 6 [3,2,1,0]

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Logic_J: Coqにおける論理

Require Export "Prop_J".

Coqの組み込み論理は非常に小さく、帰納的定義(Inductive)、全称記号(forall)、ならば(->)だけです。しかしそれ以外の論理演算子（かつ、または、否定、存在量化子、等号など）はこれら組み込みのものから定義できます。

全称記号 と ならば

実は、->とforallは 同じものです! Coqの->記法はforallの短縮記法に過ぎません。仮定に名前をつけることができることから、forall記法の方がより一般的に使われます。

例えば次の命題を考えてみましょう。

Definition funny_prop1 := forall n, forall (E : ev n), ev (n+4).

もしもこの命題を含む証明項があったら、その中でこの命題は二つの引数（一つは、数字n、もう一つはnが偶数であることの根拠E）を持つ関数になっているはずです。しかし根拠となるEはfunny_prop1の中では使われていませんから、これにわざわざEという名前をつけることはちょっと無意味です。このような場合は、次のように書くこともできます。

Definition funny_prop1' := forall n, forall (_ : ev n), ev (n+4).

また、より親しみ深い記法では次のようにも書けます。

Definition funny_prop1'' := forall n, ev n -> ev (n+4).

これはつまり “P -> Q” は単に “forall (_:P), Q” の糖衣構文に過ぎないということを示しています。

論理積、連言（Conjunction、AND）

命題PとQの論理積（logical conjunction）は、コンストラクタを一つしか持たないInductiveを使った定義で表せます。

Inductive and (P Q : Prop) : Prop :=
conj : P -> Q -> (and P Q).

注意してほしいのは、前の章で取り上げた関数evの定義と同様に、この定義もパラメータ化された命題になっていますが、この場合はパラメータが数値ではなく命題である、ということです。

この定義の内容を直感的に理解するのに、そうややこしく考える必要はありません。and P Qに根拠を与えるには、Pの根拠とQの根拠が必要だということです。もっと細かく言えば、

- もしpがPの根拠で、qがQの根拠であるなら、conj p qはand P Qの根拠となり得る。

- これはand P Qに根拠を与える唯一の方法である。というこは、もしand P Qの根拠が得られたならば、pをPの根拠とし、qをQの根拠とした上でconj p qが得られるということです。

ここまでさんざん論理積（conjunction）という言葉を使ってきましたが、ここでもっと馴染みのある、中置の記法を導入することにしましょう。

Notation "P /\ Q" := (and P Q) : type_scope.

（type_scopeという注釈は、Coqに対しこの記法が値にではなく、命題に現れるものであることを伝えまています。）

コンストラクタconjの型はどのようなものか考えてみましょう。

Check conj.

conjが四つの引数（P、Qという命題と、P、Qの根拠）をとることに注目して下さい。

基本的なことから色々なことを組み立てていくエレガントさはさておき、このような方法でconjunctionを定義することの利点は、これを含む文を、既に知っているタクティックで証明できることです。例えば、もしゴールが論理積を含んでいる場合、このたった一つのコンストラクタconjを適用するだけで証明できます。それは、conjの型を見ても分かるように現在のゴールを解決してからconjunctionの二つの部分を別々に証明するべきサブゴールにします。

Theorem and_example :
(ev 0) /\ (ev 4).
Proof.
apply conj.
apply ev_0.
apply ev_SS. apply ev_SS. apply ev_0.  Qed.

上の定理の証明オブジェクトをよく観察してみてください。

Print and_example.

この型に注目してください。

conj (ev 0) (ev 4) (... ev 0 の証明 ...) (... ev 4 の証明 ...)

さっき見たconjと同じ形をしているのが分かるでしょう。

apply conjとするかわりにsplitタクティックでも同じことができます。

Theorem and_example' :
(ev 0) /\ (ev 4).
Proof.
split.
Case "left". apply ev_0.
Case "right". apply ev_SS. apply ev_SS. apply ev_0.  Qed.

逆に、inversionタクティックを、コンテキストにある論理積の形をした仮定に使うことで、それの構築に使われた根拠を取り出し、コンテキストに加えることができます。

Theorem proj1 : forall P Q : Prop,
P /\ Q -> P.
Proof.
intros P Q H.
inversion H as [HP HQ].
apply HP.  Qed.

練習問題: ★, optional (proj2)

Theorem proj2 : forall P Q : Prop,
P /\ Q -> Q.
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem and_commut : forall P Q : Prop,
P /\ Q -> Q /\ P.
Proof.

intros P Q H.
inversion H as [HP HQ].
split.
apply HQ.
apply HP.  Qed.

この定理の証明を理解しやすくするため、再びCaseタクティックについて話します。 この証明で起こっていることをよく観察すると、P and Q の根拠となっている命題を抽出して、そこから逆向きに証明を再構築していることが分かるでしょう。

Print and_commut.

練習問題: ★★ (and_assoc)

次の証明では、inversionが、入れ子構造になった命題H : P /\ (Q /\ R)をどのようにHP: P,HQ : Q,HR : Rに分解するか、という点に注意しなががら証明を完成させなさい。

Theorem and_assoc : forall P Q R : Prop,
P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
intros P Q R H.
inversion H as [HP [HQ HR]].
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, recommended (even_ev)

今度は、前の章で棚上げしていたevenとevの等価性をが別の方向から証明してみましょう。ここで左側のandは我々が実際に注目すべきものです。右のandは帰納法の仮定となって帰納法による証明に結びついていくことになるでしょう。なぜこれが必要となるかは、左側のandをそれ自身で証明しようとして、行き詰まってみるとかるでしょう。

Theorem even_ev : forall n : nat,
(even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.

(* FILL IN HERE *) Admitted.

☐

練習問題: ★★

次の命題の証明を示すオブジェクトを作成しなさい。

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R :=
(* FILL IN HERE *) admit.

☐

Iff （両含意）

この、”if and only if（～である時、その時に限り）” で表される「両含意」という論理は馴染みのあるもので、次の二つの「ならば（含意）」をandでつないだものです。

Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

Notation "P <-> Q" := (iff P Q)
(at level 95, no associativity) : type_scope.

Theorem iff_implies : forall P Q : Prop,
(P <-> Q) -> P -> Q.
Proof.
intros P Q H.
inversion H as [HAB HBA]. apply HAB.  Qed.

Theorem iff_sym : forall P Q : Prop,
(P <-> Q) -> (Q <-> P).
Proof.

intros P Q H.
inversion H as [HAB HBA].
split.
Case "->". apply HBA.
Case "<-". apply HAB.  Qed.

練習問題: ★ (iff_properties)

上の、<->が対称であることを示す証明 (iff_sym) を使い、それが反射的であること、推移的であることを証明しなさい。

Theorem iff_refl : forall P : Prop,
P <-> P.
Proof.
(* FILL IN HERE *) Admitted.

Theorem iff_trans : forall P Q R : Prop,
(P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
(* FILL IN HERE *) Admitted.

ヒント: もしコンテキストに iff を含む仮定があれば、inversionを使ってそれを二つの含意の式に分割することができます。(なぜそうできるのか考えてみましょう。)

☐

練習問題: ★★ (MyProp_iff_ev)

ここまで、MyPropやevが これらの命題がある種の数値を特徴づける（偶数、などの）ことを見てきました。次のMyProp n <-> ev nが任意のnで成り立つことを証明しなさい。お遊びのつもりでかまわないので、その証明を、単純明快な証明、タクティックを使わないにような証明に書き換えてください。（ヒント：以前に使用した定理をうまく使えば、１行だけでかけるはずです！）

Definition MyProp_iff_ev : forall n, MyProp n <-> ev n :=
(* FILL IN HERE *) admit.

☐

Coqのいくつかのタクティックは、証明の際に低レベルな操作を避けるためiffを特別扱いします。 特にrewriteをiffに使うと、単なる等式以上のものとして扱ってくれます。

論理和、選言（Disjunction、OR）

論理和（Disjunction、OR）も、帰納的な命題として定義できます。

Inductive or (P Q : Prop) : Prop :=
| or_introl : P -> or P Q
| or_intror : Q -> or P Q.

Notation "P \/ Q" := (or P Q) : type_scope.

コンストラクタor_introlの型が何か考えてください。

Check or_introl.

このコンストラクタは三つの入力（P、Qと名付けられた命題に加え、Pの根拠）を引数にとり、P /\ Qの根拠を返します。次に、or_introrの型を見てみましょう。

Check or_intror.

ほとんどor_introlと同じように見えますが、PではなくQの根拠が要求されています。

直観的には、命題P \/ Qに根拠を与える方法は二つあることがわかります。

- Pの根拠を与える。（そしてそれがPの根拠であることを伝える。

これがコンストラクタor_introlの機能です）か、constructor), or

- Qの根拠をコンストラクタor_introrに与える。

P \/ Qは二つのコンストラクタを持っているので、P \/ Qの形の仮定にinversionを適用すると二つのサブゴールが生成されます。

Theorem or_commut : forall P Q : Prop,
P \/ Q  -> Q \/ P.
Proof.
intros P Q H.
inversion H as [HP | HQ].
Case "right". apply or_intror. apply HP.
Case "left". apply or_introl. apply HQ.  Qed.

次のように、apply or_introl、apply or_introrの代わりにleft、rightという短縮版のタクティックを使うこともできます。

Theorem or_commut' : forall P Q : Prop,
P \/ Q  -> Q \/ P.
Proof.
intros P Q H.
inversion H as [HP | HQ].
Case "right". right. apply HP.
Case "left". left. apply HQ.  Qed.

練習問題: ★★ optional (or_commut’‘)

or_commutの証明オブジェクトの型がどのようになるか、書き出してみてください。（ただし、定義済みの証明オブジェクトをPrintを使って見てみたりしないこと。）

(* FILL IN HERE *)

☐

Theorem or_distributes_over_and_1 : forall P Q R : Prop,
P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
intros P Q R. intros H. inversion H as [HP | [HQ HR]].
Case "left". split.
SCase "left". left. apply HP.
SCase "right". left. apply HP.
Case "right". split.
SCase "left". right. apply HQ.
SCase "right". right. apply HR.  Qed.

練習問題: ★★, recommended (or_distributes_over_and_2)

Theorem or_distributes_over_and_2 : forall P Q R : Prop,
(P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (or_distributes_over_and)

Theorem or_distributes_over_and : forall P Q R : Prop,
P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
(* FILL IN HERE *) Admitted.

☐

/\、\/のandb、orbへの関連付け

我々はすでに、Coqの計算における型(Type) と論理の命題 (Prop) との類似性について見てきました。ここではもう一つ、bool 型を扱うandbとorbが、/\と\/とのつながりともいうべきある種の類似性を持っていることに触れましょう。この類似性は、次の定理を見ればもっとはっきりします。これは、andbやorbが、ある入力に対する振る舞いを、その入力に対する命題にどのように変換するかを示したものです。

Theorem andb_true__and : forall b c,
andb b c = true -> b = true /\ c = true.
Proof.

intros b c H.
destruct b.
Case "b = true". destruct c.
SCase "c = true". apply conj. reflexivity. reflexivity.
SCase "c = false". inversion H.
Case "b = false". inversion H.  Qed.

Theorem and__andb_true : forall b c,
b = true /\ c = true -> andb b c = true.
Proof.

intros b c H.
inversion H.
rewrite H0. rewrite H1. reflexivity. Qed.

練習問題: ★ (bool_prop)

Theorem andb_false : forall b c,
andb b c = false -> b = false \/ c = false.
Proof.
(* FILL IN HERE *) Admitted.

Theorem orb_true : forall b c,
orb b c = true -> b = true \/ c = true.
Proof.
(* FILL IN HERE *) Admitted.

Theorem orb_false : forall b c,
orb b c = false -> b = false /\ c = false.
Proof.
(* FILL IN HERE *) Admitted.

☐

偽であるということ

論理学でいうところの「偽」は、Coqでは「帰納的に定義されてはいるがコンストラクタを一つも持たない命題」として定義されています。

Inductive False : Prop := .

直観的な理解:Falseは、根拠を示す方法を一つも持たない命題

練習問題: ★ (False_ind_principle)

「偽」に関する帰納的な公理を何か思いつくことができますか？

☐

Falseにはコンストラクタがないので、Falseの意味するところのものを反転（invert）してもサブゴールが生成されません。このことはつまり、「偽」からはどんなゴールも証明できる、ということです。

Theorem False_implies_nonsense :
False -> 2 + 2 = 5.
Proof.
intros contra.
inversion contra.  Qed.

これはどういうことでしょうか？inversionタクティックは仮定contraをその取りうるケースに分解し、それぞれにサブゴールを生成します。ここでcontraがFalseの根拠となっているため、そこから取りうるケースは存在しません。このため、証明に値するサブゴールがなくなり、そこで証明が終わってしまうのです。

逆に、Falseを証明する唯一の方法は、コンテキストに何か矛盾がないかを探すことです。

Theorem nonsense_implies_False :
2 + 2 = 5 -> False.
Proof.
intros contra.
inversion contra.  Qed.

実際、False_implies_nonsenseの証明は、特定の意味を持つ証明すべきことを何も持っていないので、任意のPに対して簡単に一般化できます。

Theorem ex_falso_quodlibet : forall (P:Prop),
False -> P.
Proof.
intros P contra.
inversion contra.  Qed.

ラテン語の 「ex falso quodlibet 」は、文字通り「偽からはあなたの望むものすべてがもたらされる」というような意味です。この定理は、「 principle of explosion 」としても知られています。

真であるということ

Coqで「偽」を定義することができたので、同じ考え方で「真」を定義することができるか、ということが次の関心事になります。もちろん、その答えは「Yes」です。

練習問題: ★★ (True_induction)

Trueを、帰納的な命題として定義しなさい。あなたの定義に対してCoqはどのような帰納的原理を生成してくれるでしょうか。 （直観的にはTrueはただ当たり前のように根拠を示される命題であるべきです。代わりに、帰納的原理から帰納的な定義を逆にたどっていくほうが近道だと気づくかもしれません。）

(* FILL IN HERE *)

☐

しかしながら、Falseとは違い、広い意味で解釈するとTrueには理論的な意味で奇妙なところがあります。ゴールの証明に使うには当たり前すぎ（それゆえつまらない）、仮定として有意義な情報を与えてくれないのです。

否定

命題Pの論理的な補集合というべきものは、not Pもしくは短縮形として~Pと表されます。

Definition not (P:Prop) := P -> False.

直観的には 「もしPがtrueでないなら、すべてが（Falseでさえ）仮定Pから導かれるということです。.

Notation "~ x" := (not x) : type_scope.

Check not.

Coqで否定を扱えるようになるにはある程度慣れが必要です。たとえ何かがどう見ても真に思える場合でも、そのことをCoqに納得させるのは最初のうちはなかなか大変です。ウォームアップのつもりで、否定のに関する馴染みのある定理を取り上げてみましょう。

Theorem not_False :
~ False.
Proof.
unfold not. intros H. inversion H.  Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
(P /\ ~P) -> Q.
Proof.

intros P Q H. inversion H as [HP HNA]. unfold not in HNA.
apply HNA in HP. inversion HP.  Qed.

Theorem double_neg : forall P : Prop,
P -> ~~P.
Proof.

intros P H. unfold not. intros G. apply G. apply H.  Qed.

練習問題: ★★, recommended (double_neg_inf)

[]
*)

FILL IN HERE double_negの非形式的な証明を書きなさい。:

Theorem:Pimplies~~P, for any propositionP.

Proof:(* FILL IN HERE *)☐

練習問題: ★★, recommended (contrapositive)

Theorem contrapositive : forall P Q : Prop,
(P -> Q) -> (~Q -> ~P).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (not_both_true_and_false)

Theorem not_both_true_and_false : forall P : Prop,
~ (P /\ ~P).
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem five_not_even :
~ ev 5.
Proof.

unfold not. intros Hev5. inversion Hev5 as [|n Hev3 Heqn].
inversion Hev3 as [|n' Hev1 Heqn']. inversion Hev1.  Qed.

練習問題: ★ ev_not_ev_S

定理five_not_evenは、「５は偶数ではない」というようなとても当たり前の事実を確認するものです。今度はもう少し面白い例です。

Theorem ev_not_ev_S : forall n,
ev n -> ~ ev (S n).
Proof.
unfold not. intros n H. induction H.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (informal_not_PNP)

命題forall P : Prop, ~(P /\ ~P)の形式的でない証明を（英語で）書きなさい。

(* FILL IN HERE *)

☐

このうちいくつかは、古典論理ではtrueと判断できるにもかかわらず、Coqに組み込まれた機能だけでは証明できないものがあるので注意が必要です。

Theorem classic_double_neg : forall P : Prop,
~~P -> P.
Proof.

intros P H. unfold not in H.

Admitted.

練習問題: ★★★★★, optional (classical_axioms)

さらなる挑戦を求める人のために、 Coq’Art book (p. 123) から一つ練習問題を取り上げてみます。次の五つの文は、よく「古典論理の特性」と考えられているもの（Coqにビルトインされている構成的論理の対極にあるもの）です。これらをCoqで証明することはできませんが、古典論理を使うことが必要なら、矛盾なく「証明されていない公理」として道具に加えることができます。これら五つの命題が等価であることを証明しなさい。

Definition peirce := forall P Q: Prop,
((P->Q)->P)->P.
Definition classic := forall P:Prop,
~~P -> P.
Definition excluded_middle := forall P:Prop,
P \/ ~P.
Definition de_morgan_not_and_not := forall P Q:Prop,
~(~P/\~Q) -> P\/Q.
Definition implies_to_or := forall P Q:Prop,
(P->Q) -> (~P\/Q).

(* FILL IN HERE *)

☐

不等であるということ

x <> yというのは、~(x = y)と同じことです。

Notation "x <> y" := (~ (x = y)) : type_scope.

不等性は、その中に「否定」を含んでいるため、やはりその扱いにはある程度の慣れが必要です。ここで一つ有用なトリックをお見せしましょう。もし、証明すべきゴールがあり得ない式（例えばfalse = trueというような文）であった場合は、ex_falso_quodlibetという補題をapplyで適用すると、ゴールをFalseにすることができます。このことを覚えておけば、コンテキストの中の~Pという形の仮定を使うことがとても簡単になります。特に、x<>yという形の仮定の場合はに有用です。

Theorem not_false_then_true : forall b : bool,
b <> false -> b = true.
Proof.
intros b H. destruct b.
Case "b = true". reflexivity.
Case "b = false".
unfold not in H.
apply ex_falso_quodlibet.
apply H. reflexivity.   Qed.

練習問題: ★★, recommended (not_eq_beq_false)

Theorem not_eq_beq_false : forall n n' : nat,
n <> n' ->
beq_nat n n' = false.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (beq_false_not_eq)

Theorem beq_false_not_eq : forall n m,
false = beq_nat n m -> n <> m.
Proof.
(* FILL IN HERE *) Admitted.

☐

存在量化子

もう一つの論理的接続詞は、存在量化子（ existentialquantification ）です。これは、次のような定義でその意味をとらえることができます。

Inductive ex (X:Type) (P : X->Prop) : Prop :=
ex_intro : forall (witness:X), P witness -> ex X P.

このexは、型引数Xとそれに関する属性Pによって決まる命題です。「Pを満たすxが存在する」という主張に根拠を与えるため、ある特定の値x（「証拠」と呼ぶことにします）を具体的に示すことでP xの根拠を得ることができます。つまりこれは、xが性質Pを持っていることの根拠です。

例として、このような存在量化子を持つ命題を見てみましょう。:

Definition some_nat_is_even : Prop :=
ex nat ev.

この、命題を証明するためには、証拠として特定の値（この場合4）を与え、それが偶数である根拠を示す必要があります。

Definition snie : some_nat_is_even :=
ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)).

Coqの容易な表記法の定義は、存在量化された命題を記述するための、より馴染みやすい表記を、ビルトインされたを全称量化子と同レベルで実現しています。そのおかげで、「偶数となる自然数が存在する」ことを示す命題をex nat evと書く代わりに、たとえばexists x:nat, ev xのように書くことができます。（これを理解するためにCoqの「表記法」がどのように作用しているかを完全に理解しないといけない、ということではありません。）

Notation "'exists' x , p" := (ex _ (fun x => p))
(at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
(at level 200, x ident, right associativity) : type_scope.

存在を示す必要がある場合には、だいたいいつも同じようなタクティックの組み合わせが使われます。例えば、ある値の存在を証明する場合には、その値をコンストラクタex_introにapplyすればいいのです。ex_introの前提はその結論に現れないうような変数（これが「証拠」となります）を必要とするため、applyを使用する際にはその値をきちんと提示することが必要になります。

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
apply ex_intro with (witness:=2).
reflexivity.  Qed.

もう一度書きますが、ここでは具体的な値を証拠として用意する必要があります。

apply ex_intro with (witness:=e)と書く代わりに、短縮形としてexists eと記述することもできます。どちらも同じ意味です。

Example exists_example_1' : exists n,
n + (n * n) = 6.
Proof.
exists 2.
reflexivity.  Qed.

逆に、コンテキストに置かれた仮定の中に存在を示すものがある場合は、それをinversionタクティックで取り除くことができます。変数に名前を付けるためas...パターンを使っていることに注目してください。Coqはそれを「証拠」につける名前とし、仮定が証拠を保持する根拠をそこから得ます。 （名前をきちんと選ばないと、Coqはそれを単なる証拠としか考えることができず、その先の証明で混乱してしまいます。）

Theorem exists_example_2 : forall n,
(exists m, n = 4 + m) ->
(exists o, n = 2 + o).
Proof.
intros n H.
inversion H as [m Hm].
exists (2 + m).
apply Hm.  Qed.

練習問題: ★ (english_exists)

英語では、以下の命題は何を意味しているでしょうか？

ex nat (fun n => ev (S n))

(* FILL IN HERE *)

次の証明オブジェクトの定義を完成させなさい

Definition p : ex nat (fun n => ev (S n)) :=
(* FILL IN HERE *) admit.

☐

練習問題: ★ (dist_not_exists)

“全てのxについてPが成り立つ” ということと “Pを満たさないxは存在しない” ということが等価であることを証明しなさい。

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
(forall x, P x) -> ~ (exists x, ~ P x).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (not_exists_dist)

一方、古典論理の「排中律（law of the excluded middle）」が必要とされる場合もあります。

Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★ (dist_exists_or)

存在量化子が論理和において分配法則を満たすことを証明しなさい。

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
(exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
(* FILL IN HERE *) Admitted.

☐

等しいということ（同値性）

Coqには、等価という関係すら組み込まれていませんから、次のように帰納的に定義してやります（ここではこれまで散々使った標準ライブラリでの定義と衝突することを防ぐために、モジュールの中で定義することにします。）

Module MyEquality.

Inductive eq (X:Type) : X -> X -> Prop :=
refl_equal : forall x, eq X x x.

次に定義するのは、標準的な中置記法です（Coqの型引数合成を使用しています）。

Notation "x = y" := (eq _ x y)
(at level 70, no associativity) : type_scope.

この例は少し難解かもしれません。これがどういうものかを考えると、集合Xが与えられると、「集合Xに属する値 (xandy) にインデックスされた、xはyに等しい」というような命題の 集団 を定義してくれるということです。この集団に属する命題に根拠を与えるためには、一つの方法しかありません。それは、コンストラクタrefl_equalに型Xとその値x : Xを適用し、xがxと等しいという根拠を生成することです。

次の定義は少し違った形になっています。 – Coqの標準ライブラリではこちらの定義が採用されています。

Inductive eq' (X:Type) (x:X) : X -> Prop :=
refl_equal' : eq' X x x.

Notation "x =' y" := (eq' _ x y)
(at level 70, no associativity) : type_scope.

練習問題: ★★★, optional (two_defs_of_eq_coincide)

これら二つの定義が等価であることを確認しなさい。

Theorem two_defs_of_eq_coincide : forall (X:Type) (x y : X),
x = y <-> x =' y.
Proof.
(* FILL IN HERE *) Admitted.

☐

二つ目の定義の優れたところは、Coqが生成する帰納法の原理が正確に「ライプニッツの同値関係（ Leibniz equality ）」と親和している点です。それはつまり、「xとyが等しいということは、 任意の命題Pがxでtrueとなるならばyでもtrueとなる」ということです。

Check eq'_ind.

一つ大事なことが残っています。確かにrefl_equalは2 = 2というような証明に根拠を与えることに使えます。1 + 1 = 2はどうでしょうか？答えは Yes です。実際、これらは証明としてはほとんど同じようなものだと言えます。 その理由は Coq が二つの式がシンプルな計算ルールによって交換可能であることをを示し、それを”同値である”として処理しているからです。このルールはEval simplと同じものです。ただしこれには、関数適用の評価、定義のインライン化、matchの簡約が含まれています。

タクティックを使った同値性の証明では、simplを使うことで暗黙的にこの交換ルールに触れています（reflexivityのような他のタクティックでも、明示的に、もしくは暗黙的に含まれています）。このことは、次のような明示的な証明オブジェクトで確認することができます。

Definition four : 2 + 2 = 1 + 3 :=
refl_equal nat 4.
Definition singleton : forall (X:Set) (x:X), []++[x] = x::[]  :=
fun (X:Set) (x:X) => refl_equal (list X) [x].

End MyEquality.

Inversion 再び

これまでにもinversionが等値性にからむ仮定や帰納的に定義された命題に対して使われるところを見てきました。今度もやることは変わりませんが、もう少し近くまで寄ってinversionの振る舞いを観察してみましょう。

一般的にinversionタクティックは、

- 帰納的に定義された型Pの命題Hをとる。

- その型Pの定義にある各コンストラクタCが、

- HがCから成っていると仮定するような新しいサブゴールを作る。

- Cの引数（前提）を、追加の仮定としてサブゴールのコンテキストに加える。

- Cの結論（戻り値の型）を現在のゴールとmatchして、Cを適用できるような一連の等式算出する。

- そしてこれらの等式をサブゴールのコンテキストに加えてから、

- もしこの等式が充足可能でない場合（S n = Oというような式を含むなど）は、 即座にサブゴールを解決する。

例 :orで構築された仮定を反転（ invert ）すると、orに二つのコンストラクタがあるため二つのサブゴールが生成されます。コンストラクタ (P \/ Q) の結果（戻り値の型）はPやQの形からくる制約を付けません。そのため追加の等式がサブゴールのコンテキストに加えられることはありません。

例 :andで構築された仮定を反転（ invert ）すると、andにはコンストラクタが一つしかないため、サブゴールも一つしか生成されません。やはり、コンストラクタ(P /\ Q) の結果（戻り値の型）はPやQの形からくる制約を付けず、追加の等式がサブゴールのコンテキストに加えられることはありません。このコンストラクタは引数を二つとりますが、それらはサブゴールのコンテキストに現れます。

例 :eqで構築された仮定を反転（ invert ）すると、これにもやはりコンストラクタが一つしかないため、サブゴールも一つしか生成されません。しかしこの場合コンストラクタrefl_equalの形は我々にもう少し情報を与えてくれます。それは、eqの二つの引数は同じでなければならないという点です。inversionタクティックはこの事実をコンテキストに加えてくれます。

命題としての関係

evのように数値でパラメータ化された命題は、属性（ property ）と見なすこともできます。つまり、それに属する値についてその命題が証明可能であるようなnatの部分集合の定義と見ることができるということです。同様に、引数（パラメータ）を二つ持つ命題は、その二つの「関係」を表していると考えられます。つまり、その命題について証明可能な値のペアの集合の定義、というわけです。

Module LeFirstTry.

これまでにもすでに、帰納的に定義された関係の基本的なものは出てきていました。等値性がそれです。他にも、よく使われるものとして「等しいかまたは小さい」という関係があります。

この定義はかなり直観的なものになります。これは、ある数値がもう一つの数値より小さいかまたは等しい、ということを示すには二つの方法があることを示しています。一つはそれらが同じ数であるかどうかを確認すること。もう一つは最初の数が。二つ目の数の一つ前の数より小さいかまたは等しい、ということの根拠を得ることです。

Inductive le : nat -> nat -> Prop :=
| le_n : forall n, le n n
| le_S : forall n m, (le n m) -> (le n (S m)).

End LeFirstTry.

これはこれで<=という関係の妥当なな定義だと言えます。しかし少し観察してみると定義の左側のに現れるnは全て同じだということがわかります。ということは、個々のコンストラクタにではなく定義全体に全称量化子を使うことができるということです。このことは先程eqという関係の二番目の定義でやったことと同じです。

Inductive le (n:nat) : nat -> Prop :=
| le_n : le n n
| le_S : forall m, (le n m) -> (le n (S m)).

Notation "m <= n" := (le m n).

少し対称性が損なわれたようにも見えますが、この二番目の定義の方がいいのです。なぜでしょうか？それは、こちらのほうがよりシンプルな帰納法の原理を生成してくれるからです（eqの二番目の定義にも同じことが言えます）。

Check le_ind.

一方、最初の定義に Coq が生成する帰納法の原理には、もっと多くの量化子が含まれることになります。これでは、帰納法を使った証明がごちゃごちゃしてしまいます。これがleの最初の定義で生成された帰納法の原理です。

コンストラクタle_nとle_Sを使った<=にからむ証明は、前章のeqがそうであったように、属性についての証明のいくつかのパターンに倣っています。<=の形をしたゴール（例えば3<=3や3<=6など）に、そのコンストラクタをapply することができますし、inversion のようなタクティックを使って（~(2 <= 1)の証明をしようとする際のように） コンテキストに<=を含む仮定から情報を抽出することもできます。

ここで、定義が正しくなされているのかのチェックをしてみましょう。（注意して欲しいのは、ここでやることが、最初のレクチャーで書いてもらった、ある種のシンプルな「ユニットテスト」のようなものですが、今回のものは以前のものとちょっと違います。今回のものには、simplやreflexivityはほとんど役に立ちません。簡約だけで証明できるようなものではないからです。

Theorem test_le1 :
3 <= 3.
Proof.

apply le_n.  Qed.

Theorem test_le2 :
3 <= 6.
Proof.

apply le_S. apply le_S. apply le_S. apply le_n.  Qed.

Theorem test_le3 :
~ (2 <= 1).
Proof.

intros H. inversion H. inversion H1.  Qed.

「より小さい」という関係（n < m）は、leを使って定義できます。

Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

他にも、数値の関係についていくつか見てみましょう。

Inductive square_of : nat -> nat -> Prop :=
sq : forall n:nat, square_of n (n * n).

Inductive next_nat (n:nat) : nat -> Prop :=
| nn : next_nat n (S n).

Inductive next_even (n:nat) : nat -> Prop :=
| ne_1 : ev (S n) -> next_even n (S n)
| ne_2 : ev (S (S n)) -> next_even n (S (S n)).

練習問題: ★★, recommended (total_relation)

二つの自然数のペア同士の間に成り立つ帰納的な関係total_relationを定義しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★ (empty_relation)

自然数の間では決して成り立たない関係empty_relationを帰納的に定義しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★, recommended (R_provability)

Module R.

次は三つや四つの値の間に成り立つ関係を同じように定義してみましょう。例えば、次のような数値の三項関係が考えられます。

Inductive R : nat -> nat -> nat -> Prop :=
| c1 : R 0 0 0
| c2 : forall m n o, R m n o -> R (S m) n (S o)
| c3 : forall m n o, R m n o -> R m (S n) (S o)
| c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
| c5 : forall m n o, R m n o -> R n m o.

[]
*)

FILL IN HERE

- 次の命題のうち、この関係を満たすと証明できると言えるのはどれでしょうか。 -R 1 1 2

- R 2 2 6

- この関係Rの定義からコンストラクタc5を取り除くと、証明可能な命題の範囲はどのように変わるでしょうか？端的に（１文で）説明しなさい。

- この関係Rの定義からコンストラクタc4を取り除くと、証明可能な命題の範囲はどのように変わるでしょうか？端的に（１文で）説明しなさい。

(* FILL IN HERE *)☐

練習問題: ★★★, optional (R_fact)

関係Rの、等値性に関する特性をあげ、それを証明しなさい。 それは、もしR m n oが true ならmについてどんなことが言えるでしょうか？nやoについてはどうでしょうか？その逆は？

(* FILL IN HERE *)

☐

End R.

練習問題: ★★★, recommended (all_forallb)

リストに関する属性allを定義しなさい。それは、型Xと属性P : X -> Propをパラメータとし、all X P lが「リストlの全ての要素が属性 [P} を満たす」とするものです。

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
(* FILL IN HERE *)
.

Poly.vの練習問題forall_exists_challengeに出てきた関数forallbを思い出してみましょう。

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
match l with
| [] => true
| x :: l' => andb (test x) (forallb test l')
end.

属性allを使って関数forallbの仕様を書き、それを満たすことを証明しなさい。できるだけその仕様が厳格になるようにすること。

関数forallbの重要な性質が、あなたの仕様から洩れている、ということはありませんか？

(* FILL IN HERE *)

☐

練習問題: ★★★★, optional (filter_challenge)

Coq の主な目的の一つは、プログラムが特定の仕様を満たしていることを証明することです。それがどういうことか、filter関数の定義が仕様を満たすか証明してみましょう。まず、その関数の仕様を非形式的に書き出してみます。

集合Xと関数test: X->bool、リストlとその型list Xを想定する。さらに、lが二つのリストl1とl2が順序を維持したままマージされたもので、リストl1の要素はすべてtestを満たし、l2の要素はすべて満たさないとすると、filter test l = l1が成り立つ。

リストlがl1とl2を順序を維持したままマージしたものである、とは、それがl1とl2の要素をすべて含んでいて、しかも 互いに入り組んではいてもl1、l2の要素が同じ順序になっている、ということです。例えば、

[1,4,6,2,3]

は、以下の二つを順序を維持したままマージしたものです。

[1,6,2]

と、

[4,3]

課題は、この仕様をCoq の定理の形に書き直し、それを証明することです。（ヒント：まず、一つのりすとが二つのリストをマージしたものとなっている、ということを示す定義を書く必要がありますが、これは帰納的な関係であって、Fixpointで書くようなものではありません。）

(* FILL IN HERE *)

☐

練習問題: ★★★★★, optional (filter_challenge_2)

filterの振る舞いに関する特性を別の切り口で表すとこうなります。「testの結果がtrueなる要素だけでできた、リストlのすべての部分リストの中で、filter test lが最も長いリストである。」これを形式的に記述し、それを証明しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★★, optional (no_repeats)

次の、帰納的に定義された命題を見て、

Inductive appears_in {X:Type} (a:X) : list X -> Prop :=
| ai_here : forall l, appears_in a (a::l)
| ai_later : forall b l, appears_in a l -> appears_in a (b::l).

値aが、少なくとも一度はリストlの中に現れるということを、厳密に表現する方法を考えなさい。

appears_inに関するウォームアップ問題としてもう一つ、

Lemma appears_in_app : forall {X:Type} (xs ys : list X) (x:X),
appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
(* FILL IN HERE *) Admitted.

Lemma app_appears_in : forall {X:Type} (xs ys : list X) (x:X),
appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
(* FILL IN HERE *) Admitted.

では、appears_inを使って命題disjoint X l1 l2を定義してください。これは、型Xの二つのリストl1、l2が共通の要素を持たない場合にのみ証明可能な命題です。

(* FILL IN HERE *)

次は、appears_inを使って帰納的な命題no_repeats X lを定義してください。これは, 型Xのリストlの中のどの要素も、他の要素と異なっている場合のみ証明できるような命題です。例えば、no_repeats nat [1,2,3,4] やno_repeats bool [] は証明可能ですが、no_repeats nat [1,2,1] やno_repeats bool [true,true] は証明できないようなものです。

(* FILL IN HERE *)

最後に、disjoint、no_repeats、++（リストの結合）の三つを使った、何か面白い定理を考えて、それを証明してください。

(* FILL IN HERE *)

☐

少し脱線:<=と<についてのさらなる事実

ここで少し新しいことを中断して、<=や<といった関係についての事実をいくつか書き溜めていくことにしましょう。それらはここから先に進む際に必要になってくるばかりでなく、その証明自体がとてもよい練習問題になってくれます。

練習問題: ★★, optional (le_exercises)

Theorem O_le_n : forall n,
0 <= n.
Proof.
(* FILL IN HERE *) Admitted.

Theorem n_le_m__Sn_le_Sm : forall n m,
n <= m -> S n <= S m.
Proof.
(* FILL IN HERE *) Admitted.

Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
Proof.
intros n m.  generalize dependent n.  induction m.
(* FILL IN HERE *) Admitted.

Theorem le_plus_l : forall a b,
a <= a + b.
Proof.
(* FILL IN HERE *) Admitted.

Theorem plus_lt : forall n1 n2 m,
n1 + n2 < m ->
n1 < m /\ n2 < m.
Proof.
(* FILL IN HERE *) Admitted.

Theorem lt_S : forall n m,
n < m ->
n < S m.
Proof.
(* FILL IN HERE *) Admitted.

Theorem ble_nat_true : forall n m,
ble_nat n m = true -> n <= m.
Proof.
(* FILL IN HERE *) Admitted.

Theorem ble_nat_n_Sn_false : forall n m,
ble_nat n (S m) = false ->
ble_nat n m = false.
Proof.
(* FILL IN HERE *) Admitted.

Theorem ble_nat_false : forall n m,
ble_nat n m = false -> ~(n <= m).
Proof.

(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, recommended (nostutter)

述語の帰納的な定義を定式化できるようになるというのは、これから先の学習に必要なスキルになってきます。

この練習問題は、何の力も借りず自力で解いてください。もし誰かの力を借りてしまった場合は、そのことをコメントに書いておいてください。

同じ数値が連続して現れるリストを “stutters” （どもったリスト）と呼ぶことにします。述語 “nostutter mylist” は、mylistが「どもったリスト」でないことを意味しています。nostutterの帰納的な定義を記述しなさい。（これは以前の練習問題に出てきたno_repeatsという述語とは異なるものです。リスト1,4,1は repeats ではありますが stutter ではありません。）

Inductive nostutter:  list nat -> Prop :=
(* FILL IN HERE *)
.

できた定義が、以下のテストを通過することを確認してください。通過できないものがあったら、定義を修正してもかまいません。あなたの書いた定義が、正しくはあるけれど私の用意した模範解答と異なっているかもしれません。その場合、このテストを通過するために別の証明を用意する必要があります。

以下の Example にコメントとして提示された証明には、色々な種類のnostutterの定義に対応できるようにするため、まだ説明していないタクティックがいくつか使用されています。 まずこれらのコメントをはずしただけの状態で確認できればいいのですが、もしそうしたいなら、これらの証明をもっと基本的なタクティックで書き換えて証明してもかまいません。

Example test_nostutter_1:      nostutter [3,1,4,1,5,6].
(* FILL IN HERE *) Admitted.

Example test_nostutter_2:  nostutter [].
(* FILL IN HERE *) Admitted.

Example test_nostutter_3:  nostutter [5].
(* FILL IN HERE *) Admitted.

Example test_nostutter_4:      not (nostutter [3,1,1,4]).
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★★, optional (pigeonhole principle)

「鳩の巣定理（ “pigeonhole principle” ）」は、「数えるあげる」ということについての基本的な事実を提示しています。「もしn個の鳩の巣にn個より多い数のものを入れようとするなら、どのような入れ方をしてもいくつかの鳩の巣には必ず一つ以上のものが入ることになる。」というもので、この、数値に関する見るからに自明な事実を証明するにも、なかなか自明とは言えない手段が必要になります。我々は既にそれを知っているのですが...

まず、補題を二つほど証明しておきます。（既に数値のリストについては証明済みのものですが、任意のリストについてはのものはまだないので）

Lemma app_length : forall {X:Type} (l1 l2 : list X),
length (l1 ++ l2) = length l1 + length l2.
Proof.
(* FILL IN HERE *) Admitted.

Lemma appears_in_app_split : forall {X:Type} (x:X) (l:list X),
appears_in x l ->
exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
(* FILL IN HERE *) Admitted.

そして、述語repeatsの定義をします（以前の練習問題no_repeatsに類似したものです）。それはrepeats X lが、「lの中に少なくとも一組の同じ要素（型Xの）を含む」という主張となるようなものです。

Inductive repeats {X:Type} : list X -> Prop :=
(* FILL IN HERE *)
.

この「鳩の巣定理」を定式化する方法を一つ挙げておきましょう。リストl2が鳩の巣に貼られたラベルの一覧を、リストl1はそのラベルの、アイテムへの割り当ての一覧を表しているとします。もしラベルよりも沢山のアイテムがあったならば、少なくとも二つのアイテムに同じラベルが貼られていることになります。おそらくこの証明には「排中律（excluded_middle）」が必要になるでしょう。

Theorem pigeonhole_principle: forall {X:Type} (l1 l2:list X),
excluded_middle ->
(forall x, appears_in x l1 -> appears_in x l2) ->
length l2 < length l1 ->
repeats l1.
Proof.  intros X l1. induction l1.
(* FILL IN HERE *) Admitted.

☐

選択課題

論理積（連言）や論理和（連言）に関する帰納法の原理は、帰納的に定義された命題に対して簡約された帰納法の原理を Coq が生成する方法をとてもよく示しています。これについては最後の章でお話しします。とりあえずこれに挑戦してみてください。

練習問題: ★ (and_ind_principle)

連言（ conjunction ）についての帰納法の原理を予想して、確認しなさい。

☐

練習問題: ★ (or_ind_principle)

選言（ disjunction ）についての帰納法の原理を予想して、確認しなさい。

☐

Check and_ind.

命題and P Qの帰納的な定義から、

Inductive and (P Q : Prop) : Prop :=
conj : P -> Q -> (and P Q).

我々は Coq がこのような帰納法の原理を生成することを期待します。

and_ind_max :
forall (P Q : Prop) (P0 : P /\ Q -> Prop),
(forall (a : P) (b : Q), P0 (conj P Q a b)) ->
forall a : P /\ Q, P0 a

しかし実際には、もっとシンプルで使いやすいものが生成されます。

and_ind :
forall P Q P0 : Prop,
(P -> Q -> P0) ->
P /\ Q -> P0

同様に、or P Qの帰納的な定義が与えられると、

Inductive or (P Q : Prop) : Prop :=
| or_introl : P -> or P Q
| or_intror : Q -> or P Q.

以下のような、原則通りの帰納法の原理を制する代わりに、

or_ind_max :
forall (P Q : Prop) (P0 : P \/ Q -> Prop),
(forall a : P, P0 (or_introl P Q a)) ->
(forall b : Q, P0 (or_intror P Q b)) ->
forall o : P \/ Q, P0 o

Coq はこのような帰納法の原理が生成されます。

or_ind :
forall P Q P0 : Prop,
(P -> P0) ->
(Q -> P0) ->
P \/ Q -> P0

帰納法のための明白な証明オブジェクト

タクティックを使った証明は一般に簡単に済むことが多いですが、証明式を直接書いてしまえるなら、そうしたほうが簡単な場合もあります。特に、Coq にちょっとだけ変わった方法をとらせたい時はそうです。

natの帰納的な定義からCoqが自動的に生成した自然数に関する帰納法の原理を思い出してください。

この帰納法についての補題には何のタネも仕掛けもありません。これは単に、証明を必要とする Coq の別の補題です。Coq はこれにも自動的に証明を生成してくれます。

Print nat_ind.  Print nat_rect.

これは次のように読めます :Pが 0 の場合に成り立つという根拠fとforall n:nat, P n -> P (S n)の根拠f0があると仮定します。そうすると、Pが任意の自然数nで成り立つことを、再帰的に定義された関数F（ここでは、トップレベルで使われるFixpointではなく、Fixを使って定義されています）を使って示すことができます。Fはnについて以下のようなパターンマッチをしています：

- もし 0 ならば、FはfをP nが成り立つことの根拠とする。

- もしS n0ならば、FはP n0が成り立つ根拠を手に入れるために、n0を持ってそれ自身を再帰呼び出しする。そうして得た根拠がf0に適用されP (S n)が成り立つことが示される。

Fは、集合Setではなく、根拠Propを操作することになっただけの普通の再帰的な関数です。

関数型プログラミングが少し面白くなるような脇道です。もしかするとあなたは関数Fのmatchが、アノテーションas n0 return (P n0)を必要としていることに気づいたかもしれません。それは Coq の型チェッカが二つのmatchの枝が、実は同じ型P nを返すことを明確にするために必要なものなのですが、これは本質的に Haskell の GADT (generalized algebraic datatype) と同じものです。実際、Fは依存型（ dependent type ）をしており、その結果の方はその引数に依存します。 GADT はこのような単純な依存型を表現する際に使えます。我々は、nat_indの証明に使用したこのようなアプローチを、標準的でない（ non-standard ）帰納法の原理を証明する際にも使うことができます。以前このような証明をしようとしていたことを思い出してください。forall n : nat, even n -> ev n.

これを、通常のnに対する帰納法でやろうとしても失敗してしまいます。なぜなら、この帰納法の原理はeven n -> even (S n)を証明しようとする時にしかうまく機能してくれないからです。これはもちろん証明不能な命題です。このような場合、前の章ではちょっとした小技を使いました。

[Theorem even_ev : forall n : nat,(even n -> ev n) / (even (S n) -> ev (S n))].

これについては、標準的でない帰納法の原理（二つずつ、となるような）を定義して証明することで、より良い証明が得られます。

Definition nat_ind2 :
forall (P : nat -> Prop),
P 0 ->
P 1 ->
(forall n : nat, P n -> P (S(S n))) ->
forall n : nat , P n :=
fun P => fun P0 => fun P1 => fun PSS =>
fix f (n:nat) := match n return P n with
0 => P0
| 1 => P1
| S (S n') => PSS n' (f n')
end.

一度これを手にいれてしまえば、今回のような帰納法の原理を使った証明全般にこれを使うことができます。これを補題としてタクティックを使うと、さらに直観に反したものになります（試してみてください！）。induction ... usingタクティックは、このように標準的でない帰納法の原理を取る際に便利です。

Lemma even_ev' : forall n, even n -> ev n.
Proof.
intros.
induction n as [ | |n'] using nat_ind2.
Case "even 0".
apply ev_0.
Case "even 1".
inversion H.
Case "even (S(S n'))".
apply ev_SS.
apply IHn'.  unfold even.  unfold even in H.  simpl in H. apply H.
Qed.

Coq の信頼できるコンピューティング基盤

ここで一つの疑問が起こってきます。自動化された証明アシスタントが「なぜ信用できるのか？」という疑問です。つまり、これらの実装にバグがあるなら、その証明にも疑いを持たざるを得ません。

このような考えを完全に排除することはできませんが、Coq カリー・ハワード同型対応をその基礎に置いているという事実は Coq 自身の強い基礎ともなっています。なぜなら、命題は型であり、証明は項であり、まだ証明されていない命題が妥当かどうかを調べることは、項の型をチェックする（ type-checking ）ことに等しいからです。型チェッカは十分に信頼できるほど小さく率直に書かれたプログラムであり、それこそが Coq の「信頼できるコンピューティング基盤」となっています。その「信頼性が必要となる一部のコード」は正確に動き、また十分に小さいのです。型チェッカの役割とはなんでしょうか？その一番の役割は、各々の関数の適用で、予想された型と実際の型が一致していることを確認することです。つまり、matchの各枝の式が、帰納的な型のコンストラクタと対応しており、すべてが同じ型を返すようになっているか、などです。しかしこれには若干の弱点もあります。

- Coq の型はそれ自身が式となっているため、その型チェッカがそれらを比較する前際に、変換ルールに基づいて正規化しなければならない。

- 型チェッカは、matchの式が「尽くされている（exhaustive ）ことを確認しなければならない。つまり、その型ににあるコンストラクタに対応する枝をすべて持っていなければならい。その理由は、次に提示された証明オブジェクトについて考えればわかるはずです。

Definition or_bogus : forall P Q, P \/ Q -> P :=
fun (P Q : Prop) (A : P \/ Q) =>
match A with
| or_introl H => H
end.

この定義では、型は正しく一致していますが、matchがorの一方のコンストラクタのことしか考えていません。Coq は、このようなケースがないかをチェックし、このような定義を拒絶します。

- 型チェッカは、各fixの式が終了することを確認しなければならない。これは文法レベルで「各々の再帰呼び出しに元々の引数にわたってきた式の部分式が渡されていること」をチェックをすることで実現されている。この理由の本質的なところを理解するために次の証明について考えてください。

Definition nat_false : forall (n:nat), False :=
fix f (n:nat) : False := f n.

やはり、これも型について何も問題はありませんが、残念なことに Coq はこの定義を拒絶します。

Coq の「確実さ」は、タクティックの仕組みではなく、型チェックの仕組みによってもたらされていることに注目してください。もしタクティックの実装にバグがあれば（実際にこれはあったことです！）、タクティックは間違った証明を構築してしまうでしょう。しかし、Qedを入力した時点で、Coq はその正しさを１から検証しなおします。型チェッカを通過した補題のみ、その後の証明の構築に使える定理となることができるのです。

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Rel_J:関係の性質

この短い章では、いくつかの基本的な定義を行います。それらは後にSmallstep_J.vにおけるスモールステップ操作的意味論で必要となるものです。Smallstep_J.vの直前まで手をつけないでおくこともできますが、Coqの基本的推論機構を使う良い練習問題ともなるので、Logic_J.vの直後で見ておくのがよいかもしれません。

Require Export Logic_J.

関係(relation)はパラメータを持った命題にほかなりません。大学の離散数学の講義で習っているように、関係を「一般的に」議論し記述する方法がいくつもあります。

- 関係を分類する方法(反射的か、推移的か、など)、関係のクラスについて一般的に証明できる定理、

関係からの別の関係の構成、などです。ここでちょっと立ち止まって、後で有用になるいくつかをふりかえってみましょう。

集合Xの「上の」関係は、X2つをパラメータとする命題です。–つまり、集合Xの2つの要素に関する論理的主張です。

Definition relation (X: Type) := X->X->Prop.

若干まぎらわしいことに、Coqの標準ライブラリでは、一般的な用語”関係(relation)”を、この特定の場合(つまり1つの集合上の二項関係)を指すためだけに使っています。ライブラリとの整合性を保つために、ここでもそれに従います。したがって、Coq の識別子relationは常に、集合上の二項関係を指すために使います。一方、日本語の”関係”は、Coq の relation を指す場合もあれば、より一般の任意の数の(それぞれ別のものかもしれない)集合の間の関係を指す場合もあります。どちらを指しているかは常に議論の文脈から明らかになるようにします。

関係の基本性質

集合X上の関係Rは、次の条件を満たすとき、部分関数(partial function)です。条件とは、すべてのxに対して、R x yとなるyは高々1つであるということ

- つまり、R x y1かつR x y2ならばy1 = y2となることです。

Definition partial_function {X: Type} (R: relation X) := forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

例えば、Logic_J.vで定義されているnext_nat関係は部分関数です。

Theorem next_nat_partial_function :
partial_function next_nat.
Proof.
unfold partial_function.
intros x y1 y2 P Q.
inversion P. inversion Q.
reflexivity.  Qed.

しかし、数値上の<=関係は部分関数ではありません。

これは矛盾を導くことで示すことができます。簡単にいうと:<=が部分関数であると仮定します。すると、0<=0かつ0<=1から、0=1となります。これはおかしなことです。したがって、<=が部分関数だという仮定は矛盾するということになります。

Theorem le_not_a_partial_function :
~ (partial_function le).
Proof.
unfold not. unfold partial_function. intros H.
assert (0 = 1) as Nonsense.
Case "Proof of assertion".
apply H with 0.
apply le_n.
apply le_S. apply le_n.
inversion Nonsense.   Qed.

練習問題:★★, optional

Logic_J.v に定義されたtotal_relationが部分関数ではないことを示しなさい。

(* FILL IN HERE *)

☐

練習問題:★★, optional

Logic_J.v に定義されたempty_relationが部分関数ではないことを示しなさい。

(* FILL IN HERE *)

☐

集合X上の反射的(reflexive)関係とは、Xのすべての要素について、成立する関係です。(訳注: 集合X上の関係Rが反射的とは、Xの任意の要素xについてR x xが成立することです。)

Definition reflexive {X: Type} (R: relation X) :=
forall a : X, R a a.

Theorem le_reflexive :
reflexive le.
Proof.
unfold reflexive. intros n. apply le_n.  Qed.

関係Rが推移的(transitive)であるとは、R a bかつR b cならば常にR a cとなることです。

Definition transitive {X: Type} (R: relation X) :=
forall a b c : X, (R a b) -> (R b c) -> (R a c).

Theorem le_trans :
transitive le.
Proof.
intros n m o Hnm Hmo.
induction Hmo.
Case "le_n". apply Hnm.
Case "le_S". apply le_S. apply IHHmo.  Qed.

Theorem lt_trans:
transitive lt.
Proof.
unfold lt. unfold transitive.
intros n m o Hnm Hmo.
apply le_S in Hnm.
apply le_trans with (a := (S n)) (b := (S m)) (c := o).
apply Hnm.
apply Hmo. Qed.

練習問題:★★, optional

lt_transは、帰納法を使って手間をかければ、le_trans を使わずに証明することができます。これをやってみなさい。

Theorem lt_trans' :
transitive lt.
Proof.

unfold lt. unfold transitive.
intros n m o Hnm Hmo.
induction Hmo as [| m' Hm'o].
(* FILL IN HERE *) Admitted.

☐

練習問題:★★, optional

同じことを、oについての帰納法で証明しなさい。

Theorem lt_trans'' :
transitive lt.
Proof.
unfold lt. unfold transitive.
intros n m o Hnm Hmo.
induction o as [| o'].
(* FILL IN HERE *) Admitted.

☐

leの推移性は、同様に、後に(つまり以下の反対称性の証明において)有用な事実を証明するのに使うことができます...

Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
Proof.
intros n m H. apply le_trans with (S n).
apply le_S. apply le_n.
apply H.  Qed.

練習問題:★, optional

Theorem le_S_n : forall n m,
(S n <= S m) -> (n <= m).
Proof.
(* FILL IN HERE *) Admitted.

FILL IN HERE ☐

練習問題:★★, optional(le_Sn_n_inf)

以下の定理の非形式的な証明を示しなさい。

定理: すべてのnについて、~(S n <= n)

形式的な証明は後のoptionalな練習問題ですが、ここでは、形式的な証明を行わずに、まず非形式的な証明を示しなさい。

証明:(* FILL IN HERE *)☐

練習問題:★, optional

Theorem le_Sn_n : forall n,
~ (S n <= n).
Proof.
(* FILL IN HERE *) Admitted.

☐

反射性と推移性は後の章で必要となる主要概念ですが、Coq で関係を扱う練習をもう少ししましょう。次のいくつかの概念もよく知られたものです。

関係Rが対称的(symmetric)であるとは、R a bならばR b aとなることです。

Definition symmetric {X: Type} (R: relation X) :=
forall a b : X, (R a b) -> (R b a).

練習問題:★★, optional

Theorem le_not_symmetric :
~ (symmetric le).
Proof.
(* FILL IN HERE *) Admitted.

☐

関係Rが反対称的(antisymmetric)であるとは、R a bかつR b aならばa = bとなることです。 – つまり、Rにおける「閉路」は自明なものしかないということです。(訳注:この「つまり」以降は、Rは反射的かつ推移的でもあるという前提の場合。)

Definition antisymmetric {X: Type} (R: relation X) :=
forall a b : X, (R a b) -> (R b a) -> a = b.

練習問題:★★, optional

Theorem le_antisymmetric :
antisymmetric le.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題:★★, optional

Theorem le_step : forall n m p,
n < m ->
m <= S p ->
n <= p.
Proof.
(* FILL IN HERE *) Admitted.

☐

関係が同値関係(equivalence)であるとは、その関係が、反射的、対称的、かつ推移的であることです。

Definition equivalence {X:Type} (R: relation X) :=
(reflexive R) /\ (symmetric R) /\ (transitive R).

関係が半順序(partial order)であるとは、その関係が、反射的、反対称的、かつ推移的であることです。Coq 標準ライブラリでは、半順序のことを単に”順序(order)”と呼びます。

Definition order {X:Type} (R: relation X) :=
(reflexive R) /\ (antisymmetric R) /\ (transitive R).

前順序(preorder)とは、半順序の条件から反対称性を除いたものです。

Definition preorder {X:Type} (R: relation X) :=
(reflexive R) /\ (transitive R).

Theorem le_order :
order le.
Proof.
unfold order. split.
Case "refl". apply le_reflexive.
split.
Case "antisym". apply le_antisymmetric.
Case "transitive.". apply le_trans.  Qed.

反射推移閉包

関係Rの反射推移閉包とは、Rを含み反射性と推移性の両者を満たす最小の関係のことです。形式的には、Coq標準ライブラリのRelationモジュールで、以下のように定義されます。

Inductive clos_refl_trans {A: Type} (R: relation A) : relation A :=
| rt_step : forall x y, R x y -> clos_refl_trans R x y
| rt_refl : forall x, clos_refl_trans R x x
| rt_trans : forall x y z,
clos_refl_trans R x y -> clos_refl_trans R y z -> clos_refl_trans R x z.

例えば、next_nat関係の反射推移閉包はle関係となります。

Theorem next_nat_closure_is_le : forall n m,
(n <= m) <-> ((clos_refl_trans next_nat) n m).
Proof.
intros n m. split.
Case "->".
intro H. induction H.
apply rt_refl.
apply rt_trans with m. apply IHle. apply rt_step. apply nn.
Case "<-".
intro H. induction H.
SCase "rt_step".  inversion H. apply le_S.  apply le_n.
SCase "rt_refl". apply le_n.
SCase "rt_trans".
apply le_trans with y.
apply IHclos_refl_trans1.
apply IHclos_refl_trans2.  Qed.

上の反射推移閉包の定義は自然です。–定義はRの反射推移閉包がRを含み反射律と推移律について閉じている最小の関係であることを明示的に述べています。しかし、この定義は、証明をする際にはあまり便利ではないのです。

- rt_trans 規則の”非決定性”によって、しばしばわかりにくい帰納法になってしまいます。

以下は、より使いやすい定義です...

Inductive refl_step_closure {X:Type} (R: relation X)
: X -> X -> Prop :=
| rsc_refl  : forall (x : X),
refl_step_closure R x x
| rsc_step : forall (x y z : X),
R x y ->
refl_step_closure R y z ->
refl_step_closure R x z.

(以下のTactic Notationの定義は Imp_J.v で説明されます。その章をまだ読んでいないならば、ここではそれを無視して構いません。)

Tactic Notation "rt_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "rt_step" | Case_aux c "rt_refl"
| Case_aux c "rt_trans" ].

Tactic Notation "rsc_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "rsc_refl" | Case_aux c "rsc_step" ].

新しい反射推移閉包の定義は、rtc_R規則とrtc_trans規則を「まとめ」て、1ステップの規則にします。このステップの左側はRを1回だけ使います。このことが帰納法をはるかに簡単なものにします。

次に進む前に、二つの定義が同じものを定義していることを確認しなければなりません...

最初に、rscが、「失われた」2つのrtcコンストラクタの働きを代替することを示す二つの補題を証明します。

Theorem rsc_R : forall (X:Type) (R:relation X) (x y : X),
R x y -> refl_step_closure R x y.
Proof.
intros X R x y r.
apply rsc_step with y. apply r. apply rsc_refl.   Qed.

練習問題:★★, optional(rsc_trans)

Theorem rsc_trans :
forall (X:Type) (R: relation X) (x y z : X),
refl_step_closure R x y  ->
refl_step_closure R y z ->
refl_step_closure R x z.
Proof.
(* FILL IN HERE *) Admitted.

☐

そして、反射推移閉包の2つの定義が同じ関係を定義していることを証明するために、上記の事実を使います。

練習問題:★★★, optional (rtc_rsc_coincide)

Theorem rtc_rsc_coincide :
forall (X:Type) (R: relation X) (x y : X),
clos_refl_trans R x y <-> refl_step_closure R x y.
Proof.
(* FILL IN HERE *) Admitted.

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

SfLib_J: Software Foundations ライブラリ

Here we collect together several useful definitions and theoremsfrom Basics.v, List.v, Poly.v, Ind.v, and Logic.v that are notalready in the Coq standard library. From now on we canImportorExportthis file, instead of cluttering our environment withall the examples and false starts in those files.

ここでは、Basics.v, List.v, Poly.v, Ind.v, and Logic.vの中から、使い勝手のよい定義や定理でCoqのスタンダードライブラリに含まれていないものをを集めてみました。これ以降、環境を色々な証明で散らかす代わりに、このライブラリファイルをImport、Exportするだけで済むようになります。

Coq スタンダードライブラリから

Require Omega.
Require Export Bool.
Require Export List.
Require Export Arith.
Require Export Arith.EqNat.

Basics.vから

Definition admit {T: Type} : T.  Admitted.

Require String. Open Scope string_scope.

Ltac move_to_top x :=
match reverse goal with
| H : _ |- _ => try move x after H
end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
let H := fresh in
assert (x = v) as H by reflexivity;
clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
first [
set (x := name); move_to_top x
| assert_eq x name; move_to_top x
| fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

Fixpoint ble_nat (n m : nat) : bool :=
match n with
| O => true
| S n' =>
match m with
| O => false
| S m' => ble_nat n' m'
end
end.

Theorem andb_true_elim1 : forall b c,
andb b c = true -> b = true.
Proof.
intros b c H.
destruct b.
Case "b = true".
reflexivity.
Case "b = false".
rewrite <- H. reflexivity.  Qed.

Theorem andb_true_elim2 : forall b c,
andb b c = true -> c = true.
Proof.

Admitted.

Theorem beq_nat_sym : forall (n m : nat),
beq_nat n m = beq_nat m n.

Admitted.

Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
(at level 60, right associativity).

Props.vから

Inductive ev : nat -> Prop :=
| ev_0 : ev O
| ev_SS : forall n:nat, ev n -> ev (S (S n)).

Logic.vから

Theorem andb_true : forall b c,
andb b c = true -> b = true /\ c = true.
Proof.
intros b c H.
destruct b.
destruct c.
apply conj. reflexivity. reflexivity.
inversion H.
inversion H.  Qed.

Theorem not_eq_beq_false : forall n n' : nat,
n <> n' ->
beq_nat n n' = false.
Proof.

Admitted.

Theorem ex_falso_quodlibet : forall (P:Prop),
False -> P.
Proof.
intros P contra.
inversion contra.  Qed.

Theorem ev_not_ev_S : forall n,
ev n -> ~ ev (S n).
Proof.

Admitted.

Theorem ble_nat_true : forall n m,
ble_nat n m = true -> n <= m.

Admitted.

Theorem ble_nat_false : forall n m,
ble_nat n m = false -> ~(n <= m).

Admitted.

Inductive appears_in (n : nat) : list nat -> Prop :=
| ai_here : forall l, appears_in n (n::l)
| ai_later : forall m l, appears_in n l -> appears_in n (m::l).

Definition relation (X:Type) := X -> X -> Prop.

Definition partial_function {X: Type} (R: relation X) :=
forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

Inductive next_nat (n:nat) : nat -> Prop :=
| nn : next_nat n (S n).

Inductive total_relation : nat -> nat -> Prop :=
tot : forall n m : nat, total_relation n m.

Inductive empty_relation : nat -> nat -> Prop := .

Inductive refl_step_closure (X:Type) (R: relation X)
: X -> X -> Prop :=
| rsc_refl  : forall (x : X),
refl_step_closure X R x x
| rsc_step : forall (x y z : X),
R x y ->
refl_step_closure X R y z ->
refl_step_closure X R x z.
Implicit Arguments refl_step_closure [[X]].

Tactic Notation "rsc_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "rsc_refl" | Case_aux c "rsc_step" ].

Theorem rsc_R : forall (X:Type) (R:relation X) (x y : X),
R x y -> refl_step_closure R x y.
Proof.
intros X R x y r.
apply rsc_step with y. apply r. apply rsc_refl.   Qed.

Theorem rsc_trans :
forall (X:Type) (R: relation X) (x y z : X),
refl_step_closure R x y  ->
refl_step_closure R y z ->
refl_step_closure R x z.
Proof.
(* FILL IN HERE *) Admitted.

Inductive id : Type :=
Id : nat -> id.

Definition beq_id id1 id2 :=
match (id1, id2) with
(Id n1, Id n2) => beq_nat n1 n2
end.

Theorem beq_id_refl : forall i,
true = beq_id i i.
Proof.
intros. destruct i.
apply beq_nat_refl.  Qed.

Theorem beq_id_eq : forall i1 i2,
true = beq_id i1 i2 -> i1 = i2.
Proof.
intros i1 i2 H.
destruct i1. destruct i2.
apply beq_nat_eq in H. subst.
reflexivity.  Qed.

Theorem beq_id_false_not_eq : forall i1 i2,
beq_id i1 i2 = false -> i1 <> i2.
Proof.
intros i1 i2 H.
destruct i1. destruct i2.
apply beq_nat_false in H.
intros C. apply H. inversion C. reflexivity.  Qed.

Theorem not_eq_beq_id_false : forall i1 i2,
i1 <> i2 -> beq_id i1 i2 = false.
Proof.
intros i1 i2 H.
destruct i1. destruct i2.
assert (n <> n0).
intros C. subst. apply H. reflexivity.
apply not_eq_beq_false. assumption.  Qed.

Theorem beq_id_sym: forall i1 i2,
beq_id i1 i2 = beq_id i2 i1.
Proof.
intros i1 i2. destruct i1. destruct i2. apply beq_nat_sym. Qed.

Definition partial_map (A:Type) := id -> option A.

Definition empty {A:Type} : partial_map A := (fun _ => None).

Definition extend {A:Type} (Gamma : partial_map A) (x:id) (T : A) :=
fun x' => if beq_id x x' then Some T else Gamma x'.

Lemma extend_eq : forall A (ctxt: partial_map A) x T,
(extend ctxt x T) x = Some T.
Proof.
intros. unfold extend. rewrite <- beq_id_refl. auto.
Qed.

Lemma extend_neq : forall A (ctxt: partial_map A) x1 T x2,
beq_id x2 x1 = false ->
(extend ctxt x2 T) x1 = ctxt x1.
Proof.
intros. unfold extend. rewrite H. auto.
Qed.

Lemma extend_shadow : forall A (ctxt: partial_map A) t1 t2 x1 x2,
extend (extend ctxt x2 t1) x2 t2 x1 = extend ctxt x2 t2 x1.
Proof with auto.
intros. unfold extend. destruct (beq_id x2 x1)...
Qed.

使い勝手のいいタクティックをいくつか

Tactic Notation "solve_by_inversion_step" tactic(t) :=
match goal with
| H : _ |- _ => solve [ inversion H; subst; t ]
end
|| fail "because the goal is not solvable by inversion.".

Tactic Notation "solve" "by" "inversion" "1" :=
solve_by_inversion_step idtac.
Tactic Notation "solve" "by" "inversion" "2" :=
solve_by_inversion_step (solve by inversion 1).
Tactic Notation "solve" "by" "inversion" "3" :=
solve_by_inversion_step (solve by inversion 2).
Tactic Notation "solve" "by" "inversion" :=
solve by inversion 1.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Imp_J: 単純な命令型プログラム

この章では、コースの残りに続く新しい方向へ進み始めます。ここまではもっぱらCoq自身について学習してきましたが、ここからは、主として別のものを形式化するためにCoqを使います。はじめの例は、Imp と呼ばれる単純な命令型プログラミング言語です。下の例は、おなじみの数学的関数を Imp で書いたものです。

Z ::= X;
Y ::= 1;
WHILE not (Z = 0) DO
Y ::= Y * Z;
Z ::= Z - 1
END

この章ではImpの構文(syntax)と意味(semantics)をどのように定義するかを見ます。続く章では、プログラムの同値性(program equivalence)の理論を展開し、命令型プログラムについての推論のための論理として一番知られているホーア論理(Hoare Logic)を紹介します。

Sflib

マイナーな技術的ポイント: ここまでの定義をLogic_J.vからインポートする代わりに、Sflib_J.vという小さなライブラリをインポートします。このライブラリは、前の章の定義や定理のうち、残りの章で実際に使うものだけを集めたものです。読者はそれほど違うものとは感じないでしょう。というのは、Sflib で抜けているもののほとんどは、Coqの標準ライブラリの定義と同じものだからです。こうする主な理由は、Coqのグローバルな環境を整理して、例えば、関係する定理を探すのを容易にするためです。

Require Export SfLib_J.

算術式とブール式

Impを三つの部分に分けて示します: 最初に算術式(arithmetic expressions)とブール式(boolean expressions)、次にこれらの式に変数(variables)を加えたもの、そして最後に代入(assignment)、条件分岐(conditions)、コマンド合成(sequencing)、ループ(loops)を持つコマンド(commands)の言語です。

Module AExp.

構文

次の2つの定義は、算術式とブール式の抽象構文(abstract syntax)を定めます。

Inductive aexp : Type :=
| ANum : nat -> aexp
| APlus : aexp -> aexp -> aexp
| AMinus : aexp -> aexp -> aexp
| AMult : aexp -> aexp -> aexp.

Inductive bexp : Type :=
| BTrue : bexp
| BFalse : bexp
| BEq : aexp -> aexp -> bexp
| BLe : aexp -> aexp -> bexp
| BNot : bexp -> bexp
| BAnd : bexp -> bexp -> bexp.

この章では、プログラマが実際に書く具象構文から抽象構文木への変換は省略します。例えば、文字列"1+2*3"をAST(Abstract Syntax Tree, 抽象構文木)APlus (ANum 1) (AMult (ANum 2) (ANum 3))にする変換のことです。この変換ができる字句解析器と構文解析器をファイルImpParser_J.vで簡単に実装します。このファイル(Imp_J.v)を理解するにはImpParser_J.vの理解は必要ではありませんが、もしそれらの技術についてのコース(例えばコンパイラコース)を受講していないならば、ざっと見てみるのも良いでしょう。

比較のため、同じ抽象構文を定義する慣習的なBNF(Backus-Naur Form)文法を以下に示します:

aexp ::= nat
| aexp '+' aexp
| aexp '-' aexp
| aexp '*' aexp

bexp ::= true
| false
| aexp '=' aexp
| aexp '<=' aexp
| bexp 'and' bexp
| 'not' bexp

上述のCoq版と比較して...

- BNFはより非形式的です。例えば、 BNFは式の表面的な構文についていくらかの情報を与えています(可算は+と記述され、それは中置記号であるという事実などです)が、字句解析と構文解析の他の面は定めないままになっています(+、-、*の相対的優先順位などです)。(例えばコンパイラを実装するときに)この記述を形式的定義にするためには、追加の情報、および人間の知性が必要でしょう。 Coq版はこれらの情報を整合的に省略し、抽象構文だけに集中します。

- 一方、BNF版はより軽くて、おそらく読むのがより簡単です。 非形式的であることで柔軟性を持っているので、黒板を使って議論する場面などでは特段に有効です。そういう場面では、細部をいちいち正確に確定させていくことより、全体的アイデアを伝えることが重要だからです。 実際、BNFのような記法は山ほどあり、人は皆、それらの間を自由に行き来しますし、通常はそれらのうちのどのBNFを使っているかを気にしません。その必要がないからです。おおざっぱな非形式的な理解だけが必要なのです。

両方の記法に通じているのは良いことです。非形式的なものは人間とのコミュニケーションのために、形式的なものは実装と証明のためにです。

評価

算術式を評価する(evaluating)とその式を1つの数に簡約します。

Fixpoint aeval (e : aexp) : nat :=
match e with
| ANum n => n
| APlus a1 a2 => (aeval a1) + (aeval a2)
| AMinus a1 a2  => (aeval a1) - (aeval a2)
| AMult a1 a2 => (aeval a1) * (aeval a2)
end.

Example test_aeval1:
aeval (APlus (ANum 2) (ANum 2)) = 4.
Proof. reflexivity. Qed.

同様に、ブール式を評価するとブール値になります。

Fixpoint beval (e : bexp) : bool :=
match e with
| BTrue       => true
| BFalse      => false
| BEq a1 a2   => beq_nat (aeval a1) (aeval a2)
| BLe a1 a2   => ble_nat (aeval a1) (aeval a2)
| BNot b1     => negb (beval b1)
| BAnd b1 b2  => andb (beval b1) (beval b2)
end.

最適化(Optimization)

ここまで定義したものはわずかですが、その定義から既にいくらかのものを得ることができます。算術式をとって、それを少し簡単化する関数を定義するとします。すべての0+e(つまり(APlus (ANum 0) e))を単にeにするものです。

Fixpoint optimize_0plus (e:aexp) : aexp :=
match e with
| ANum n =>
ANum n
| APlus (ANum 0) e2 =>
optimize_0plus e2
| APlus e1 e2 =>
APlus (optimize_0plus e1) (optimize_0plus e2)
| AMinus e1 e2 =>
AMinus (optimize_0plus e1) (optimize_0plus e2)
| AMult e1 e2 =>
AMult (optimize_0plus e1) (optimize_0plus e2)
end.

この最適化が正しいことをすることを確認するために、いくつかの例についてテストして出力がよさそうかを見てみることができます。

Example test_optimize_0plus:
optimize_0plus (APlus (ANum 2)
(APlus (ANum 0)
(APlus (ANum 0) (ANum 1))))
= APlus (ANum 2) (ANum 1).
Proof. reflexivity. Qed.

しかし、もし最適化が正しいことを確認したいならば、

- つまり、最適化した式がオリジナルの式と同じ評価結果を返すことを確認したいならば、

証明すべきです。

Theorem optimize_0plus_sound: forall e,
aeval (optimize_0plus e) = aeval e.
Proof.
intros e. induction e.
Case "ANum". reflexivity.
Case "APlus". destruct e1.
SCase "e1 = ANum n". destruct n.
SSCase "n = 0".  simpl. apply IHe2.
SSCase "n <> 0". simpl. rewrite IHe2. reflexivity.
SCase "e1 = APlus e1_1 e1_2".
simpl. simpl in IHe1. rewrite IHe1.
rewrite IHe2. reflexivity.
SCase "e1 = AMinus e1_1 e1_2".
simpl. simpl in IHe1. rewrite IHe1.
rewrite IHe2. reflexivity.
SCase "e1 = AMult e1_1 e1_2".
simpl. simpl in IHe1. rewrite IHe1.
rewrite IHe2. reflexivity.
Case "AMinus".
simpl. rewrite IHe1. rewrite IHe2. reflexivity.
Case "AMult".
simpl. rewrite IHe1. rewrite IHe2. reflexivity.  Qed.

Coq の自動化

前の証明の最後の繰り返しはちょっと面倒です。今のところまだ耐えられますが、証明対象の言語や算術式や最適化が今に比べて著しく複雑だったら、現実的に問題になるでしょう。

ここまで、Coq のタクティックのほんのひとつかみだけですべての証明をしてきていて、証明を自動的に構成する非常に強力な機構を完全に無視してきました。このセクションではこれらの機構のいくつかを紹介します。それ以上のものを、以降のいくつかの章で次第に見ることになるでしょう。それらに慣れるには多少エネルギーが必要でしょう。

- Coq の自動化は電動工具です。–

しかし自動化機構を使うことで、より複雑な定義や、より興味深い性質について、退屈で繰り返しの多いローレベルな詳細に飲み込まれることなく、作業をスケールアップできます。

タクティカル(Tacticals)

タクティカル(tactical)は Coq の用語で、他のタクティックを引数に取るタクティックのことです。「高階タクティック」(“higher-order tactics”)と言っても良いでしょう。

tryタクティカル

非常にシンプルなタクティカルの1つがtryです。Tがタクティックのとき、タクティックtry TはTと同様ですが、Tが失敗するときtry Tは(失敗せずに)何もしない点が違います。

;タクティカル

別の非常に基本的なタクティカルは;と書かれます。T,T1, ...,Tnがタクティックのとき、

T; [T1 | T2 | ... | Tn]

はタクティックで、最初にTを行ない、Tによって生成された最初のサブゴールにT1を行ない、二番目のサブゴールにT2を行ない、... という処理をします。

すべてのTiが同じタクティックT'であるという特別な場合、

T; [T' | T' | ... | T']

と書く代わりにT;T'と書くだけで済ますことができます。つまり、TとT'がタクティックのとき、T;T'はタクティックで、最初にTを行ない、Tが生成したそれぞれのサブゴールにT'を行ないます。これが;の実際に一番よく使われる形です。

例えば、次の簡単な補題を考えます:

Lemma foo : forall n, ble_nat 0 n = true.
Proof.
intros.
destruct n.

Case "n=0". simpl. reflexivity.
Case "n=Sn'". simpl. reflexivity.

Qed.

上の証明を;タクティカルを使って簡単化できます。

Lemma foo' : forall n, ble_nat 0 n = true.
Proof.
intros.

destruct n;

simpl;

reflexivity.
Qed.

tryと;の両方を使うと、ちょっと前に悩まされた証明の繰り返しを取り除くことができます。

Theorem optimize_0plus_sound': forall e,
aeval (optimize_0plus e) = aeval e.
Proof.
intros e.
induction e;

try (simpl; rewrite IHe1; rewrite IHe2; reflexivity).
Case "ANum". reflexivity.
Case "APlus".
destruct e1;

try (simpl; simpl in IHe1; rewrite IHe1; rewrite IHe2; reflexivity).

SCase "e1 = ANum n". destruct n;
simpl; rewrite IHe2; reflexivity.   Qed.

実際的にはCoqの専門家は、tryをinductionのようなタクティックと一緒に使うことで、多くの似たような「簡単な」場合を一度に処理します。これは自然に非形式的な証明に対応します。

この定理の形式的な証明の構造にマッチする非形式的な証明は次の通りです:

「定理」: すべての算術式eについて

aeval (optimize_0plus e) = aeval e.

「証明」:eについての帰納法を使う。AMinusとAMultの場合は帰納仮定から直接得られる。残るのは以下の場合である:

- あるnについてe = ANum nとする。示すべきことは次の通りである:

aeval (optimize_0plus (ANum n)) = aeval (ANum n).

これはoptimize_0plusの定義からすぐに得られる。

- あるe1とe2についてe = APlus e1 e2とする。 示すべきことは次の通りである:

aeval (optimize_0plus (APlus e1 e2))
= aeval (APlus e1 e2).

e1のとり得る形を考える。そのほとんどの場合、optimize_0plusは部分式について単に自分自身を再帰的に呼び出し、e1と同じ形の新しい式を再構成する。これらの場合、結果は帰納仮定からすぐに得られる。

興味深い場合は、あるnについてe1 = ANum nであるときである。このときn = ANum 0ならば次が成立する:

optimize_0plus (APlus e1 e2) = optimize_0plus e2

そしてe2についての帰納仮定がまさに求めるものである。一方、あるn'についてn = S n'ならば、optimize_0plusはやはり自分自身を再帰的に呼び出し、結果は帰納仮定から得られる。☐

この証明はさらに改良できます。最初の場合(e = ANum nのとき)はかなり自明です。帰納仮定からすぐに得られると言ったものより自明でしょう。それなのに完全に記述しています。これを消して、単に最初に「ほとんどの場合、すぐに、あるいは帰納仮定から直接得られる。興味深いのはAPlusの場合だけである...」と言った方がより良く、より明快でしょう。同じ改良を形式的な証明にも行うことができます。以下のようになります:

Theorem optimize_0plus_sound'': forall e,
aeval (optimize_0plus e) = aeval e.
Proof.
intros e.
induction e;

try (simpl; rewrite IHe1; rewrite IHe2; reflexivity);

try reflexivity.

Case "APlus".
destruct e1; try (simpl; simpl in IHe1; rewrite IHe1;
rewrite IHe2; reflexivity).
SCase "e1 = ANum n". destruct n;
simpl; rewrite IHe2; reflexivity.  Qed.

Coqはまた、タクティックスクリプトを「プログラミングする」いろいろな方法も提供します。

- Tactic Notationコマンドは、「略記法タクティック」(“shorthand tactics”) を定義する簡単な方法を提供します。「略記法タクティック」は、呼ばれると、いろいろなタクティックを一度に適用します。

- より洗練されたプログラミングのために、 CoqはLtacと呼ばれる小さなビルトインのプログラミング言語と、証明の状態を調べたり変更したりするためのLtacのプリミティブを提供します。その詳細はここで説明するにはちょっと複雑過ぎます(しかも、LtacがCoqの設計の一番美しくない部分だというのは共通見解です!)。しかし、詳細はリファレンスマニュアルにありますし、Coqの標準ライブラリには、読者が参考にできるLtacの定義のたくさんの例があります。

- Coqの内部構造のより深いレベルにアクセスする新しいタクティックを作ることができる OCaml API も存在します。しかしこれは、普通のCoqユーザにとっては、苦労が報われることはほとんどありません。

Tactic Notation機構は取り組むのに一番簡単で、多くの目的に十分なパワーを発揮します。例を挙げます。

Tactic Notation "simpl_and_try" tactic(c) :=
simpl;
try c.

これは1つのタクティックcを引数としてとるsimpl_and_tryという新しいタクティカルを定義しています。そして、タクティックsimpl; try cと同値なものとして定義されます。例えば、証明内で”simpl_and_try reflexivity.“と書くことは”simpl; try reflexivity.“と書くことと同じでしょう。

次のサブセクションでは、この機構のより洗練された使い方を見ます...

場合分けを万全にする

inductionやdestructで、ほとんどの場合を一度に扱えるのはとても便利ですが、またちょっと混乱もします。よく起こる問題は、このスタイルで記述された証明をメンテナンスすることが難しいということです。例えば、後で、aexpの定義を拡張して、やはり特別な引数をとるコンストラクタを追加したとします。このとき上述の証明は成立しなくなっているでしょう。なぜなら、CoqはAPlusについてのサブゴールの前にこのコンストラクタに対応するサブゴールを生成し、その結果、APlusの場合に取りかかる時には、Coqは実際にはまったく別のコンストラクタを待っていることになるからです。ここで欲しいのは、「この場所でAFooの場合を期待していましたが、証明スクリプトはAPlusについて話しています。」という賢いエラーメッセージです。以下は、これを難なく可能にするちょっとしたトリックです。

Tactic Notation "aexp_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ANum" | Case_aux c "APlus"
| Case_aux c "AMinus" | Case_aux c "AMult" ].

(Case_auxはCase、SCase、SSCase等の共通機能を実装します。例えば、Case "foo"はCase_aux Case "foo"と定義されます。)

例えば、eが型aexpの変数のとき、

aexp_cases (induction e) Case

と書くとeについての帰納法を実行し(単にinduction eと書いたのと同じです)、そして、「その上に」、inductionによって生成されたそれぞれのサブゴールにCaseタグを付加します。このタグは、そのサブゴールがどのコンストラクタから来たかのラベルです。例えば、aexp_casesを使った、optimize_0plus_soundのさらに別証です:

Theorem optimize_0plus_sound''': forall e,
aeval (optimize_0plus e) = aeval e.
Proof.
intros e.
aexp_cases (induction e) Case;
try (simpl; rewrite IHe1; rewrite IHe2; reflexivity);
try reflexivity.

Case "APlus".
aexp_cases (destruct e1) SCase;
try (simpl; simpl in IHe1; rewrite IHe1; rewrite IHe2; reflexivity).
SCase "ANum". destruct n;
simpl; rewrite IHe2; reflexivity.  Qed.

optimize_0plusの変換がaexpの値を変えないことから、bexpの値を変えずに、bexpに現れるaexpをすべて変換するためにoptimize_0plusが適用できるべきでしょう。bexpについてこの変換をする関数を記述しなさい。そして、それが健全であることを証明しなさい。ここまで見てきたタクティカルを使って証明を可能な限りエレガントにしなさい。

(* FILL IN HERE *)

☐

*)

FILL IN HERE 設計練習: 定義したoptimize_0plus関数で実装された最適化は、算術式やブール式に対して考えられるいろいろな最適化の単なる1つに過ぎません。より洗練された最適化関数を記述し、その正しさを証明しなさい。

(* FILL IN HERE *)

☐

omegaタクティックは「プレスバーガー算術」(Presburger arithmetic、「プレスブルガー算術」とも)と呼ばれる一階述語論理のサブセットの決定手続き(decision procedure)を実装します。William Pugh が1992年に発明したOmegaアルゴリズムに基いています。

ゴールが以下の要素から構成された全称限量された論理式とします。以下の要素とは:

- 数値定数、加算(+とS)、減算(-とpred)、 定数の積算(これがプレスバーガー算術である条件です)、

- 等式(=と<>)および不等式(<=)、

- 論理演算子/\,\/,~,->

です。このとき、omegaを呼ぶと、ゴールを解くか、そのゴールが偽であると告げるか、いずれかになります。

Example silly_presburger_example : forall m n o p,
m + n <= n + o /\ o + 3 = p + 3 ->
m <= p.
Proof.
intros. omega.
Qed.

Andrew Appel はomegaを「サンタクロース・タクティック」と呼んでいます。

最後に、役に立ちそうないろいろなタクティックをいくつか紹介します。

- clear H: 仮定Hをコンテキストから消去します。

- subst x: コンテキストから仮定x = eまたはe = xを発見し、xをコンテキストおよび現在のゴールのすべての場所でeに置き換え、この仮定を消去します。

- subst:x = eおよびe = xの形のすべての仮定を置換します。

- rename... into...: 証明コンテキストの仮定の名前を変更します。 例えば、コンテキストがxという名前の変数を含んでいるとき、rename x into yは、すべてのxの出現をyに変えます。

- assumption: ゴールにちょうどマッチする仮定Hをコンテキストから探そうとします。 発見されたときはapply Hと同様に振る舞います。

- contradiction:Falseと同値の仮定Hをコンテキストから探そうとします。 発見されたときはゴールを解きます。

- constructor: 現在のゴールを解くのに使えるコンストラクタcを (現在の環境のInductiveによる定義から)探そうとします。発見されたときはapply cと同様に振る舞います。

以降の証明でこれらのたくさんの例を見るでしょう。

関係としての評価

aevalとbevalをFixpointsによって定義された関数として示しました。評価について考える別の方法は、それを式と値との間の関係(relation)と見ることです。

この考えに立つと、算術式についてCoqのInductiveによる以下の定義が自然に出てきます...

Module aevalR_first_try.

Inductive aevalR : aexp -> nat -> Prop :=
| E_ANum  : forall (n: nat),
aevalR (ANum n) n
| E_APlus : forall (e1 e2: aexp) (n1 n2: nat),
aevalR e1 n1 ->
aevalR e2 n2 ->
aevalR (APlus e1 e2) (n1 + n2)
| E_AMinus: forall (e1 e2: aexp) (n1 n2: nat),
aevalR e1 n1 ->
aevalR e2 n2 ->
aevalR (AMinus e1 e2) (n1 - n2)
| E_AMult : forall (e1 e2: aexp) (n1 n2: nat),
aevalR e1 n1 ->
aevalR e2 n2 ->
aevalR (AMult e1 e2) (n1 * n2).

関係についてよく行うように、aevalRの中置記法を定義するのが便利です。算術式eが値nに評価されることをe || nと書きます。(この記法は煩わしいascii記号の限界の1つです。評価関係の標準記法は二重の下向き矢印です。HTML版ではそのようにタイプセットしますが、ascii の.v ファイルでは可能な近似として縦棒二本を使います。)

Notation "e '||' n" := (aevalR e n) : type_scope.

End aevalR_first_try.

実際は、CoqではaevalR自身の定義中でこの記法を使うことができます。これにより、e || nの形の主張を含む証明で、aevalR e nという形の定義に戻らなければならない状況にならずに済みます。

このためには、最初に記法を「予約」し、それから定義と、記法が何を意味するかの宣言とを一緒に行います。

Reserved Notation "e '||' n" (at level 50, left associativity).

Inductive aevalR : aexp -> nat -> Prop :=
| E_ANum : forall (n:nat),
(ANum n) || n
| E_APlus : forall (e1 e2: aexp) (n1 n2 : nat),
(e1 || n1) -> (e2 || n2) -> (APlus e1 e2) || (n1 + n2)
| E_AMinus : forall (e1 e2: aexp) (n1 n2 : nat),
(e1 || n1) -> (e2 || n2) -> (AMinus e1 e2) || (n1 - n2)
| E_AMult :  forall (e1 e2: aexp) (n1 n2 : nat),
(e1 || n1) -> (e2 || n2) -> (AMult e1 e2) || (n1 * n2)

where "e '||' n" := (aevalR e n) : type_scope.

Tactic Notation "aevalR_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E_ANum" | Case_aux c "E_APlus"
| Case_aux c "E_AMinus" | Case_aux c "E_AMult" ].

評価の、関係による定義と関数による定義が、すべての算術式について一致することを証明するのは簡単です...

Theorem aeval_iff_aevalR : forall a n,
(a || n) <-> aeval a = n.
Proof.
split.
Case "->".
intros H.
aevalR_cases (induction H) SCase; simpl.
SCase "E_ANum".
reflexivity.
SCase "E_APlus".
rewrite IHaevalR1.  rewrite IHaevalR2.  reflexivity.
SCase "E_AMinus".
rewrite IHaevalR1.  rewrite IHaevalR2.  reflexivity.
SCase "E_AMult".
rewrite IHaevalR1.  rewrite IHaevalR2.  reflexivity.
Case "<-".
generalize dependent n.
aexp_cases (induction a) SCase;
simpl; intros; subst.
SCase "ANum".
apply E_ANum.
SCase "APlus".
apply E_APlus.
apply IHa1. reflexivity.
apply IHa2. reflexivity.
SCase "AMinus".
apply E_AMinus.
apply IHa1. reflexivity.
apply IHa2. reflexivity.
SCase "AMult".
apply E_AMult.
apply IHa1. reflexivity.
apply IHa2. reflexivity.
Qed.

タクティカルをより積極的に使ったより短い証明です:

Theorem aeval_iff_aevalR' : forall a n,
(a || n) <-> aeval a = n.
Proof.

split.
Case "->".
intros H; induction H; subst; reflexivity.
Case "<-".
generalize dependent n.
induction a; simpl; intros; subst; constructor;
try apply IHa1; try apply IHa2; reflexivity.
Qed.

関係bevalRをaevalRと同じスタイルで記述し、それがbevalと同値であることを証明しなさい。

☐

*)

算術式とブール式の評価の定義について、関数を使うか関係を使うかはほとんど趣味の問題です。一般に、Coqは関係を扱う方がいくらかサポートが厚いです。特に帰納法についてはそうです。一方、ある意味で関数による定義の方がより多くの情報を持っています。なぜなら、関数は決定的でなければならず、またすべての引数について定義されていなければなりません。関数については、必要ならばこれらの性質を明示的に示さなければなりません。

しかしながら、評価の定義として、関係による定義が関数による定義よりはるかに望ましい状況があります。以下で簡単に見ます。

推論規則記法

非形式的な議論には、aevalRや似たような関係についての規則を、推論規則(inference rules)と呼ばれる、より読みやすいグラフィカルな形で書くのが便利です。推論規則は、横線の上の前提から、横線の下の結論を導出できることを述べます。例えば、コンストラクタE_APlus...

| E_APlus : forall (e1 e2: aexp) (n1 n2: nat),
aevalR e1 n1 ->
aevalR e2 n2 ->
aevalR (APlus e1 e2) (n1 + n2)

...は推論規則として次のように書けるでしょう:

e1 || n1
e2 || n2
--------------------                         (E_APlus)
APlus e1 e2 || n1+n2

形式的には、推論規則について何も深いものはありません。単なる含意です。右に書かれた規則名はコンストラクタで、横線より上の前提の間の各改行と横線自体は->と読むことができます。規則で言及されるすべての変数(e1、n1等)は暗黙のうちに冒頭で全称限量子に束縛されています。規則の集合全体はInductive宣言で囲われていると理解されます(これは完全に暗黙のまま置かれるか、非形式的に「aevalRは以下の規則について閉じた最小の関係とします...」などと述べられるかします)。

例えば、||は以下の規則について閉じた最小の関係です:

-----------                               (E_ANum)
ANum n || n

e1 || n1
e2 || n2
--------------------                         (E_APlus)
APlus e1 e2 || n1+n2

e1 || n1
e2 || n2
---------------------                        (E_AMinus)
AMinus e1 e2 || n1-n2

e1 || n1
e2 || n2
--------------------                         (E_AMult)
AMult e1 e2 || n1*n2

End AExp.

変数を持つ式

さて、Impの定義に戻りましょう。次にしなければならないことは、算術式とブール式に変数を拡張することです。話を単純にするため、すべての変数はグローバルで、数値だけを持つとしましょう。

識別子

始めに、プログラム変数などの識別子(identifiers)を形式化しなければなりません。このために文字列を使うこともできるでしょうし、(実際のコンパイラでは)シンボルテーブルへのポインタのようなある種の特別な構造を使うこともできるでしょう。しかし、簡単にするため、識別子に単に自然数を使います。

(このセクションをモジュールに隠します。それは、これらの定義が実際にはSfLib_J.vにあるからです。しかし説明のためにここで繰り返します。)

Module Id.

新しいデータタイプIdを定義して、識別子と数値を混乱しないようにします。

Inductive id : Type :=
Id : nat -> id.

Definition beq_id X1 X2 :=
match (X1, X2) with
(Id n1, Id n2) => beq_nat n1 n2
end.

さて、この方法で「覆った」数値を識別子としたので、数値のいくつかの性質を、対応する識別子の性質として繰り返しておくのが便利です。そうすると、定義や証明の中の識別子を、覆いを開いて中の数値を晒すことなく抽象的に扱うことができます。識別子について知らなければならないことは、識別子同士が同じか違うかだけなので、本当に2、3のことだけが必要です。

Theorem beq_id_refl : forall X,
true = beq_id X X.
Proof.
intros. destruct X.
apply beq_nat_refl.  Qed.

練習問題: ★, optional (beq_id_eq)

この問題とそれに続く練習問題では、帰納法を使わずに、既に証明した自然数の同様の結果を適用しなさい。上述したいくつかのタクティックが使えるかもしれません。

Theorem beq_id_eq : forall i1 i2,
true = beq_id i1 i2 -> i1 = i2.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★, optional (beq_id_false_not_eq)

Theorem beq_id_false_not_eq : forall i1 i2,
beq_id i1 i2 = false -> i1 <> i2.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★, optional (not_eq_beq_id_false)

Theorem not_eq_beq_id_false : forall i1 i2,
i1 <> i2 -> beq_id i1 i2 = false.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★, optional (beq_id_sym)

Theorem beq_id_sym: forall i1 i2,
beq_id i1 i2 = beq_id i2 i1.
Proof.
(* FILL IN HERE *) Admitted.

☐

End Id.

状態

状態(state)はプログラムの実行のある時点のすべての変数の現在値を表します。

簡単にするため(部分関数を扱うのを避けるため)、どのようなプログラムも有限個の変数しか使わないにもかかわらず、状態はすべての変数について値を定義しているものとします。

Definition state := id -> nat.

Definition empty_state : state :=
fun _ => 0.

Definition update (st : state) (X:id) (n : nat) : state :=
fun X' => if beq_id X X' then n else st X'.

updateについての単純な性質が必要です。

練習問題: ★★, optional (update_eq)

Theorem update_eq : forall n X st,
(update st X n) X = n.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (update_neq)

Theorem update_neq : forall V2 V1 n st,
beq_id V2 V1 = false ->
(update st V2 n) V1 = (st V1).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (update_example)

タクティックを使って遊び始める前に、定理が言っていることを正確に理解していることを確認しなさい!

Theorem update_example : forall (n:nat),
(update empty_state (Id 2) n) (Id 3) = 0.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★ (update_shadow)

Theorem update_shadow : forall x1 x2 k1 k2 (f : state),
(update  (update f k2 x1) k2 x2) k1 = (update f k2 x2) k1.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (update_same)

Theorem update_same : forall x1 k1 k2 (f : state),
f k1 = x1 ->
(update f k1 x1) k2 = f k2.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (update_permute)

Theorem update_permute : forall x1 x2 k1 k2 k3 f,
beq_id k2 k1 = false ->
(update (update f k2 x1) k1 x2) k3 = (update (update f k1 x2) k2 x1) k3.
Proof.
(* FILL IN HERE *) Admitted.

☐

構文

前に定義した算術式に、単にもう1つコンストラクタを追加することで変数を追加できます:

Inductive aexp : Type :=
| ANum : nat -> aexp
| AId : id -> aexp
| APlus : aexp -> aexp -> aexp
| AMinus : aexp -> aexp -> aexp
| AMult : aexp -> aexp -> aexp.

Tactic Notation "aexp_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ANum" | Case_aux c "AId" | Case_aux c "APlus"
| Case_aux c "AMinus" | Case_aux c "AMult" ].

変数の略記法:

Definition X : id := Id 0.
Definition Y : id := Id 1.
Definition Z : id := Id 2.

(プログラム変数のこの慣習(X,Y,Z)は、型に大文字の記号を使うという以前の使用法と衝突します。コースのこの部分では多相性を多用はしないので、このことが混乱を招くことはないはずです。)

bexpの定義は前と同じです(ただし新しいaexpを使います):

Inductive bexp : Type :=
| BTrue : bexp
| BFalse : bexp
| BEq : aexp -> aexp -> bexp
| BLe : aexp -> aexp -> bexp
| BNot : bexp -> bexp
| BAnd : bexp -> bexp -> bexp.

Tactic Notation "bexp_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "BTrue" | Case_aux c "BFalse" | Case_aux c "BEq"
| Case_aux c "BLe" | Case_aux c "BNot" | Case_aux c "BAnd" ].

評価

算術とブールの評価器は、自明な方法で変数を扱うように拡張されます:

Fixpoint aeval (st : state) (e : aexp) : nat :=
match e with
| ANum n => n
| AId X => st X
| APlus a1 a2 => (aeval st a1) + (aeval st a2)
| AMinus a1 a2  => (aeval st a1) - (aeval st a2)
| AMult a1 a2 => (aeval st a1) * (aeval st a2)
end.

Fixpoint beval (st : state) (e : bexp) : bool :=
match e with
| BTrue       => true
| BFalse      => false
| BEq a1 a2   => beq_nat (aeval st a1) (aeval st a2)
| BLe a1 a2   => ble_nat (aeval st a1) (aeval st a2)
| BNot b1     => negb (beval st b1)
| BAnd b1 b2  => andb (beval st b1) (beval st b2)
end.

Example aexp1 :
aeval (update empty_state X 5)
(APlus (ANum 3) (AMult (AId X) (ANum 2)))
= 13.
Proof. reflexivity. Qed.

Example bexp1 :
beval (update empty_state X 5)
(BAnd BTrue (BNot (BLe (AId X) (ANum 4))))
= true.
Proof. reflexivity. Qed.

コマンド

さて、Imp コマンド (または主張) の構文と挙動を定義する準備が出来ました

構文

非形式的には、コマンドは以下の BNF で表現されます。構文:

com ::= 'SKIP'
| X '::=' aexp
| com ';' com
| 'WHILE' bexp 'DO' com 'END'
| 'IFB' bexp 'THEN' com 'ELSE' com 'FI'

例えば、Imp における階乗関数は以下のようになります。

Z ::= X;
Y ::= 1;
WHILE not (Z = 0) DO
Y ::= Y * Z;
Z ::= Z - 1
END

このコマンドが終わったとき、変数Yは変数Xの階乗の値を持つでしょう。

以下に、コマンドの構文の形式的な定義を示します。

Inductive com : Type :=
| CSkip : com
| CAss : id -> aexp -> com
| CSeq : com -> com -> com
| CIf : bexp -> com -> com -> com
| CWhile : bexp -> com -> com.

Tactic Notation "com_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
| Case_aux c "IFB" | Case_aux c "WHILE" ].

いつものとおり、より読みやすいよう、いくつかのNotation宣言が使えます。しかし、Coq の組み込みの表記と衝突しないよう、少し気をつける必要があります(手軽さを維持しつつ！)。特に、aexpとbexpについては、すでに定義した数値演算子やブール演算子との混同を避けるために、新しい表記は導入しません。(同様の理由により、条件文に対しては通常使われるIFの代わりにIFBというキーワードを使います。)

Notation "'SKIP'" :=
CSkip.
Notation "X '::=' a" :=
(CAss X a) (at level 60).
Notation "c1 ; c2" :=
(CSeq c1 c2) (at level 80, right associativity).
Notation "'WHILE' b 'DO' c 'END'" :=
(CWhile b c) (at level 80, right associativity).
Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
(CIf e1 e2 e3) (at level 80, right associativity).

例えば先の階乗関数を Coq での形式的な定義として記述し直すと、以下のようになります。

Definition fact_in_coq : com :=
Z ::= AId X;
Y ::= ANum 1;
WHILE BNot (BEq (AId Z) (ANum 0)) DO
Y ::= AMult (AId Y) (AId Z);
Z ::= AMinus (AId Z) (ANum 1)
END.

例

以下に、さらなる例を挙げます。

割り当て:

Definition plus2 : com :=
X ::= (APlus (AId X) (ANum 2)).

Definition XtimesYinZ : com :=
Z ::= (AMult (AId X) (AId Y)).

Definition subtract_slowly_body : com :=
Z ::= AMinus (AId Z) (ANum 1) ;
X ::= AMinus (AId X) (ANum 1).

ループ:

Definition subtract_slowly : com :=
WHILE BNot (BEq (AId X) (ANum 0)) DO
subtract_slowly_body
END.

Definition subtract_3_from_5_slowly : com :=
X ::= ANum 3 ;
Z ::= ANum 5 ;
subtract_slowly.

無限ループ:

Definition loop : com :=
WHILE BTrue DO
SKIP
END.

階乗関数再び (あとで戻って証明するとき便利なように、細かい部品に分割してあります)。

Definition fact_body : com :=
Y ::= AMult (AId Y) (AId Z) ;
Z ::= AMinus (AId Z) (ANum 1).

Definition fact_loop : com :=
WHILE BNot (BEq (AId Z) (ANum 0)) DO
fact_body
END.

Definition fact_com : com :=
Z ::= AId X ;
Y ::= ANum 1 ;
fact_loop.

評価

次に、Imp のコマンドの実行が何を意味するかを定義する必要があります。WHILEループは、これを少々扱いにくいものにしています ...

評価関数

以下はWHILE以外のコマンドの評価関数を得ようとした、最初の試みです。

Fixpoint ceval_step1 (st : state) (c : com) : state :=
match c with
| SKIP =>
st
| l ::= a1 =>
update st l (aeval st a1)
| c1 ; c2 =>
let st' := ceval_step1 st c1 in
ceval_step1 st' c2
| IFB b THEN c1 ELSE c2 FI =>
if (beval st b)
then ceval_step1 st c1
else ceval_step1 st c2
| WHILE b1 DO c1 END =>
st
end.

次の試みでは、評価が常に停止することを保証するため、数の引数を追加して「ステップ指数」として用いています。

Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state :=
match i with
| O => empty_state
| S i' =>
match c with
| SKIP =>
st
| l ::= a1 =>
update st l (aeval st a1)
| c1 ; c2 =>
let st' := ceval_step2 st c1 i' in
ceval_step2 st' c2 i'
| IFB b THEN c1 ELSE c2 FI =>
if (beval st b)
then ceval_step2 st c1 i'
else ceval_step2 st c2 i'
| WHILE b1 DO c1 END =>
if (beval st b1)
then let st' := ceval_step2 st c1 i' in
ceval_step2 st' c i'
else st
end
end.

注: ここでの指数iは「評価のステップ数」を数えるものだろうか？という点が気になります。しかしよく見ると、そうではないと分かります。例えば、直列実行に対する規則では、2 つの再帰呼び出しに同じiが渡されています。iがどのように扱われているのかを正確に理解することは、以下で演習問題として与えられているceval__ceval_stepの証明で重要となるでしょう。

3 つ目の試みでは、単なるstateの代わりにoption stateを返すようにしています。こうすると、通常終了と異常終了を区別出来ます。

Fixpoint ceval_step3 (st : state) (c : com) (i : nat)
: option state :=
match i with
| O => None
| S i' =>
match c with
| SKIP =>
Some st
| l ::= a1 =>
Some (update st l (aeval st a1))
| c1 ; c2 =>
match (ceval_step3 st c1 i') with
| Some st' => ceval_step3 st' c2 i'
| None => None
end
| IFB b THEN c1 ELSE c2 FI =>
if (beval st b)
then ceval_step3 st c1 i'
else ceval_step3 st c2 i'
| WHILE b1 DO c1 END =>
if (beval st b1)
then match (ceval_step3 st c1 i') with
| Some st' => ceval_step3 st' c i'
| None => None
end
else Some st
end
end.

オプション状態に対する場合分けに繰り返し含まれている「配管」を隠すための、補助的なちょっとした記法を導入すると、この定義の読みやすさは改善出来ます。

Notation "'LETOPT' x <== e1 'IN' e2"
:= (match e1 with
| Some x => e2
| None => None
end)
(right associativity, at level 60).

Fixpoint ceval_step (st : state) (c : com) (i : nat)
: option state :=
match i with
| O => None
| S i' =>
match c with
| SKIP =>
Some st
| l ::= a1 =>
Some (update st l (aeval st a1))
| c1 ; c2 =>
LETOPT st' <== ceval_step st c1 i' IN
ceval_step st' c2 i'
| IFB b THEN c1 ELSE c2 FI =>
if (beval st b)
then ceval_step st c1 i'
else ceval_step st c2 i'
| WHILE b1 DO c1 END =>
if (beval st b1)
then LETOPT st' <== ceval_step st c1 i' IN
ceval_step st' c i'
else Some st
end
end.

Definition test_ceval (st:state) (c:com) :=
match ceval_step st c 500 with
| None    => None
| Some st => Some (st X, st Y, st Z)
end.

練習問題: ★★, recommended (pup_to_n)

1からXまでの整数を変数Yに足す (つまり1 + 2 + ... + X)Imp プログラムを書きなさい。下に示したテストを満たすことを確認しなさい。

Definition pup_to_n : com :=
(* FILL IN HERE *) admit.

☐

練習問題: ★★, optional (peven)

Xが偶数だったらZに0を、そうでなければZに1をセットするWhileプログラムを書きなさい。テストにはceval_testを使いなさい。

(* FILL IN HERE *)

☐

関係としての評価

ここに改善策があります:cevalを関数ではなく関係 (relation) として定義しましょう。つまり、上のaevalRとbevalRと同様にTypeではなくPropで定義しましょう。

これは重要な変更です。ステップ指数をすべての場所で引き回す馬鹿馬鹿しさから解放してくれるのに加え、定義での柔軟性を与えてくれます。例えば、もし言語に並行性の要素を導入したら、評価の定義を非決定的に書きたくなるでしょう。つまり、その関数は全関数でないだけでなく、部分関数ですらないかも知れません！

ceavl関係に対する表記としてc / st || st'を使います。正確に言うと、c / st || st'と書いたらプログラムcを初期状態stで評価すると、その結果は最終状態st'になる、ということを意味します。これは「cは状態stをst'に持っていく」とも言えます。

----------------                            (E_Skip)
SKIP / st || st

aeval st a1 = n
--------------------------------                     (E_Ass)
l := a1 / st || (update st l n)

c1 / st || st'
c2 / st' || st''
-------------------                            (E_Seq)
c1;c2 / st || st''

beval st b1 = true
c1 / st || st'
-------------------------------------                (E_IfTrue)
IF b1 THEN c1 ELSE c2 FI / st || st'

beval st b1 = false
c2 / st || st'
-------------------------------------               (E_IfFalse)
IF b1 THEN c1 ELSE c2 FI / st || st'

beval st b1 = false
------------------------------                 (E_WhileEnd)
WHILE b1 DO c1 END / st || st

beval st b1 = true
c1 / st || st'
WHILE b1 DO c1 END / st' || st''
---------------------------------               (E_WhileLoop)
WHILE b1 DO c1 END / st || st''

以下に形式的な定義を挙げます。(上の推論規則とどのように対応するか、確認しておきましょう。)

Reserved Notation "c1 '/' st '||' st'" (at level 40, st at level 39).

Inductive ceval : com -> state -> state -> Prop :=
| E_Skip : forall st,
SKIP / st || st
| E_Ass  : forall st a1 n l,
aeval st a1 = n ->
(l ::= a1) / st || (update st l n)
| E_Seq : forall c1 c2 st st' st'',
c1 / st  || st' ->
c2 / st' || st'' ->
(c1 ; c2) / st || st''
| E_IfTrue : forall st st' b1 c1 c2,
beval st b1 = true ->
c1 / st || st' ->
(IFB b1 THEN c1 ELSE c2 FI) / st || st'
| E_IfFalse : forall st st' b1 c1 c2,
beval st b1 = false ->
c2 / st || st' ->
(IFB b1 THEN c1 ELSE c2 FI) / st || st'
| E_WhileEnd : forall b1 st c1,
beval st b1 = false ->
(WHILE b1 DO c1 END) / st || st
| E_WhileLoop : forall st st' st'' b1 c1,
beval st b1 = true ->
c1 / st || st' ->
(WHILE b1 DO c1 END) / st' || st'' ->
(WHILE b1 DO c1 END) / st || st''

where "c1 '/' st '||' st'" := (ceval c1 st st').

Tactic Notation "ceval_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq"
| Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
| Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" ].

評価を関数ではなく関係として定義することのコストは、あるプログラムを実行した結果がとある状態になる、というのを Coq の計算機構にやってもらうだけではなく、その「証明」を構築する必要がある、ということです。

Example ceval_example1:
(X ::= ANum 2;
IFB BLe (AId X) (ANum 1)
THEN Y ::= ANum 3
ELSE Z ::= ANum 4
FI)
/ empty_state
|| (update (update empty_state X 2) Z 4).
Proof.

apply E_Seq with (update empty_state X 2).
Case "assignment command".
apply E_Ass. reflexivity.
Case "if command".
apply E_IfFalse.
reflexivity.
apply E_Ass. reflexivity.  Qed.

練習問題: ★★ (ceval_example2)

Example ceval_example2:
(X ::= ANum 0; Y ::= ANum 1; Z ::= ANum 2) / empty_state ||
(update (update (update empty_state X 0) Y 1) Z 2).
Proof.
(* FILL IN HERE *) Admitted.

☐

関係による評価とステップ指数を利用した評価の等価性

算術式とブール式で行ったように、2 つの評価の定義が本当に、結局のところ同じものになるのかを確認したくなるでしょう。この章では、それを確認します。定理の主張を理解して、証明の構造を追えることを確認しておいて下さい。

Theorem ceval_step__ceval: forall c st st',
(exists i, ceval_step st c i = Some st') ->
c / st || st'.
Proof.
intros c st st' H.
inversion H as [i E].
clear H.
generalize dependent st'.
generalize dependent st.
generalize dependent c.
induction i as [| i' ].

Case "i = 0 -- contradictory".
intros c st st' H. inversion H.

Case "i = S i'".
intros c st st' H.
com_cases (destruct c) SCase;
simpl in H; inversion H; subst; clear H.
SCase "SKIP". apply E_Skip.
SCase "::=". apply E_Ass. reflexivity.

SCase ";".
remember (ceval_step st c1 i') as r1. destruct r1.
SSCase "Evaluation of r1 terminates normally".
apply E_Seq with s.
apply IHi'. rewrite Heqr1. reflexivity.
apply IHi'. simpl in H1. assumption.
SSCase "Otherwise -- contradiction".
inversion H1.

SCase "IFB".
remember (beval st b) as r. destruct r.
SSCase "r = true".
apply E_IfTrue. rewrite Heqr. reflexivity.
apply IHi'. assumption.
SSCase "r = false".
apply E_IfFalse. rewrite Heqr. reflexivity.
apply IHi'. assumption.

SCase "WHILE". remember (beval st b) as r. destruct r.
SSCase "r = true".
remember (ceval_step st c i') as r1. destruct r1.
SSSCase "r1 = Some s".
apply E_WhileLoop with s. rewrite Heqr. reflexivity.
apply IHi'. rewrite Heqr1. reflexivity.
apply IHi'. simpl in H1. assumption.
SSSCase "r1 = None".
inversion H1.
SSCase "r = false".
inversion H1.
apply E_WhileEnd.
rewrite Heqr. subst. reflexivity.  Qed.

練習問題: ★★★★ (ceval_step__ceval_inf)

[]
*)

FILL IN HERE いつものテンプレートにのっとって、ceval_step__cevalの形式的でない証明を書きましょう。(帰納的に定義された値の場合分けに対するテンプレートは、帰納法の仮定がないこと以外は帰納法と同じ見た目になるはずです。)単に形式的な証明のステップを書き写すだけでなく、人間の読者に主要な考えが伝わるようにしなさい。

(* FILL IN HERE *)☐

Theorem ceval_step_more: forall i1 i2 st st' c,
i1 <= i2 ->
ceval_step st c i1 = Some st' ->
ceval_step st c i2 = Some st'.
Proof.
induction i1 as [|i1']; intros i2 st st' c Hle Hceval.
Case "i1 = 0".
inversion Hceval.
Case "i1 = S i1'".
destruct i2 as [|i2']. inversion Hle.
assert (Hle': i1' <= i2') by omega.
com_cases (destruct c) SCase.
SCase "SKIP".
simpl in Hceval. inversion Hceval.
reflexivity.
SCase "::=".
simpl in Hceval. inversion Hceval.
reflexivity.
SCase ";".
simpl in Hceval. simpl.
remember (ceval_step st c1 i1') as st1'o.
destruct st1'o.
SSCase "st1'o = Some".
symmetry in Heqst1'o.
apply (IHi1' i2') in Heqst1'o; try assumption.
rewrite Heqst1'o. simpl. simpl in Hceval.
apply (IHi1' i2') in Hceval; try assumption.
SSCase "st1'o = None".
inversion Hceval.

SCase "IFB".
simpl in Hceval. simpl.
remember (beval st b) as bval.
destruct bval; apply (IHi1' i2') in Hceval; assumption.

SCase "WHILE".
simpl in Hceval. simpl.
destruct (beval st b); try assumption.
remember (ceval_step st c i1') as st1'o.
destruct st1'o.
SSCase "st1'o = Some".
symmetry in Heqst1'o.
apply (IHi1' i2') in Heqst1'o; try assumption.
rewrite -> Heqst1'o. simpl. simpl in Hceval.
apply (IHi1' i2') in Hceval; try assumption.
SSCase "i1'o = None".
simpl in Hceval. inversion Hceval.  Qed.

練習問題: ★★★, recommended (ceval__ceval_step)

以下の証明を完成させなさい。何度かceval_step_moreが必要となり、さらに<=とplusに関するいくつかの基本的な事実が必要となるでしょう。

Theorem ceval__ceval_step: forall c st st',
c / st || st' ->
exists i, ceval_step st c i = Some st'.
Proof.
intros c st st' Hce.
ceval_cases (induction Hce) Case.
(* FILL IN HERE *) Admitted.

☐

Theorem ceval_and_ceval_step_coincide: forall c st st',
c / st || st'
<-> exists i, ceval_step st c i = Some st'.
Proof.
intros c st st'.
split. apply ceval__ceval_step. apply ceval_step__ceval.
Qed.

実行の決定性

評価の定義を計算的なものから関係的なものに変更するのは、評価は全関数であるべきという (Fixpoint の定義におけるCoq の制限によって課せられる) 不自然な要求から逃れさせてくれる良い変更です。しかしこれは、2 つ目の評価の定義は本当に部分関数なのか？という疑問ももたらします。つまり、同じ状態stから始めて、あるコマンドcを違った方法で評価し、2 つの異なる出力状態st'とst''に至るのは可能か？ということです。

実際には、こうなることはありません。評価関係cevalは部分関数です。以下に証明を挙げます:

Theorem ceval_deterministic: forall c st st1 st2,
c / st || st1  ->
c / st || st2 ->
st1 = st2.
Proof.
intros c st st1 st2 E1 E2.
generalize dependent st2.
ceval_cases (induction E1) Case;
intros st2 E2; inversion E2; subst.
Case "E_Skip". reflexivity.
Case "E_Ass". reflexivity.
Case "E_Seq".
assert (st' = st'0) as EQ1.
SCase "Proof of assertion". apply IHE1_1; assumption.
subst st'0.
apply IHE1_2. assumption.
Case "E_IfTrue".
SCase "b1 evaluates to true".
apply IHE1. assumption.
SCase "b1 evaluates to false (contradiction)".
rewrite H in H5. inversion H5.
Case "E_IfFalse".
SCase "b1 evaluates to true (contradiction)".
rewrite H in H5. inversion H5.
SCase "b1 evaluates to false".
apply IHE1. assumption.
Case "E_WhileEnd".
SCase "b1 evaluates to true".
reflexivity.
SCase "b1 evaluates to false (contradiction)".
rewrite H in H2. inversion H2.
Case "E_WhileLoop".
SCase "b1 evaluates to true (contradiction)".
rewrite H in H4. inversion H4.
SCase "b1 evaluates to false".
assert (st' = st'0) as EQ1.
SSCase "Proof of assertion". apply IHE1_1; assumption.
subst st'0.
apply IHE1_2. assumption.  Qed.

以下に、より巧みな証明を示します。これは関係による定義と指数を利用した定義の評価が同じである事実を利用しています。

Theorem ceval_deterministic' : forall c st st1 st2,
c / st || st1  ->
c / st || st2 ->
st1 = st2.
Proof.
intros c st st1 st2 He1 He2.
apply ceval__ceval_step in He1.
apply ceval__ceval_step in He2.
inversion He1 as [i1 E1].
inversion He2 as [i2 E2].
apply ceval_step_more with (i2 := i1 + i2) in E1.
apply ceval_step_more with (i2 := i1 + i2) in E2.
rewrite E1 in E2. inversion E2. reflexivity.
omega. omega.  Qed.

プログラムの検証

ここから Imp におけるプログラムの検証に対する系統だったテクニックに深く関わっていきます。しかし、その多くはむき出しの (もとの) 定義を扱うだけで出来ます。この章では、いくつかの例を探します。

基本的な例

Theorem plus2_spec : forall st n st',
st X = n ->
plus2 / st || st' ->
st' X = n + 2.
Proof.
intros st n st' HX Heval.

inversion Heval. subst.
apply update_eq.  Qed.

練習問題: ★★★, recommended (XtimesYinZ_spec)

XtimesYinZ の Imp プログラムの仕様を書いて証明しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★, recommended (loop_never_stops)

Theorem loop_never_stops : forall st st',
~(loop / st || st').
Proof.
intros st st' contra. unfold loop in contra.
remember (WHILE BTrue DO SKIP END) as loopdef.

(* FILL IN HERE *) Admitted.

☐

Fixpoint no_whiles (c : com) : bool :=
match c with
| SKIP       => true
| _ ::= _    => true
| c1 ; c2  => andb (no_whiles c1) (no_whiles c2)
| IFB _ THEN ct ELSE cf FI => andb (no_whiles ct) (no_whiles cf)
| WHILE _ DO _ END  => false
end.

練習問題: ★★, optional (no_whilesR)

性質no_whilesはプログラムが while ループを含まない場合trueを返します。Inductive を使ってcが while ループのないプログラムのとき証明可能な性質no_whilesRを書きなさい。さらに、それがno_whilesと等価であることを示しなさい。

Inductive no_whilesR: com -> Prop :=
(* FILL IN HERE *)
.

Theorem no_whiles_eqv:
forall c, no_whiles c = true <-> no_whilesR c.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★★, optional (no_whiles_terminating)

while ループを含まない Imp プログラムは必ず停止します。これを定理として記述し、証明しなさい。

(no_whilesとno_whilesRのどちらでも好きなほうを使いなさい。)

(* FILL IN HERE *)

☐

プログラム正当性 (Optional)

階乗のプログラムを思い出しましょう:

Print fact_body. Print fact_loop. Print fact_com.

階乗関数の別の「数学的な」定義を以下に示します:

Fixpoint real_fact (n:nat) : nat :=
match n with
| O => 1
| S n' => n * (real_fact n')
end.

変数Xがある数xを持つ状態でfact_comを実行すると、変数Yがxの階乗の値を持つ状態で停止する、ということを示したくなります。これを示すため、ループ不変式 (loop invariant) という重要な概念を使います。

Definition fact_invariant (x:nat) (st:state) :=
(st Y) * (real_fact (st Z)) = real_fact x.

Theorem fact_body_preserves_invariant: forall st st' x,
fact_invariant x st ->
st Z <> 0 ->
fact_body / st || st' ->
fact_invariant x st'.
Proof.
unfold fact_invariant, fact_body.
intros st st' x Hm HZnz He.
inversion He; subst; clear He.
inversion H1; subst; clear H1.
inversion H4; subst; clear H4.
unfold update. simpl.

destruct (st Z) as [| z'].
apply ex_falso_quodlibet. apply HZnz. reflexivity.
rewrite <- Hm. rewrite <- mult_assoc.
replace (S z' - 1) with z' by omega.
reflexivity.  Qed.

Theorem fact_loop_preserves_invariant : forall st st' x,
fact_invariant x st ->
fact_loop / st || st' ->
fact_invariant x st'.
Proof.
intros st st' x H Hce.
remember fact_loop as c.
ceval_cases (induction Hce) Case;
inversion Heqc; subst; clear Heqc.
Case "E_WhileEnd".

assumption.
Case "E_WhileLoop".

apply IHHce2.
apply fact_body_preserves_invariant with st;
try assumption.
intros Contra. simpl in H0; subst.
rewrite Contra in H0. inversion H0.
reflexivity.  Qed.

Theorem guard_false_after_loop: forall b c st st',
(WHILE b DO c END) / st || st' ->
beval st' b = false.
Proof.
intros b c st st' Hce.
remember (WHILE b DO c END) as cloop.
ceval_cases (induction Hce) Case;
inversion Heqcloop; subst; clear Heqcloop.
Case "E_WhileEnd".
assumption.
Case "E_WhileLoop".
apply IHHce2. reflexivity.  Qed.

これらをすべてつなぎ合わせましょう...

Theorem fact_com_correct : forall st st' x,
st X = x ->
fact_com / st || st' ->
st' Y = real_fact x.
Proof.
intros st st' x HX Hce.
inversion Hce; subst; clear Hce.
inversion H1; subst; clear H1.
inversion H4; subst; clear H4.
inversion H1; subst; clear H1.
rename st' into st''. simpl in H5.

remember (update (update st Z (st X)) Y 1) as st'.
assert (fact_invariant (st X) st').
subst. unfold fact_invariant, update. simpl. omega.

assert (fact_invariant (st X) st'').
apply fact_loop_preserves_invariant with st'; assumption.
unfold fact_invariant in H0.

apply guard_false_after_loop in H5. simpl in H5.
destruct (st'' Z).
Case "st'' Z = 0". simpl in H0. omega.
Case "st'' Z > 0 (impossible)". inversion H5.
Qed.

この、状態をつっついて定義を展開するような全体のやり方を、何かより強力な補題や、より一貫性のある推論原理で改善できないのかと思う人もいるかもしれません。実は、それがまさに次の章(Hoare_J.v)の主題です!

練習問題: ★★★★, optional (subtract_slowly_spec)

上のfact_comの仕様、および以下の不変式をガイドとして、subtract_slowly の仕様を証明しなさい。

Definition ss_invariant (x:nat) (z:nat) (st:state) :=
minus (st Z) (st X) = minus z x.

(* FILL IN HERE *)

☐

追加の練習問題

C 風のforループをコマンドの言語に追加し、cevalの定義をforループの意味も与えるよう更新して、このファイルにあるすべての証明が Coq に通るよう、必要なところへforループに対する場合分けを追加しなさい。

forループは (a) 初めに実行される主張、(b) 各繰り返しで実行される、ループを続けてよいか決定するテスト、(c) 各ループの繰り返しの最後に実行される主張、および(d) ループの本体を構成する主張によってパラメタ化されていなければなりません。(forループに対する具体的な表記の構成を気にする必要はありませんが、やりたければ自由にやって構いません。)

(* FILL IN HERE *)

☐

多くのモダンなプログラミング言語はブール演算子andに対し、「省略した」実行を使っています。BAnd b1 b2を実行するには、まずb1を評価します。それがfalseに評価されるならば、b2の評価はせず、すぐにBAnd式全体の結果をfalseに評価します。そうでなければ、BAnd式の結果を決定するため、b2が評価されます。

このようにBAndを省略して評価する、別のバージョンのbevalを書き、それがbeavlと等価であることを証明しなさい。

(* FILL IN HERE *)

HP の電卓、Forth や Postscript などのプログラミング言語、および Java Virtual Machine などの抽象機械はすべて、スタックを使って算術式を評価します。例えば、

(2*3)+(3*(4-2))

という式は

2 3 * 3 4 2 - * +

と入力され、以下のように実行されるでしょう:

[]            |    2 3 * 3 4 2 - * +
[2]           |    3 * 3 4 2 - * +
[3, 2]        |    * 3 4 2 - * +
[6]           |    3 4 2 - * +
[3, 6]        |    4 2 - * +
[4, 3, 6]     |    2 - * +
[2, 4, 3, 6]  |    - * +
[2, 3, 6]     |    * +
[6, 6]        |    +
[12]          |

この練習問題のタスクは、eaxpをスタック機械の命令列に変換する小さなコンパイラを書き、その正当性を証明することです。

スタック言語の命令セットは、以下の命令から構成されます:

- SPush n: 数nをスタックにプッシュする。

- SLoad X: ストアから識別子Xに対応する値を読み込み、スタックにプッシュする。

- SPlus: スタックの先頭の 2 つの数をポップし、それらを足して、 結果をスタックにプッシュする。

- SMinus: 上と同様。ただし引く。

- SMult: 上と同様。ただし掛ける。

Inductive sinstr : Type := | SPush : nat -> sinstr | SLoad : id -> sinstr | SPlus : sinstr | SMinus : sinstr | SMult : sinstr.

スタック言語のプログラムを評価するための関数を書きなさい。入力として、状態、数のリストとして表現されたスタック(スタックの先頭要素はリストの先頭)、および命令のリストとして表現されたプログラムを受け取り、受け取ったプログラムの実行した後のスタックを返します。下にある例で、その関数のテストをしなさい。

上の仕様では、スタックが 2 つ未満の要素しか含まずにSPlusやSMinus、SMult命令に至った場合を明示していないままなことに注意しましょう。我々のコンパイラはそのような奇形のプログラムは生成しないので、これは重要でないという意味です。しかし正当性の証明をするときは、いくつかの選択のほうが証明をより簡単にすることに気づくかもしれません。

Fixpoint s_execute (st : state) (stack : list nat)
(prog : list sinstr)
: list nat :=
(* FILL IN HERE *) admit.

Example s_execute1 :
s_execute empty_state []
[SPush 5, SPush 3, SPush 1, SMinus]
= [2, 5].
(* FILL IN HERE *) Admitted.

Example s_execute2 :
s_execute (update empty_state X 3) [3,4]
[SPush 4, SLoad X, SMult, SPlus]
= [15, 4].
(* FILL IN HERE *) Admitted.

次に、aexpをスタック機械のプログラムにコンパイルする関数を書きなさい。このプログラムを実行する影響は、もとの式の値をスタックに積むことと同じでなければなりません。

Fixpoint s_compile (e : aexp) : list sinstr :=
(* FILL IN HERE *) admit.

最後に、compile関数が正しく振る舞うことを述べている以下の定理を証明しなさい。まずは使える帰納法の仮定を得るため、より一般的な補題を述べる必要があるでしょう。

(* FILL IN HERE *)

Theorem s_compile_correct : forall (st : state) (e : aexp),
s_execute st [] (s_compile e) = [ aeval st e ].
Proof.
(* FILL IN HERE *) Admitted.

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

ImpParser_J: Coqでの字句解析と構文解析

Imp_J.vでのImp言語の開発は、具象構文の問題を完全に無視しています。つまり、プログラマが書くアスキー文字列をデータ型aexp、bexp、comで定義された抽象構文木にどうやって変換するか、という問題です。このファイルでは、Coqの関数プログラミング機能によって簡単な字句解析器と構文解析器(パーサ)を構築することで、この残っている問題を終わらせます。

ここでやることは、細部まで理解する必要はありません。説明はかなり少なく、練習問題もありません。一番のポイントは単に、それをやることが可能なことを示すことです。コードを眺めてみて欲しいところです。ほとんどの部分はそれほど複雑ではありません。ただパーサはある「モナド的」プログラミング法をしているので、理解するのにちょっと骨が折れるかもしれません。しかし、ほとんどの読者は、一番最後の「例」のさわりまで飛ばしたいことでしょう。

内部処理

Require Import SfLib_J.
Require Import Imp_J.

Require Import String.
Require Import Ascii.

Open Scope list_scope.

字句解析

Definition isWhite (c : ascii) : bool :=
let n := nat_of_ascii c in
orb (orb (beq_nat n 32)
(beq_nat n 9))
(orb (beq_nat n 10)
(beq_nat n 13)).

Notation "x '<=?' y" := (ble_nat x y)
(at level 70, no associativity) : nat_scope.

Definition isLowerAlpha (c : ascii) : bool :=
let n := nat_of_ascii c in
andb (97 <=? n) (n <=? 122).

Definition isAlpha (c : ascii) : bool :=
let n := nat_of_ascii c in
orb (andb (65 <=? n) (n <=? 90))
(andb (97 <=? n) (n <=? 122)).

Definition isDigit (c : ascii) : bool :=
let n := nat_of_ascii c in
andb (48 <=? n) (n <=? 57).

Inductive chartype := white | alpha | digit | other.

Definition classifyChar (c : ascii) : chartype :=
if isWhite c then
white
else if isAlpha c then
alpha
else if isDigit c then
digit
else
other.

Fixpoint list_of_string (s : string) : list ascii :=
match s with
| EmptyString => []
| String c s => c :: (list_of_string s)
end.

Fixpoint string_of_list (xs : list ascii) : string :=
fold_right String EmptyString xs.

Definition token := string.

Fixpoint tokenize_helper (cls : chartype) (acc xs : list ascii)
: list (list ascii) :=
let tk := match acc with [] => [] | _::_ => [rev acc] end in
match xs with
| [] => tk
| (x::xs') =>
match cls, classifyChar x, x with
| _, _, "("      => tk ++ ["("]::(tokenize_helper other [] xs')
| _, _, ")"      => tk ++ [")"]::(tokenize_helper other [] xs')
| _, white, _    => tk ++ (tokenize_helper white [] xs')
| alpha,alpha,x  => tokenize_helper alpha (x::acc) xs'
| digit,digit,x  => tokenize_helper digit (x::acc) xs'
| other,other,x  => tokenize_helper other (x::acc) xs'
| _,tp,x         => tk ++ (tokenize_helper tp [x] xs')
end
end %char.

Definition tokenize (s : string) : list string :=
map string_of_list (tokenize_helper white [] (list_of_string s)).

Example tokenize_ex1 :
tokenize "abc12==3  223*(3+(a+c))" %string
= ["abc", "12", "==", "3", "223",
"*", "(", "3", "+", "(",
"a", "+", "c", ")", ")"]%string.
Proof. reflexivity. Qed.

構文解析

Option と Error

Inductive optionE (X:Type) : Type :=
| SomeE : X -> optionE X
| NoneE : string -> optionE X.

Implicit Arguments SomeE [[X]].
Implicit Arguments NoneE [[X]].

Notation "'DO' ( x , y ) <== e1 ;; e2"
:= (match e1 with
| SomeE (x,y) => e2
| NoneE err => NoneE err
end)
(right associativity, at level 60).

Notation "'DO' ( x , y ) <-- e1 ;; e2 'OR' e3"
:= (match e1 with
| SomeE (x,y) => e2
| NoneE err => e3
end)
(right associativity, at level 60, e2 at next level).

シンボルテーブル

Fixpoint build_symtable (xs : list token) (n : nat) : (token -> nat) :=
match xs with
| [] => (fun s => n)
| x::xs =>
if (forallb isLowerAlpha (list_of_string x))
then (fun s => if string_dec s x then n else (build_symtable xs (S n) s))
else build_symtable xs n
end.

パーサ構築のための一般コンビネータ

Open Scope string_scope.

Definition parser (T : Type) :=
list token -> optionE (T * list token).

Fixpoint many_helper {T} (p : parser T) acc steps xs :=
match steps, p xs with
| 0, _ => NoneE "Too many recursive calls"
| _, NoneE _ => SomeE ((rev acc), xs)
| S steps', SomeE (t, xs') => many_helper p (t::acc) steps' xs'
end.

Fixpoint many {T} (p : parser T) (steps : nat) : parser (list T) :=
many_helper p [] steps.

Definition firstExpect {T} (t : token) (p : parser T) : parser T :=
fun xs => match xs with
| x::xs' => if string_dec x t
then p xs'
else NoneE ("expected '" ++ t ++ "'.")
| [] =>  NoneE ("expected '" ++ t ++ "'.")
end.

Definition expect (t : token) : parser unit :=
firstExpect t (fun xs => SomeE(tt, xs)).

Impの再帰下降パーサ

Definition parseIdentifier (symtable :string->nat) (xs : list token)
: optionE (id * list token) :=
match xs with
| [] => NoneE "Expected identifier"
| x::xs' =>
if forallb isLowerAlpha (list_of_string x) then
SomeE (Id (symtable x), xs')
else
NoneE ("Illegal identifier:'" ++ x ++ "'")
end.

Definition parseNumber (xs : list token) : optionE (nat * list token) :=
match xs with
| [] => NoneE "Expected number"
| x::xs' =>
if forallb isDigit (list_of_string x) then
SomeE (fold_left (fun n d =>
10 * n + (nat_of_ascii d - nat_of_ascii "0"%char))
(list_of_string x)
0,
xs')
else
NoneE "Expected number"
end.

Fixpoint parsePrimaryExp (steps:nat) symtable (xs : list token)
: optionE (aexp * list token) :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO (i, rest) <-- parseIdentifier symtable xs ;;
SomeE (AId i, rest)
OR DO (n, rest) <-- parseNumber xs ;;
SomeE (ANum n, rest)
OR (DO (e, rest)  <== firstExpect "(" (parseSumExp steps' symtable) xs;;
DO (u, rest') <== expect ")" rest ;;
SomeE(e,rest'))
end
with parseProductExp (steps:nat) symtable (xs : list token)  :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO (e, rest) <==
parsePrimaryExp steps' symtable xs ;;
DO (es, rest') <==
many (firstExpect "*" (parsePrimaryExp steps' symtable)) steps' rest;;
SomeE (fold_left AMult es e, rest')
end
with parseSumExp (steps:nat) symtable (xs : list token)  :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO (e, rest) <==
parseProductExp steps' symtable xs ;;
DO (es, rest') <==
many (fun xs =>
DO (e,rest') <--
firstExpect "+" (parseProductExp steps' symtable) xs;;
SomeE ( (true, e), rest')
OR DO (e,rest') <==
firstExpect "-" (parseProductExp steps' symtable) xs;;
SomeE ( (false, e), rest'))
steps' rest;;
SomeE (fold_left (fun e0 term =>
match term with
(true,  e) => APlus e0 e
| (false, e) => AMinus e0 e
end)
es e,
rest')
end.

Definition parseAExp := parseSumExp.

Fixpoint parseAtomicExp (steps:nat) (symtable : string->nat) (xs : list token)  :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO    (u,rest) <-- expect "true" xs;;
SomeE (BTrue,rest)
OR DO (u,rest) <-- expect "false" xs;;
SomeE (BFalse,rest)
OR DO (e,rest) <-- firstExpect "not" (parseAtomicExp steps' symtable) xs;;
SomeE (BNot e, rest)
OR DO (e,rest) <-- firstExpect "(" (parseConjunctionExp steps' symtable) xs;;
(DO (u,rest') <== expect ")" rest;; SomeE (e, rest'))
OR DO (e, rest) <== parseProductExp steps' symtable xs ;;
(DO (e', rest') <--
firstExpect "==" (parseAExp steps' symtable) rest ;;
SomeE (BEq e e', rest')
OR DO (e', rest') <--
firstExpect "<=" (parseAExp steps' symtable) rest ;;
SomeE (BLe e e', rest')
OR
NoneE "Expected '==' or '<=' after arithmetic expression")
end
with parseConjunctionExp (steps:nat) (symtable : string->nat) (xs : list token)   :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO (e, rest) <==
parseAtomicExp steps' symtable xs ;;
DO (es, rest') <==
many (firstExpect "&&" (parseAtomicExp steps' symtable)) steps' rest;;
SomeE (fold_left BAnd es e, rest')
end.

Definition parseBExp := parseConjunctionExp.

Fixpoint parseSimpleCommand (steps:nat) (symtable:string->nat) (xs : list token) :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO (u, rest) <-- expect "SKIP" xs;;
SomeE (SKIP, rest)
OR DO (e,rest) <--
firstExpect "IF" (parseBExp steps' symtable) xs;;
DO (c,rest')  <==
firstExpect "THEN" (parseSequencedCommand steps' symtable) rest;;
DO (c',rest'') <==
firstExpect "ELSE" (parseSequencedCommand steps' symtable) rest';;
DO (u,rest''') <==
expect "END" rest'';;
SomeE(IFB e THEN c ELSE c' FI, rest''')
OR DO (e,rest) <--
firstExpect "WHILE" (parseBExp steps' symtable) xs;;
DO (c,rest') <==
firstExpect "DO" (parseSequencedCommand steps' symtable) rest;;
DO (u,rest'') <==
expect "END" rest';;
SomeE(WHILE e DO c END, rest'')
OR DO (i, rest) <==
parseIdentifier symtable xs;;
DO (e, rest') <==
firstExpect ":=" (parseAExp steps' symtable) rest;;
SomeE(i ::= e, rest')
end

with parseSequencedCommand (steps:nat) (symtable:string->nat) (xs : list token) :=
match steps with
| 0 => NoneE "Too many recursive calls"
| S steps' =>
DO (c, rest) <==
parseSimpleCommand steps' symtable xs;;
DO (c', rest') <--
firstExpect ";" (parseSequencedCommand steps' symtable) rest;;
SomeE(c ; c', rest')
OR
SomeE(c, rest)
end.

Definition parse (str : string) : optionE (com * list token) :=
let tokens := tokenize str in
parseSequencedCommand 1000 (build_symtable tokens 0) tokens.

例

Eval compute in parse

"IF x == y + 1 + 2 - y * 6 + 3 THEN
x := x * 1;
y := 0
ELSE
SKIP
END  ".

====>

SomeE
(IFB BEq (AId (Id 0))
(APlus
(AMinus (APlus (APlus (AId (Id 1)) (ANum 1)) (ANum 2))
(AMult (AId (Id 1)) (ANum 6)))
(ANum 3))
THEN Id 0 ::= AMult (AId (Id 0)) (ANum 1); Id 1 ::= ANum 0
ELSE SKIP FI, [])

Eval compute in parse

"SKIP;
z:=x*y*(x*x);
WHILE x==x DO
IF z <= z*z && not x == 2 THEN
x := z;
y := z
ELSE
SKIP
END;
SKIP
END;
x:=z  ".

====>

SomeE
(SKIP;
Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2)))
(AMult (AId (Id 1)) (AId (Id 1)));
WHILE BEq (AId (Id 1)) (AId (Id 1)) DO
IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0))))
(BNot (BEq (AId (Id 1)) (ANum 2)))
THEN Id 1 ::= AId (Id 0); Id 2 ::= AId (Id 0)
ELSE SKIP FI;
SKIP
END;
Id 1 ::= AId (Id 0),
[])

Eval compute in parse

"SKIP;
z:=x*y*(x*x);
WHILE x==x DO
IF z <= z*z && not x == 2 THEN
x := z;
y := z
ELSE
SKIP
END;
SKIP
END;
x:=z  ".

=====>

SomeE
(SKIP;
Id 0 ::= AMult (AMult (AId (Id 1)) (AId (Id 2)))
(AMult (AId (Id 1)) (AId (Id 1)));
WHILE BEq (AId (Id 1)) (AId (Id 1)) DO
IFB BAnd (BLe (AId (Id 0)) (AMult (AId (Id 0)) (AId (Id 0))))
(BNot (BEq (AId (Id 1)) (ANum 2)))
THEN Id 1 ::= AId (Id 0);
Id 2 ::= AId (Id 0)
ELSE SKIP
FI;
SKIP
END;
Id 1 ::= AId (Id 0),
[]).

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Equiv_J: プログラムの同値性

Require Export Imp_J.

宿題割当てについての一般的アドバイス

- Coqによる証明問題は、そこまでに文中で行ってきた証明となるべく同じようにできるようにしています。 宿題に取り組む前に、そこまでの証明を自分でも(紙上とCoqの両方で)やってみなさい。そして、細部まで理解していることを確認しなさい。そうすることは、多くの時間を節約することになるでしょう。

- 問題にする Coq の証明はそれなりに複雑なため、 単に怪しそうなところをランダムに探ってみるような方法で解くことはまず無理です。なぜその性質が真で、どう進めば証明になるかを最初に考える必要があります。そのための一番良い方法は、形式的な証明を始める前に、紙の上に非形式的な証明をスケッチでも良いので書いてみることです。そうすることで、定理が成立することを直観的に確信できます。

- 仕事を減らすために自動化を使いなさい。この章の練習問題の証明のいくつかは、 もしすべての場合を明示的に書き出すとすると、とても長くなります。

振る舞い同値性

前の章で、簡単なプログラム変換の正しさを調べました。optimize_0plus関数です。対象としたプログラミング言語は、算術式の言語の最初のバージョンでした。それには変数もなく、そのためプログラム変換が正しいとはどういうことを意味する(means)かを定義することはとても簡単でした。つまり、変換の結果得られるプログラムが常に、それを評価すると元のプログラムと同じ数値になるということでした。

Imp言語全体についてプログラム変換の正しさを語るためには、変数の役割、および状態について考えなければなりません。

定義

aexpとbexpについては、どう定義すれば良いかは明らかです。2つのaexpまたはbexpが振る舞い同値である(behaviorally equivalent)とは、「すべての状態で」2つの評価結果が同じになることです。

Definition aequiv (a1 a2 : aexp) : Prop :=
forall (st:state),
aeval st a1 = aeval st a2.

Definition bequiv (b1 b2 : bexp) : Prop :=
forall (st:state),
beval st b1 = beval st b2.

コマンドについては、状況はもうちょっと微妙です。簡単に「2つのコマンドが振る舞い同値であるとは、両者を同じ状態から開始すれば同じ状態で終わることである」と言うわけには行きません。コマンドによっては(特定の状態から開始したときには)停止しないためどのような状態にもならないことがあるからです!すると次のように言う必要があります。2つのコマンドが振る舞い同値であるとは、任意の与えられた状態から両者をスタートすると、両者ともに発散するか、両者ともに停止して同じ状態になることです。これを簡潔に表現すると、「1つ目が停止して特定の状態になるならば2つ目も同じになり、逆もまた成り立つ」となります。

Definition cequiv (c1 c2 : com) : Prop :=
forall (st st':state),
(c1 / st || st') <-> (c2 / st || st').

練習問題: ★★, optional (pairs_equiv)

(b)
[[
WHILE BTrue DO
WHILE BFalse DO X ::= APlus (AId X) (ANum 1) END
END
]]
and
[[
WHILE BFalse DO
WHILE BTrue DO X ::= APlus (AId X) (ANum 1) END
END
]]

(* FILL IN HERE *)

[] *)

FILL IN HERE FILL IN HERE 以下のプログラムの対の中で、同値なのはどれでしょうか？それぞれについて、”yes” か “no” を書きなさい。

WHILE (BLe (ANum 1) (AId X)) DO
X ::= APlus (AId X) (ANum 1)
END

と

WHILE (BLe (ANum 2) (AId X)) DO
X ::= APlus (AId X) (ANum 1)
END

(* FILL IN HERE *)

WHILE BTrue DO
WHILE BFalse DO X ::= APlus (AId X) (ANum 1) END
END

と

WHILE BFalse DO
WHILE BTrue DO X ::= APlus (AId X) (ANum 1) END
END

(* FILL IN HERE *)

☐

例

Theorem aequiv_example:
aequiv (AMinus (AId X) (AId X)) (ANum 0).
Proof.
intros st. simpl. apply minus_diag.
Qed.

Theorem bequiv_example:
bequiv (BEq (AMinus (AId X) (AId X)) (ANum 0)) BTrue.
Proof.
intros st. unfold beval.
rewrite aequiv_example. reflexivity.
Qed.

コマンドの同値性の例として、SKIPにからんだ自明な変換から見てみましょう:

Theorem skip_left: forall c,
cequiv
(SKIP; c)
c.
Proof.
intros c st st'.
split; intros H.
Case "->".
inversion H. subst.
inversion H2. subst.
assumption.
Case "<-".
apply E_Seq with st.
apply E_Skip.
assumption.
Qed.

練習問題: ★★ (skip_right)

Theorem skip_right: forall c,
cequiv
(c; SKIP)
c.
Proof.
(* FILL IN HERE *) Admitted.

☐

IFBコマンドを簡単化する変換を探索することもできます:

Theorem IFB_true_simple: forall c1 c2,
cequiv
(IFB BTrue THEN c1 ELSE c2 FI)
c1.
Proof.
intros c1 c2.
split; intros H.
Case "->".
inversion H; subst. assumption. inversion H5.
Case "<-".
apply E_IfTrue. reflexivity. assumption.  Qed.

もちろん、ガードがBTrueそのままである条件文を書こうとするプログラマはほとんどいないでしょう。より興味深いのは、ガードが真と「同値である」場合です...

「定理」:もしbがBTrueと同値ならば、IFB b THEN c1 ELSE c2 FIはc1と同値である。

「証明」:

- (->) すべてのstとst'に対して、もしIFB b THEN c1 ELSE c2 FI / st || st'ならばc1 / st || st'となることを示す。 IFB b THEN c1 ELSE c2 FI / st || st'を示すのに使うことができた可能性のある規則、つまりE_IfTrueとE_IfFalseとで、場合分けをする。

- IFB b THEN c1 ELSE c2 FI / st || st'の導出の最後の規則がE_IfTrueであると仮定する。このとき、E_IfTrueの仮定よりc1 / st || st'となる。これはまさに証明したいことである。

- 一方、IFB b THEN c1 ELSE c2 FI / st || st'の導出の最後の規則がE_IfFalseと仮定する。すると、beval st b = falseかつc2 / st || st'となる。 bがBTrueと同値であったことから、すべてのstについて、beval st b = beval st BTrueが成立する。これは特にbeval st b = trueを意味する。なぜならbeval st BTrue = trueだからである。しかしこれは矛盾である。なぜなら、E_IfFalseからbeval st b = falseでなければならないからである。従って、最後の規則はE_IfFalseではあり得ない。

- (<-) すべてのstとst'について、もしc1 / st|| st'ならばIFB b THEN c1 ELSE c2 FI / st || st'となることを示す。 bがBTrueと同値であることから、beval st b=beval st BTrue=trueとなる。仮定c1 / st || st'よりE_IfTrueが適用でき、IFB b THEN c1 ELSE c2 FI / st || st'となる。☐

以下がこの証明の形式化版です:

Theorem IFB_true: forall b c1 c2,
bequiv b BTrue  ->
cequiv
(IFB b THEN c1 ELSE c2 FI)
c1.
Proof.
intros b c1 c2 Hb.
split; intros H.
Case "->".
inversion H; subst.
SCase "b evaluates to true".
assumption.
SCase "b evaluates to false (contradiction)".
rewrite Hb in H5.
inversion H5.
Case "<-".
apply E_IfTrue; try assumption.
rewrite Hb. reflexivity.  Qed.

練習問題: ★★, recommended (IFB_false)

Theorem IFB_false: forall b c1 c2,
bequiv b BFalse  ->
cequiv
(IFB b THEN c1 ELSE c2 FI)
c2.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★ (swap_if_branches)

Theorem swap_if_branches: forall b e1 e2,
cequiv
(IFB b THEN e1 ELSE e2 FI)
(IFB BNot b THEN e2 ELSE e1 FI).
Proof.
(* FILL IN HERE *) Admitted.

☐

whileループについては、同様の2つ定理があります:ガードがBFalseと同値であるループはSKIPと同値である、というものと、ガードがBTrueと同値であるループはWHILE BTrue DO SKIP END(あるいは他の任意の停止しないプログラム)と同値である、というものです。1つ目のものは簡単です。

Theorem WHILE_false : forall b c,
bequiv b BFalse ->
cequiv
(WHILE b DO c END)
SKIP.
Proof.
intros b c Hb. split; intros H.
Case "->".
inversion H; subst.
SCase "E_WhileEnd".
apply E_Skip.
SCase "E_WhileLoop".
rewrite Hb in H2. inversion H2.
Case "<-".
inversion H; subst.
apply E_WhileEnd.
rewrite Hb.
reflexivity.  Qed.

練習問題: ★★ (WHILE_false_informal)

[]
*)

FILL IN HERE WHILE_falseの非形式的証明を記述しなさい。

(* FILL IN HERE *)☐

2つ目の事実を証明するためには、ガードがBTrueと同値であるwhileループが停止しないことを言う補題が1つ必要です:

「補題」:bがBTrueと同値のとき、(WHILE b DO c END) / st || st'となることはない。

「証明」:(WHILE b DO c END) / st || st'と仮定する。(WHILE b DO c END) / st || st'の導出についての帰納法によって、この仮定から矛盾が導かれることを示す。

- (WHILE b DO c END) / st || st'が規則E_WhileEndから証明されると仮定する。すると仮定からbeval st b = falseとなる。しかしこれは、bがBTrueと同値という仮定と矛盾する。

- (WHILE b DO c END) / st || st'が規則E_WhileLoopを使って証明されると仮定する。すると帰納法の仮定として(WHILE b DO c END) / st || st'が矛盾するということが得られる。これはまさに証明しようとしていることである。

- 上記が(WHILE b DO c END) / st || st'の証明に使うことができる可能性がある規則のすべてであり、帰納法の他の場合は、すぐに矛盾になる。☐

Lemma WHILE_true_nonterm : forall b c st st’, bequiv b BTrue -> ~( (WHILE b DO c END) / st || st’ ). Proof. intros b c st st’ Hb. intros H. remember (WHILE b DO c END) as cw. ceval_cases (induction H) Case;

inversion Heqcw; subst; clear Heqcw.

Case “E_WhileEnd”. rewrite Hb in H. inversion H. Case “E_WhileLoop”. apply IHceval2. reflexivity. Qed.

練習問題: ★★, optional (WHILE_true_nonterm_informal)

*)

FILL IN HERE 補題WHILE_true_nontermが意味するものを日本語で書きなさい。

(* FILL IN HERE *)

☐

練習問題: ★★, recommended (WHILE_true)

ここでWHILE_true_nontermを使いなさい。

Theorem WHILE_true: forall b c,
bequiv b BTrue  ->
cequiv
(WHILE b DO c END)
(WHILE BTrue DO SKIP END).
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem loop_unrolling: forall b c,
cequiv
(WHILE b DO c END)
(IFB b THEN (c; WHILE b DO c END) ELSE SKIP FI).
Proof.

intros b c st st'.
split; intros Hce.
Case "->".
inversion Hce; subst.
SCase "loop doesn't run".
apply E_IfFalse. assumption. apply E_Skip.
SCase "loop runs".
apply E_IfTrue. assumption.
apply E_Seq with (st' := st'0). assumption. assumption.
Case "<-".
inversion Hce; subst.
SCase "loop runs".
inversion H5; subst.
apply E_WhileLoop with (st' := st'0).
assumption. assumption. assumption.
SCase "loop doesn't run".
inversion H5; subst. apply E_WhileEnd. assumption.  Qed.

練習問題: ★★, optional (seq_assoc)

Theorem seq_assoc : forall c1 c2 c3,
cequiv ((c1;c2);c3) (c1;(c2;c3)).
Proof.
(* FILL IN HERE *) Admitted.

☐

最後に、代入に関する簡単な同値を見てみましょう。これは、ちょっとトリッキーです。まず最初に、ある種の「意味のない」代入が除去できることを示せないか、やってみましょう。一番自明なのは:

Theorem identity_assignment_first_try : forall (X:id),
cequiv
(X ::= AId X)
SKIP.
Proof.
intros. split; intro H.
Case "->".
inversion H; subst.  simpl.
replace (update st X (st X)) with st.
constructor.

Admitted.

何がどうなっているのでしょう？我々の状態は単に識別子から値への関数であることを思い出してください。Coqでは、関数同士が等しいとは、その定義が簡単化(simplification)の範囲での変形を除いて構文的に同じということです。(簡単化だけが Coq でeqコンストラクタに適用することが許されたものなのです!)実際には、update操作の繰り返しで構築された関数については、2つの関数が等しいと証明できるのは「同じ」update操作を同じ順番で適用した場合だけです。上述の定理では、第一パラメータcequivのupdateの列は第二パラメータのものより1つ長いので、等しさが成立しないのも当然です。

しかし、この問題はかなり一般的なものです。何か別の「自明な」事実、例えば

cequiv (X ::= APlus (AId X ANum 1) ;
X ::= APlus (AId X ANum 1))
(X ::= APlus (AId X ANum 2))

あるいは

cequiv (X ::= ANum 1; Y ::= ANum 2)
(y ::= ANum 2; X ::= ANum 1)

を証明しようとするとき、同じように行き詰まることになります。つまり、すべての入力に対して同一の振る舞いをする2つの関数が出てくるのですが、その2つがeqであることが証明できないのです。

こういった状況でこれから使おうとしている推論原理は、関数外延性(functional extensionality)と呼ばれます:

forall x, f x = g x
-------------------
f = g

この原理は Coq のビルトインの論理からは導出できませんが、追加公理(axiom)として導入することは安全です。

Axiom functional_extensionality : forall {X Y: Type} {f g : X -> Y},
(forall (x: X), f x = g x) ->  f = g.

Coq にこの公理を導入することが矛盾を生むものではないことを示すことができます。(このように、この公理の導入は、excluded_middleのような古典論理の公理を追加するのと同様なのです。)

この公理のおかげで、先の定理を証明することができます:

Theorem identity_assignment : forall (X:id),
cequiv
(X ::= AId X)
SKIP.
Proof.
intros. split; intro H.
Case "->".
inversion H; subst. simpl.
replace (update st X (st X)) with st.
constructor.
apply functional_extensionality. intro.
rewrite update_same; reflexivity.
Case "<-".
inversion H; subst.
assert (st' = (update st' X (st' X))).
apply functional_extensionality. intro.
rewrite update_same; reflexivity.
rewrite H0 at 2.
constructor. reflexivity.
Qed.

練習問題: ★★, recommended (assign_aequiv)

Theorem assign_aequiv : forall X e,
aequiv (AId X) e ->
cequiv SKIP (X ::= e).
Proof.
(* FILL IN HERE *) Admitted.

☐

振る舞い同値の性質

ここからは、定義したプログラムの同値概念の性質を調べていきましょう。

振る舞い同値は同値関係である

最初に、aexps、bexps、comの同値が、本当に「同値関係」であること、つまり、反射性、対称性、推移性を持つことを検証します:

Lemma refl_aequiv : forall (a : aexp), aequiv a a.
Proof.
intros a st. reflexivity.  Qed.

Lemma sym_aequiv : forall (a1 a2 : aexp),
aequiv a1 a2 -> aequiv a2 a1.
Proof.
intros a1 a2 H. intros st. symmetry. apply H.  Qed.

Lemma trans_aequiv : forall (a1 a2 a3 : aexp),
aequiv a1 a2 -> aequiv a2 a3 -> aequiv a1 a3.
Proof.
unfold aequiv. intros a1 a2 a3 H12 H23 st.
rewrite (H12 st). rewrite (H23 st). reflexivity.  Qed.

Lemma refl_bequiv : forall (b : bexp), bequiv b b.
Proof.
unfold bequiv. intros b st. reflexivity.  Qed.

Lemma sym_bequiv : forall (b1 b2 : bexp),
bequiv b1 b2 -> bequiv b2 b1.
Proof.
unfold bequiv. intros b1 b2 H. intros st. symmetry. apply H.  Qed.

Lemma trans_bequiv : forall (b1 b2 b3 : bexp),
bequiv b1 b2 -> bequiv b2 b3 -> bequiv b1 b3.
Proof.
unfold bequiv. intros b1 b2 b3 H12 H23 st.
rewrite (H12 st). rewrite (H23 st). reflexivity.  Qed.

Lemma refl_cequiv : forall (c : com), cequiv c c.
Proof.
unfold cequiv. intros c st st'. apply iff_refl.  Qed.

Lemma sym_cequiv : forall (c1 c2 : com),
cequiv c1 c2 -> cequiv c2 c1.
Proof.
unfold cequiv. intros c1 c2 H st st'.
assert (c1 / st || st' <-> c2 / st || st') as H'.
SCase "Proof of assertion". apply H.
apply iff_sym. assumption.
Qed.

Lemma iff_trans : forall (P1 P2 P3 : Prop),
(P1 <-> P2) -> (P2 <-> P3) -> (P1 <-> P3).
Proof.
intros P1 P2 P3 H12 H23.
inversion H12. inversion H23.
split; intros A.
apply H1. apply H. apply A.
apply H0. apply H2. apply A.  Qed.

Lemma trans_cequiv : forall (c1 c2 c3 : com),
cequiv c1 c2 -> cequiv c2 c3 -> cequiv c1 c3.
Proof.
unfold cequiv. intros c1 c2 c3 H12 H23 st st'.
apply iff_trans with (c2 / st || st'). apply H12. apply H23.  Qed.

振る舞い同値は合同関係である

よりわかりにくいですが、振る舞い同値は、合同関係(congruence)でもあります。つまり、2つのサブプログラムが同値ならば、それを含むプログラム全体も同値です:

aequiv a1 a1'
-----------------------------
cequiv (i ::= a1) (i ::= a1')

cequiv c1 c1'
cequiv c2 c2'
------------------------
cequiv (c1;c2) (c1';c2')

...などです。(注意して欲しいのですが、ここで推論規則の記法を使っていますが、これは定義の一部ではありません。単に正しい含意を読みやすい形で書き出しただけです。この含意は以下で証明します。)

合同性がなぜ重要なのか、次の節で具体的な例(fold_constants_com_soundの証明)によって見ます。ただ、メインのアイデアは、大きなプログラムの小さな部分を同値の小さな部分で置き換えると、大きなプログラム全体が元のものと同値になることを、変化していない部分についての明示的な証明「なしに」わかるということです。つまり、大きなプログラムの小さな変更についての証明の負担が、プログラムではなく変更に比例するということです。

Theorem CAss_congruence : forall i a1 a1',
aequiv a1 a1' ->
cequiv (CAss i a1) (CAss i a1').
Proof.
intros i a1 a2 Heqv st st'.
split; intros Hceval.
Case "->".
inversion Hceval. subst. apply E_Ass.
rewrite Heqv. reflexivity.
Case "<-".
inversion Hceval. subst. apply E_Ass.
rewrite Heqv. reflexivity.  Qed.

ループの合同性は帰納法が必要になるので、さらに少しおもしろいものになります。

「定理」:WHILEについての同値は合同関係である。すなわち、もしb1がb1'と同値であり、c1がc1'と同値ならば、WHILE b1 DO c1 ENDはWHILE b1' DO c1' ENDと同値である。

「証明」:b1がb1'と同値、c1がc1'と同値であるとする。すべてのstとst'について、証明すべきことは、WHILE b1 DO c1 END / st || st'の必要十分条件はWHILE b1' DO c1' END / st || st'であることである。必要条件と十分条件の両方向を別々に証明する。

- (->)WHILE b1 DO c1 END / st || st'ならばWHILE b1' DO c1' END / st || st'であることを、WHILE b1 DO c1 END / st || st'の導出についての帰納法で示す。自明でないのは、導出の最後の規則がE_WhileEndまたはE_WhileLoopのときだけである。

- E_WhileEnd: この場合、 規則の形からbeval st b1 = falseかつst = st'となる。しかしb1とb1'が同値であることからbeval st b1' = c1' END / st || st'になる。さらにE-WhileEndを適用すると証明すべきWHILE b1' DO c1' END / st || st'が得られる。

- E_WhileLoop: 規則の形からbeval st b1 = trueおよび、ある状態st'0について帰納法の仮定WHILE b1' DO c1' END / st'0 || st'のもとで、c1 / st || st'0かつWHILE b1 DO c1 END / st'0 || st'となる。 c1とc1'が同値であることから、c1' / st || st'0となる。さらにb1とb1'が同値であることから、beval st b1' = trueとなる。E-WhileLoopを適用すると、証明すべきWHILE b1' DO c1' END / st || st'が得られる。

- (<-) 同様である。

☐

Theorem CWhile_congruence : forall b1 b1' c1 c1',
bequiv b1 b1' -> cequiv c1 c1' ->
cequiv (WHILE b1 DO c1 END) (WHILE b1' DO c1' END).
Proof.
unfold bequiv,cequiv.
intros b1 b1' c1 c1' Hb1e Hc1e st st'.
split; intros Hce.
Case "->".
remember (WHILE b1 DO c1 END) as cwhile.
induction Hce; inversion Heqcwhile; subst.
SCase "E_WhileEnd".
apply E_WhileEnd. rewrite <- Hb1e. apply H.
SCase "E_WhileLoop".
apply E_WhileLoop with (st' := st').
SSCase "show loop runs". rewrite <- Hb1e. apply H.
SSCase "body execution".
apply (Hc1e st st').  apply Hce1.
SSCase "subsequent loop execution".
apply IHHce2. reflexivity.
Case "<-".
remember (WHILE b1' DO c1' END) as c'while.
induction Hce; inversion Heqc'while; subst.
SCase "E_WhileEnd".
apply E_WhileEnd. rewrite -> Hb1e. apply H.
SCase "E_WhileLoop".
apply E_WhileLoop with (st' := st').
SSCase "show loop runs". rewrite -> Hb1e. apply H.
SSCase "body execution".
apply (Hc1e st st').  apply Hce1.
SSCase "subsequent loop execution".
apply IHHce2. reflexivity.  Qed.

練習問題: ★★★, optional (CSeq_congruence)

Theorem CSeq_congruence : forall c1 c1' c2 c2',
cequiv c1 c1' -> cequiv c2 c2' ->
cequiv (c1;c2) (c1';c2').
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★ (CIf_congruence)

Theorem CIf_congruence : forall b b' c1 c1' c2 c2',
bequiv b b' -> cequiv c1 c1' -> cequiv c2 c2' ->
cequiv (IFB b THEN c1 ELSE c2 FI) (IFB b' THEN c1' ELSE c2' FI).
Proof.
(* FILL IN HERE *) Admitted.

☐

同値である2つのプログラムとその同値の証明の例です...

Example congruence_example:
cequiv
(X ::= ANum 0;
IFB (BEq (AId X) (ANum 0))
THEN
Y ::= ANum 0
ELSE
Y ::= ANum 42
FI)
(X ::= ANum 0;
IFB (BEq (AId X) (ANum 0))
THEN
Y ::= AMinus (AId X) (AId X)
ELSE
Y ::= ANum 42
FI).
Proof.
apply CSeq_congruence.
apply refl_cequiv.
apply CIf_congruence.
apply refl_bequiv.
apply CAss_congruence. unfold aequiv. simpl.
symmetry. apply minus_diag.
apply refl_cequiv.
Qed.

ケーススタディ: 定数畳み込み

プログラム変換(program transformation)とは、プログラムを入力とし、出力としてそのプログラムの何らかの変形を生成する関数です。定数畳み込みのようなコンパイラの最適化は標準的な例ですが、それ以外のものもたくさんあります。

プログラム変換の健全性

プログラム変換が健全(sound)とは、その変換が元のプログラムの振る舞いを保存することです。aexp、bexp、comの変換の健全性の概念を定義することができます。

Definition atrans_sound (atrans : aexp -> aexp) : Prop :=
forall (a : aexp),
aequiv a (atrans a).

Definition btrans_sound (btrans : bexp -> bexp) : Prop :=
forall (b : bexp),
bequiv b (btrans b).

Definition ctrans_sound (ctrans : com -> com) : Prop :=
forall (c : com),
cequiv c (ctrans c).

定数畳み込み変換

式が定数(constant)であるとは、その式が変数参照を含まないことです。

定数畳み込みは、定数式をその値に置換する最適化です。

Fixpoint fold_constants_aexp (a : aexp) : aexp :=
match a with
| ANum n       => ANum n
| AId i        => AId i
| APlus a1 a2  =>
match (fold_constants_aexp a1, fold_constants_aexp a2) with
| (ANum n1, ANum n2) => ANum (n1 + n2)
| (a1', a2') => APlus a1' a2'
end
| AMinus a1 a2 =>
match (fold_constants_aexp a1, fold_constants_aexp a2) with
| (ANum n1, ANum n2) => ANum (n1 - n2)
| (a1', a2') => AMinus a1' a2'
end
| AMult a1 a2  =>
match (fold_constants_aexp a1, fold_constants_aexp a2) with
| (ANum n1, ANum n2) => ANum (n1 * n2)
| (a1', a2') => AMult a1' a2'
end
end.

Example fold_aexp_ex1 :
fold_constants_aexp
(AMult (APlus (ANum 1) (ANum 2)) (AId X))
= AMult (ANum 3) (AId X).
Proof. reflexivity. Qed.

定数畳み込みのこのバージョンは簡単な足し算等を消去していないことに注意します。複雑になるのを避けるため、1つの最適化に焦点を絞っています。式の単純化の他の方法を組込むことはそれほど難しいことではありません。定義と証明が長くなるだけです。

Example fold_aexp_ex2 :
fold_constants_aexp
(AMinus (AId X) (APlus (AMult (ANum 0) (ANum 6)) (AId Y)))
= AMinus (AId X) (APlus (ANum 0) (AId Y)).
Proof. reflexivity. Qed.

(BEqとBLeの場合に)fold_constants_aexpをbexpに持ち上げることができるだけでなく、定数「ブール」式をみつけてその場で置換することもできます。

Fixpoint fold_constants_bexp (b : bexp) : bexp :=
match b with
| BTrue        => BTrue
| BFalse       => BFalse
| BEq a1 a2  =>
match (fold_constants_aexp a1, fold_constants_aexp a2) with
| (ANum n1, ANum n2) => if beq_nat n1 n2 then BTrue else BFalse
| (a1', a2') => BEq a1' a2'
end
| BLe a1 a2  =>
match (fold_constants_aexp a1, fold_constants_aexp a2) with
| (ANum n1, ANum n2) => if ble_nat n1 n2 then BTrue else BFalse
| (a1', a2') => BLe a1' a2'
end
| BNot b1  =>
match (fold_constants_bexp b1) with
| BTrue => BFalse
| BFalse => BTrue
| b1' => BNot b1'
end
| BAnd b1 b2  =>
match (fold_constants_bexp b1, fold_constants_bexp b2) with
| (BTrue, BTrue) => BTrue
| (BTrue, BFalse) => BFalse
| (BFalse, BTrue) => BFalse
| (BFalse, BFalse) => BFalse
| (b1', b2') => BAnd b1' b2'
end
end.

Example fold_bexp_ex1 :
fold_constants_bexp (BAnd BTrue (BNot (BAnd BFalse BTrue)))
= BTrue.
Proof. reflexivity. Qed.

Example fold_bexp_ex2 :
fold_constants_bexp
(BAnd (BEq (AId X) (AId Y))
(BEq (ANum 0)
(AMinus (ANum 2) (APlus (ANum 1) (ANum 1)))))
= BAnd (BEq (AId X) (AId Y)) BTrue.
Proof. reflexivity. Qed.

コマンド内の定数を畳み込みするために、含まれるすべての式に対応する畳み込み関数を適用します。

Fixpoint fold_constants_com (c : com) : com :=
match c with
| SKIP      =>
SKIP
| i ::= a  =>
CAss i (fold_constants_aexp a)
| c1 ; c2  =>
(fold_constants_com c1) ; (fold_constants_com c2)
| IFB b THEN c1 ELSE c2 FI =>
match fold_constants_bexp b with
| BTrue => fold_constants_com c1
| BFalse => fold_constants_com c2
| b' => IFB b' THEN fold_constants_com c1
ELSE fold_constants_com c2 FI
end
| WHILE b DO c END =>
match fold_constants_bexp b with
| BTrue => WHILE BTrue DO SKIP END
| BFalse => SKIP
| b' => WHILE b' DO (fold_constants_com c) END
end
end.

Example fold_com_ex1 :
fold_constants_com
(X ::= APlus (ANum 4) (ANum 5);
Y ::= AMinus (AId X) (ANum 3);
IFB BEq (AMinus (AId X) (AId Y)) (APlus (ANum 2) (ANum 4)) THEN
SKIP
ELSE
Y ::= ANum 0
FI;
IFB BLe (ANum 0) (AMinus (ANum 4) (APlus (ANum 2) (ANum 1))) THEN
Y ::= ANum 0
ELSE
SKIP
FI;
WHILE BEq (AId Y) (ANum 0) DO
X ::= APlus (AId X) (ANum 1)
END) =
(X ::= ANum 9;
Y ::= AMinus (AId X) (ANum 3);
IFB BEq (AMinus (AId X) (AId Y)) (ANum 6) THEN
SKIP
ELSE
(Y ::= ANum 0)
FI;
Y ::= ANum 0;
WHILE BEq (AId Y) (ANum 0) DO
X ::= APlus (AId X) (ANum 1)
END).
Proof. reflexivity. Qed.

定数畳み込みの健全性

上でやったことが正しいことを示さなければなりません。以下が算術式に対する証明です:

Theorem fold_constants_aexp_sound :
atrans_sound fold_constants_aexp.
Proof.
unfold atrans_sound. intros a. unfold aequiv. intros st.
aexp_cases (induction a) Case; simpl;

try reflexivity;

try (destruct (fold_constants_aexp a1);
destruct (fold_constants_aexp a2);
rewrite IHa1; rewrite IHa2; reflexivity). Qed.

練習問題: ★★★, optional (fold_bexp_BEq_informal)

ここに、ブール式の定数畳み込みに関する健全性の議論のBEqの場合の非形式的証明を示します。これを丁寧に読みその後の形式的証明と比較しなさい。次に、形式的証明のBLe部分を(もし可能ならばBEqの場合を見ないで)記述しなさい。

「定理」:ブール式に対する定数畳み込み関数fold_constants_bexpは健全である。

「証明」:すべてのブール式bについてbがfold_constants_bexpと同値であることを示す。bについての帰納法を行う。bがBEq a1 a2という形の場合を示す。

この場合、

beval st (BEq a1 a2)
= beval st (fold_constants_bexp (BEq a1 a2)).

を示せば良い。これには2種類の場合がある:

- 最初に、あるn1とn2について、fold_constants_aexp a1 = ANum n1かつfold_constants_aexp a2 = ANum n2と仮定する。 この場合、

fold_constants_bexp (BEq a1 a2)
= if beq_nat n1 n2 then BTrue else BFalse

かつ

beval st (BEq a1 a2)
= beq_nat (aeval st a1) (aeval st a2).

となる。算術式についての定数畳み込みの健全性(補題fold_constants_aexp_sound)より、

aeval st a1
= aeval st (fold_constants_aexp a1)
= aeval st (ANum n1)
= n1

かつ

aeval st a2
= aeval st (fold_constants_aexp a2)
= aeval st (ANum n2)
= n2,

である。従って、

beval st (BEq a1 a2)
= beq_nat (aeval a1) (aeval a2)
= beq_nat n1 n2.

となる。また、(n1 = n2とn1 <> n2の場合をそれぞれ考えると)

beval st (if beq_nat n1 n2 then BTrue else BFalse)
= if beq_nat n1 n2 then beval st BTrue else beval st BFalse
= if beq_nat n1 n2 then true else false
= beq_nat n1 n2.

となることは明らかである。ゆえに

beval st (BEq a1 a2)
= beq_nat n1 n2.
= beval st (if beq_nat n1 n2 then BTrue else BFalse),

となる。これは求められる性質である。

- それ以外の場合、fold_constants_aexp a1とfold_constants_aexp a2のどちらかは定数ではない。この場合、

beval st (BEq a1 a2)
= beval st (BEq (fold_constants_aexp a1)
(fold_constants_aexp a2)),

を示せば良い。bevalの定義から、これは

beq_nat (aeval st a1) (aeval st a2)
= beq_nat (aeval st (fold_constants_aexp a1))
(aeval st (fold_constants_aexp a2)).

を示すことと同じである。算術式についての定数畳み込みの健全性(fold_constants_aexp_sound)より、

aeval st a1 = aeval st (fold_constants_aexp a1)
aeval st a2 = aeval st (fold_constants_aexp a2),

となり、この場合も成立する。☐

Theorem fold_constants_bexp_sound:
btrans_sound fold_constants_bexp.
Proof.
unfold btrans_sound. intros b. unfold bequiv. intros st.
bexp_cases (induction b) Case;

try reflexivity.
Case "BEq".

rename a into a1. rename a0 into a2. simpl.
remember (fold_constants_aexp a1) as a1'.
remember (fold_constants_aexp a2) as a2'.
replace (aeval st a1) with (aeval st a1') by
(subst a1'; rewrite <- fold_constants_aexp_sound; reflexivity).
replace (aeval st a2) with (aeval st a2') by
(subst a2'; rewrite <- fold_constants_aexp_sound; reflexivity).
destruct a1'; destruct a2'; try reflexivity.

simpl. destruct (beq_nat n n0); reflexivity.
Case "BLe".
(* FILL IN HERE *) admit.
Case "BNot".
simpl. remember (fold_constants_bexp b) as b'.
rewrite IHb.
destruct b'; reflexivity.
Case "BAnd".
simpl.
remember (fold_constants_bexp b1) as b1'.
remember (fold_constants_bexp b2) as b2'.
rewrite IHb1. rewrite IHb2.
destruct b1'; destruct b2'; reflexivity.  Qed.

☐

練習問題: ★★★ (fold_constants_com_sound)

次の証明のWHILEの場合を完成させなさい。

Theorem fold_constants_com_sound :
ctrans_sound fold_constants_com.
Proof.
unfold ctrans_sound. intros c.
com_cases (induction c) Case; simpl.
Case "SKIP". apply refl_cequiv.
Case "::=". apply CAss_congruence. apply fold_constants_aexp_sound.
Case ";". apply CSeq_congruence; assumption.
Case "IFB".
assert (bequiv b (fold_constants_bexp b)).
SCase "Pf of assertion". apply fold_constants_bexp_sound.
remember (fold_constants_bexp b) as b'.
destruct b';

try (apply CIf_congruence; assumption).
SCase "b always true".
apply trans_cequiv with c1; try assumption.
apply IFB_true; assumption.
SCase "b always false".
apply trans_cequiv with c2; try assumption.
apply IFB_false; assumption.
Case "WHILE".
(* FILL IN HERE *) Admitted.

☐

(0 + n)の消去の健全性、再び

Imp_J.vのoptimize_0plusの定義をふり返ります。

Fixpoint optimize_0plus (e:aexp) : aexp :=
match e with
| ANum n =>
ANum n
| APlus (ANum 0) e2 =>
optimize_0plus e2
| APlus e1 e2 =>
APlus (optimize_0plus e1) (optimize_0plus e2)
| AMinus e1 e2 =>
AMinus (optimize_0plus e1) (optimize_0plus e2)
| AMult e1 e2 =>
AMult (optimize_0plus e1) (optimize_0plus e2)
end.

この関数は、aexpの上で定義されていて、状態を扱わないことに注意します。

変数を扱えるようにした、この関数の新しいバージョンを記述しなさい。また、bexpおよびコマンドに対しても、同様のものを記述しなさい:

optimize_0plus_aexp
optimize_0plus_bexp
optimize_0plus_com

これらの関数の健全性を、fold_constants_*について行ったのと同様に証明しなさい。optimize_0plus_comの証明においては、合同性補題を確実に使いなさい(そうしなければ証明はとても長くなるでしょう!)。

次に、コマンドに対して次の処理を行う最適化関数を定義しなさい。行うべき処理は、まず定数畳み込みを(fold_constants_comを使って)行い、次に0 + n項を(optimize_0plus_comを使って)消去することです。

- この最適化関数の出力の意味のある例を示しなさい。

- この最適化関数が健全であることを示しなさい。(この部分は「とても」簡単なはずです。)

(* FILL IN HERE *)

☐

プログラムが同値でないことを証明する

c1がX ::= a1; Y ::= a2という形のコマンドで、c2がコマンドX ::= a1; Y ::= a2'であると仮定します。ただしa2'は、a2の中のすべてのXをa1で置換したものとします。例えば、c1とc2は次のようなものです。

c1  =  (X ::= 42 + 53;
Y ::= Y + X)
c2  =  (X ::= 42 + 53;
Y ::= Y + (42 + 53))

明らかに、この例の場合はc1とc2は同値です。しかし、一般にそうだと言えるでしょうか？

この後すぐ、そうではないことを示します。しかし、ここでちょっと立ち止まって、自分の力で反例を見つけることができるか試してみるのは意味があることです。(あるいは、クラスでの議論を思い出してください。)

次が、式の中の指定された変数を別の算術式で置換する関数の形式的定義です。

Fixpoint subst_aexp (i : id) (u : aexp) (a : aexp) : aexp :=
match a with
| ANum n       => ANum n
| AId i'       => if beq_id i i' then u else AId i'
| APlus a1 a2  => APlus (subst_aexp i u a1) (subst_aexp i u a2)
| AMinus a1 a2 => AMinus (subst_aexp i u a1) (subst_aexp i u a2)
| AMult a1 a2  => AMult (subst_aexp i u a1) (subst_aexp i u a2)
end.

Example subst_aexp_ex :
subst_aexp X (APlus (ANum 42) (ANum 53)) (APlus (AId Y) (AId X)) =
(APlus (AId Y) (APlus (ANum 42) (ANum 53))).
Proof. reflexivity.  Qed.

そして次が、興味対象の性質です。上記コマンドc1とc2が常に同値であることを主張するものです。

Definition subst_equiv_property := forall i1 i2 a1 a2,
cequiv (i1 ::= a1; i2 ::= a2)
(i1 ::= a1; i2 ::= subst_aexp i1 a1 a2).

残念ながら、この性質は、常には成立「しません」。

「定理」:すべてのi1,i2,a1,a2について、次が成立するわけではない:

cequiv (i1 ::= a1; i2 ::= a2)
(i1 ::= a1; i2 ::= subst_aexp i1 a1 a2).

「証明」:仮にすべてのi1,i2,a1,a2について

cequiv (i1 ::= a1; i2 ::= a2)
(i1 ::= a1; i2 ::= subst_aexp i1 a1 a2)

が成立するとする。次のプログラムを考える:

X ::= APlus (AId X) (ANum 1); Y ::= AId X

次のことに注意する:

(X ::= APlus (AId X) (ANum 1); Y ::= AId X)
/ empty_state || st1,

ここでst1 = { X |-> 1, Y |-> 1 }である。

仮定より、次が言える:

cequiv (X ::= APlus (AId X) (ANum 1); Y ::= AId X)
(X ::= APlus (AId X) (ANum 1); Y ::= APlus (AId X) (ANum 1))

すると、cequivの定義より、次が言える:

(X ::= APlus (AId X) (ANum 1); Y ::= APlus (AId X) (ANum 1))
/ empty_state || st1.

しかし次のことも言える:

(X ::= APlus (AId X) (ANum 1); Y ::= APlus (AId X) (ANum 1))
/ empty_state || st2,

ただしst2 = { X |-> 1, Y |-> 2 }である。st1 <> st2に注意すると、これはcevalが決定性を持つことに矛盾する!☐

Theorem subst_inequiv :
~ subst_equiv_property.
Proof.
unfold subst_equiv_property.
intros Contra.

remember (X ::= APlus (AId X) (ANum 1);
Y ::= AId X)
as c1.
remember (X ::= APlus (AId X) (ANum 1);
Y ::= APlus (AId X) (ANum 1))
as c2.
assert (cequiv c1 c2) by (subst; apply Contra).

remember (update (update empty_state X 1) Y 1) as st1.
remember (update (update empty_state X 1) Y 2) as st2.
assert (H1: c1 / empty_state || st1);
assert (H2: c2 / empty_state || st2);
try (subst;
apply E_Seq with (st' := (update empty_state X 1));
apply E_Ass; reflexivity).
apply H in H1.

assert (Hcontra: st1 = st2)
by (apply (ceval_deterministic c2 empty_state); assumption).
assert (Hcontra': st1 Y = st2 Y)
by (rewrite Hcontra; reflexivity).
subst. inversion Hcontra'.  Qed.

上で成立すると考えていた同値は、完全に意味がないものではありません。それは実際、ほとんど正しいのです。それを直すためには、最初の代入の右辺に変数Xが現れる場合を排除すれば良いのです。

Inductive var_not_used_in_aexp (X:id) : aexp -> Prop :=
| VNUNum: forall n, var_not_used_in_aexp X (ANum n)
| VNUId: forall Y, X <> Y -> var_not_used_in_aexp X (AId Y)
| VNUPlus: forall a1 a2,
var_not_used_in_aexp X a1 ->
var_not_used_in_aexp X a2 ->
var_not_used_in_aexp X (APlus a1 a2)
| VNUMinus: forall a1 a2,
var_not_used_in_aexp X a1 ->
var_not_used_in_aexp X a2 ->
var_not_used_in_aexp X (AMinus a1 a2)
| VNUMult: forall a1 a2,
var_not_used_in_aexp X a1 ->
var_not_used_in_aexp X a2 ->
var_not_used_in_aexp X (AMult a1 a2).

Lemma aeval_weakening : forall i st a ni,
var_not_used_in_aexp i a ->
aeval (update st i ni) a = aeval st a.
Proof.
(* FILL IN HERE *) Admitted.

var_not_used_in_aexpを使って、subst_equiv_propertyの正しいバージョンを形式化し、証明しなさい。

(* FILL IN HERE *)

☐

Theorem inequiv_exercise:
~ cequiv (WHILE BTrue DO SKIP END) SKIP.
Proof.
(* FILL IN HERE *) Admitted.

☐

外延性を使わずに行う (Optional)

純粋主義者は、functional_extensionalityを使うことに不服かもしれません。一般に、公理を追加することは非常に危険です。特に、一度にいくつも追加するときは(追加するものが相互に矛盾することもあるため)そうです。実際は、functional_extensionalityとexcluded_middleは両者とも何の問題もなく導入できます。しかし、Coqユーザの中には、このような「ヘビーウェイト」の一般テクニックを避け、Coqの標準論理の中で特定の問題のために技巧的解法を使うことを選びたい人もいるでしょう。

ここで扱っている問題に特定するなら、状態を表現している関数についてやりたいことをやるために等しさの定義を拡張するより、状態の同値(equivalence)の概念を明示的に与えることもできたかもしれません。例えば:

Definition stequiv (st1 st2 : state) : Prop :=
forall (X:id), st1 X = st2 X.

Notation "st1 '~' st2" := (stequiv st1 st2) (at level 30).

stequivが同値関係(equivalence、 つまり、反射的、対称的、推移的関係)であることを証明することは容易です。この同値関係により、すべての状態の集合は同値類に分割されます。

Lemma stequiv_refl : forall (st : state),
st ~ st.
Proof.
(* FILL IN HERE *) Admitted.

☐

Lemma stequiv_sym : forall (st1 st2 : state),
st1 ~ st2 ->
st2 ~ st1.
Proof.
(* FILL IN HERE *) Admitted.

☐

Lemma stequiv_trans : forall (st1 st2 st3 : state),
st1 ~ st2 ->
st2 ~ st3 ->
st1 ~ st3.
Proof.
(* FILL IN HERE *) Admitted.

☐

別の有用な事実です...

Lemma stequiv_update : forall (st1 st2 : state),
st1 ~ st2 ->
forall (X:id) (n:nat),
update st1 X n ~ update st2 X n.
Proof.
(* FILL IN HERE *) Admitted.

☐

aevalとbevalが同値類のすべての要素に対して同じように振る舞うことは、ここからストレートに証明できます:

Lemma stequiv_aeval : forall (st1 st2 : state),
st1 ~ st2 ->
forall (a:aexp), aeval st1 a = aeval st2 a.
Proof.
(* FILL IN HERE *) Admitted.

☐

Lemma stequiv_beval : forall (st1 st2 : state),
st1 ~ st2 ->
forall (b:bexp), beval st1 b = beval st2 b.
Proof.
(* FILL IN HERE *) Admitted.

☐

同値である状態の面からcevalの振る舞いを特徴づけることもできます(cevalは関係なので、この結果を書き下すのはもうちょっと複雑です)。

Lemma stequiv_ceval: forall (st1 st2 : state),
st1 ~ st2 ->
forall (c: com) (st1': state),
(c / st1 || st1') ->
exists st2' : state,
((c / st2 || st2') /\  st1' ~ st2').
Proof.
intros st1 st2 STEQV c st1' CEV1. generalize dependent st2.
induction CEV1; intros st2 STEQV.
Case "SKIP".
exists st2. split.
constructor.
assumption.
Case ":=".
exists (update st2 l n). split.
constructor.  rewrite <- H. symmetry.  apply stequiv_aeval.
assumption. apply stequiv_update.  assumption.
Case ";".
destruct (IHCEV1_1 st2 STEQV) as [st2' [P1 EQV1]].
destruct (IHCEV1_2 st2' EQV1) as [st2'' [P2 EQV2]].
exists st2''.  split.
apply E_Seq with st2';  assumption.
assumption.
Case "IfTrue".
destruct (IHCEV1 st2 STEQV) as [st2' [P EQV]].
exists st2'.  split.
apply E_IfTrue.  rewrite <- H. symmetry. apply stequiv_beval.
assumption. assumption. assumption.
Case "IfFalse".
destruct (IHCEV1 st2 STEQV) as [st2' [P EQV]].
exists st2'. split.
apply E_IfFalse. rewrite <- H. symmetry. apply stequiv_beval.
assumption.  assumption. assumption.
Case "WhileEnd".
exists st2. split.
apply E_WhileEnd. rewrite <- H. symmetry. apply stequiv_beval.
assumption. assumption.
Case "WhileLoop".
destruct (IHCEV1_1 st2 STEQV) as [st2' [P1 EQV1]].
destruct (IHCEV1_2 st2' EQV1) as [st2'' [P2 EQV2]].
exists st2''. split.
apply E_WhileLoop with st2'.  rewrite <- H. symmetry.
apply stequiv_beval. assumption. assumption. assumption.
assumption.
Qed.

ここでcequivを=の代わりに~を使って再定義する必要があります。定義の簡潔さと対称性を保ったまま再定義するのは、それほど自明なことではありません。しかしその方法はあります(Andrew McCreightに感謝します)。最初に||のより緩いバージョンを定義します。これは同値概念の中に「畳み込まれ」ます。

Reserved Notation "c1 '/' st '||'' st'" (at level 40, st at level 39).

Inductive ceval' : com -> state -> state -> Prop :=
| E_equiv : forall c st st' st'',
c / st || st' ->
st' ~ st'' ->
c / st ||' st''
where   "c1 '/' st '||'' st'" := (ceval' c1 st st').

するとcequiv'の新しい定義は馴染みのあるものになります:

Definition cequiv' (c1 c2 : com) : Prop :=
forall (st st' : state),
(c1 / st ||' st') <-> (c2 / st ||' st').

もとのコマンド同値の概念が、新しいものと同じ強さかそれより強いことをサニティチェックします。(その逆は当然成立しません。)

Lemma cequiv__cequiv' : forall (c1 c2: com),
cequiv c1 c2 -> cequiv' c1 c2.
Proof.
unfold cequiv, cequiv'; split; intros.
inversion H0 ; subst.  apply E_equiv with st'0.
apply (H st st'0); assumption. assumption.
inversion H0 ; subst.  apply E_equiv with st'0.
apply (H st st'0). assumption. assumption.
Qed.

最後にもとの例を再度扱います... (証明を完成しなさい。)

Example identity_assignment' :
cequiv' SKIP (X ::= AId X).
Proof.
unfold cequiv'.  intros.  split; intros.
Case "->".
inversion H; subst; clear H. inversion H0; subst.
apply E_equiv with (update st'0 X (st'0 X)).
constructor. reflexivity.  apply stequiv_trans with st'0.
unfold stequiv. intros. apply update_same.
reflexivity. assumption.
Case "<-".
(* FILL IN HERE *) Admitted.

☐

概して、この明示的な同値のアプローチは、関数外延性を使うものよりかなり難しくなります。(Coqは”setoids”という先進的な仕組みを持っています。setoid は同値関係の扱いをいくらか容易にします。その方法は、同値関係をシステムに登録すると、それを使った書き換えタクティックが、もとの等しさ(equality)に対してとほとんど同じようにはたらくようになるというものです。)しかしこの、状態の同値を明示的に記述する方法は知っておく価値があります。なぜなら、この方法は、問題となる同値が関数についてのもの「ではない」状況でも使えるからです。例えば、状態の写像を二分探索木を使って行ったとすると、このような明示的な同値を使う必要があるでしょう。

さらなる練習問題

この練習問題は、Imp_J.vのoptionalの練習問題 add_for_loop を拡張したものです。もとの add_for_loop は、コマンド言語に C-言語のスタイルのforループを拡張しなさい、というものでした。ここでは次のことを証明しなさい:

for (c1 ; b ; c2) {
c3
}

は

c1 ;
WHILE b DO
c3 ;
c2
END

と同値である。

(* FILL IN HERE *)

☐

Theorem swap_noninterfering_assignments: forall l1 l2 a1 a2,
l1 <> l2 ->
var_not_used_in_aexp l1 a2 ->
var_not_used_in_aexp l2 a1 ->
cequiv
(l1 ::= a1; l2 ::= a2)
(l2 ::= a2; l1 ::= a1).
Proof.

(* FILL IN HERE *) Admitted.

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

ImpList_J: Imp のリスト拡張

Require Export SfLib_J.

リストを持つ Imp プログラム

興味深い性質とその簡単な証明を併せ持つ数値関数はそんなにたくさんはありません。(もちろん、興味深い数値関数はたくさんあり、それらはいろいろなおもしろい性質を持っています。なんといっても数論全体なのです!しかし大抵の場合、その性質の証明には、たくさんの補題が必要となるのです。)推論対象として、あといくつかのプログラムを書くことができるようにするために、Impの拡張版を導入します。拡張版では、変数は数値だけでなく数値のリストも変域とします。基本操作には、リストの先頭(head)と後部(tail)を取る操作、リストが空か否かを判定する操作が拡張されます。

このためには、state、aexp、aeval、bexp、bevalの定義を変えるだけで良いのです。comとcevalは字面上の変更なく再利用できます。ただ、新しい定義の中にコピー&ペーストしてやる必要はありますが。

Imp_J.vの素材を繰り返すことから始めましょう。

定義の繰り返し

Inductive id : Type :=
Id : nat -> id.

Definition beq_id id1 id2 :=
match (id1, id2) with
(Id n1, Id n2) => beq_nat n1 n2
end.

Theorem beq_id_refl : forall i,
true = beq_id i i.
Proof.
intros. destruct i.
apply beq_nat_refl.  Qed.

Theorem beq_id_eq : forall i1 i2,
true = beq_id i1 i2 -> i1 = i2.
Proof.
intros i1 i2 H.
destruct i1. destruct i2.
apply beq_nat_eq in H. subst.
reflexivity.  Qed.

Theorem beq_id_false_not_eq : forall i1 i2,
beq_id i1 i2 = false -> i1 <> i2.
Proof.
intros i1 i2 H.
destruct i1. destruct i2.
apply beq_nat_false in H.
intros C. apply H. inversion C. reflexivity.  Qed.

Theorem not_eq_beq_id_false : forall i1 i2,
i1 <> i2 -> beq_id i1 i2 = false.
Proof.
intros i1 i2 H.
destruct i1. destruct i2.
assert (n <> n0).
intros C. subst. apply H. reflexivity.
apply not_eq_beq_false. assumption.  Qed.

Definition X : id := Id 0.
Definition Y : id := Id 1.
Definition Z : id := Id 2.

拡張

一番の変更点にかかります。

新しい言語では、aexpの評価はnatになるのではなく、値(value、型valの要素)になります。値は、natか、またはnatのリストです。

同様に、stateは識別子をnatではなくvalにマッピングします。それによって、リストを変更可能な変数に格納できるのです。

Inductive val : Type :=
| VNat : nat -> val
| VList : list nat -> val.

Definition state := id -> val.

Definition empty_state : state := fun _ => VNat 0.
Definition update (st : state) (V:id) (n : val) : state :=
fun V' => if beq_id V V' then n else st V'.

Impには静的型システムがありません。そのため、プログラマが2つのリストを足したり、数値の先頭をとったりすることを防ぐことはできません。そういう不条理な状況をどうするかを決めなければなりません。

これに対しては次のようなシンプルなやり方を採用します。もし算術関数が引数としてリストを受けとったときには、そのリストを数値0として扱います。同様に、もしリスト関数が数値を引数として受けとったときには、その数値をnilとして扱います。(Javascript参照。Javascriptでは3を空リストに足すと3になる...)

2つの関数asnatとaslistは、valをそれぞれ数値およびリストのコンテキストで解釈します。aevalは、数値操作またはリスト操作を評価するときには常に、asnatやaslistを呼びます。

Definition asnat (v : val) : nat :=
match v with
| VNat n => n
| VList _ => 0
end.

Definition aslist (v : val) : list nat :=
match v with
| VNat n => []
| VList xs => xs
end.

ここで、算術式とブール式について、抽象構文と評価関数の定義の足りないところを埋めます。

Inductive aexp : Type :=
| ANum : nat -> aexp
| AId : id -> aexp
| APlus : aexp -> aexp -> aexp
| AMinus : aexp -> aexp -> aexp
| AMult : aexp -> aexp -> aexp

| AHead : aexp -> aexp
| ATail : aexp -> aexp
| ACons : aexp -> aexp -> aexp
| ANil  : aexp.

Tactic Notation "aexp_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ANum" | Case_aux c "AId" | Case_aux c "APlus"
| Case_aux c "AMinus" | Case_aux c "AMult"
| Case_aux c "AHead" | Case_aux c "ATail"
| Case_aux c "ACons" | Case_aux c "ANil" ].

Definition tail (l : list nat) :=
match l with
| x::xs => xs
| [] => []
end.

Definition head (l : list nat) :=
match l with
| x::xs => x
| [] => 0
end.

Fixpoint aeval (st : state) (e : aexp) : val :=
match e with
| ANum n => VNat n
| AId i => st i
| APlus a1 a2   => VNat (asnat (aeval st a1) + asnat (aeval st a2))
| AMinus a1 a2  => VNat (asnat (aeval st a1) - asnat (aeval st a2))
| AMult a1 a2   => VNat (asnat (aeval st a1) * asnat (aeval st a2))

| ATail a => VList (tail (aslist (aeval st a)))
| AHead a => VNat (head (aslist (aeval st a)))
| ACons a1 a2 => VList (asnat (aeval st a1) :: aslist (aeval st a2))
| ANil => VList []
end.

bexpを拡張して、リストが空かどうかをテストする操作を追加します。また、bevalをそれに合わせて変更します。

Inductive bexp : Type :=
| BTrue : bexp
| BFalse : bexp
| BEq : aexp -> aexp -> bexp
| BLe : aexp -> aexp -> bexp
| BNot : bexp -> bexp
| BAnd : bexp -> bexp -> bexp

| BIsCons : aexp -> bexp.

Tactic Notation "bexp_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "BTrue" | Case_aux c "BFalse" | Case_aux c "BEq"
| Case_aux c "BLe" | Case_aux c "BNot" | Case_aux c "BAnd"
| Case_aux c "BIsCons" ].

Fixpoint beval (st : state) (e : bexp) : bool :=
match e with
| BTrue       => true
| BFalse      => false
| BEq a1 a2   => beq_nat (asnat (aeval st a1)) (asnat (aeval st a2))
| BLe a1 a2   => ble_nat (asnat (aeval st a1)) (asnat (aeval st a2))
| BNot b1     => negb (beval st b1)
| BAnd b1 b2  => andb (beval st b1) (beval st b2)

| BIsCons a    => match aslist (aeval st a) with
| _::_ => true
| [] => false
end
end.

定義の繰り返し

ここで、Imp_J.vから低レベルの仕事を少々と、comとcevalの定義を繰り返さなければなりません。おもしろみのある変化は何もありません。算術式とブール式の新しい定義のコンテキストで、同じ定義、同じ補題、同じ証明を繰り返すだけです。

(このカット&ペーストは本当に必要なのでしょうか？答えはNoです。Coq には強力なモジュールシステムがあって、変化する部分に関する同じ定義を抽象化することもできます。ただ、その説明をここですると、主題から逸れていってしまいます。)

Theorem update_eq : forall n V st,
(update st V n) V = n.
Proof.
intros n V st.
unfold update.
rewrite <- beq_id_refl.
reflexivity.
Qed.

Theorem update_neq : forall V2 V1 n st,
beq_id V2 V1 = false ->
(update st V2 n) V1 = (st V1).
Proof.
intros V2 V1 n st Hneq.
unfold update.
rewrite -> Hneq.
reflexivity. Qed.

Theorem update_shadow : forall x1 x2 k1 k2 (f : state),
(update  (update f k2 x1) k2 x2) k1 = (update f k2 x2) k1.
Proof.
intros x1 x2 k1 k2 f.
unfold update.
destruct (beq_id k2 k1); reflexivity.  Qed.

Theorem update_same : forall x1 k1 k2 (f : state),
f k1 = x1 ->
(update f k1 x1) k2 = f k2.
Proof.
intros x1 k1 k2 f Heq.
unfold update. subst.
remember (beq_id k1 k2) as b.
destruct b.
Case "true".
apply beq_id_eq in Heqb. subst. reflexivity.
Case "false".
reflexivity.  Qed.

Theorem update_permute : forall x1 x2 k1 k2 k3 f,
beq_id k2 k1 = false ->
(update (update f k2 x1) k1 x2) k3 = (update (update f k1 x2) k2 x1) k3.
Proof.
intros x1 x2 k1 k2 k3 f H.
unfold update.
remember (beq_id k1 k3) as b13.
remember (beq_id k2 k3) as b23.
apply beq_id_false_not_eq in H.
destruct b13; try reflexivity.
Case "true".
destruct b23; try reflexivity.
SCase "true".
apply beq_id_eq in Heqb13.
apply beq_id_eq in Heqb23.
subst. apply ex_falso_quodlibet. apply H. reflexivity.  Qed.

comとcevalの定義は、前とまったく同じで済みます。

Inductive com : Type :=
| CSkip : com
| CAss : id -> aexp -> com
| CSeq : com -> com -> com
| CIf : bexp -> com -> com -> com
| CWhile : bexp -> com -> com.

Tactic Notation "com_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
| Case_aux c "IFB" | Case_aux c "WHILE" ].

Notation "'SKIP'" :=
CSkip.
Notation "l '::=' a" :=
(CAss l a) (at level 60).
Notation "c1 ; c2" :=
(CSeq c1 c2) (at level 80, right associativity).
Notation "'WHILE' b 'DO' c 'END'" :=
(CWhile b c) (at level 80, right associativity).
Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
(CIf e1 e2 e3) (at level 80, right associativity).

Reserved Notation "c1 '/' st '||' st'" (at level 40, st at level 39).

Inductive ceval : state -> com -> state -> Prop :=
| E_Skip : forall st,
SKIP / st || st
| E_Asgn  : forall st a1 n l,
aeval st a1 = n ->
(l ::= a1) / st || (update st l n)
| E_Seq : forall c1 c2 st st' st'',
c1 / st  || st' ->
c2 / st' || st'' ->
(c1 ; c2) / st || st''
| E_IfTrue : forall st st' b1 c1 c2,
beval st b1 = true ->
c1 / st || st' ->
(IFB b1 THEN c1 ELSE c2 FI) / st || st'
| E_IfFalse : forall st st' b1 c1 c2,
beval st b1 = false ->
c2 / st || st' ->
(IFB b1 THEN c1 ELSE c2 FI) / st || st'
| E_WhileEnd : forall b1 st c1,
beval st b1 = false ->
(WHILE b1 DO c1 END) / st || st
| E_WhileLoop : forall st st' st'' b1 c1,
beval st b1 = true ->
c1 / st || st' ->
(WHILE b1 DO c1 END) / st' || st'' ->
(WHILE b1 DO c1 END) / st || st''

where "c1 '/' st '||' st'" := (ceval st c1 st').

Tactic Notation "ceval_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E_Skip" | Case_aux c "E_Asgn" | Case_aux c "E_Seq"
| Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
| Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop" ].

Definition loop : com :=
WHILE BTrue DO
SKIP
END.

Theorem loop_never_stops : forall st st',
~(loop / st || st').
Proof.
intros st st' contra. unfold loop in contra.
remember (WHILE BTrue DO SKIP END) as loopdef.
ceval_cases (induction contra) Case; try (inversion Heqloopdef).
Case "E_WhileEnd".
rewrite -> H1 in H. inversion H.
Case "E_WhileLoop".
apply IHcontra2. subst. reflexivity.  Qed.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Hoare_J: ホーア論理

/\ verification_conditions P' c
His full development (based on an old version of our formalized
decorated programs, unfortunately), can be found in the file
/underconstruction/PilkiewiczFormalizedDecorated.v *)

/\ verification_conditions P' c
彼の完全版(残念ながら、我々の修飾付きプログラムの古いバージョンをベースにしている)は
以下のファイルにある。
/underconstruction/PilkiewiczFormalizedDecorated.v *)

Require Export ImpList_J.

コースの最初のパートで用意した数学的道具立てを、小さなプログラミング言語 Imp の理論の学習に適用し始めています。

- Imp の抽象構文木(abstract syntax trees)の型を定義しました。 また、操作的意味論(operational semantics)を与える評価関係(evaluation relation、状態間の部分関数)も定義しました。定義した言語は小さいですが、C, C++, Java などの本格的な言語の主要な機能を持っています。その中には変更可能な状態や、いくつかのよく知られた制御構造も含まれます。

- いくつものメタ理論的性質(metatheoretic properties)を証明しました。 “メタ”というのは、言語で書かれた特定のプログラムの性質ではなく言語自体の性質という意味です。証明したものには、以下のものが含まれます:

- 評価の決定性

- 異なった書き方をした定義の同値性

- プログラムのあるクラスの、停止性の保証

- プログラムの動作の同値性(Equiv_J.vのオプションの章において) もしここで止めたとしても、有用なものを持っていることになります。それは、プログラミング言語とその特性を定義し議論する、数学的に正確で、柔軟で、使いやすい、主要な性質に適合した道具立てです。 これらの性質は、言語を設計する人、コンパイラを書く人、そしてユーザも知っておくべきものです。実際、その多くは我々が扱うプログラミング言語を理解する上で本当に基本的なことですので、”定理”と意識することはなかったかもしれません。しかし、直観的に明らかだと思っている性質はしばしばとても曖昧で、時には間違っていることもあります! この問題については、後に型(types)とその健全性(type soundness)を議論する際に再度出てきます。

- プログラムの検証(program verification)の例を2つ行いました。 Imp を厳密に定義し、ある特定のプログラム(つまり階乗計算と遅い引き算)がその動作についての特定の仕様を満たすことを、形式的に証明するものでした。

この章では、この最後の考え方をさらに進めます。一般にフロイド-ホーア論理(Floyd-Hoare Logic)、あるいは、少々不公平に省略してホーア論理(Hoare Logic)と呼ばれている推論システムを作ります。この推論システムの中では、Imp の各構文要素に対して1つの一般的な”証明規則”(proof rule)が与えられ、これによってその構文要素を含むプログラムについての推論ができるようになっています。

ホーア論理の起源は1960年代です。そして今現在まで継続してさかんに研究がされています。実際のソフトウェアシステムの仕様を定め検証するために使われている非常に多くのツールは、ホーア論理を核としているのです。

ホーア論理

ホーア論理は2つの重要なことがらを提供します。プログラムの仕様(specification)を自然に記述する方法と、その仕様が適合していることを証明する合成的証明法(compositionalproof technique)です。ここでの”合成的”(compositional)という意味は、証明の構造が証明対象となるプログラムの構造を直接的に反映しているということです。

表明

プログラムの仕様について話そうとするとき、最初に欲しくなるのは、ある特定の時点で成立している性質 – つまり、与えられたメモリ状態で真になり得るか、なり得ないかの性質 – についての表明(assertions)を作る方法です。

Definition Assertion := state -> Prop.

練習問題: ★ (assertions)

以下の表明を日本語に直しなさい。

fun st =>  asnat (st X) = 3
fun st =>  asnat (st X) = x
fun st =>  asnat (st X) <= asnat (st Y)
fun st =>  asnat (st X) = 3 \/ asnat (st X) <= asnat (st Y)
fun st =>  (asnat (st Z)) * (asnat (st Z)) <= x
/\ ~ (((S (asnat (st Z))) * (S (asnat (st Z)))) <= x)
fun st =>  True
fun st =>  False

☐

この方法で表明を書くことは、形式的に正しいのです。

- この方法は意図することを正確におさえています。

そしてこれがまさに Coq の証明で使う方法なのです。しかしこれはいくつかの理由から、若干ヘビーに見えます。(1)すべての個々の表明は、fun st=>から始まっています。(2)状態stは変数を参照するために使うただ1つのものです(2つの別々の状態を同時に考える必要はありません)。(3)表明で参照するすべての変数はasnatまたはaslistの強制型変換により、取り散らかっています。表明を非形式的に書くときには、いくらか簡単にします。最初のfun st =>は書かず、st Xのかわりに単にXと書きます。またasnatとaslistは略します。

非形式的には、次のように書くかわりに

fun st =>  (asnat (st Z)) * (asnat (st Z)) <= x
/\ ~ ((S (asnat (st Z))) * (S (asnat (st Z))) <= x)

次のように書きます。

Z * Z <= x
/\ ~((S Z) * (S Z) <= x).

ホーアの三つ組

次に、コマンドの振舞いの仕様を定める、つまりコマンドの振舞いについての表明を作る方法が必要です。

表明を、状態の性質について表明するものとして定義してきました。そして、コマンドの振舞いは、状態を別の状態に変換するものです。これから、コマンドについての表明は次の形をとります:

- “もしcが表明Pを満たす状態から開始され、また、cがいつかは停止するならば、最終状態では、表明Qが成立することを保証する。”

この表明は ホーアの三つ組(Hoare Triple)と呼ばれます。性質Pはcの事前条件(precondition)と呼ばれます。Qはcの事後条件(postcondition)と呼ばれます。

(伝統的に、ホーアの三つ組は{P} c {Q}と書かれます。しかし Coq では一重の中カッコは別の意味で既に使われています。)

Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion) : Prop :=
forall st st',
c / st || st'  ->
P st  ->
Q st'.

ホーアの三つ組を今後多用するので、簡潔な記法を用意すると便利です:

{{P}}  c  {{Q}}.

Notation "{{ P }}  c" :=          (hoare_triple P c (fun st => True)) (at level 90)
: hoare_spec_scope.
Notation "{{ P }}  c  {{ Q }}" := (hoare_triple P c Q) (at level 90, c at next level)
: hoare_spec_scope.
Open Scope hoare_spec_scope.

このhoare_spec_scopeアノテーションは、Coqに、この記法はグローバルではなく特定のコンテキストで使うものであることを伝えるものです。Open Scopeは、このファイルがそのコンテキストであることを Coq に伝えます。最初の、事後条件を持たない記法は、ここで実際に使うことはありません。これは単に後に定義する記法のための場所を用意したものです。後に修飾付きプログラムについて議論する際に使います。

練習問題: ★ (triples)

以下のホーアの三つ組を日本語に直しなさい。

{{True}} c {{X = 5}}

{{X = x}} c {{X = x + 5)}}

{{X <= Y}} c {{Y <= X}}

{{True}} c {{False}}

{{X = x}}
c
{{Y = real_fact x}}.

{{True}}
c
{{(Z * Z) <= x /\ ~ (((S Z) * (S Z)) <= x)}}

☐

練習問題: ★ (valid_triples)

以下のホーアの三つ組のうち、正しい(valid)ものを選択しなさい。

- 正しいとは、P,c,Qの関係が真であるということです。

{{True}} X ::= 5 {{X = 5}}

{{X = 2}} X ::= X + 1 {{X = 3}}

{{True}} X ::= 5; Y ::= 0 {{X = 5}}

{{X = 2 / X = 3}} X ::= 5 {{X = 0}}

{{True}} SKIP {{False}}

{{False}} SKIP {{True}}

{{True}} WHILE True DO SKIP END {{False}}

{{X = 0}} WHILE X == 0 DO X ::= X + 1 END {{X = 1}}

{{X = 1}} WHILE X <> 0 DO X ::= X + 1 END {{X = 100}}

(読みやすくするため、コマンド内の式について、非形式的な数学記法を使います。この章の最後までその方針をとります。)

☐

ウォーミングアップとして、ホーアの三つ組についての2つの事実を見てみます。

Theorem hoare_post_true : forall (P Q : Assertion) c,
(forall st, Q st) ->
{{P}} c {{Q}}.
Proof.
intros P Q c H. unfold hoare_triple.
intros st st' Heval HP.
apply H.  Qed.

Theorem hoare_pre_false : forall (P Q : Assertion) c,
(forall st, ~(P st)) ->
{{P}} c {{Q}}.
Proof.
intros P Q c H. unfold hoare_triple.
intros st st' Heval HP.
unfold not in H. apply H in HP.
inversion HP.  Qed.

最弱事前条件

いくつかの ホーアの三つ組は、他のものより興味深いものです。例えば:

{{ False }}  X ::= Y + 1  {{ X <= 5 }}

はあまり興味深いものではありません。これは完全に正しいものですが、何も有用なことを伝えてくれません。事前条件がどのような状態でも満たされないことから、コマンドX ::= Y + 1によって事後条件X <= 5に至るどのような状況も記述していません。一方、

{{ Y <= 4 /\ Z = 0 }}  X ::= Y + 1 {{ X <= 5 }}

は有用です。これは、何らかの方法でY <= 4 /\ Z = 0であるという状況を作りあげた後、このコマンドを実行すると事後条件を満たす状態になる、ということを伝えています。しかしながら、この三つ組はもう少し改良できます。なぜなら、事前条件のZ = 0という節は、実際には事後条件X <= 5に何の影響も与えないからです。(このコマンドと事後条件のもとで)最も有効な三つ組は次のものです:

{{ Y <= 4 }}  X ::= Y + 1  {{ X <= 5 }}

言いかえると、Y <= 4は事後条件X <= 5に対してコマンドX ::= Y + 1の最弱の(weakest)正しい事前条件です。

一般に、次が成立するとき”PはQに対するcの最弱事前条件である”と言います:

- {{P}} c {{Q}}, かつ

- P'が{{P'}} c {{Q}}を満たす表明ならば, すべての状態stについて、P' stならばP stとなる。

つまり、PがQに対するcの最弱事前条件であるとは、(a)PはQとcの事前条件で、かつ、(b)Pはcの後でQを保証する最弱の(weakest)(もっとも簡単に充足できる)表明である、ということです。

練習問題: ★ (wp)

以下のコマンドの以下の事後条件に対する最弱事前条件を示しなさい。

{{ ? }}  SKIP  {{ X = 5 }}

{{ ? }}  X ::= Y + Z {{ X = 5 }}

{{ ? }}  X ::= Y  {{ X = Y }}

{{ ? }}
IFB X == 0 THEN Y ::= Z + 1 ELSE Y ::= W + 2 FI
{{ Y = 5 }}

{{ ? }}
X ::= 5
{{ X = 0 }}

{{ ? }}
WHILE True DO X ::= 0 END
{{ X = 0 }}

☐

証明規則

ホーア論理のゴールは、ホーアの三つ組の正しさを証明する”合成的”手法を提供することです。つまり、プログラムの正しさの証明の構造は、プログラムの構造をそのまま反映したものになるということです。このゴールのために、以降の節では、Impのコマンドのいろいろな構文要素のそれぞれ対して、その構文要素について推論するための規則を1つずつ導入します。代入に1つ、コマンド合成に1つ、条件分岐に1つ、等です。それに加えて、複数のものを結合するために有用な2つの”構造的”規則を導入します。

代入の規則は、ホーア論理の証明規則の中で最も基本的なものです。この規則は次のように働きます。

次の(正しい)ホーアの三つ組を考えます。

{{ Y = 1 }}  X ::= Y  {{ X = 1 }}

日本語で言うと、Yの値が1である状態から始めて、XをYに代入するならば、Xが1である状態になる、ということです。つまり、1である、という性質がXからYに移された、ということです。

同様に、

{{ Y + Z = 1 }}  X ::= Y + Z  {{ X = 1 }}

においては、同じ性質(1であること)が代入の右辺のY+ZからXに移動されています。

より一般に、aが「任意の」算術式のとき、

{{ a = 1 }}  X ::= a {{ X = 1 }}

は正しいホーアの三つ組になります。

さらに一般化して、aが「任意の」算術式、Qが数についての「任意の」性質のとき、

{{ Q(a) }}  X ::= a {{ Q(X) }}

は正しいホーアの三つ組です。

これを若干言い換えると、代入に対する一般ホーア規則になります:

{{ Q において X を a で置換したもの }}  X ::= a  {{ Q }}

例えば、以下は、代入規則の正しい適用です:

{{ X + 1 <= 5 }}  X ::= X + 1  {{ X <= 5 }}

{{ 3 = 3 }}  X ::= 3  {{ X = 3 }}

{{ 0 <= 3 /\ 3 <= 5 }}  X ::= 3  {{ 0 <= X /\ X <= 5 }}

Qを、算術式をインデックスとする表明の族として扱うことで、代入規則を Coq で直接形式化してみることもできます。例えば次のようになります。

Theorem hoare_asgn_firsttry :
forall (Q : aexp -> Assertion) V a,
{{fun st => Q a st}} (V ::= a) {{fun st => Q (AId V) st}}.

しかし、この形式化は2つの理由であまり良くないのです。第一に、この式は本当に正しいとは言えないのです!(反例として、Qとして自分の引数の「構文」を調べるものを考えてみましょう。次のようなものです:

Definition Q (a:aexp) : Prop :=
match a with
| AID (Id 0) => fun st => False
| _          => fun st => True
end.

このとき、代入として、V = Id 0を考えると、事前条件はTrueとなりますが、事後条件はFalseになります。)第二の理由は、たとえ同様のことが証明できたとしても、これは使いにくいのです。

規則を形式化するはるかにスムーズな方法は、以下の洞察から得られます:

- “QにおいてXを a で置換したもの”が状態stで成立する必要十分条件は、Qが状態update st X (aeval st a)で成立することである。

つまり、ある状態で、Qを置換してできるものを表明することは、その状態を置換してできる状態で、Qを表明することと同じだということです。

状態の置換を次のように定義します:

Definition assn_sub V a Q : Assertion :=
fun (st : state) =>
Q (update st V (aeval st a)).

これを使って、代入の証明規則を形式的に与えます:

------------------------------ (hoare_asgn)
{{assn_sub V a Q}} V::=a {{Q}}

Theorem hoare_asgn : forall Q V a,
{{assn_sub V a Q}} (V ::= a) {{Q}}.
Proof.
unfold hoare_triple.
intros Q V a st st' HE HQ.
inversion HE. subst.
unfold assn_sub in HQ. assumption.  Qed.

この規則を使った最初の形式的証明が次のものです。

Example assn_sub_example :
{{fun st => 3 = 3}}
(X ::= (ANum 3))
{{fun st => asnat (st X) = 3}}.
Proof.
assert ((fun st => 3 = 3) =
(assn_sub X (ANum 3) (fun st => asnat (st X) = 3))).
Case "Proof of assertion".
unfold assn_sub. reflexivity.
rewrite -> H. apply hoare_asgn.  Qed.

この証明はあまり綺麗ではありません。なぜなら、hoare_asgn規則が最初のゴールに直接適用されてはいないからです。この規則は、事前条件が、何らかのQ、V、aについてassn_sub Q V aという形をしているときのみに適用できます。このため、ゴールをこの形にするためのちょっとした補題から始めなければならないのです。

hoare_asgnを使おうとするときに、毎回ゴール状態に対してこのような小細工をするのは面倒です。幸い、より簡単な方法があります。その一つは、明示的な等式の形の仮定を導く、いくらか一般性の高い定理を示すことです:

Theorem hoare_asgn_eq : forall Q Q' V a,
Q' = assn_sub V a Q ->
{{Q'}} (V ::= a) {{Q}}.
Proof.
intros Q Q' V a H. rewrite H. apply hoare_asgn.  Qed.

hoare_asgnのこのバージョンを使うことで、証明をよりスムーズに行うことができます。

Example assn_sub_example' :
{{fun st => 3 = 3}}
(X ::= (ANum 3))
{{fun st => asnat (st X) = 3}}.
Proof.
apply hoare_asgn_eq. reflexivity.  Qed.

練習問題: ★★ (hoare_asgn_examples)

次の非形式的なホーアの三つ組...

{{ X + 1 <= 5 }}  X ::= X + 1  {{ X <= 5 }}
{{ 0 <= 3 /\ 3 <= 5 }}  X ::= 3  {{ 0 <= X /\ X <= 5 }}

...を、形式的記述に直し、hoare_asgn_eqを使って証明しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★ (hoarestate2)

*)

FILL IN HERE 代入規則は、最初に見たとき、ほとんどの人が後向きの規則であるように感じます。もし今でも後向きに見えるならば、前向きバージョンの規則を考えてみるのも良いかもしれません。次のものは自然に見えます:

{{ True }} X ::= a {{ X = a }}

この規則の問題点を指摘しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★, optional (hoare_asgn_weakest)

hoare_asgn規則の事前条件が、本当に最弱事前条件であることを示しなさい。

Theorem hoare_asgn_weakest : forall P V a Q,
{{P}} (V ::= a) {{Q}} ->
forall st, P st -> assn_sub V a Q st.
Proof.
(* FILL IN HERE *) Admitted.

☐

帰結

代入規則の適用のぎこちなさに関する上記の議論は、より一般的なポイントを示しています。ホーア規則から得られる事前条件と事後条件は欲しいものではないことがしばしばあるのです。(上の例のように)それらは論理的に同値ですが、構文的に違う形をしているために、証明しようと思うゴールと単一化することができないのです。あるいは、(事前条件について)必要なものより論理的に弱かったり、(事後条件について)論理的に強かったりするのです。

例えば、

{{3 = 3}} X ::= 3 {{X = 3}},

が代入規則に直接従うのに対して、より自然な三つ組

{{True}} X ::= 3 {{X = 3}}.

はそうではないのです。この三つ組も正しいのですが、hoare_asgn(またはhoare_asgn_eq) のインスタンスではないのです。なぜなら、Trueと3 = 3は、構文的に等しい表明ではないからです。

一般に、{{P}} c {{Q}}が導出できるとき、P'ならばPが言えるだけP'が十分強ければ、PをP'に置き換えることは正しく、またQならばQ'が言えるときには、QをQ'に置き換えることは正しいのです。

この洞察をまとめたものが、次の帰結規則(Rule of Consequence)です。

{{P'}} c {{Q'}}
P implies P' (in every state)
Q' implies Q (in every state)
-----------------------------  (hoare_consequence)
{{P}} c {{Q}}

便宜上、さらに2つの帰結規則を用意します。1つは事前条件を強めるだけのもの、もう1つは事後条件を弱めるだけのものです。

{{P'}} c {{Q}}
P implies P' (in every state)
-----------------------------   (hoare_consequence_pre)
{{P}} c {{Q}}

{{P}} c {{Q'}}
Q' implies Q (in every state)
-----------------------------    (hoare_consequence_post)
{{P}} c {{Q}}

以下が形式化版です:

Theorem hoare_consequence : forall (P P' Q Q' : Assertion) c,
{{P'}} c {{Q'}} ->
(forall st, P st -> P' st) ->
(forall st, Q' st -> Q st) ->
{{P}} c {{Q}}.
Proof.
intros P P' Q Q' c Hht HPP' HQ'Q.
intros st st' Hc HP.
apply HQ'Q.  apply (Hht st st'). assumption.
apply HPP'. assumption.  Qed.

Theorem hoare_consequence_pre : forall (P P' Q : Assertion) c,
{{P'}} c {{Q}} ->
(forall st, P st -> P' st) ->
{{P}} c {{Q}}.
Proof.
intros P P' Q c Hhoare Himp.
apply hoare_consequence with (P' := P') (Q' := Q);
try assumption.
intros st H. apply H.  Qed.

Theorem hoare_consequence_post : forall (P Q Q' : Assertion) c,
{{P}} c {{Q'}} ->
(forall st, Q' st -> Q st) ->
{{P}} c {{Q}}.
Proof.
intros P Q Q' c Hhoare Himp.
apply hoare_consequence with (P' := P) (Q' := Q');
try assumption.
intros st H. apply H.  Qed.

(例えば、(“_pre“版の)帰結規則を次のように使うことができます:

{{ True }} =>
{{ 1 = 1 }}
X ::= 1
{{ X = 1 }}

あるいは、形式化すると...

Example hoare_asgn_example1 :
{{fun st => True}} (X ::= (ANum 1)) {{fun st => asnat (st X) = 1}}.
Proof.
apply hoare_consequence_pre with (P' := (fun st => 1 = 1)).
apply hoare_asgn_eq. reflexivity.
intros st H. reflexivity.  Qed.

余談:eapplyタクティック

ここで、良い機会ですので、Coq の別の便利な機能を紹介しておきましょう。上述の例で明示的にP'を書かなければならないことは、少々やっかいです。なぜなら、すぐ次にやること、つまりhoare_asgn規則を適用すること、が、まさに、それがどうでなければならないかを決定することだからです。こういう場合、applyの代わりにeapplyを使うことができます。そうすることは、本質的に、「抜けている部分は後で埋めます」とCoq に伝えることになります。

Example hoare_asgn_example1' :
{{fun st => True}}
(X ::= (ANum 1))
{{fun st => asnat (st X) = 1}}.
Proof.
eapply hoare_consequence_pre.
apply hoare_asgn_eq. reflexivity.
intros st H. reflexivity.  Qed.

一般に、eapply Hタクティックはapply Hとほぼ同様にはたらきますが、次の点が違います。Hの結論部とゴールとの単一化ではHの前提部に現れる変数のすべてが具体化されなかった場合、apply Hは失敗しますが、eapply Hは残った変数を存在変数(existential variables、?nnnと記述される)に置換します。存在変数は、証明の以降の部分で(さらなる単一化により)決定される式が入る場所を示すものです。

他に同様のはたらきをするものには、eassumptionタクティックがあります。

Skip

SKIPは状態を変えないことから、任意の性質 P を保存します:

--------------------  (hoare_skip)
{{ P }} SKIP {{ P }}

Theorem hoare_skip : forall P,
{{P}} SKIP {{P}}.
Proof.
intros P st st' H HP. inversion H. subst.
assumption.  Qed.

コマンド合成

より興味深いことに、コマンドc1が、Pが成立する任意の状態をQが成立する状態にし、c2が、Qが成立する任意の状態をRが成立する状態にするとき、c1に続いてc2を行うことは、Pが成立する任意の状態をRが成立する状態にします:

{{ P }} c1 {{ Q }}
{{ Q }} c2 {{ R }}
---------------------  (hoare_seq)
{{ P }} c1;c2 {{ R }}

Theorem hoare_seq : forall P Q R c1 c2,
{{Q}} c2 {{R}} ->
{{P}} c1 {{Q}} ->
{{P}} c1;c2 {{R}}.
Proof.
intros P Q R c1 c2 H1 H2 st st' H12 Pre.
inversion H12; subst.
apply (H1 st'0 st'); try assumption.
apply (H2 st st'0); try assumption. Qed.

形式的規則hoare_seqにおいては、前提部分が「逆順」である(c1の前にc2が来る)ことに注意してください。この順は、規則を使用する多くの場面で情報の自然な流れにマッチするのです。

非形式的には、この規則を利用した証明を記録する良い方法は、c1とc2の間に中間表明Qを記述する”修飾付きプログラム”の様にすることです:

{{ a = n }}
X ::= a;
{{ X = n }}      <---- 修飾 Q
SKIP
{{ X = n }}

Example hoare_asgn_example3 : forall a n,
{{fun st => aeval st a = n}}
(X ::= a; SKIP)
{{fun st => st X = n}}.
Proof.
intros a n. eapply hoare_seq.
Case "right part of seq".
apply hoare_skip.
Case "left part of seq".
eapply hoare_consequence_pre. apply hoare_asgn.
intros st H.  subst.  reflexivity. Qed.

練習問題: ★★ (hoare_asgn_example4)

次の修飾付きプログラムを形式的証明に直しなさい:

{{ True }} =>
{{ 1 = 1 }}
X ::= 1;
{{ X = 1 }} =>
{{ X = 1 /\ 2 = 2 }}
Y ::= 2
{{ X = 1 /\ Y = 2 }}

Example hoare_asgn_example4 :
{{fun st => True}} (X ::= (ANum 1); Y ::= (ANum 2))
{{fun st => asnat (st X) = 1 /\ asnat (st Y) = 2}}.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (swap_exercise)

XとYの値を交換するImpプログラムcを書き、それが次の仕様を満たすことを(Coq で)示しなさい:

{{X <= Y}} c {{Y <= X}}

(* FILL IN HERE *)

☐

練習問題: ★★★, optional (hoarestate1)

次の命題が証明できない理由を説明しなさい:

forall (a : aexp) (n : nat),
{{fun st => aeval st a = n}} (X ::= (ANum 3); Y ::= a)
{{fun st => asnat (st Y) = n}}.

(* FILL IN HERE *)

☐

条件分岐

条件分岐コマンドについて推論するために、どのような規則が必要でしょうか？確かに、分岐のどちらの枝を実行した後でも表明Qが成立するならば、条件分岐全体でもQが成立するでしょう。これから次のように書くべきかもしれません:

{{P}} c1 {{Q}}
{{P}} c2 {{Q}}
--------------------------------
{{P}} IFB b THEN c1 ELSE c2 {{Q}}

しかし、これはかなり弱いのです。例えば、この規則を使っても次のことを示すことができません:

{{True}}
IFB X == 0
THEN Y ::= 2
ELSE Y ::= X + 1
FI
{{ X <= Y }}

なぜなら、この規則では、”then”部と”else”部のどちらの代入が起こる状態なのかについて、何も言っていないからです。

しかし、実際には、より詳しいことを言うことができます。”then”の枝では、ブール式bの評価結果がtrueになることがわかっています。また”else”の枝では、それがfalseになることがわかっています。この情報を補題の前提部分で利用できるようにすることで、c1とc2の振舞いについて(つまり事後条件Qが成立する理由について)推論するときに、より多くの情報を使うことができるようになります。

{{P /\  b}} c1 {{Q}}
{{P /\ ~b}} c2 {{Q}}
------------------------------------  (hoare_if)
{{P}} IFB b THEN c1 ELSE c2 FI {{Q}}

この規則を形式的に解釈するために、もう少しやることがあります。

厳密には、上述の表明において、表明とブール式の連言P /\ bは、型チェックを通りません。これを修正するために、ブール式bを形式的に「持ち上げ」て、表明にしなければなりません。このためにbassn bと書きます。これは”ブール式bの評価結果が(任意の状態で)trueになる”という表明です。

Definition bassn b : Assertion :=
fun st => (beval st b = true).

bassnについての2つの便利な事実です:

Lemma bexp_eval_true : forall b st,
beval st b = true -> (bassn b) st.
Proof.
intros b st Hbe.
unfold bassn. assumption.  Qed.

Lemma bexp_eval_false : forall b st,
beval st b = false -> ~ ((bassn b) st).
Proof.
intros b st Hbe contra.
unfold bassn in contra.
rewrite -> contra in Hbe. inversion Hbe.  Qed.

いよいよ条件分岐についてのホーア証明規則を形式化し、正しいことを証明できます。

Theorem hoare_if : forall P Q b c1 c2,
{{fun st => P st /\ bassn b st}} c1 {{Q}} ->
{{fun st => P st /\ ~(bassn b st)}} c2 {{Q}} ->
{{P}} (IFB b THEN c1 ELSE c2 FI) {{Q}}.
Proof.
intros P Q b c1 c2 HTrue HFalse st st' HE HP.
inversion HE; subst.
Case "b is true".
apply (HTrue st st').
assumption.
split. assumption.
apply bexp_eval_true. assumption.
Case "b is false".
apply (HFalse st st').
assumption.
split. assumption.
apply bexp_eval_false. assumption. Qed.

以下が、最初に挙げたプログラムが与えられた条件を満たすことの証明です。

Example if_example :
{{fun st => True}}
IFB (BEq (AId X) (ANum 0))
THEN (Y ::= (ANum 2))
ELSE (Y ::= APlus (AId X) (ANum 1))
FI
{{fun st => asnat (st X) <= asnat (st Y)}}.
Proof.

apply hoare_if.
Case "Then".
eapply hoare_consequence_pre. apply hoare_asgn.
unfold bassn, assn_sub, update. simpl. intros.
inversion H.
symmetry in H1; apply beq_nat_eq in H1.
rewrite H1.  omega.
Case "Else".
eapply hoare_consequence_pre. apply hoare_asgn.
unfold assn_sub, update; simpl; intros. omega.
Qed.

ループ

最後に、ループについての推論規則が必要です。次のループを考えます:

WHILE b DO c END

そして、次の三つ組が正しくなる事前条件Pと事後条件Qを探します:

{{P}} WHILE b DO c END {{Q}}

まず、bが最初から偽であるときを考えましょう。このときループの本体はまったく実行されません。この場合は、ループはSKIPと同様の振舞いをしますので、次のように書いても良いかもしれません。

{{P}} WHILE b DO c END {{P}}.

しかし、条件分岐について議論したのと同様に、最後でわかっていることはもう少し多いのです。最終状態ではPであるだけではなくbが偽になっているのです。そこで、事後条件にちょっと付け足すことができます:

{{P}} WHILE b DO c END {{P /\ ~b}}

それでは、ループの本体が実行されるときはどうなるでしょう？ループを最後に抜けるときにはPが成立することを確実にするために、コマンドcの終了時点で常にPが成立することを確認する必要があるのは確かでしょう。さらに、Pがcの最初の実行の前に成立しており、cを実行するたびに、終了時点でPの成立が再度確立されることから、Pがcの実行前に常に成立していると仮定することができます。このことから次の規則が得られます:

{{P}} c {{P}}
-----------------------------------
{{P}} WHILE b DO c END {{P /\ ~b}}

命題Pは不変条件(invariant)と呼ばれます。

これで求める規則にかなり近付いたのですが、もうちょっとだけ改良できます。ループ本体の開始時点で、Pが成立しているだけでなく、ガードbが現在の状態で真であるということも言えます。このことは、cについての推論の際にいくらかの情報を与えてくれます。結局、規則の最終バージョンはこうなります:

{{P /\ b}} c {{P}}
-----------------------------------  [hoare_while]
{{P}} WHILE b DO c END {{P /\ ~b}}

Lemma hoare_while : forall P b c,
{{fun st => P st /\ bassn b st}} c {{P}} ->
{{P}} WHILE b DO c END {{fun st => P st /\ ~ (bassn b st)}}.
Proof.
intros P b c Hhoare st st' He HP.

remember (WHILE b DO c END) as wcom.
ceval_cases (induction He) Case; try (inversion Heqwcom); subst.

Case "E_WhileEnd".
split. assumption. apply bexp_eval_false.  assumption.

Case "E_WhileLoop".
apply IHHe2.  reflexivity.
apply (Hhoare st st'); try assumption.
split. assumption. apply bexp_eval_true. assumption.  Qed.

Example while_example :
{{fun st => asnat (st X) <= 3}}
WHILE (BLe (AId X) (ANum 2))
DO X ::= APlus (AId X) (ANum 1) END
{{fun st => asnat (st X) = 3}}.
Proof.
eapply hoare_consequence_post.
apply hoare_while.
eapply hoare_consequence_pre.
apply hoare_asgn.
unfold bassn,  assn_sub. intros.  rewrite update_eq. simpl.
inversion H as [_ H0].  simpl in H0. apply ble_nat_true in H0.
omega.
unfold bassn. intros. inversion H as [Hle Hb]. simpl in Hb.
remember (ble_nat (asnat (st X)) 2) as le.  destruct le.
apply ex_falso_quodlibet. apply Hb; reflexivity.
symmetry in Heqle. apply ble_nat_false in Heqle. omega.
Qed.

while規則を使うと、次のホーアの三つ組も証明できます。これは最初は驚くでしょう...

Theorem always_loop_hoare : forall P Q,
{{P}} WHILE BTrue DO SKIP END {{Q}}.
Proof.
intros P Q.
apply hoare_consequence_pre with (P' := fun st : state => True).
eapply hoare_consequence_post.
apply hoare_while.
Case "Loop body preserves invariant".
apply hoare_post_true. intros st. apply I.
Case "Loop invariant and negated guard imply postcondition".
simpl. intros st [Hinv Hguard].
apply ex_falso_quodlibet. apply Hguard. reflexivity.
Case "Precondition implies invariant".
intros st H. constructor.  Qed.

実際は、この結果は驚くことはないのです。ふり返ってhoare_tripleの定義を見てみると、コマンドが停止した場合「のみ」に意味がある表明をしているのです。

Print hoare_triple.

もしコマンドが停止しなければ、事後条件で何でも好きなことが証明できます。以下は、同じことのより直接的な証明です:

Theorem always_loop_hoare' : forall P Q,
{{P}} WHILE BTrue DO SKIP END {{Q}}.
Proof.
unfold hoare_triple. intros P Q st st' contra.
apply loop_never_stops in contra.  inversion contra.
Qed.

停止するコマンドについてだけを議論するホーア規則は、「部分」正当性(“partial” correctness)を記述していると言われます。「完全」正当性(“total” correctness)についてのホーア規則を与えることも可能です。それは、コマンドが停止するという事実を組み込んだものです。

練習問題:REPEATのホーア規則

Module RepeatExercise.

練習問題: ★★★★ (hoare_repeat)

この練習問題では、コマンド言語に新たなコンストラクタCRepeatを追加します。repeatの評価規則を記述し、このコマンドを含むプログラムについての新たなホーア論理の定理を、言語に追加しなさい。

以降の問題に進む前にこの練習問題をやっておくことをお勧めします。この問題は、素材の理解を確固としたものにする助けになるからです。

Inductive com : Type :=
| CSkip : com
| CAss : id -> aexp -> com
| CSeq : com -> com -> com
| CIf : bexp -> com -> com -> com
| CWhile : bexp -> com -> com
| CRepeat : com -> bexp -> com.

REPEATはWHILEと同じように振舞います。ただし、ループのガードが本体の実行の「後で」評価され、それが「偽」である間はループがくりかえされるという点が違います。このことにより、本体は常に少なくとも1回は実行されることになります。

Tactic Notation "com_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
| Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "CRepeat" ].

Notation "'SKIP'" :=
CSkip.
Notation "c1 ; c2" :=
(CSeq c1 c2) (at level 80, right associativity).
Notation "X '::=' a" :=
(CAss X a) (at level 60).
Notation "'WHILE' b 'DO' c 'END'" :=
(CWhile b c) (at level 80, right associativity).
Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
(CIf e1 e2 e3) (at level 80, right associativity).
Notation "'REPEAT' e1 'UNTIL' b2 'END'" :=
(CRepeat e1 b2) (at level 80, right associativity).

以下のcevalにREPEATの新たな規則を追加しなさい。WHILEの規則を参考にして構いません。ただ、REPEATの本体は1度は実行されることと、ループの終了はガードが真になったときであることは忘れないで下さい。そして、この場合を扱えるように、ceval_casesタクティックを更新しなさい。

Inductive ceval : state -> com -> state -> Prop :=
| E_Skip : forall st,
ceval st SKIP st
| E_Ass  : forall st a1 n V,
aeval st a1 = n ->
ceval st (V ::= a1) (update st V n)
| E_Seq : forall c1 c2 st st' st'',
ceval st c1 st' ->
ceval st' c2 st'' ->
ceval st (c1 ; c2) st''
| E_IfTrue : forall st st' b1 c1 c2,
beval st b1 = true ->
ceval st c1 st' ->
ceval st (IFB b1 THEN c1 ELSE c2 FI) st'
| E_IfFalse : forall st st' b1 c1 c2,
beval st b1 = false ->
ceval st c2 st' ->
ceval st (IFB b1 THEN c1 ELSE c2 FI) st'
| E_WhileEnd : forall b1 st c1,
beval st b1 = false ->
ceval st (WHILE b1 DO c1 END) st
| E_WhileLoop : forall st st' st'' b1 c1,
beval st b1 = true ->
ceval st c1 st' ->
ceval st' (WHILE b1 DO c1 END) st'' ->
ceval st (WHILE b1 DO c1 END) st''
(* FILL IN HERE *)
.

Tactic Notation "ceval_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E_Skip" | Case_aux c "E_Ass" | Case_aux c "E_Seq"
| Case_aux c "E_IfTrue" | Case_aux c "E_IfFalse"
| Case_aux c "E_WhileEnd" | Case_aux c "E_WhileLoop"
(* FILL IN HERE *)
].

上記から2つの定義のコピーし、新しいcevalを使うようにしました。

Notation "c1 '/' st '||' st'" := (ceval st c1 st')
(at level 40, st at level 39).
Definition hoare_triple (P:Assertion) (c:com) (Q:Assertion)
: Prop :=
forall st st', (c / st || st') -> P st -> Q st'.
Notation "{{ P }}  c  {{ Q }}" := (hoare_triple P c Q) (at level 90, c at next level).

repeatコマンドの適切な証明規則を表現する定理hoare_repeatを述べ、証明しなさい。このときにhoare_whileをモデルとして利用しなさい。

(* FILL IN HERE *)

End RepeatExercise.

☐

修飾付きプログラム

ホーア論理の一番のポイントは、合成的ということです。証明の構造は常にプログラムの構造に従います。このことから、それぞれの文の周辺を適切な表明で修飾することで(低レベルの計算の詳細を省いた)証明の本質的アイデアを非形式的に記録できるのではないか、と考えられます。そういった修飾付きプログラム(decorated program)は、自身の正しさの(非形式的)証明を伴っています。

例えば、次は完全な修飾付きプログラムです:

{{ True }} =>
{{ x = x }}
X ::= x;
{{ X = x }} =>
{{ X = x /\ z = z }}
Z ::= z;
{{ X = x /\ Z = z }} =>
{{ Z - X = z - x }}
WHILE X <> 0 DO
{{ Z - X = z - x /\ X <> 0 }} =>
{{ (Z - 1) - (X - 1) = z - x }}
Z ::= Z - 1;
{{ Z - (X - 1) = z - x }}
X ::= X - 1
{{ Z - X = z - x }}
END;
{{ Z - X = z - x /\ ~ (X <> 0) }} =>
{{ Z = z - x }} =>
{{ Z + 1 = z - x + 1 }}
Z ::= Z + 1
{{ Z = z - x + 1 }}

具体的には、修飾付きプログラムはプログラムテキストと表明が交互に記述されたものです。修飾付きプログラムが正しい証明を表現していることをチェックするには、個々のコマンドが前後の表明と整合していることを「ローカルに」チェックします。このローカルな整合性チェックは次のようになります:

- SKIPは事前条件と事後条件が同じときに、整合しています。

{{ P }}
SKIP
{{ P }}

- c1とc2のコマンド合成が(表明PとRに関して)ローカルに整合的であるとは、c1が(PとQに関して)整合的であり、c2が(QとRに関して)整合的であることです:

{{ P }}
c1;
{{ Q }}
c2
{{ R }}

- 代入がローカルに整合的であるとは、事後条件を適切に置換したものが事前条件であることです:

{{ P where a is substituted for X }}
X ::= a
{{ P }}

- 条件分岐が(表明PとQに関して)ローカルに整合的であるとは、 “then”と”else”の枝の最初の表明がそれぞれP/\bとP/\~bであり、”then”枝が(P/\bとQに関して)ローカルに整合的で、”else”枝が(P/\~bとQに関して)ローカルに整合的であることです:

{{ P }}
IFB b THEN
{{ P /\ b }}
c1
{{ Q }}
ELSE
{{ P /\ ~b }}
c2
{{ Q }}
FI

- While ループがローカルに整合的であるとは、(事前条件をPとするとき) 事後条件がP/\~bであって、ループ本体の事前条件と事後条件がそれぞれP/\bとPであることです:

{{ P }}
WHILE b DO
{{ P /\ b }}
c1
{{ P }}
END
{{ P /\ ~b }}

- =>の前後に1つずつの表明が並べられたものがローカルに整合的であるとは、=>の前の表明が成立するならば=>の後の表明が成立するということが(すべての状態で)言えることです:

{{ P }} =>
{{ P' }}

ホーア論理によるプログラムについての推論

例: 遅い引き算

非形式的には:

{{ X = x /\ Z = z }} =>
{{ Z - X = z - x }}
WHILE X <> 0 DO
{{ Z - X = z - x /\ X <> 0 }} =>
{{ (Z - 1) - (X - 1) = z - x }}
Z ::= Z - 1;
{{ Z - (X - 1) = z - x }}
X ::= X - 1
{{ Z - X = z - x }}
END
{{ Z - X = z - x /\ ~ (X <> 0) }} =>
{{ Z = z - x }}

形式的には:

Definition subtract_slowly : com :=
WHILE BNot (BEq (AId X) (ANum 0)) DO
Z ::= AMinus (AId Z) (ANum 1);
X ::= AMinus (AId X) (ANum 1)
END.

Definition subtract_slowly_invariant x z :=
fun st => minus (asnat (st Z)) (asnat (st X)) = minus z x.

Theorem subtract_slowly_correct : forall x z,
{{fun st => asnat (st X) = x /\ asnat (st Z) = z}}
subtract_slowly
{{fun st => asnat (st Z) = minus z x}}.
Proof.

intros x z. unfold subtract_slowly.

eapply hoare_consequence with (P' := subtract_slowly_invariant x z).
apply hoare_while.

Case "Loop body preserves invariant".

eapply hoare_seq. apply hoare_asgn.

eapply hoare_consequence_pre. apply hoare_asgn.

unfold subtract_slowly_invariant, assn_sub, update, bassn. simpl.
intros st [Inv GuardTrue].

remember (beq_nat (asnat (st X)) 0) as Q; destruct Q.
inversion GuardTrue.
symmetry in HeqQ.  apply beq_nat_false in HeqQ.
omega.
Case "Initial state satisfies invariant".

unfold subtract_slowly_invariant.
intros st [HX HZ]. omega.
Case "Invariant and negated guard imply postcondition".

intros st [Inv GuardFalse].
unfold subtract_slowly_invariant in Inv.
unfold bassn in GuardFalse. simpl in GuardFalse.

destruct (asnat (st X)).
omega.
apply ex_falso_quodlibet.   apply GuardFalse. reflexivity.
Qed.

練習問題: ゼロへの簡約

次の while ループは、非常にシンプルなため、不変条件が必要ありません:

{{ True }}
WHILE X <> 0 DO
{{ True /\ X <> 0 }} =>
{{ True }}
X ::= X - 1
{{ True }}
END
{{ True /\ X = 0 }} =>
{{ X = 0 }}

この証明を Coq に変換しなさい。slow_subtractionの証明がアイデアの参考になるでしょう。

練習問題: ★★ (reduce_to_zero_correct)

Definition reduce_to_zero : com :=
WHILE BNot (BEq (AId X) (ANum 0)) DO
X ::= AMinus (AId X) (ANum 1)
END.

Theorem reduce_to_zero_correct :
{{fun st => True}}
reduce_to_zero
{{fun st => asnat (st X) = 0}}.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: 遅い足し算

次のプログラムは変数Xを変数Zに足します。そのために、Xを減らしてZを増やすということを繰り返します。

Definition add_slowly : com :=
WHILE BNot (BEq (AId X) (ANum 0)) DO
Z ::= APlus (AId Z) (ANum 1);
X ::= AMinus (AId X) (ANum 1)
END.

練習問題: ★★★ (add_slowly_decoration)

上記の例subtract_slowlyのパターンに従って、add_slowlyの適切な事前条件と事後条件を与えなさい。次に(非形式的に)そのプログラムを前例にならって修飾しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★ (add_slowly_formal)

Coq のHoare_tripleのように、add_slowlyの仕様を形式的に記述しなさい。そして正しさを証明しなさい。

(* FILL IN HERE *)

☐

例: パリティ

次は、よりトリッキーな例です。修飾付きプログラムを完全に理解していることを確認してください。Coqの証明の詳細のすべてを理解することが必要なわけではありません(それは、それほど大変ではないですが)。すべての必要なアイデアは非形式的なバージョンの中に含まれています。

{{ X = x }} =>
{{ X = x /\ 0 = 0 }}
Y ::= 0;
{{ X = x /\ Y = 0 }} =>
{{ (Y=0 <-> ev (x-X)) /\ X<=x }}
WHILE X <> 0 DO
{{ (Y=0 <-> ev (x-X)) /\ X<=x /\ X<>0 }} =>
{{ (1-Y)=0 <-> ev (x-(X-1)) /\ X-1<=x }}
Y ::= 1 - Y;
{{ Y=0 <-> ev (x-(X-1)) /\ X-1<=x }}
X ::= X - 1
{{ Y=0 <-> ev (x-X) /\ X<=x }}
END
{{ (Y=0 <-> ev (x-X)) /\ X<=x /\ ~(X<>0) }} =>
{{ Y=0 <-> ev x }}

Definition find_parity : com :=
Y ::= (ANum 0);
WHILE (BNot (BEq (AId X) (ANum 0))) DO
Y ::= AMinus (ANum 1) (AId Y);
X ::= AMinus (AId X) (ANum 1)
END.

Definition find_parity_invariant x :=
fun st =>
asnat (st X) <= x
/\ (asnat (st Y) = 0 /\ ev (x - asnat (st X)) \/ asnat (st Y) = 1 /\ ~ev (x - asnat (st X))).

Lemma not_ev_ev_S_gen: forall n,
(~ ev n -> ev (S n)) /\
(~ ev (S n) -> ev (S (S n))).
Proof.
induction n as [| n'].
Case "n = 0".
split; intros H.
SCase "->".
apply ex_falso_quodlibet. apply H. apply ev_0.
SCase "<-".
apply ev_SS. apply ev_0.
Case "n = S n'".
inversion IHn' as [Hn HSn]. split; intros H.
SCase "->".
apply HSn. apply H.
SCase "<-".
apply ev_SS. apply Hn. intros contra.
apply H. apply ev_SS. apply contra.  Qed.

Lemma not_ev_ev_S : forall n,
~ ev n -> ev (S n).
Proof.
intros n.
destruct (not_ev_ev_S_gen n) as [H _].
apply H.
Qed.

Theorem find_parity_correct : forall x,
{{fun st => asnat (st X) = x}}
find_parity
{{fun st => asnat (st Y) = 0 <-> ev x}}.
Proof.
intros x. unfold find_parity.
apply hoare_seq with (Q := find_parity_invariant x).
eapply hoare_consequence.
apply hoare_while with (P := find_parity_invariant x).
Case "Loop body preserves invariant".
eapply hoare_seq.
apply hoare_asgn.
eapply hoare_consequence_pre.
apply hoare_asgn.
intros st [[Inv1 Inv2] GuardTrue].
unfold find_parity_invariant, bassn, assn_sub, aeval in *.
rewrite update_eq.
rewrite (update_neq Y X); auto.
rewrite (update_neq X Y); auto.
rewrite update_eq.
simpl in GuardTrue. destruct (asnat (st X)).
inversion GuardTrue. simpl.
split. omega.
inversion Inv2 as [[H1 H2] | [H1 H2]]; rewrite H1;
[right|left]; (split; simpl; [omega |]).
apply ev_not_ev_S in H2.
replace (S (x - S n)) with (x-n) in H2 by omega.
rewrite <- minus_n_O. assumption.
apply not_ev_ev_S in H2.
replace (S (x - S n)) with (x - n) in H2 by omega.
rewrite <- minus_n_O. assumption.
Case "Precondition implies invariant".
intros st H. assumption.
Case "Invariant implies postcondition".
unfold bassn, find_parity_invariant. simpl.
intros st [[Inv1 Inv2] GuardFalse].
destruct (asnat (st X)).
split; intro.
inversion Inv2.
inversion H0 as [_ H1]. replace (x-0) with x in H1 by omega.
assumption.
inversion H0 as [H0' _]. rewrite H in H0'. inversion H0'.
inversion Inv2.
inversion H0. assumption.
inversion H0 as [_ H1]. replace (x-0) with x in H1 by omega.
apply ex_falso_quodlibet. apply H1. assumption.
apply ex_falso_quodlibet. apply GuardFalse. reflexivity.
Case "invariant established before loop".
eapply hoare_consequence_pre.
apply hoare_asgn.
intros st H.
unfold assn_sub, find_parity_invariant, update. simpl.
subst.
split.
omega.
replace (asnat (st X) - asnat (st X)) with 0 by omega.
left. split. reflexivity.
apply ev_0.  Qed.

練習問題: ★★★ (wrong_find_parity_invariant)

find_parityの不変条件の主張として次のものはもっともらしく見えます。

Definition find_parity_invariant' x :=
fun st =>
(asnat (st Y)) = 0 <-> ev (x - asnat (st X)).

これがなぜうまくはたらかないかを説明しなさい。(ヒント: 形式的証明を考え、その問題を探そうとするのは時間の無駄です。ループの本体が実際に性質を保存するかどうかだけを考えなさい。)

(* FILL IN HERE *)

☐

例: 平方根の探索

Definition sqrt_loop : com :=
WHILE BLe (AMult (APlus (ANum 1) (AId Z))
(APlus (ANum 1) (AId Z)))
(AId X) DO
Z ::= APlus (ANum 1) (AId Z)
END.

Definition sqrt_com : com :=
Z ::= ANum 0;
sqrt_loop.

Definition sqrt_spec (x : nat) : Assertion :=
fun st =>
((asnat (st Z)) * (asnat (st Z))) <= x
/\ ~ (((S (asnat (st Z))) * (S (asnat (st Z)))) <= x).

Definition sqrt_inv (x : nat) : Assertion :=
fun st =>
asnat (st X) = x
/\ ((asnat (st Z)) * (asnat (st Z))) <= x.

Theorem random_fact_1 : forall st,
(S (asnat (st Z))) * (S (asnat (st Z))) <= asnat (st X) ->
bassn (BLe (AMult (APlus (ANum 1) (AId Z))
(APlus (ANum 1) (AId Z)))
(AId X)) st.
Proof.
intros st Hle.  unfold bassn. simpl.
destruct (asnat (st X)) as [|x'].
Case "asnat (st X) = 0".
inversion Hle.
Case "asnat (st X) = S x'".
simpl in Hle. apply le_S_n in Hle.
remember (ble_nat (plus (asnat (st Z))
((asnat (st Z)) * (S (asnat (st Z))))) x')
as ble.
destruct ble. reflexivity.
symmetry in Heqble. apply ble_nat_false in Heqble.
unfold not in Heqble. apply Heqble in Hle. inversion Hle.
Qed.

Theorem random_fact_2 : forall st,
bassn (BLe (AMult (APlus (ANum 1) (AId Z))
(APlus (ANum 1) (AId Z)))
(AId X)) st ->
asnat (aeval st (APlus (ANum 1) (AId Z)))
* asnat (aeval st (APlus (ANum 1) (AId Z)))
<= asnat (st X).
Proof.
intros st Hble. unfold bassn in Hble. simpl in *.
destruct (asnat (st X)) as [| x'].
Case "asnat (st X) = 0".
inversion Hble.
Case "asnat (st X) = S x'".
apply ble_nat_true in Hble. omega. Qed.

Theorem sqrt_com_correct : forall x,
{{fun st => True}} (X ::= ANum x; sqrt_com) {{sqrt_spec x}}.
Proof.
intros x.
apply hoare_seq with (Q := fun st => asnat (st X) = x).
Case "sqrt_com".
unfold sqrt_com.
apply hoare_seq with (Q := fun st => asnat (st X) = x
/\ asnat (st Z) = 0).

SCase "sqrt_loop".
unfold sqrt_loop.
eapply hoare_consequence.
apply hoare_while with (P := sqrt_inv x).

SSCase "loop preserves invariant".
eapply hoare_consequence_pre.
apply hoare_asgn. intros st H.
unfold assn_sub. unfold sqrt_inv in *.
inversion H as [[HX HZ] HP]. split.
SSSCase "X is preserved".
rewrite update_neq; auto.
SSSCase "Z is updated correctly".
rewrite (update_eq (aeval st (APlus (ANum 1) (AId Z))) Z st).
subst. apply random_fact_2. assumption.

SSCase "invariant is true initially".
intros st H. inversion H as [HX HZ].
unfold sqrt_inv. split. assumption.
rewrite HZ. simpl. omega.

SSCase "after loop, spec is satisfied".
intros st H. unfold sqrt_spec.
inversion H as [HX HP].
unfold sqrt_inv in HX.  inversion HX as [HX' Harith].
split. assumption.
intros contra. apply HP. clear HP.
simpl. simpl in contra.
apply random_fact_1. subst x. assumption.

SCase "Z set to 0".
eapply hoare_consequence_pre. apply hoare_asgn.
intros st HX.
unfold assn_sub. split.
rewrite update_neq; auto.
rewrite update_eq; auto.

Case "assignment of X".
eapply hoare_consequence_pre. apply hoare_asgn.
intros st H.
unfold assn_sub. rewrite update_eq; auto.  Qed.

練習問題: ★★★, optional (sqrt_informal)

上記の正しさの証明に対応する修飾付きプログラムを記述しなさい。

(* FILL IN HERE *)

☐

練習問題: 階乗

Module Factorial.

Fixpoint real_fact (n:nat) : nat :=
match n with
| O => 1
| S n' => n * (real_fact n')
end.

階乗を計算する Imp プログラムを思い出してください:

Definition fact_body : com :=
Y ::= AMult (AId Y) (AId Z);
Z ::= AMinus (AId Z) (ANum 1).

Definition fact_loop : com :=
WHILE BNot (BEq (AId Z) (ANum 0)) DO
fact_body
END.

Definition fact_com : com :=
Z ::= (AId X);
Y ::= ANum 1;
fact_loop.

練習問題: ★★★, optional (fact_informal)

[[
{{ X = x }}
Z ::= X;
Y ::= 1;
WHILE Z <> 0 DO
Y ::= Y * Z;
Z ::= Z - 1
END
{{ Y = real_fact x }}
]]
*)

FILL IN HERE fact_comを修飾して、以下の事前条件、事後条件として与えられる仕様を満たすことを示しなさい。帰結規則のために(形式的には)算術式や不等号などについての推論が必要になりますが、ここまでと同様、それらは省略して構いません。

(* FILL IN HERE *)

{{ X = x }}
Z ::= X;
Y ::= 1;
WHILE Z <> 0 DO
Y ::= Y * Z;
Z ::= Z - 1
END
{{ Y = real_fact x }}

☐

練習問題: ★★★★, optional (fact_formal)

fact_com がこの仕様を満たすことを、形式的に証明しなさい。その際、自分の非形式的な証明をガイドとして使いなさい。(例で行ったように)ループ不変条件を分離して主張しても構いません。

Theorem fact_com_correct : forall x,
{{fun st => asnat (st X) = x}} fact_com
{{fun st => asnat (st Y) = real_fact x}}.
Proof.
(* FILL IN HERE *) Admitted.

☐

End Factorial.

リストを扱うプログラムについての推論

練習問題: ★★★ (list_sum)

以下は、リストの要素の合計の直接的定義と、その合計を計算するImpプログラムです

Definition sum l := fold_right plus 0 l.

Definition sum_program :=
Y ::= ANum 0;
WHILE (BIsCons (AId X)) DO
Y ::= APlus (AId Y) (AHead (AId X)) ;
X ::= ATail (AId X)
END.

sum_programの以下の仕様の「非形式的な」証明を、修飾を付けたバージョンのプログラムの形で与えなさい。

Definition sum_program_spec := forall l,
{{ fun st => aslist (st X) = l }}
sum_program
{{ fun st => asnat (st Y) = sum l }}.

(* FILL IN HERE *)

☐ *

次に、リストを扱うあるプログラムの「形式的な」ホーア論理の証明を見てみましょう。次のプログラムは、数値YがリストXの中に含まれるかどうかをチェックし、もし含まれたならばZを1にします。このプログラムを検証します。

Definition list_member :=
WHILE BIsCons (AId X) DO
IFB (BEq (AId Y) (AHead (AId X))) THEN
Z ::= (ANum 1)
ELSE
SKIP
FI;
X ::= ATail (AId X)
END.

Definition list_member_spec := forall l n,
{{ fun st => st X = VList l /\ st Y = VNat n /\ st Z = VNat 0 }}
list_member
{{ fun st => st Z = VNat 1 <-> appears_in n l }}.

証明は非形式的に書くと次のようになるものを使います:

{{ X = l /\ Y = n /\ Z = 0 }} =>
{{ Y = n /\ exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p) }}
WHILE (BIsCons X)
DO
{{ Y = n /\ (exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p))
/\ (BIsCons X) }}
IFB (Y == head X) THEN
{{ Y = n
/\ (exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p))
/\ (BIsCons X)
/\ Y == AHead X }} =>
{{ Y = n /\ (exists p, p ++ tail X = l
/\ (1 = 1 <-> appears_in n p)) }}
Z ::= 1
{{ Y = n /\ (exists p, p ++ tail X = l
/\ (Z = 1 <-> appears_in n p)) }}
ELSE
{{ Y = n
/\ (exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p))
/\ (BIsCons X)
/\ ~ (Y == head X) }} =>
{{ Y = n
/\ (exists p, p ++ tail X = l /\ (Z = 1 <-> appears_in n p)) }}
SKIP
{{ Y = n
/\ (exists p, p ++ tail X = l /\ (Z = 1 <-> appears_in n p)) }}
FI;
X ::= ATail X
{{ Y = n
/\ (exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p)) }}
END
{{ Y = n
/\ (exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p))
/\ ~ (BIsCons X) }} =>
{{ Z = 1 <-> appears_in n l }}

証明で興味深い点はただ1つ、ループ不変条件の選び方です:

exists p, p ++ X = l /\ (Z = 1 <-> appears_in n p)

これは、ループの繰り返しのたびに、もとのリストlがXの現在値と別のリストpとを結合したものと同一であることを言っています。このpはプログラム内の変数の値ではないですが、最初から証明が進んでいく間、保持されていきます。(このようなpは、よく”幽霊変数”(ghost variable)と呼ばれます。)

このようなリストpが存在することを示すために、繰り返しの毎回、Xの先頭にpの「最後」を加えています。このために Poly_J.vのsnocを使っています。

Fixpoint snoc {X:Type} (l:list X) (v:X) : (list X) :=
match l with
| nil      =>  [ v ]
| cons h t => h :: (snoc t v)
end.

Lemma snoc_equation : forall (A : Type) (h:A) (x y : list A),
snoc x h ++ y = x ++ h :: y.
Proof.
intros A h x y.
induction x.
Case "x = []". reflexivity.
Case "x = cons". simpl. rewrite IHx. reflexivity.
Qed.

メインの証明はたくさんの補題を使います。

Lemma appears_in_snoc1 : forall a l,
appears_in a (snoc l a).
Proof.
induction l.
Case "l = []". apply ai_here.
Case "l = cons". simpl. apply ai_later. apply IHl.
Qed.

Lemma appears_in_snoc2 : forall a b l,
appears_in a l ->
appears_in a (snoc l b).
Proof.
induction l; intros H; inversion H; subst; simpl.
Case "l = []". apply ai_here.
Case "l = cons". apply ai_later. apply IHl. assumption.
Qed.

Lemma appears_in_snoc3 : forall a b l,
appears_in a (snoc l b) ->
(appears_in a l \/ a = b).
Proof.
induction l; intros H.
Case "l = []". inversion H.
SCase "ai_here". right. reflexivity.
SCase "ai_later". left. assumption.
Case "l = cons". inversion H; subst.
SCase "ai_here". left. apply ai_here.
SCase "ai_later". destruct (IHl H1).
left. apply ai_later. assumption.
right. assumption.
Qed.

Lemma append_singleton_equation : forall (x : nat) l l',
(l ++ [x]) ++ l' = l ++ x :: l'.
Proof.
intros x l l'.
induction l.
reflexivity.
simpl. rewrite IHl. reflexivity.
Qed.

Lemma append_nil : forall (A : Type) (l : list A),
l ++ [] = l.
Proof.
induction l.
reflexivity.
simpl. rewrite IHl. reflexivity.
Qed.

Lemma beq_true__eq : forall n n',
beq_nat n n' = true ->
n = n'.
Proof.
induction n; destruct n'.
Case "n = 0, n' = 0".     reflexivity.
Case "n = 0, n' = S _".   simpl. intros H. inversion H.
Case "n = S, n' = 0".     simpl. intros H. inversion H.
Case "n = S, n' = S".     simpl. intros H.
rewrite (IHn n' H). reflexivity.
Qed.

Lemma beq_nat_refl : forall n,
beq_nat n n = true.
Proof.
induction n.
reflexivity.
simpl. assumption.
Qed.

Theorem list_member_correct : forall l n,
{{ fun st => st X = VList l /\ st Y = VNat n /\ st Z = VNat 0 }}
list_member
{{ fun st => st Z = VNat 1 <-> appears_in n l }}.
Proof.
intros l n.
eapply hoare_consequence.
apply hoare_while with (P := fun st =>
st Y = VNat n
/\ exists p, p ++ aslist (st X) = l
/\ (st Z = VNat 1 <-> appears_in n p)).

eapply hoare_seq.
apply hoare_asgn.
apply hoare_if.
Case "If taken".
eapply hoare_consequence_pre.
apply hoare_asgn.
intros st [[[H1 [p [H2 H3]]] H9] H10].
unfold assn_sub. split.

rewrite update_neq; try reflexivity.
rewrite update_neq; try reflexivity.
assumption.

remember (aslist (st X)) as x.
destruct x as [|h x'].
unfold bassn in H9. unfold beval in H9. unfold aeval in H9.
rewrite <- Heqx in H9. inversion H9.

exists (snoc p h).
rewrite update_eq.
unfold aeval. rewrite update_neq; try reflexivity.
rewrite <- Heqx.
split.
rewrite snoc_equation. assumption.

rewrite update_neq; try reflexivity.
rewrite update_eq.
split.
simpl.
unfold bassn in H10. unfold beval in H10.
unfold aeval in H10. rewrite H1 in H10.
rewrite <- Heqx in H10. simpl in H10.
rewrite (beq_true__eq _ _ H10).
intros. apply appears_in_snoc1.

intros. reflexivity.
Case "If not taken".
eapply hoare_consequence_pre. apply hoare_skip.
unfold assn_sub.
intros st [[[H1 [p [H2 H3]]] H9] H10].
split.

rewrite update_neq; try reflexivity.
assumption.

remember (aslist (st X)) as x.
destruct x as [|h x'].
unfold bassn in H9. unfold beval in H9. unfold aeval in H9.
rewrite <- Heqx in H9. inversion H9.

exists (snoc p h).
split.
rewrite update_eq.
unfold aeval. rewrite <- Heqx.
rewrite snoc_equation. assumption.

rewrite update_neq; try reflexivity.
split.
intros. apply appears_in_snoc2. apply H3. assumption.

intros.  destruct (appears_in_snoc3 _ _ _ H).
SCase "later".
inversion H3 as [_ H3'].
apply H3'. assumption.
SCase "here (absurd)".
subst.
unfold bassn in H10. unfold beval in H10. unfold aeval in H10.
rewrite <- Heqx in H10. rewrite H1 in H10.
simpl in H10. rewrite beq_nat_refl in H10.
apply ex_falso_quodlibet. apply H10. reflexivity.

intros st [H1 [H2 H3]].
rewrite H1. rewrite H2. rewrite H3.
split.
reflexivity.
exists []. split.
reflexivity.
split; intros H; inversion H.

simpl.   intros st [[H1 [p [H2 H3]]] H5].

unfold bassn in H5. unfold beval in H5. unfold aeval in H5.
destruct (aslist (st X)) as [|h x'].
rewrite append_nil in H2.
rewrite <- H2.
assumption.

apply ex_falso_quodlibet. apply H5. reflexivity.
Qed.

練習問題: ★★★★, optional (list_reverse)

Poly_J.vのrevを思い出してください。リストを逆順にするものです。

Fixpoint rev {X:Type} (l:list X) : list X :=
match l with
| nil      => []
| cons h t => snoc (rev t) h
end.

リストを逆順にする Imp プログラムlist_reverse_programを記述しなさい。次の仕様を満たすことを形式的に証明しなさい:

forall l : list nat,
{{ X =  l /\ Y = nil }}
list_reverse_program
{{ Y = rev l }}.

補題append_nilとrev_equationを使うのが良いでしょう。

Lemma rev_equation : forall (A : Type) (h : A) (x y : list A),
rev (h :: x) ++ y = rev x ++ h :: y.
Proof.
intros. simpl. apply snoc_equation.
Qed.

(* FILL IN HERE *)

☐

修飾付きプログラムの形式化

ホーアの三つ組を、非形式的な修飾付きプログラムで記述することは結局、コマンドに十分な表明を付加することで、三つ組の正しさをチェックすることを、ある表明が別のものより強いことを示す簡単な代数的計算に簡約化することになります。

この節では、この非形式的なスタイルを、実際は完全に形式的に表現できることを示します。

構文

最初にしなければならないことは、表明を埋め込んだコマンド構文を形式化することです。この形のコマンドを修飾付きコマンド(decorated commands)またはdcomと呼びます。

Inductive dcom : Type :=
| DCSkip :  Assertion -> dcom
| DCSeq : dcom -> dcom -> dcom
| DCAsgn : id -> aexp ->  Assertion -> dcom
| DCIf : bexp ->  Assertion -> dcom ->  Assertion -> dcom -> dcom
| DCWhile : bexp -> Assertion -> dcom -> Assertion -> dcom
| DCPre : Assertion -> dcom -> dcom
| DCPost : dcom -> Assertion -> dcom.

Tactic Notation "dcom_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "Skip" | Case_aux c "Seq" | Case_aux c "Asgn"
| Case_aux c "If" | Case_aux c "While"
| Case_aux c "Pre" | Case_aux c "Post" ].

Notation "'SKIP' {{ P }}"
:= (DCSkip P)
(at level 10) : dcom_scope.
Notation "l '::=' a {{ P }}"
:= (DCAsgn l a P)
(at level 60, a at next level) : dcom_scope.
Notation "'WHILE' b 'DO' {{ Pbody }} d 'END' {{ Ppost }}"
:= (DCWhile b Pbody d Ppost)
(at level 80, right associativity) : dcom_scope.
Notation "'IFB' b 'THEN' {{ P }} d 'ELSE' {{ P' }} d' 'FI'"
:= (DCIf b P d P' d')
(at level 80, right associativity)  : dcom_scope.
Notation "'=>' {{ P }} d"
:= (DCPre P d)
(at level 90, right associativity)  : dcom_scope.
Notation "{{ P }} d"
:= (DCPre P d)
(at level 90)  : dcom_scope.
Notation "d '=>' {{ P }}"
:= (DCPost d P)
(at level 91, right associativity)  : dcom_scope.
Notation " d ; d' "
:= (DCSeq d d')
(at level 80, right associativity)  : dcom_scope.

Delimit Scope dcom_scope with dcom.

既に定義されているコマンドcomの記法Notationとの衝突を避けるため、dcom_scopeという特別なスコープを導入します。そして、例を宣言% dcomで包み、記法をこのスコープ内で解釈したいことを表します。

注意深い読者は、DCPreコンストラクタに対して2つの記法を定義していることに気付くでしょう。=>を使うものと使わないものです。=>を使わないものは、プログラムの一番最初の事前条件を与える意図で用意したものです。

Example dec_while : dcom := (
{{ fun st => True }}
WHILE (BNot (BEq (AId X) (ANum 0)))
DO
{{ fun st => ~(asnat (st X) = 0) }}
X ::= (AMinus (AId X) (ANum 1))
{{ fun _ => True }}
END
{{ fun st => asnat (st X) = 0 }}
) % dcom.

dcomからcomに変換するのは簡単です。アノテーションをすべて消せば良いのです。

Fixpoint extract (d:dcom) : com :=
match d with
| DCSkip _          => SKIP
| DCSeq d1 d2       => (extract d1 ; extract d2)
| DCAsgn V a _      => V ::= a
| DCIf b _ d1 _ d2  => IFB b THEN extract d1 ELSE extract d2 FI
| DCWhile b _ d _   => WHILE b DO extract d END
| DCPre _ d         => extract d
| DCPost d _        => extract d
end.

dcomの定義のどこに表明を置くかの選択は、ちょっと微妙です。一番簡単な方法は、すべてのdcomに事前条件と事後条件の表明を付けてしまうことかもしれません。しかしそうすると、同じアノテーションが繰替えされて、とてもうるさいプログラムになってしまうでしょう。例えば、SKIP;SKIPは次のように表明が付加されることになります。

{{P}} ({{P}} SKIP {{P}}) ; ({{P}} SKIP {{P}}) {{P}},

それぞれのSKIPの事前条件、事後条件と、さらにセミコロンの事前条件、事後条件として同じものが付加されています!

この代わりに、次の規則に従うことにします:

- dcom``dに対する事後条件はdに埋め込む

- 事前条件はコンテキストから与えられるようにする。

言い換えると、この表現での不変条件は、dcom``dと事前条件Pがホーアの三つ組{{P}} (extract d) {{post d}}を決定するということです。ここでpostは次のように定義されます:

Fixpoint post (d:dcom) : Assertion :=
match d with
| DCSkip P                => P
| DCSeq d1 d2             => post d2
| DCAsgn V a Q            => Q
| DCIf  _ _ d1 _ d2       => post d1
| DCWhile b Pbody c Ppost => Ppost
| DCPre _ d               => post d
| DCPost c Q              => Q
end.

修飾付きプログラムから「最初の事前条件」を抽出する同様の関数が定義できます。

Fixpoint pre (d:dcom) : Assertion :=
match d with
| DCSkip P                => fun st => True
| DCSeq c1 c2             => pre c1
| DCAsgn V a Q            => fun st => True
| DCIf  _ _ t _ e         => fun st => True
| DCWhile b Pbody c Ppost => fun st => True
| DCPre P c               => P
| DCPost c Q              => pre c
end.

この関数は、最弱事前条件を計算する、というような洗練されたことは何もしません。単に、プログラムの一番最初から明示的に付加されたアノテーションを再帰的に探します。もし(代入だけのものやSKIPのように)明示的事前条件を持たない場合には、デフォルトの答えを返します。

preとpostを使い、修飾付きプログラムの一番最初には常に明示的な事前条件のアノテーションを付ける慣習を守ることを仮定すると、修飾付きプログラムが正しいとはどういうことかを以下のように表現できます:

Definition dec_correct (d:dcom) :=
{{pre d}} (extract d) {{post d}}.

このホーアの三つ組が正しい(valid)かどうかをチェックするには、修飾付きプログラムから「証明課題」(“proof obligations”)を抽出することが必要となります。この課題は、しばしば検証条件(verification conditions)と呼ばれます。なぜなら、修飾が論理的に整合していて、全体として正しさの証明になることを確認するために(修飾付きプログラムを調べるプロセスによって)検証されるべき事実だからです。

検証条件の抽出

最初に、記法について少々:

Definition assert_implies (P Q : Assertion) : Prop :=
forall st, P st -> Q st.

assert_implies P QをP ~~> Q(ASCIIでは,P ~``~> Q)と書きます。

Notation "P ~~> Q" := (assert_implies P Q) (at level 80).
Notation "P <~~> Q" := (P ~~> Q /\ Q ~~> P) (at level 80).

次に、主要な定義です。関数verification_conditionsはdcom``dと事前条件Pをとり、命題(proposition)を返します。その命題は、もし証明できたならば、三つ組{{P}} (extract d) {{post d}}が正しいことになります。この関数はその命題を作るために、dを調べまわって、すべてのローカルチェックの / (and)をとります。ローカルチェックとは、前に修飾付きプログラムについての非形式的規則のところでリストアップしたもののことです。(厳密に言うと、帰結規則の使用法を拡げるために非形式的規則をちょっと揉んでやる必要があります。ただ、対応関係は明確でしょう。)

Fixpoint verification_conditions (P : Assertion) (d:dcom) : Prop :=
match d with
| DCSkip Q          =>
(P ~~> Q)
| DCSeq d1 d2      =>
verification_conditions P d1
/\ verification_conditions (post d1) d2
| DCAsgn V a Q      =>
(P ~~> assn_sub V a Q)
| DCIf b P1 t P2 e  =>
((fun st => P st /\ bassn b st) ~~> P1)
/\ ((fun st => P st /\ ~ (bassn b st)) ~~> P2)
/\ (post t = post e)
/\ verification_conditions P1 t
/\ verification_conditions P2 e
| DCWhile b Pbody d Ppost      =>

(P ~~> post d)
/\ ((fun st => post d st /\ bassn b st) <~~> Pbody)
/\ ((fun st => post d st /\ ~(bassn b st)) <~~> Ppost)
/\ verification_conditions (fun st => post d st /\ bassn b st) d
| DCPre P' d         =>
(P ~~> P') /\ verification_conditions P' d
| DCPost d Q        =>
verification_conditions P d /\ (post d ~~> Q)
end.

そしてついに、主定理です。この定理は、verification_conditions関数が正しくはたらくことを主張します。当然ながら、その証明にはホーア論理のすべての規則が必要となります。

これまで、いろいろなタクティックについて、ゴールではなくコンテキストの値に適用する別形を使ってきました。このアイデアの拡張が構文tactic in *です。この構文では、tacticをゴールとコンテキストのすべての仮定とに適用します。このしくみは、下記のようにsimplタクティックと組み合わせて使うのが普通です。

Theorem verification_correct : forall d P,
verification_conditions P d -> {{P}} (extract d) {{post d}}.
Proof.
dcom_cases (induction d) Case; intros P H; simpl in *.
Case "Skip".
eapply hoare_consequence_pre.
apply hoare_skip.
assumption.
Case "Seq".
inversion H as [H1 H2]. clear H.
eapply hoare_seq.
apply IHd2. apply H2.
apply IHd1. apply H1.
Case "Asgn".
eapply hoare_consequence_pre.
apply hoare_asgn.
assumption.
Case "If".
inversion H as [HPre1 [HPre2 [HQeq [HThen HElse]]]]; clear H.
apply hoare_if.
eapply hoare_consequence_pre. apply IHd1. apply HThen. assumption.
simpl. rewrite HQeq.
eapply hoare_consequence_pre. apply IHd2. apply HElse. assumption.
Case "While".
rename a into Pbody. rename a0 into Ppost.
inversion H as [Hpre [Hbody [Hpost Hd]]]; clear H.
eapply hoare_consequence.
apply hoare_while with (P := post d).
apply IHd. apply Hd.
assumption. apply Hpost.
Case "Pre".
inversion H as [HP Hd]; clear H.
eapply hoare_consequence_pre. apply IHd. apply Hd. assumption.
Case "Post".
inversion H as [Hd HQ]; clear H.
eapply hoare_consequence_post. apply IHd. apply Hd. assumption.
Qed.

例

verification_conditionsが生成する命題はかなり大きく、/ でつながれた命題の中には本質的に自明なものも多く含まれます。

Eval simpl in (verification_conditions (fun st => True) dec_while).

ここまで見てきたタクティックだけを使うことでこれらの命題の証明を進めることは確かにできるのですが、いくらか自動化を入れることで、よりスムーズに進められるようにできます。最初に自前のタクティックverifyを定義します。このタクティックは、split を繰り返し適用して/、その後omegaとeauto(便利な一般用途のタクティック。後に詳しく議論します)を適用可能な限り使います。

Tactic Notation "verify" :=
try apply verification_correct;
repeat split;
simpl; unfold assert_implies;
unfold bassn in *; unfold beval in *; unfold aeval in *;
unfold assn_sub; simpl in *;
intros;
repeat match goal with [H : _ /\ _ |- _] => destruct H end;
try eauto; try omega.

verify適用後残るのは、修飾の正しさをチェックするのに「興味深い部分だけ」です。例えば:

Theorem dec_while_correct :
dec_correct dec_while.
Proof.
verify; destruct (asnat (st X)).
inversion H0.
unfold not. intros. inversion H1.
apply ex_falso_quodlibet. apply H. reflexivity.
reflexivity.
reflexivity.
apply ex_falso_quodlibet. apply H0. reflexivity.
unfold not. intros. inversion H0.
inversion H.
Qed.

別の例(前に見た修飾付きプログラムを形式化したもの)です:

Example subtract_slowly_dec (x:nat) (z:nat) : dcom := (
{{ fun st => asnat (st X) = x /\ asnat (st Z) = z }}
WHILE BNot (BEq (AId X) (ANum 0))
DO   {{ fun st => asnat (st Z) - asnat (st X) = z - x
/\ bassn (BNot (BEq (AId X) (ANum 0))) st }}
Z ::= AMinus (AId Z) (ANum 1)
{{ fun st => asnat (st Z) - (asnat (st X) - 1) = z - x }} ;
X ::= AMinus (AId X) (ANum 1)
{{ fun st => asnat (st Z) - asnat (st X) = z - x }}
END
{{ fun st =>   asnat (st Z)
- asnat (st X)
= z - x
/\ ~ bassn (BNot (BEq (AId X) (ANum 0))) st }}
=>
{{ fun st => asnat (st Z) = z - x }}
) % dcom.

Theorem subtract_slowly_dec_correct : forall x z,
dec_correct (subtract_slowly_dec x z).
Proof.
intros. verify.
rewrite <- H.
assert (H1: update st Z (VNat (asnat (st Z) - 1)) X = st X).
apply update_neq. reflexivity.
rewrite -> H1. destruct (asnat (st X)) as [| X'].
inversion H0. simpl. rewrite <- minus_n_O. omega.
destruct (asnat (st X)).
omega.
apply ex_falso_quodlibet. apply H0. reflexivity.
Qed.

練習問題: ★★★ (slow_assignment_dec)

Xに現在設定されている値を変数Yに代入する遠回りの方法は、Yを0から始め、Xを0になるまで減らしていきながら、その各ステップでYを増やしていくことです。

次が、このアイデアをxをパラメータとする非形式的な修飾付きプログラムで表したものです:

{{ True }}
X ::= x
{{ X = x }} ;
Y ::= 0
{{ X = x /\ Y = 0 }} ;
WHILE X <> 0 DO
{{ X + Y = x /\ X > 0 }}
X ::= X - 1
{{ Y + X + 1 = x }} ;
Y ::= Y + 1
{{ Y + X = x }}
END
{{ Y = x /\ X = 0 }}

対応するdcom型の値を返す関数を記述し、その正しさを証明しなさい。

(* FILL IN HERE *)

☐

練習問題: ★★★★, optional (factorial_dec)

以前に扱った階乗関数を思い出してください:

Fixpoint real_fact (n:nat) : nat :=
match n with
| O => 1
| S n' => n * (real_fact n')
end.

subtract_slowly_decのパターンに倣って、階乗計算の修飾付きImpプログラムを記述し、その正しさを証明しなさい。

(* FILL IN HERE *)

☐

最後に、より大きな例として、新しい道具立てを使ってlist_member_correctの証明を再度行ってみましょう。

verifyタクティックはhoare_consequenceを利用するたびに(つまり修飾付きプログラムに=>が現れるたびに)サブゴールを作ることに注意します。これらの含意は、リストについての事実(例えばl ++ [= l]など)に依存しています。言い換えると、ホーア論理のインフラは命令型プログラムの実行についての一般的な部分を扱い、一方ユーザは(例えば数値のリストという)問題領域特有の補題を証明しなければなりません。

Definition list_member_dec (n : nat) (l : list nat) : dcom := (
{{ fun st => st X = VList l /\ st Y = VNat n /\ st Z = VNat 0 }}
WHILE BIsCons (AId X)
DO {{ fun st => st Y = VNat n
/\ (exists p, p ++ aslist (st X) = l
/\ (st Z = VNat 1 <-> appears_in n p))
/\ bassn (BIsCons (AId X)) st }}
IFB (BEq (AId Y) (AHead (AId X))) THEN
{{ fun st =>
((st Y = VNat n
/\ (exists p, p ++ aslist (st X) = l
/\ (st Z = VNat 1 <-> appears_in n p)))
/\ bassn (BIsCons (AId X)) st)
/\ bassn (BEq (AId Y) (AHead (AId X))) st }}
=>
{{ fun st =>
st Y = VNat n
/\ (exists p, p ++ tail (aslist (st X)) = l
/\ (VNat 1 = VNat 1 <-> appears_in n p)) }}
Z ::= ANum 1
{{ fun st => st Y = VNat n
/\ (exists p, p ++ tail (aslist (st X)) = l
/\ (st Z = VNat 1 <-> appears_in n p)) }}
ELSE
{{ fun st =>
((st Y = VNat n
/\ (exists p, p ++ aslist (st X) = l
/\ (st Z = VNat 1 <-> appears_in n p)))
/\ bassn (BIsCons (AId X)) st)
/\ ~bassn (BEq (AId Y) (AHead (AId X))) st }}
=>
{{ fun st =>
st Y = VNat n
/\ (exists p, p ++ tail (aslist (st X)) = l
/\ (st Z = VNat 1 <-> appears_in n p)) }}
SKIP
{{ fun st => st Y = VNat n
/\ (exists p, p ++ tail (aslist (st X)) = l
/\ (st Z = VNat 1 <-> appears_in n p)) }}
FI ;
X ::= (ATail (AId X))
{{ fun st  =>
st Y = VNat n /\
(exists p : list nat, p ++ aslist (st X) = l
/\ (st Z = VNat 1 <-> appears_in n p)) }}
END
{{ fun st =>
(st Y = VNat n
/\ (exists p, p ++ aslist (st X) = l
/\ (st Z = VNat 1 <-> appears_in n p)))
/\ ~bassn (BIsCons (AId X)) st }}
=>
{{ fun st => st Z = VNat 1 <-> appears_in n l }}
) %dcom.

Theorem list_member_correct' : forall n l,
dec_correct (list_member_dec n l).
Proof.
intros n l.
verify.
Case "The loop precondition holds.".
exists []. simpl. split.
rewrite H. reflexivity.
rewrite H1. split; inversion 1.
Case "IF taken".
destruct H2 as  [p [H3 H4]].

remember (aslist (st X)) as x.
destruct x as [|h x'].
inversion H1.
exists (snoc p h).
simpl. split.
rewrite snoc_equation. assumption.
split.
rewrite H in H0.
simpl in H0.
rewrite (beq_true__eq _ _ H0).
intros. apply appears_in_snoc1.
intros. reflexivity.
Case "If not taken".
destruct H2 as [p [H3 H4]].

remember (aslist (st X)) as x.
destruct x as [|h x'].
inversion H1.
exists (snoc p h).
split.
rewrite snoc_equation. assumption.
split.
intros. apply appears_in_snoc2. apply H4. assumption.
intros Hai.  destruct (appears_in_snoc3 _ _ _ Hai).
SCase "later". apply H4. assumption.
SCase "here (absurd)".
subst.
simpl in H0. rewrite H in H0. rewrite beq_nat_refl in H0.
apply ex_falso_quodlibet. apply H0. reflexivity.
Case "Loop postcondition implies desired conclusion (->)".
destruct H2 as [p [H3 H4]].
unfold bassn in H1. simpl in H1.
destruct (aslist (st X)) as [|h x'].
rewrite append_nil in H3. subst. apply H4. assumption.
apply ex_falso_quodlibet. apply H1. reflexivity.
Case "loop postcondition implies desired conclusion (<-)".
destruct H2 as [p [H3 H4]].
unfold bassn in H1. simpl in H1.
destruct (aslist (st X)) as [|h x'].
rewrite append_nil in H3. subst. apply H4. assumption.
apply ex_falso_quodlibet. apply H1. reflexivity.
Qed.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

HoareAsLogic_J: 論理としてのホーア論理

Require Export Hoare_J.

Hoare_J.vにおけるホーア論理の提示を「モデル理論的」(“model-theoretic”)に行うこともできたでしょう。それぞれのコンストラクタに対する証明規則をプログラムの振舞いについての「定理」として提示し、プログラムの正しさ(ホーアの三つ組の正しさ)の証明は、それらの定理をCoq内で直接組み合わせることで構成するのです。

ホーア論理を提示するもう一つの方法は、完全に別個の証明体系を定義することです。コマンドやホーアの三つ組等についての公理と推論規則の集合を定めます。ホーアの三つ組の証明とは、定義されたこの論理で正しく導出されたもののことになります。こうするためには、新しい論理で正しい導出(valid derivations)の帰納的定義を与えれば良いのです。

Inductive hoare_proof : Assertion -> com -> Assertion -> Type :=
| H_Skip : forall P,
hoare_proof P (SKIP) P
| H_Asgn : forall Q V a,
hoare_proof (assn_sub V a Q) (V ::= a) Q
| H_Seq  : forall P c Q d R,
hoare_proof P c Q -> hoare_proof Q d R -> hoare_proof P (c;d) R
| H_If : forall P Q b c1 c2,
hoare_proof (fun st => P st /\ bassn b st) c1 Q ->
hoare_proof (fun st => P st /\ ~(bassn b st)) c2 Q ->
hoare_proof P (IFB b THEN c1 ELSE c2 FI) Q
| H_While : forall P b c,
hoare_proof (fun st => P st /\ bassn b st) c P ->
hoare_proof P (WHILE b DO c END) (fun st => P st /\ ~ (bassn b st))
| H_Consequence  : forall (P Q P' Q' : Assertion) c,
hoare_proof P' c Q' ->
(forall st, P st -> P' st) ->
(forall st, Q' st -> Q st) ->
hoare_proof P c Q
| H_Consequence_pre  : forall (P Q P' : Assertion) c,
hoare_proof P' c Q ->
(forall st, P st -> P' st) ->
hoare_proof P c Q
| H_Consequence_post  : forall (P Q Q' : Assertion) c,
hoare_proof P c Q' ->
(forall st, Q' st -> Q st) ->
hoare_proof P c Q.

Tactic Notation "hoare_proof_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "H_Skip" | Case_aux c "H_Asgn" | Case_aux c "H_Seq"
| Case_aux c "H_If" | Case_aux c "H_While" | Case_aux c "H_Consequence"
| Case_aux c "H_Consequence_pre" | Case_aux c "H_Consequence_post" ].

例えば、ホーアの三つ組

{{assn_sub X (X+1) (assn_sub X (X+2) (X=3))}} X::=X+1; X::=X+2 {{X=3}}.

の導出を表現する証明オブジェクトを構成しましょう。証明オブジェクトを構成するのに Coq のタクティックを使うことができます。

Example sample_proof
: hoare_proof
(assn_sub X (APlus (AId X) (ANum 1))
(assn_sub X (APlus (AId X) (ANum 2))
(fun st => st X = VNat 3) ))
(X ::= APlus (AId X) (ANum 1); (X ::= APlus (AId X) (ANum 2)))
(fun st => st X = VNat 3).
Proof.
apply H_Seq with (assn_sub X (APlus (AId X) (ANum 2))
(fun st => st X = VNat 3)).
apply H_Asgn. apply H_Asgn.
Qed.

練習問題: ★★

これらの証明オブジェクトが真の主張を表現することを証明しなさい。

Theorem hoare_proof_sound : forall P c Q,
hoare_proof P c Q -> {{P}} c {{Q}}.
Proof.
(* FILL IN HERE *) Admitted.

☐

Coqの推論機構をホーア論理についてのメタ定理を証明することに使うこともできます。例えば、Hoare_J.vで見た2つの定理に対応するものを以下に示します。ここではホーアの三つ組の意味論から直接にではなく、ホーア論理の導出(証明可能性)の構文の面から表現します。

最初のものは、すべてのPとcについて、表明{{P}} c {{True}}がホーア論理で証明可能(provable)であることを言うものです。Hoare_J.vにおける意味論的証明と比べて、この証明はより複雑になることに注意して下さい。実際、コマンドcの構造についての帰納法を行う必要があります。

Theorem H_Post_True_deriv:
forall c P, hoare_proof P c (fun _ => True).
Proof.
intro c.
com_cases (induction c) Case; intro P.
Case "SKIP".
eapply H_Consequence_pre.
apply H_Skip.

intros. apply I.
Case "::=".
eapply H_Consequence_pre.
apply H_Asgn.
intros. apply I.
Case ";".
eapply H_Consequence_pre.
eapply H_Seq.
apply (IHc1 (fun _ => True)).
apply IHc2.
intros. apply I.
Case "IFB".
apply H_Consequence_pre with (fun _ => True).
apply H_If.
apply IHc1.
apply IHc2.
intros. apply I.
Case "WHILE".
eapply H_Consequence.
eapply H_While.
eapply IHc.
intros; apply I.
intros; apply I.
Qed.

同様に、任意のcとQについて{{False}} c {{Q}}が証明可能であることを示すことができます。

Lemma False_and_P_imp: forall P Q,
False /\ P -> Q.
Proof.
intros P Q [CONTRA HP].
destruct CONTRA.
Qed.

Tactic Notation "pre_false_helper" constr(CONSTR) :=
eapply H_Consequence_pre;
[eapply CONSTR | intros ? CONTRA; destruct CONTRA].

Theorem H_Pre_False_deriv:
forall c Q, hoare_proof (fun _ => False) c Q.
Proof.
intros c.
com_cases (induction c) Case; intro Q.
Case "SKIP". pre_false_helper H_Skip.
Case "::=". pre_false_helper H_Asgn.
Case ";". pre_false_helper H_Seq. apply IHc1. apply IHc2.
Case "IFB".
apply H_If; eapply H_Consequence_pre.
apply IHc1. intro. eapply False_and_P_imp.
apply IHc2. intro. eapply False_and_P_imp.
Case "WHILE".
eapply H_Consequence_post.
eapply H_While.
eapply H_Consequence_pre.
apply IHc.
intro. eapply False_and_P_imp.
intro. simpl. eapply False_and_P_imp.
Qed.

この形での提示は「ホーア論理の証明を与えること」がどういう意味なのかについて、より明確なイメージを与えてくれます。しかし、実際の証明を記述するという観点からは完全に満足できるものではありません。かなりくどいのです。Hoare_J.vの修飾付きプログラムの形式化の節が、より良い方法を示してくれます。

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Smallstep_J: スモールステップ操作的意味論

Require Export Imp_J.
Require Import Relations.

ここまで見てきた評価器(例えばaexpのもの、bexpのもの、コマンドのもの)はビッグステップスタイルで記述されてきました。つまり、与えられた式がどのように最終的な値になるか(またはコマンドと記憶状態(store)の組がどのように最終記憶状態になるか)を特定していました。「すべてが1つの大きなステップ」で行われました。

このスタイルは単純で多くの目的のために自然な方法です(実際、Gilles Kahn は、この使用を広めた人ですが、彼はこれを自然意味論(natural semantics)と呼びました)。しかし、これではうまくいかないときもあります。特に、この方法は、並列プログラミング言語について話す自然な方法を提供してくれません。並列プログラミング言語の場合、プログラムの「意味」、つまりプログラムがどのように振る舞うかの本質は、入力状態が出力状態にどのように写像されるかだけではなく、途中で通過する状態も含みます。なぜなら、中間状態は並列実行されるコードからも観測されるからです。

ビッグステップスタイルのもう1つの欠点は、より技術的なことですが、ある種のアプリケーションには致命的です。ImpList_J.v で導入した、リストを持つImpの変種を考えましょう。0 + nilのようなプログラムの意味を、数値が期待されるコンテキストでリストが現れたときには、それを0と解釈するものとして定義する方法をとりました。しかしこれはその場限りのものでした。単純に、そのようなプログラムの振る舞いは「未定義」(undefined)と言ってしまった方がよかったでしょう。つまりどのような結果にも評価されないということです。そうすることは簡単にできるでしょう。aevalとbevalの定義方法として(Fixpoint ではなく)帰納的命題を使うだけです。すると、全関数(total function)ではなく部分関数(partial function)にすることができます。

しかしながら、この方法で Imp を定義することには深刻な欠陥があります。この言語には、コマンドが初期状態を終了状態に写像するのに失敗するまったく異なる2種類の理由があります。1つは評価が無限ループに陥ることによるもの、もう1つは、どこかの地点でプログラムが、ブール値の次の値をとるなどの意味のない操作をしようとして、どの評価規則も適用できなくなることによるものです。

この2つの結果、つまり「停止しないこと」と「間違った設定によって行き詰まること」は、まったく別物です。特に、1つ目は許容し(無限ループの可能性を許すことは、プログラミングにwhileのような一般的ループ構造を使う便利さの代償です)、2つ目(これはただの間違いです)は禁じたいのです。これは例えば言語に何らかの「型チェック」(typechecking)を追加することで実現できます。実のところ、これはこのコースの残りの部分の主要なトピックです。最初のステップとして、停止しないことと、間違いによる「行き詰まり状態」を区別することができる別の意味提示方法が必要です。

このように、いろいろな理由で、プログラムの振る舞いを定義し推論するよりきめの細かい方法が欲しいのです。これがこの章のトピックです。与えられたプログラムに対して計算の「アトミックなステップ」がどのように行なわれるかを定める「スモールステップ」の関係によって、「ビッグステップ」のeval関係を置き換えます。

おもちゃの言語

無駄な議論を省くため、定数と足し算だけの極端に単純な言語に戻りましょう。この章の終わりには、同じテクニックをImp言語全体に適用する方法がわかるでしょう。

Inductive tm : Type :=
| tm_const : nat -> tm
| tm_plus : tm -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_const" | Case_aux c "tm_plus" ].

Module SimpleArith0.

次がこの言語の標準的な評価器です。ここまでやってきたのと同じ(ビッグステップの)スタイルで記述されています。

Fixpoint eval (t : tm) : nat :=
match t with
| tm_const n => n
| tm_plus a1 a2 => eval a1 + eval a2
end.

End SimpleArith0.

Module SimpleArith1.

次は同じ評価器を、まったく同じスタイルながら、帰納的に定義された関係によって定式化したものです。再び、「tがnに評価される」を記法t || nで表しています。

------                                (E_Const)
n || n

t1 || n1
t2 || n2
---------------------                          (E_Plus)
t1 + t2 || plus n1 n2

2つ目の規則でn1 + n2ではなくplus n1 n2と書いています。これは、||の左側にある+が抽象構文木のノードであるのに対し、||の右側の加算は数値n1とn2の数学的な和であることを強調するためです。形式的なCoqのバージョンではこの区別についてより堅苦しくなっています。

Reserved Notation " t '||' n " (at level 50, left associativity).

Inductive eval : tm -> nat -> Prop :=
| E_Const : forall n,
tm_const n || n
| E_Plus : forall t1 t2 n1 n2,
t1 || n1 ->
t2 || n2 ->
tm_plus t1 t2 || plus n1 n2

where " t '||' n " := (eval t n).

End SimpleArith1.

次はわずかに変わっています。まだビッグステップスタイルですが、項の最終結果が数値そのものではなく、また項になっています。

Reserved Notation " t '||' t' " (at level 50, left associativity).

Inductive eval : tm -> tm -> Prop :=
| E_Const : forall n1,
tm_const n1 || tm_const n1
| E_Plus : forall t1 n1 t2 n2,
t1 || tm_const n1 ->
t2 || tm_const n2 ->
tm_plus t1 t2 || tm_const (plus n1 n2)

where " t '||' t' " := (eval t t').

(非形式的な規則では、定数「項」nとそのままの「数値」nの区別を省いているので、何も変わらないことに注意します。)

Tactic Notation "eval_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E_Const" | Case_aux c "E_Plus" ].

Module SimpleArith2.

そして、次がスモールステップ版です。

----------------------              (ST_PlusConstConst)
n1 + n2 ==> plus n1 n2

t1 || t1'
-------------------                         (ST_Plus1)
t1 + t2 || t1' + t2

t2 || t2'
-------------------                         (ST_Plus2)
n1 + t2 || n1 + t2'

なお、ここでは記法を簡単にするため変数名を使っています。慣習として、n1とn2は定数(tm_constで構成されるもの)のみを指します。一方t1とt2は任意の項を指します。形式的規則では明示的なコンストラクタを使ってこの区別をします。

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_PlusConstConst : forall n1 n2,
tm_plus (tm_const n1) (tm_const n2) ==> tm_const (plus n1 n2)
| ST_Plus1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_plus t1 t2 ==> tm_plus t1' t2
| ST_Plus2 : forall n1 t2 t2',
t2 ==> t2' ->
tm_plus (tm_const n1) t2 ==> tm_plus (tm_const n1) t2'

where " t '==>' t' " := (step t t').

注目すること:

- 定義しているのは簡約のちょうど1ステップです。 そこでは1つのtm_plusノードがその値に置き換えられます。

- 各ステップでは「最左」の準備ができている(つまり、引数が両方とも定数である)tm_plusノードを探して、それをその場で書き換えます。最初の規則はtm_plusノードをどのように書き換えるかを定めます。残りの2つの規則は、それをどう探すかを定めます。

- 定数の項は、ステップを進めません。

Tactic Notation “step_cases” tactic(first) ident(c) := first; [ Case_aux c “ST_PlusConstConst” | Case_aux c “ST_Plus1” | Case_aux c “ST_Plus2” ].

step関係を使った推論の例を2つ...

もしt1が1ステップでt1'になるならば、tm_plus t1 t2は1ステップでplus t1' t2になります:

Example test_step_1 :
tm_plus
(tm_plus (tm_const 0) (tm_const 3))
(tm_plus (tm_const 2) (tm_const 4))
==>
tm_plus
(tm_const (plus 0 3))
(tm_plus (tm_const 2) (tm_const 4)).
Proof.
apply ST_Plus1. apply ST_PlusConstConst.  Qed.

練習問題: ★★ (test_step_2)

和の右側がステップを進むことができるのは、左側が終了したときだけです:もしt2が1ステップでt2'になるならば、tm_plus (tm_const n) t2は1ステップでtm_plus (tm_const n) t2'になります。(次の証明を完成させなさい):

Example test_step_2 :
tm_plus
(tm_const 0)
(tm_plus
(tm_const 2)
(tm_plus (tm_const 0) (tm_const 3)))
==>
tm_plus
(tm_const 0)
(tm_plus
(tm_const 2)
(tm_const (plus 0 3))).
Proof.
(* FILL IN HERE *) Admitted.

☐

関係==>のおもしろい性質の1つは、Imp プログラムの言語の評価関係と同様、決定性を持つ(deterministic)ということです。

「定理」: 各tに対して、tが1ステップでt'になる(t ==> t'が証明可能な)t'は高々1つである。形式的には、これは、==>が部分関数であるというのと同じです。

「証明スケッチ」:xが1ステップでy1とy2のどちらにもなるとき、y1とy2が等しいことを、step x y1の導出についての帰納法で示す。この導出とstep x y2の導出のそれぞれで使われた最後の規則によって、いくつかの場合がある。

- もし両者ともST_PlusConstConstならば、一致は明らかである。

- 導出が両者ともST_Plus1またはST_Plus2で終わるならば、 帰納法の仮定から成立する。

- 一方がST_PlusConstConstで、他方がST_Plus1またはST_Plus2であることはあり得ない。なぜなら、そうなるためには、xがtm_plus t1 t2の形で(ST_PlusConstConstより)t1とt2が両者とも定数であり、かつt1またはt2がtm_plus ...の形でなければならない。

- 同様に、一方がST_Plus1で他方がST_Plus2であることもあり得ない。 なぜなら、そのためには、xはtm_plus t1 t2の形で、t1がtm_plus t1 t2の形でもtm_const nの形でもなければならないからである。☐

Theorem step_deterministic: partial_function step. Proof. unfold partial_function. intros x y1 y2 Hy1 Hy2. generalize dependent y2. step_cases (induction Hy1) Case; intros y2 Hy2. Case “ST_PlusConstConst”. step_cases (inversion Hy2) SCase. SCase “ST_PlusConstConst”. reflexivity. SCase “ST_Plus1”. inversion H2. SCase “ST_Plus2”. inversion H2. Case “ST_Plus1”. step_cases (inversion Hy2) SCase. SCase “ST_PlusConstConst”. rewrite <- H0 in Hy1. inversion Hy1. SCase “ST_Plus1”. rewrite <- (IHHy1 t1‘0). reflexivity. assumption. SCase “ST_Plus2”. rewrite <- H in Hy1. inversion Hy1. Case “ST_Plus2”. step_cases (inversion Hy2) SCase. SCase “ST_PlusConstConst”. rewrite <- H1 in Hy1. inversion Hy1. SCase “ST_Plus1”. inversion H2. SCase “ST_Plus2”. rewrite <- (IHHy1 t2‘0). reflexivity. assumption. Qed.

End SimpleArith2.

値

定義した1ステップ簡約の定義をちょっとだけ一般化するために少し時間をとりましょう。

関係==>を抽象機械(abstract machine)の定義と考えるのは便利です:

- どの時点でも、機械の状態(state)は項です。

- 機械のステップ(step)は、計算のアトミックな単位です。ここでは、1つの加算処理です。

- 機械の停止状態(halting states)は、さらなる計算が存在しない状態です。

このとき、項tは以下のように評価できます:

- tを機械の開始状態としてとります。

- 次のような機械の状態の列を見つけるために、==>関係を繰り返し使います。 見つけるのは、tから始まり、それぞれの状態から1ステップでその次の状態になる列です。

- もう簡約ができなくなったとき、機械の最終状態を、実行結果として「読み出し」ます。

直観的には、機械の最終状態が常に、あるnについてのtm_const nという形の項になることは明らかです。そのような項を「値」(values)と呼びます。

Inductive value : tm -> Prop :=
v_const : forall n, value (tm_const n).

値の概念を導入したので、これを==>関係の定義に使うことで、ST_Plus2規則をもう少しだけ直観的なものにできます:

----------------------              (ST_PlusConstConst)
n1 + n2 ==> plus n1 n2

t1 || t1'
-------------------                         (ST_Plus1)
t1 + t2 || t1' + t2

t2 || t2'
-------------------                         (ST_Plus2)
v1 + t2 || v1 + t2'

再び、変数名が重要な情報を担っています:慣習として、v1は値のみを変域とし、一方t1とt2は任意の項を変域とします。規則のCoqバージョンでは、同じ目的のために明示的なvalue仮定を使います。

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_PlusConstConst : forall n1 n2,
tm_plus (tm_const n1) (tm_const n2)
==> tm_const (plus n1 n2)
| ST_Plus1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_plus t1 t2 ==> tm_plus t1' t2
| ST_Plus2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
tm_plus v1 t2 ==> tm_plus v1 t2'

where " t '==>' t' " := (step t t').

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_PlusConstConst"
| Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2" ].

練習問題: ★★★, recommended (redo_determinacy)

この変更のサニティチェックのため、決定性を再検証しましょう。

証明スケッチ: もしxが1ステップでy1にもy2にも進むならば、y1とy2が等しいことを示さなければならない。step x y1とstep x y2の導出の最後の規則を考える。

- もし両者ともST_PlusConstConstならば、一致は明らかである。

- 一方がST_PlusConstConstで、他方がST_Plus1またはST_Plus2であることはあり得ない。なぜなら、そうなるためには、xがtm_plus t1 t2の形で(ST_PlusConstConstより)t1とt2が両者とも定数であり、かつt1またはt2がtm_plus ...の形でなければならない。

- 同様に、一方がST_Plus1で他方がST_Plus2であることもあり得ない。 なぜなら、そのためには、xがtm_plus t1 t2の形で、t1はtm_plus t1 t2の形であり、かつ(tm_const nの形であるから)値でもなければならないからである。

- 導出が両者ともST_Plus1またはST_Plus2で終わるならば、 帰納法の仮定から成立する。☐

証明のほとんどは前のものと同じです。しかし、練習問題の効果を最大にするために、ゼロから証明を書き、前のものを見るのは行き詰まった時だけにしなさい。

Theorem step_deterministic :
partial_function step.
Proof.
(* FILL IN HERE *) Admitted.

☐

強進行と正規形

おもちゃの言語に対する1ステップの簡約の定義はかなり単純です。しかし、より大きな言語に対しては、何か規則を忘れてしまうことは簡単に起き、項が完全に値に簡約されていないのにステップを進めなくなってしまうことが発生します。次の定理は、このような間違いをしていないことを示します。

「定理(強進行)」(Strong Progress):すべてのt:tmについてtは値であるか、ある項t'があってt ==> t'となる。

「証明」:tについての帰納法で証明する。

- t = tm_const nとする。すると、tはvalue(値)である。

- t = tm_plus t1 t2と仮定する。ここで(帰納仮定から)t1は値であるか、1ステップであるt1'になり、また、t2は値であるか、1ステップであるt2'になる。ここで必要なのは、tm_plus t1 t2が値であるか、あるt'に1ステップで進むということを示すことである。

- もしt1とt2がともに値なら、ST_PlusConstConstによりtはステップを進むことができる。

- もしt1が値でt2がステップを進むことができるならば、ST_Plus2によりtもステップを進むことができる。

- もしt1がステップを進むことができるならば、ST_Plus1によりtもステップを進むことができる。☐

この重要な性質は「強進行」(strong progress)と呼ばれます。これは、すべての項が値であるか、別の項に「進行できる」(“make progress”)ことからきた名称です。「強」(“strong”)という修飾句は、後の章のより細分されたバージョン(単に「進行」(“progress”)と呼ばれる)と区別するためのものです。

Theorem strong_progress : forall t,
value t \/ (exists t', t ==> t').
Proof.
tm_cases (induction t) Case.
Case "tm_const". left. apply v_const.
Case "tm_plus". right. inversion IHt1.
SCase "l". inversion IHt2.
SSCase "l". inversion H. inversion H0.
exists (tm_const (plus n n0)).
apply ST_PlusConstConst.
SSCase "r". inversion H0 as [t' H1].
exists (tm_plus t1 t').
apply ST_Plus2. apply H. apply H1.
SCase "r". inversion H as [t' H0].
exists (tm_plus t' t2).
apply ST_Plus1. apply H0.  Qed.

「進行する」という概念の拡張から、value(値)についての興味深い性質がわかります:値とはこの意味で進行「できない」項のことに他なりません。この事実を述べるために、進行できない項に名前をつけましょう。そういう項を「正規形」(normal form)と呼びます。

Definition normal_form {X:Type} (R:relation X) (t:X) : Prop :=
~ exists t', R t t'.

この定義は実際には、任意の集合Xの上の「任意の」関係Rについて、何が正規形であるかを定めています。今興味対象としている、項の上の特定の1ステップ簡約関係に限るものではありません。このコースで後に、別の関係の議論において同じ用語法を用います。

強進行定理の洞察を一般化するためにこの用語を使います。この言語では、正規形と値とは実質的に同じものです。

Lemma value_is_nf : forall t,
value t -> normal_form step t.
Proof.
unfold normal_form. intros t H. inversion H.
intros contra. inversion contra. inversion H1.
Qed.

Lemma nf_is_value : forall t,
normal_form step t -> value t.
Proof.
unfold normal_form. intros t H.
assert (G : value t \/ exists t', t ==> t').
SCase "Proof of assertion". apply strong_progress.
inversion G.
SCase "l". apply H0.
SCase "r". apply ex_falso_quodlibet. apply H. assumption.  Qed.

Corollary nf_same_as_value : forall t,
normal_form step t <-> value t.
Proof.
split. apply nf_is_value. apply value_is_nf.
Qed.

なぜこれが興味深いのでしょう？ 2つの理由があります:

- なぜならvalue(値)は構文的概念です。つまり項の形を見ることで定義されます。 一方normal_form(正規形)は意味論的なものです。つまり項がどのようにステップを進むかによって定義されます。この2つの概念が一致することは自明ではないのです!

- 実際、正規形と値の概念が一致「しない」言語はたくさん存在します。

これがどうして起こるのか調べてみましょう...

例えば、value(値)の定義を間違えていて、簡約が完了していない項を含んでいるかもしれません。

Module Temp1.

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n)
| v_funny : forall t1 n2,
value (tm_plus t1 (tm_const n2)).

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_PlusConstConst : forall n1 n2,
tm_plus (tm_const n1) (tm_const n2) ==> tm_const (plus n1 n2)
| ST_Plus1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_plus t1 t2 ==> tm_plus t1' t2
| ST_Plus2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
tm_plus v1 t2 ==> tm_plus v1 t2'

where " t '==>' t' " := (step t t').

練習問題: ★★★, recommended (value_not_same_as_normal_form)

Lemma value_not_same_as_normal_form :
exists t, value t /\ ~ normal_form step t.
Proof.
(* FILL IN HERE *) Admitted.

☐

End Temp1.

あるいは、stepの定義を間違えていて、値とされたものをさらに簡約するようになっているかもしれません。

Module Temp2.

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n).

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_Funny : forall n,
tm_const n ==> tm_plus (tm_const n) (tm_const 0)
| ST_PlusConstConst : forall n1 n2,
tm_plus (tm_const n1) (tm_const n2) ==> tm_const (plus n1 n2)
| ST_Plus1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_plus t1 t2 ==> tm_plus t1' t2
| ST_Plus2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
tm_plus v1 t2 ==> tm_plus v1 t2'

where " t '==>' t' " := (step t t').

練習問題: ★★★, recommended (value_not_same_as_normal_form)

Lemma value_not_same_as_normal_form :
exists t, value t /\ ~ normal_form step t.
Proof.
(* FILL IN HERE *) Admitted.

☐

End Temp2.

最後に、valueとstepの定義を間違えていて、ある項について、値でもなく、step関係で1ステップ進むこともできなくなっているかもしれません。そのような項は「行き詰まり」(stuck)と呼ぶべきでしょう。

Module Temp3.

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n).

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_PlusConstConst : forall n1 n2,
tm_plus (tm_const n1) (tm_const n2) ==> tm_const (plus n1 n2)
| ST_Plus1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_plus t1 t2 ==> tm_plus t1' t2

where " t '==>' t' " := (step t t').

(ST_Plus2がないことに注意します。)

練習問題: ★★★ (value_not_same_as_normal_form’)

Lemma value_not_same_as_normal_form :
exists t, ~ value t /\ normal_form step t.
Proof.
(* FILL IN HERE *) Admitted.

☐

End Temp3.

練習問題

Module Temp4.

以下は、別の非常に簡単な言語です。項は、加算と数値の代わりに、真理値 true と false、および条件式です...

Inductive tm : Type :=
| tm_true : tm
| tm_false : tm
| tm_if : tm -> tm -> tm -> tm.

Inductive value : tm -> Prop :=
| v_true : value tm_true
| v_false : value tm_false.

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_IfTrue : forall t1 t2,
tm_if tm_true t1 t2 ==> t1
| ST_IfFalse : forall t1 t2,
tm_if tm_false t1 t2 ==> t2
| ST_If : forall t1 t1' t2 t3,
t1 ==> t1' ->
tm_if t1 t2 t3 ==> tm_if t1' t2 t3

where " t '==>' t' " := (step t t').

練習問題: ★ (smallstep_bools)

以下の命題のうち証明できるものはどれでしょう？(これは単に頭の体操です。しかしさらなるチャレンジとしてCoqで自分の答えを自由に証明してみなさい。)

Definition bool_step_prop1 :=
tm_false ==> tm_false.

(* FILL IN HERE *)

Definition bool_step_prop2 :=
tm_if
tm_true
(tm_if tm_true tm_true tm_true)
(tm_if tm_false tm_false tm_false)
==>
tm_true.

(* FILL IN HERE *)

Definition bool_step_prop3 :=
tm_if
(tm_if tm_true tm_true tm_true)
(tm_if tm_true tm_true tm_true)
tm_false
==>
tm_if
tm_true
(tm_if tm_true tm_true tm_true)
tm_false.

(* FILL IN HERE *)

☐

練習問題: ★★★, recommended (progress_bool)

加算式についてと同様に、ブール式についても進行定理が証明できます。(やってみなさい。)

Theorem strong_progress : forall t,
value t \/ (exists t', t ==> t').
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★, optional (step_deterministic)

Theorem step_deterministic :
partial_function step.
Proof.
(* FILL IN HERE *) Admitted.

☐

Module Temp5.

練習問題: ★★ (smallstep_bool_shortcut)

条件式のthenとelseの枝が同じ値のとき(ともにtm_trueであるか、ともにtm_falseであるかのとき)、ガードが値に簡約されていなくても、条件式全体を枝の値に簡約するように、ステップ関係にバイパスを追加したいとします。例えば次の命題を証明できるようにしたいとします:

tm_if
(tm_if tm_true tm_true tm_true)
tm_false
tm_false
==>
tm_false.

ステップ関係にこのための追加の節を記述し、bool_step_prop4を証明しなさい。

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_IfTrue : forall t1 t2,
tm_if tm_true t1 t2 ==> t1
| ST_IfFalse : forall t1 t2,
tm_if tm_false t1 t2 ==> t2
| ST_If : forall t1 t1' t2 t3,
t1 ==> t1' ->
tm_if t1 t2 t3 ==> tm_if t1' t2 t3
(* FILL IN HERE *)

where " t '==>' t' " := (step t t').

☐

Definition bool_step_prop4 :=
tm_if
(tm_if tm_true tm_true tm_true)
tm_false
tm_false
==>
tm_false.

Example bool_step_prop4_holds :
bool_step_prop4.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★ (properties_of_altered_step)

講義ノートのステップ関係についての決定性定理と強進行定理が、上記のステップの定義についても証明できます。ST_ShortCircuit節を追加した後で...

- step関係はそれでも決定性を持つでしょうか？ yes または no と書き、簡潔に(1文で)その答えを説明しなさい。 Optional: Coq でその答えが正しいことを証明しなさい。

(* FILL IN HERE *)

- 強進行定理は成立するでしょうか？ yes または no と書き、簡潔に(1文で)その答えを説明しなさい。 Optional: Coq でその答えが正しいことを証明しなさい。

(* FILL IN HERE *)

*)

FILL IN HERE

- 一般に、オリジナルのステップ関係から1つ以上のコンストラクタを取り除いて、 強進行性を持たなくする方法はあるでしょうか？yes または no と書き、簡潔に(1文で)その答えを説明しなさい。

(* FILL IN HERE *)

☐

End Temp5.
End Temp4.

マルチステップ簡約

ここまでは、1ステップ簡約関係==>に取り組んできました。これは、プログラムを実行する抽象機械の1つのステップを形式化したものです。

この機械を使って、プログラムを完全に簡約してみるのもおもしろいでしょう。つまり、その最後の結果がどうなるかを調べることです。これは以下のように形式化できます:

- 最初に、「マルチステップ簡約関係」(multi-step reduction relation)==>*を定義します。この関係は、tから1ステップ簡約を何らかの回数回行うことでt'に到達できるとき、tとt'を関係づけるものです。

- 次に項tの結果(“result”)を、tがマルチステップ簡約で到達できる正規形tとして定義します。

マルチステップ簡約(multi-step reduction)関係==>*は1ステップ関係==>の反射推移閉包です。

Definition stepmany := refl_step_closure step.

Notation " t '==>*' t' " := (stepmany t t') (at level 40).

例えば...

Lemma test_stepmany_1:
tm_plus
(tm_plus (tm_const 0) (tm_const 3))
(tm_plus (tm_const 2) (tm_const 4))
==>*
tm_const (plus (plus 0 3) (plus 2 4)).
Proof.
apply rsc_step with
(tm_plus
(tm_const (plus 0 3))
(tm_plus (tm_const 2) (tm_const 4))).
apply ST_Plus1. apply ST_PlusConstConst.
apply rsc_step with
(tm_plus
(tm_const (plus 0 3))
(tm_const (plus 2 4))).
apply ST_Plus2. apply v_const.
apply ST_PlusConstConst.
apply rsc_R.
apply ST_PlusConstConst.  Qed.

以下は別証です。eapplyを使うことで、すべての中間的な項を明示的に構成する必要をなくしたものです。

Lemma test_stepmany_1':
tm_plus
(tm_plus (tm_const 0) (tm_const 3))
(tm_plus (tm_const 2) (tm_const 4))
==>*
tm_const (plus (plus 0 3) (plus 2 4)).
Proof.
eapply rsc_step. apply ST_Plus1. apply ST_PlusConstConst.
eapply rsc_step. apply ST_Plus2. apply v_const.
apply ST_PlusConstConst.
eapply rsc_step. apply ST_PlusConstConst.
apply rsc_refl.  Qed.

練習問題: ★ (test_stepmany_2)

Lemma test_stepmany_2:
tm_const 3 ==>* tm_const 3.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (test_stepmany_3)

Lemma test_stepmany_3:
tm_plus (tm_const 0) (tm_const 3)
==>*
tm_plus (tm_const 0) (tm_const 3).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★ (test_stepmany_4)

Lemma test_stepmany_4:
tm_plus
(tm_const 0)
(tm_plus
(tm_const 2)
(tm_plus (tm_const 0) (tm_const 3)))
==>*
tm_plus
(tm_const 0)
(tm_const (plus 2 (plus 0 3))).
Proof.
(* FILL IN HERE *) Admitted.

☐

正規形再び

tが0以上のステップでt'に簡約され、t'が正規形のとき、「t'はtの正規形である」と言います。

Definition step_normal_form := normal_form step.

Definition normal_form_of (t t' : tm) :=
(t ==>* t' /\ step_normal_form t').

1ステップ簡約が決定性を持つことを既に見ました。つまり、項が1ステップ進む方法は高々1種類だということです。このことから、tが正規形に到達するならば、その正規形は1つに決まることになります。つまり、normal_form_ofは部分関数です。言い換えると、normal_form t t'を、(「t'はtの正規形である」と読む以外に)「tの正規形はt'である」と読んでよいということです。(訳注：原文では “the normal form oft“と定冠詞を使ってよいことと記述されています。)

練習問題: ★★★, optional (test_stepmany_3)

Theorem normal_forms_unique:
partial_function normal_form_of.
Proof.
unfold partial_function. unfold normal_form_of.  intros x y1 y2 P1 P2.
destruct P1 as [P11 P12]. destruct P2 as [P21 P22].
generalize dependent y2.

(* FILL IN HERE *) Admitted.

☐

実のところ、この言語については、より強いことが成立します(これは他のすべての言語で成立することではありません):「任意の」項tはいつかは正規形に到達する、ということです。つまりnormal_form_ofは全関数です。形式的には、step関係は正規化性を持つ(normalizing)と言います。

Definition normalizing {X:Type} (R:relation X) :=
forall t, exists t',
(refl_step_closure R) t t' /\ normal_form R t'.

stepが正規化性を持つことを証明するため、二つの補題を必要とします。

一つは、tがt'に何ステップかで簡約されるならば、tがtm_plusノードの左側の子ノードとして現れるときには、t内で同じ簡約ステップ列が可能である、ということ、そしてまた同様のことが、tが(左側の子ノードが値である)tm_plusの右側の子ノードとして現れるときにも言える、ということです。

Lemma stepmany_congr_1 : forall t1 t1' t2,
t1 ==>* t1' ->
tm_plus t1 t2 ==>* tm_plus t1' t2.
Proof.
intros t1 t1' t2 H. rsc_cases (induction H) Case.
Case "rsc_refl". apply rsc_refl.
Case "rsc_step". apply rsc_step with (tm_plus y t2).
apply ST_Plus1. apply H.
apply IHrefl_step_closure.  Qed.

練習問題: ★★

Lemma stepmany_congr_2 : forall t1 t2 t2',
value t1 ->
t2 ==>* t2' ->
tm_plus t1 t2 ==>* tm_plus t1 t2'.
Proof.
(* FILL IN HERE *) Admitted.

☐

「定理」:step関数は正規化性を持つ。つまり、任意のtに対して、あるt'があって、tからステップを進めるとt'に到達し、かつt'は正規形である、が成立する。

「証明スケッチ」:項についての帰納法を使う。考える対象は2つの場合である:

- あるnについてt = tm_const nである場合。 このとき、tはステップを進めることができないことから、t' = tである。左辺は反射性から導出され、右辺は、(a)(nf_same_as_valueより)値は正規形であること、(b)(v_constより)tは値であること、から導出される。

- あるt1、t2について、t = tm_plus t1 t2である場合。 帰納仮定よりt1とt2はそれぞれ正規形t1'とt2'を持つ。(nf_same_as_valueより)正規形は値であったから、あるn1、n2について、t1' = tm_const n1かつt2' = tm_const n2である。t1とt2についての==>*導出を組合せると、tm_plus t1 t2が幾つかのステップでtm_const (plus n1 n2)に簡約されることを証明できる。 t' = tm_const (plus n1 n2)が値であることは明らかなので、これは正規形である。

Theorem step_normalizing : normalizing step. Proof. unfold normalizing. tm_cases (induction t) Case. Case “tm_const”. exists (tm_const n). split. SCase “l”. apply rsc_refl. SCase “r”.

rewrite nf_same_as_value. apply v_const.
Case "tm_plus".
destruct IHt1 as [t1' H1]. destruct IHt2 as [t2' H2].
destruct H1 as [H11 H12]. destruct H2 as [H21 H22].
rewrite nf_same_as_value in H12. rewrite nf_same_as_value in H22.
inversion H12 as [n1]. inversion H22 as [n2].
rewrite <- H in H11.
rewrite <- H0 in H21.
exists (tm_const (plus n1 n2)).
split.
SCase "l".
apply rsc_trans with (tm_plus (tm_const n1) t2).
apply stepmany_congr_1. apply H11.
apply rsc_trans with
(tm_plus (tm_const n1) (tm_const n2)).
apply stepmany_congr_2. apply v_const. apply H21.
apply rsc_R. apply ST_PlusConstConst.
SCase "r".
rewrite nf_same_as_value. apply v_const.  Qed.

ビッグステップ簡約とスモールステップ簡約の同値性

小さなプログラミング言語に対して2つの異なったスタイルで操作的意味論を定義したので、その2つの定義が本当に同じものを定義しているのかを考えるのは意味があります!実際に定義は一致しているのですが、それを示すことはそれほど簡単にはできません。というより、それを正確に主張することが難しいのです。なぜなら、一方は1回で進むのが小さなステップだけですが、もう一方は大きなまとまりで進むからです。

Lemma eval__value : forall t1 t2,
eval t1 t2 ->
value t2.
Proof.
intros t1 t2 HE.
eval_cases (inversion HE) Case; apply v_const.  Qed.

練習問題: ★★★ (eval__stepmany)

この証明のために合同とrscのいくつかの性質を使うのが良いでしょう。

Theorem eval__stepmany : forall t v,
eval t v -> t ==>* v.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★ (eval__stepmany_inf)

[]
*)

ここを埋めなさい eval__stepmany の証明の非形式版を記述しなさい。

(* ここを埋めなさい *)☐

練習問題: ★★★ (step__eval)

Theorem step__eval : forall t t' v,
t ==> t' ->
t' || v ->
t || v.
Proof.
(* FILL IN HERE *) Admitted.

☐

Theorem stepmany__eval : forall t v,
normal_form_of t v -> t || v.
Proof.
intros t v Hnorm.
unfold normal_form_of in Hnorm.
inversion Hnorm as [Hs Hnf]; clear Hnorm.

rewrite nf_same_as_value in Hnf. inversion Hnf. clear Hnf.
rsc_cases (induction Hs) Case; subst.
Case "rsc_refl".
apply E_Const.
Case "rsc_step".
eapply step__eval. eassumption. apply IHHs. reflexivity.  Qed.

全部まとめることで、vがtの正規形であるのは、tがvに評価されるのと同値である、とはっきりと言うことができます。

Corollary stepmany_iff_eval : forall t v,
normal_form_of t v <-> t || v.
Proof.
split.
Case "->". apply stepmany__eval.
Case "<-". unfold normal_form_of. intros E. split. apply eval__stepmany.
assumption. rewrite nf_same_as_value. eapply eval__value. eassumption.  Qed.

さらなる練習問題

練習問題: ★★★★ (combined_properties)

ここまでに算術式と条件式を別々に考えてきました。この練習問題ではこの2つがどのように相互作用するかを調べます。

Module Combined.

Inductive tm : Type :=
| tm_const : nat -> tm
| tm_plus : tm -> tm -> tm
| tm_true : tm
| tm_false : tm
| tm_if : tm -> tm -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_const" | Case_aux c "tm_plus"
| Case_aux c "tm_true" | Case_aux c "tm_false" | Case_aux c "tm_if" ].

Inductive value : tm -> Prop :=
| v_const : forall n, value (tm_const n)
| v_true : value tm_true
| v_false : value tm_false.

Reserved Notation " t '==>' t' " (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_PlusConstConst : forall n1 n2,
tm_plus (tm_const n1) (tm_const n2) ==> tm_const (plus n1 n2)
| ST_Plus1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_plus t1 t2 ==> tm_plus t1' t2
| ST_Plus2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
tm_plus v1 t2 ==> tm_plus v1 t2'
| ST_IfTrue : forall t1 t2,
tm_if tm_true t1 t2 ==> t1
| ST_IfFalse : forall t1 t2,
tm_if tm_false t1 t2 ==> t2
| ST_If : forall t1 t1' t2 t3,
t1 ==> t1' ->
tm_if t1 t2 t3 ==> tm_if t1' t2 t3

where " t '==>' t' " := (step t t').

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_PlusConstConst"
| Case_aux c "ST_Plus1" | Case_aux c "ST_Plus2"
| Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ].

前には、plus式とif式について、以下のことを別々に証明しました...

- ステップ関係が部分関数であること(つまり、決定性を持つこと)。

- すべての項が値であるか、1ステップ進むことができるかを主張する強進行補題。

結合した言語について、これらの性質を証明、または反証しなさい。

(* FILL IN HERE *)

☐

End Combined.

スモールステップ Imp

より本気の例として、Impの操作的意味論のスモールステップ版を示します。定義はより大きくなりますが、基本的な考え方は上述のものとまったく同じです。

Inductive aval : aexp -> Prop :=
av_num : forall n, aval (ANum n).

Reserved Notation " t '/' st '==>a' t' " (at level 40, st at level 39).

Inductive astep : state -> aexp -> aexp -> Prop :=
| AS_Id : forall st i,
AId i / st ==>a ANum (st i)
| AS_Plus : forall st n1 n2,
APlus (ANum n1) (ANum n2) / st ==>a ANum (plus n1 n2)
| AS_Plus1 : forall st a1 a1' a2,
a1 / st ==>a a1' ->
(APlus a1 a2) / st ==>a (APlus a1' a2)
| AS_Plus2 : forall st v1 a2 a2',
aval v1 ->
a2 / st ==>a a2' ->
(APlus v1 a2) / st ==>a (APlus v1 a2')
| AS_Minus : forall st n1 n2,
(AMinus (ANum n1) (ANum n2)) / st ==>a (ANum (minus n1 n2))
| AS_Minus1 : forall st a1 a1' a2,
a1 / st ==>a a1' ->
(AMinus a1 a2) / st ==>a (AMinus a1' a2)
| AS_Minus2 : forall st v1 a2 a2',
aval v1 ->
a2 / st ==>a a2' ->
(AMinus v1 a2) / st ==>a (AMinus v1 a2')
| AS_Mult : forall st n1 n2,
(AMult (ANum n1) (ANum n2)) / st ==>a (ANum (mult n1 n2))
| AS_Mult1 : forall st a1 a1' a2,
a1 / st ==>a a1' ->
(AMult (a1) (a2)) / st ==>a (AMult (a1') (a2))
| AS_Mult2 : forall st v1 a2 a2',
aval v1 ->
a2 / st ==>a a2' ->
(AMult v1 a2) / st ==>a (AMult v1 a2')

where " t '/' st '==>a' t' " := (astep st t t').

Reserved Notation " t '/' st '==>b' t' " (at level 40, st at level 39).

Inductive bstep : state -> bexp -> bexp -> Prop :=
| BS_Eq : forall st n1 n2,
(BEq (ANum n1) (ANum n2)) / st ==>b
(if (beq_nat n1 n2) then BTrue else BFalse)
| BS_Eq1 : forall st a1 a1' a2,
a1 / st ==>a a1' ->
(BEq a1 a2) / st ==>b (BEq a1' a2)
| BS_Eq2 : forall st v1 a2 a2',
aval v1 ->
a2 / st ==>a a2' ->
(BEq v1 a2) / st ==>b (BEq v1 a2')
| BS_LtEq : forall st n1 n2,
(BLe (ANum n1) (ANum n2)) / st ==>b
(if (ble_nat n1 n2) then BTrue else BFalse)
| BS_LtEq1 : forall st a1 a1' a2,
a1 / st ==>a a1' ->
(BLe a1 a2) / st ==>b (BLe a1' a2)
| BS_LtEq2 : forall st v1 a2 a2',
aval v1 ->
a2 / st ==>a a2' ->
(BLe v1 a2) / st ==>b (BLe v1 (a2'))
| BS_NotTrue : forall st,
(BNot BTrue) / st ==>b BFalse
| BS_NotFalse : forall st,
(BNot BFalse) / st ==>b BTrue
| BS_NotStep : forall st b1 b1',
b1 / st ==>b b1' ->
(BNot b1) / st ==>b (BNot b1')
| BS_AndTrueTrue : forall st,
(BAnd BTrue BTrue) / st ==>b BTrue
| BS_AndTrueFalse : forall st,
(BAnd BTrue BFalse) / st ==>b BFalse
| BS_AndFalse : forall st b2,
(BAnd BFalse b2) / st ==>b BFalse
| BS_AndTrueStep : forall st b2 b2',
b2 / st ==>b b2' ->
(BAnd BTrue b2) / st ==>b (BAnd BTrue b2')
| BS_AndStep : forall st b1 b1' b2,
b1 / st ==>b b1' ->
(BAnd b1 b2) / st ==>b (BAnd b1' b2)

where " t '/' st '==>b' t' " := (bstep st t t').

実際にはブール値の定義にかかずらってはいなかったことに注意します。==>bの定義にはブール値の定義は必要ありません(なぜでしょう？)。言語がちょっと大きかったら必要になったかもしれませんが。

コマンドの意味論は興味深い部分です。うまくやるために2つの小さなトリックを使います:

- SKIPを「コマンド値」(“command value”)として使います。 つまり、正規形に逹したコマンドです。

- 代入コマンドはSKIPに簡約されます(その際に状態を更新します)。

- コマンド合成は、左側の部分コマンドがSKIPに簡約されるのを待って、 それを捨ててしまいます。そして続けて右側の部分コマンドの簡約をします。

- WHILEコマンドの簡約は、条件文とそれに続く同じWHILEコマンドになります。(求められる効果を得るために他にもいろいろな方法はありますが、いずれも、もとのWHILEコマンドをどこかに保存して、ループ本体の1コピーを評価することには変わりありません。)

Reserved Notation ” t ‘/’ st ‘==>’ t’ ‘/’ st’ ” (at level 40, st at level 39, t’ at level 39).

Inductive cstep : (com * state) -> (com * state) -> Prop := | CS_AssStep : forall st i a a’, a / st ==>a a’ -> (i ::= a) / st ==> (i ::= a’) / st | CS_Ass : forall st i n, (i ::= (ANum n)) / st ==> SKIP / (update st i n) | CS_SeqStep : forall st c1 c1’ st’ c2, c1 / st ==> c1’ / st’ -> (c1 ; c2) / st ==> (c1’ ; c2) / st’ | CS_SeqFinish : forall st c2, (SKIP ; c2) / st ==> c2 / st | CS_IfTrue : forall st c1 c2, IFB BTrue THEN c1 ELSE c2 FI / st ==> c1 / st | CS_IfFalse : forall st c1 c2, IFB BFalse THEN c1 ELSE c2 FI / st ==> c2 / st | CS_IfStep : forall st b b’ c1 c2, b / st ==>b b’ -> IFB b THEN c1 ELSE c2 FI / st ==> (IFB b’ THEN c1 ELSE c2 FI) / st | CS_While : forall st b c1, (WHILE b DO c1 END) / st ==> (IFB b THEN (c1; (WHILE b DO c1 END)) ELSE SKIP FI) / st

where ” t ‘/’ st ‘==>’ t’ ‘/’ st’ ” := (cstep (t,st) (t’,st’)).

並列実行 Imp

最後に、この定義スタイルの力を示すために、Imp に平行動作のコマンドを拡張しましょう。このコマンドは2つのサブコマンドを平行実行し、両者が終了した時点で終了します。スケジューリングの予測不能性を反映して、サブコマンドのアクションは任意の順序でインターリーブします。しかし、同じメモリをシェアし、同じ変数を読み書きすることでコミュニケーションできます。

Module CImp.

Inductive com : Type :=
| CSkip : com
| CAss : id -> aexp -> com
| CSeq : com -> com -> com
| CIf : bexp -> com -> com -> com
| CWhile : bexp -> com -> com

| CPar : com -> com -> com.

Tactic Notation "com_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "SKIP" | Case_aux c "::=" | Case_aux c ";"
| Case_aux c "IFB" | Case_aux c "WHILE" | Case_aux c "PAR" ].

Notation "'SKIP'" :=
CSkip.
Notation "l '::=' a" :=
(CAss l a) (at level 60).
Notation "c1 ; c2" :=
(CSeq c1 c2) (at level 80, right associativity).
Notation "'WHILE' b 'DO' c 'END'" :=
(CWhile b c) (at level 80, right associativity).
Notation "'IFB' e1 'THEN' e2 'ELSE' e3 'FI'" :=
(CIf e1 e2 e3) (at level 80, right associativity).
Notation "'PAR' c1 'WITH' c2 'END'" :=
(CPar c1 c2) (at level 80, right associativity).

Inductive cstep : (com * state)  -> (com * state) -> Prop :=
| CS_AssStep : forall st i a a',
a / st ==>a a' ->
(i ::= a) / st ==> (i ::= a') / st
| CS_Ass : forall st i n,
(i ::= (ANum n)) / st ==> SKIP / (update st i n)
| CS_SeqStep : forall st c1 c1' st' c2,
c1 / st ==> c1' / st' ->
(c1 ; c2) / st ==> (c1' ; c2) / st'
| CS_SeqFinish : forall st c2,
(SKIP ; c2) / st ==> c2 / st
| CS_IfTrue : forall st c1 c2,
(IFB BTrue THEN c1 ELSE c2 FI) / st ==> c1 / st
| CS_IfFalse : forall st c1 c2,
(IFB BFalse THEN c1 ELSE c2 FI) / st ==> c2 / st
| CS_IfStep : forall st b b' c1 c2,
b /st ==>b b' ->
(IFB b THEN c1 ELSE c2 FI) / st ==> (IFB b' THEN c1 ELSE c2 FI) / st
| CS_While : forall st b c1,
(WHILE b DO c1 END) / st ==>
(IFB b THEN (c1; (WHILE b DO c1 END)) ELSE SKIP FI) / st

| CS_Par1 : forall st c1 c1' c2 st',
c1 / st ==> c1' / st' ->
(PAR c1 WITH c2 END) / st ==> (PAR c1' WITH c2 END) / st'
| CS_Par2 : forall st c1 c2 c2' st',
c2 / st ==> c2' / st' ->
(PAR c1 WITH c2 END) / st ==> (PAR c1 WITH c2' END) / st'
| CS_ParDone : forall st,
(PAR SKIP WITH SKIP END) / st ==> SKIP / st
where " t '/' st '==>' t' '/' st' " := (cstep (t,st) (t',st')).

Definition cstepmany := refl_step_closure cstep.

Notation " t '/' st '==>*' t' '/' st' " :=
(refl_step_closure cstep  (t,st) (t',st'))
(at level 40, st at level 39, t' at level 39).

この言語のいろいろな興味深い性質の中でも格別なものは、次のプログラムが、変数Xにどのような値を入れても停止するという事実です...

Definition par_loop : com :=
PAR
Y ::= ANum 1
WITH
WHILE BEq (AId Y) (ANum 0) DO
X ::= APlus (AId X) (ANum 1)
END
END.

特に、Xを0にしても停止できます:

Example par_loop_example_0:
exists st',
par_loop / empty_state  ==>* SKIP / st'
/\ st' X = 0.
Proof.
eapply ex_intro. split.
unfold par_loop.
eapply rsc_step. apply CS_Par1.
apply CS_Ass.
eapply rsc_step. apply CS_Par2. apply CS_While.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq1. apply AS_Id.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq. simpl.
eapply rsc_step. apply CS_Par2. apply CS_IfFalse.
eapply rsc_step. apply CS_ParDone.
eapply rsc_refl.
reflexivity. Qed.

Xを2にしても停止します:

Example par_loop_example_2:
exists st',
par_loop / empty_state ==>* SKIP / st'
/\ st' X = 2.
Proof.
eapply ex_intro. split.
eapply rsc_step. apply CS_Par2. apply CS_While.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq1. apply AS_Id.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq. simpl.
eapply rsc_step. apply CS_Par2. apply CS_IfTrue.
eapply rsc_step. apply CS_Par2. apply CS_SeqStep.
apply CS_AssStep. apply AS_Plus1. apply AS_Id.
eapply rsc_step. apply CS_Par2. apply CS_SeqStep.
apply CS_AssStep. apply AS_Plus.
eapply rsc_step. apply CS_Par2. apply CS_SeqStep.
apply CS_Ass.
eapply rsc_step. apply CS_Par2. apply CS_SeqFinish.

eapply rsc_step. apply CS_Par2. apply CS_While.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq1. apply AS_Id.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq. simpl.
eapply rsc_step. apply CS_Par2. apply CS_IfTrue.
eapply rsc_step. apply CS_Par2. apply CS_SeqStep.
apply CS_AssStep. apply AS_Plus1. apply AS_Id.
eapply rsc_step. apply CS_Par2. apply CS_SeqStep.
apply CS_AssStep. apply AS_Plus.
eapply rsc_step. apply CS_Par2. apply CS_SeqStep.
apply CS_Ass.

eapply rsc_step. apply CS_Par1. apply CS_Ass.
eapply rsc_step. apply CS_Par2. apply CS_SeqFinish.
eapply rsc_step. apply CS_Par2. apply CS_While.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq1. apply AS_Id.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq. simpl.
eapply rsc_step. apply CS_Par2. apply CS_IfFalse.
eapply rsc_step. apply CS_ParDone.
eapply rsc_refl.
reflexivity. Qed.

より一般に...

練習問題: ★★★, optional

Lemma par_body_n__Sn : forall n st,
st X = n /\ st Y = 0 ->
par_loop / st ==>* par_loop / (update st X (S n)).
Proof.
(* FILL IN HERE *) Admitted.

練習問題: ★★★, optional

Lemma par_body_n : forall n st,
st X = 0 /\ st Y = 0 ->
exists st',
par_loop / st ==>*  par_loop / st' /\ st' X = n /\ st' Y = 0.
Proof.
(* FILL IN HERE *) Admitted.

... 上のループはXがどんな値をとっても抜け出せます。

Theorem par_loop_any_X:
forall n, exists st',
par_loop / empty_state ==>*  SKIP / st'
/\ st' X = n.
Proof.
intros n.
destruct (par_body_n n empty_state).
split; unfold update; reflexivity.

rename x into st.
destruct H as [H' [HX HY]].
exists (update st Y 1). split.
eapply rsc_trans with (par_loop,st). apply H'.
eapply rsc_step. apply CS_Par1. apply CS_Ass.
eapply rsc_step. apply CS_Par2. apply CS_While.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq1. apply AS_Id. rewrite update_eq.
eapply rsc_step. apply CS_Par2. apply CS_IfStep.
apply BS_Eq. simpl.
eapply rsc_step. apply CS_Par2. apply CS_IfFalse.
eapply rsc_step. apply CS_ParDone.
apply rsc_refl.

rewrite update_neq. assumption. reflexivity.
Qed.

End CImp.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Types_J: 型システム

Require Export Smallstep_J.

次に取り組むのは型システムです。型システムは、式をその評価結果の「かたち」で分類する静的解析手法です。まずは、ブール値と数のみから成る言語から始め、型に関する基本的な考え方や型付け規則、型保存（type preservation）や進行（progress）といった型システムに関する基礎的な定理を導入します。その次に単純型付きラムダ計算に移ります。単純型付きラムダ計算は（Coq を含む）近代的な関数型プログラミング言語すべての中心概念になっています。

さらに自動化

型システムの話を始める前に、 Coq の強力な自動化機能の勉強に時間を割くことにしましょう。

autoとeautoタクティック

autoタクティックを使うと

- intros

- apply（特に指定しなければ、コンテキストにある補題のみを使う）

- reflexivity

を組み合わせて解くことのできるゴールを解くことができます。

eautoタクティックはautoとほとんど同じですが、applyの代わりにeapplyを使います。

autoは失敗することはなく証明の状態を変更しない、すなわち、現在のゴールを完全に解くか何もしない、という意味で常に「安全」です。

わざとらしい例を作って試してみましょう。

Lemma auto_example_1 : forall P Q R S T U : Prop,
(P -> Q) ->
(P -> R) ->
(T -> R) ->
(S -> T -> U) ->
((P->Q) -> (P->S)) ->
T ->
P ->
U.
Proof. auto. Qed.

現在のゴールに対して可能な証明を探索する場合、autoやeautoは現在のコンテキストにある補題だけでなく、他の補題や構成子を登録したヒントデータベースを使います。これまでに出てきた補題や構成子のうちconjやor_introl、or_introrといった、いくつかのものは特に設定しなくてもヒントデータベースに登録されています。

Lemma auto_example_2 : forall P Q R : Prop,
Q ->
(Q -> R) ->
P \/ (Q /\ R).
Proof.
auto. Qed.

ある場所でautoやeautoを適用するとき、その場だけヒントデータベースを拡張したい場合にはauto using ...のようにして拡張することができます。例えば、conjやor_introl、or_introrがヒントデータベースに登録されていない場合でも、下のように書けば同じ意味になります。

Lemma auto_example_2a : forall P Q R : Prop,
Q ->
(Q -> R) ->
P \/ (Q /\ R).
Proof.
auto using conj, or_introl, or_intror.  Qed.

もちろん、それぞれの場合ごとに、自分で定義した構成子や補題のうちに証明で非常によく使うものがある、ということもあるでしょう。トップレベルに次のように書けば、そのような構成子や補題を大域的なヒントデータベースに登録することができます。

Hint Resolve l.

ここで、lは、補題や定理、もしくは帰納的に定義された命題（すなわち、型が含意であるようなもの）です。略記法として

Hint Constructors c.

と書くと、cの帰納的定義からすべての構成子を取り出しHint Resolveします。

また、

Hint Unfold d.

として（dは定義済みのシンボルです）、autoでdを使っている部分を展開し、そこからさらに登録された補題をapplyしていけるようにしておく必要があることもあります。

あとで役に立ちそうなHintをいくつか登録しておきます。

Hint Constructors refl_step_closure.
Hint Resolve beq_id_eq beq_id_false_not_eq.

注意: Coq の他の自動化機能と同じく、autoやeautoを使い過ぎると、簡単に、後で読めないような証明になってしまいます！

また、eautoを使い過ぎると、証明スクリプトが非常に遅くなることがあります。autoを使うのを常の習慣とし、eautoは必要なときにだけ使うようにしましょう。

autoやeautoの使い方について、より詳しくはUseAuto_J.vの章を参照してください。

Proof withタクティック

証明の最初の部分をProofではなくProof with (tactic)で始めると、証明の本体部分でタクティックの後に.と書く代わりに...と書くことで、そのタクティックで生成されたサブゴールすべてをtacticで解くようにすることができます（解けなかった場合には失敗します）。

この機能の一般的な使い方はProof with auto（またはeauto）です。このファイルの後の方でこの使い方の例がいくつかあります。

solve by inversionタクティック

他にも便利な自動化機能があります。コンテキストに矛盾する仮定があり、それをinversionすることでサブゴールを解く、というのはよくあることです。こういうときは、 Coq に名前を指定せずに、ただ「矛盾する仮定を見つけ、それをinversionしろ」と言いたいところです。

solve by intersionすると、ゴールを解くためにinversionできる補題がひとつある場合に、それを見つけてくれます。solve by inversion 2やsolve by inversion 3はもう少し気のきいたもので、ゴールを解くのに必要であれば 2 回、3 回とinversionを繰り返してくれます。

（solve by inversionは Coq 組み込みのものではなくSflib_J.vで定義されています。）

注意:solve by inversionを使い過ぎると、証明スクリプトが遅くなることがあります。

try solveタクティック

tがタクティックであるときtry solve [t] は以下のようなタクティックになります。

- tがゴールを解けるときtと同じように振る舞う。

- tがゴールを完全に解けなかった場合には何もしない。

より一般的には、try solve [t1 | t2 | ...] はt1、t2、……を使ってゴールを解こうとし、そのいずれを使ってもゴールを完全に解くことができなかった場合には何もしません。

ゴールを完全に解くことができなかった場合には何もしないということは、Tが実際には何の意味もないような場合にtry solve Tしても何の害もないということです。特に、;の後にtry solve TするとTで解けるサブゴールをできるかぎり解き、残りは別の方法で解く、ということができます。このタクティックでは、サブゴールが解きかけの状態のまま残るということはありません。

f_equalタクティック

f_equalタクティックを使うと、ある関数fについて、f x1 x2 ... xn = f y1 y2 ... ynのかたちのサブゴールをx1 = y1、x2 = y2、……、xn = ynで置き換えます。こうすることで手でわざわざ書き換えをしなくて済みますし、多くの場合、こうして生成されたサブゴールはautoで片付けることができます。

normalizeタクティック

Coq でプログラミング言語の定義を扱っていると、ある具体的な項がどのように簡約されるか知りたいことがよくあります。t ==>* t'という形のゴールを、tが具体的な項でt'が未知の場合に証明するときです。このような証明は単純ですが、手でやるには繰り返しが多過ぎます。例えば、前章で定義したスモールステップ簡約の関係astepを使って算術式を簡約することを考えてみてください。

Definition astep_many st := refl_step_closure (astep st).
Notation " t '/' st '==>a*' t' " := (astep_many st t t')
(at level 40, st at level 39).

Example astep_example1 :
(APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
==>a* (ANum 15).
Proof.
apply rsc_step with (APlus (ANum 3) (ANum 12)).
apply AS_Plus2.
apply av_num.
apply AS_Mult.
apply rsc_step with (ANum 15).
apply AS_Plus.
apply rsc_refl.
Qed.

正規形になるまでrsc_stepを繰り返し適用します。証明の途中に出てくる部分は、適切なヒントを与えてやればautoで解けそうです。

Hint Constructors astep aval.
Example astep_example1' :
(APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
==>a* (ANum 15).
Proof.
eapply rsc_step. auto. simpl.
eapply rsc_step. auto. simpl.
apply rsc_refl.
Qed.

下のTactic Notation定義はこのパターンを表現したものです。それに加えて、rsc_stepを実行する前にゴールを表示します。これは、項がどのように評価されるか利用者が追えるようにするためです。

Tactic Notation "print_goal" := match goal with |- ?x => idtac x end.
Tactic Notation "normalize" :=
repeat (print_goal; eapply rsc_step ;
[ (eauto 10; fail) | (instantiate; simpl)]);
apply rsc_refl.

Example astep_example1'' :
(APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
==>a* (ANum 15).
Proof.
normalize.

Qed.

またさらに、ゴールに存在量化された変数を入れて証明し、ある項の正規形を計算する、という使い方もあります。

Example astep_example1''' : exists e',
(APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state
==>a* e'.
Proof.
eapply ex_intro. normalize.
Qed.

型付きの算術式

型システムについての議論を始めるために、例のごとく、ごく単純な言語から始めましょう。この言語は、実行時の型エラーで「まずいことが起きる」可能性のあるものであってほしいので、Smallstep_J.vで使った、定数と足し算だけの言語よりはもう少し複雑なものでなければなりません。データが一種類だけ（数のみ）では単純すぎますが、二種類（数とブール値）なら、実験のための材料はもう揃っています。

言語の定義はいつも通り、お決まりの作業です。注意が必要なのは、ImpList_J.vで+等の引数をasnumやaslistを使って強制型変換してすべての演算を全域関数にしたようなテクニックは使わないということです。その代わりに、演算子をまちがった種類の被演算子に適用した場合には単にその項で行き詰まる（stuck する）、すなわちstep関係でそのような項を何とも関連づけないことにします。

構文

Inductive tm : Type :=
| tm_true : tm
| tm_false : tm
| tm_if : tm -> tm -> tm -> tm
| tm_zero : tm
| tm_succ : tm -> tm
| tm_pred : tm -> tm
| tm_iszero : tm -> tm.

Inductive bvalue : tm -> Prop :=
| bv_true : bvalue tm_true
| bv_false : bvalue tm_false.

Inductive nvalue : tm -> Prop :=
| nv_zero : nvalue tm_zero
| nv_succ : forall t, nvalue t -> nvalue (tm_succ t).

Definition value (t:tm) := bvalue t \/ nvalue t.

Hint Constructors bvalue nvalue.
Hint Unfold value.

スモールステップ簡約

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_IfTrue : forall t1 t2,
(tm_if tm_true t1 t2) ==> t1
| ST_IfFalse : forall t1 t2,
(tm_if tm_false t1 t2) ==> t2
| ST_If : forall t1 t1' t2 t3,
t1 ==> t1' ->
(tm_if t1 t2 t3) ==> (tm_if t1' t2 t3)
| ST_Succ : forall t1 t1',
t1 ==> t1' ->
(tm_succ t1) ==> (tm_succ t1')
| ST_PredZero :
(tm_pred tm_zero) ==> tm_zero
| ST_PredSucc : forall t1,
nvalue t1 ->
(tm_pred (tm_succ t1)) ==> t1
| ST_Pred : forall t1 t1',
t1 ==> t1' ->
(tm_pred t1) ==> (tm_pred t1')
| ST_IszeroZero :
(tm_iszero tm_zero) ==> tm_true
| ST_IszeroSucc : forall t1,
nvalue t1 ->
(tm_iszero (tm_succ t1)) ==> tm_false
| ST_Iszero : forall t1 t1',
t1 ==> t1' ->
(tm_iszero t1) ==> (tm_iszero t1')

where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If"
| Case_aux c "ST_Succ" | Case_aux c "ST_PredZero"
| Case_aux c "ST_PredSucc" | Case_aux c "ST_Pred"
| Case_aux c "ST_IszeroZero" | Case_aux c "ST_IszeroSucc"
| Case_aux c "ST_Iszero" ].

Hint Constructors step.

step関係は式が大域的に意味を持つかは考慮せず、次の簡約が適切な種類の被演算子に適用されているかだけを確認していることに注意してください。例えば、tm_succ tm_trueは先に進むことはできませんが、ほぼ意味のないことが自明な項

tm_succ (tm_if tm_true tm_true tm_true)

は大丈夫なのです。

正規形と値

この言語のstep関係について、まず注目に値するのは、Smallstep_J.vの章の強進行性定理（strong progress theorem）が成り立たないということです。すなわち、正規形ではあるのに（これ以上簡約できないのに）、値ではない項があるのです。（これは、そのような項を可能な「評価結果」と定義しなかったからです。）そのような項はstuckします。

Notation step_normal_form := (normal_form step).

Definition stuck (t:tm) : Prop :=
step_normal_form t /\ ~ value t.

Hint Unfold stuck.

練習問題: ★★, optional (some_tm_is_stuck)

Example some_tm_is_stuck :
exists t, stuck t.
Proof.
(* FILL IN HERE *) Admitted.

☐

ただし、この言語では値の集合と正規形の集合は同一ではありませんが、値は正規形に含まれます。これは重要なことで、さらに簡約できる値を定義しまうことはできないことを表しています。

練習問題: ★★★, optional (value_is_nf)

ヒント: 証明中で、数値であることがわかっている項に対して帰納的推論をしなければならないことになります。この帰納法は、その項自体にして適用することもできますし、その項が数値であるという事実に対して適用することもできます。どちらでも証明は進められますが、片方はもう片方よりもかなり短かくなります。練習として、ふたつの方法両方で証明を完成させなさい。

Lemma value_is_nf : forall t,
value t -> step_normal_form t.
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★, optional (step_deterministic)

value_is_nfを使うと、step関係もまた決定的であることが示せます。

Theorem step_deterministic:
partial_function step.
Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

型付け

次にこの言語から見て取れる非常に重要なことは、行き詰まる項があったとしても、そのような項は、我々としても意味を持ってほしくないようなブール値と数の取り混ぜ方をしたもので、すべて「意味がない」ということです。項とその評価結果の型（数かブール値）を関係づける型付け関係を定義することで、そのような、型の付かない項を除くことができます。

Inductive ty : Type :=
| ty_Bool : ty
| ty_Nat : ty.

型付け関係:

非形式的な記法では、型付け関係は|- t : Tと書き、「tの型はTである」と読みます。記号|-は「ターンスタイル（turnstile）」と呼びます。（後の章ではターンスタイルの左側に追加の「コンテキスト」引数のある型付け関係もあります。ここでは、コンテキストは常に空です。）

--------------                             (T_True)
|- true : Bool

---------------                            (T_False)
|- false : Bool

|- t1 : Bool    |- t2 : T    |- t3 : T
--------------------------------------                   (T_If)
|- if t1 then t2 else t3 : T

----------                               (T_Zero)
|- 0 : Nat

|- t1 : Nat
----------------                            (T_Succ)
|- succ t1 : Nat

|- t1 : Nat
----------------                            (T_Pred)
|- pred t1 : Nat

|- t1 : Nat
-------------------                         (T_IsZero)
|- iszero t1 : Bool

Inductive has_type : tm -> ty -> Prop :=
| T_True :
has_type tm_true ty_Bool
| T_False :
has_type tm_false ty_Bool
| T_If : forall t1 t2 t3 T,
has_type t1 ty_Bool ->
has_type t2 T ->
has_type t3 T ->
has_type (tm_if t1 t2 t3) T
| T_Zero :
has_type tm_zero ty_Nat
| T_Succ : forall t1,
has_type t1 ty_Nat ->
has_type (tm_succ t1) ty_Nat
| T_Pred : forall t1,
has_type t1 ty_Nat ->
has_type (tm_pred t1) ty_Nat
| T_Iszero : forall t1,
has_type t1 ty_Nat ->
has_type (tm_iszero t1) ty_Bool.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_True" | Case_aux c "T_False" | Case_aux c "T_If"
| Case_aux c "T_Zero" | Case_aux c "T_Succ" | Case_aux c "T_Pred"
| Case_aux c "T_Iszero" ].

Hint Constructors has_type.

型付け関係というのは保守的な（または静的な）近似であり、項の正規形の型を計算しているわけではない、ということをよく理解しておいてください。

Example has_type_1 :
has_type (tm_if tm_false tm_zero (tm_succ tm_zero)) ty_Nat.
Proof.
apply T_If.
apply T_False.
apply T_Zero.
apply T_Succ.
apply T_Zero.
Qed.

（型付け関係のすべての構成子をヒントデータベースに登録してあるので、実際にはautoでこの証明を自動化することができます。）

Example has_type_not :
~ has_type (tm_if tm_false tm_zero tm_true) ty_Bool.
Proof.
intros Contra. solve by inversion 2.  Qed.

練習問題: ★ (succ_hastype_nat__hastype_nat)

Example succ_hastype_nat__hastype_nat : forall t,
has_type (tm_succ t) ty_Nat ->
has_type t ty_Nat.
Proof.
(* FILL IN HERE *) Admitted.

☐

進行

型付け関係には重要な性質がふたつあります。最初のものは、型のついた（well-typed）正規形は値である（行き詰まらない）、ということです。

練習問題: ★★★, recommended (finish_progress_informal)

次の証明を完成させなさい。

[]
*)

FILL IN HERE 定理:|- t : Tであれば、tは値であるか、さもなければあるt'に対してt ==> t'である。

証明:|- t : Tの導出に関する帰納法で証明する。

- 導出で直前に適用した規則がT_Ifである場合、t = if t1 then t2 else t3かつ、|- t1 : Bool、|- t2 : Tかつ|- t3 : Tである。帰納法の仮定から、t1が値であるか、さもなければt1が何らかのt1'に簡約できる。

- t1が値のとき、t1はnvalueかbvalueである。だが、|- t1 : Boolかつ、nvalueなる項にBool型を割り当てる規則はないため、t1はnvalueではない。したがって、t1はbvalueである。すなわち、trueまたはfalseである。t1 = trueのとき、ST_IfTrueよりtはt2に簡約され、t1 = falseのときはST_IfFalseからtはt3に簡約される。どちらの場合もtの簡約は進められる。これが示そうとしていたことである。

- t1自体がST_Ifで簡約できるとき、tもまた簡約できる。

(* FILL IN HERE *)☐

練習問題: ★★★ (finish_progress)

Theorem progress : forall t T,
has_type t T ->
value t \/ exists t', t ==> t'.
Proof with auto.
intros t T HT.
has_type_cases (induction HT) Case...

Case "T_If".
right. destruct IHHT1.
SCase "t1 is a value". destruct H.
SSCase "t1 is a bvalue". destruct H.
SSSCase "t1 is tm_true".
exists t2...
SSSCase "t1 is tm_false".
exists t3...
SSCase "t1 is an nvalue".
solve by inversion 2.
SCase "t1 can take a step".
destruct H as [t1' H1].
exists (tm_if t1' t2 t3)...
(* FILL IN HERE *) Admitted.

☐

この定理はSmallstep_J.vの章の強進行性定理よりも興味深いものです。Smallstep_J.vのものは正規形はすべて値でした。本章では項が行き詰まることもありますが、行き詰まるようなものは型のつかないものだけです。

練習問題: ★ (step_review)

おさらい: 「はい」か「いいえ」（true か false）で答えなさい。（提出の必要はありません。）

- この言語では、型のついた正規形はすべて値である。

- 値はすべて正規形である。

- ワンステップ評価関係は全域関数である。

☐

型保存

型付けの第二の重要な性質は、型のついた項を一段階簡約すると、簡約結果もまた型のつく項である、ということです。

この定理は主部簡約（subject reduction）性と呼ばれることが多々あります。これは、この定理が型付け関係の主部が簡約されるときに起こることについて言っているからです。この用語は型付けを文として見たことによるもので、項が主部（subject）、型が述部（predicate）に当たります。

練習問題: ★★★, recommended (finish_preservation_informal)

以下の証明を完成させなさい。

[]
*)

FILL IN HERE 定理:|- t : Tかつt ==> t'ならば|- t' : T

証明:|- t : Tの導出に関する帰納法で証明する。

- 導出で直前に使った規則がT_Ifの場合、t = if t1 then t2 else t3、かつ|- t1 : Bool、|- t2 : Tかつ|- t3 : Tである。tがif ...の形式であることとスモールステップ簡約関係を見ると、t ==> t'を示すために使えるのはST_IfTrue、ST_IfFalseまたはST_Ifのみである。

- 直前の規則がST_IfTrueの場合、t' = t2である。|- t2 : Tであるのでこれは求める結果である。

- 直前の規則がST_IfFalseの場合、t' = t3である。|- t3 : Tであるのでこれは求める結果である。

- 直前の規則がST_Ifの場合、t' = if t1' then t2 else t3'である。ここで、t1 ==> t1'である。|- t1 : Boolであるので、帰納法の仮定から|- t1' : Boolである。また、T_If規則から|- if t1' then t2 else t3 : Tであり、これは求める結果である。

(* FILL IN HERE *)☐

練習問題: ★★ (finish_preservation)

Theorem preservation : forall t t' T,
has_type t T ->
t ==> t' ->
has_type t' T.
Proof with auto.
intros t t' T HT HE.
generalize dependent t'.
has_type_cases (induction HT) Case;

intros t' HE;

try (solve by inversion).
Case "T_If". inversion HE; subst.
SCase "ST_IFTrue". assumption.
SCase "ST_IfFalse". assumption.
SCase "ST_If". apply T_If; try assumption.
apply IHHT1; assumption.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★★ (preservation_alternate_proof)

さらに、同一の性質を型付けの導出ではなく、評価の導出に関する帰納法で証明しなさい。先ほどの証明の最初数行を注意深く読んで考え、各行が何をしているのか理解することから始めましょう。この証明でも設定はよく似ていますが、まったく同じというわけではありません。

Theorem preservation' : forall t t' T,
has_type t T ->
t ==> t' ->
has_type t' T.
Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

型の健全性

進行と型保存を合わせると、型のついた項は決してstuck状態にはならないことを示せます。

Definition stepmany := (refl_step_closure step).
Notation "t1 '==>*' t2" := (stepmany t1 t2) (at level 40).

Corollary soundness : forall t t' T,
has_type t T ->
t ==>* t' ->
~(stuck t').
Proof.
intros t t' T HT P. induction P; intros [R S].
destruct (progress x T HT); auto.
apply IHP.  apply (preservation x y T HT H).
unfold stuck. split; auto.   Qed.

実際、現在の（本当に単純な）言語では、型のついた項はすべて正規形に簡約されます。これを正規化性（normalization property）と言います。（証明は単純ですが面倒です。）より言語機能の豊富な言語ではこの性質は満たされないことも多々ありますが、型のついた項がすべて正規形に簡約される言語もあります。（例えば、 Coq のFixpoint言語や、次の章で見る単純型付きラムダ計算等。）

追加演習

練習問題: ★, recommended (subject_expansion)

[]
*)

FILL IN HERE 主部簡約性が成り立つのなら、その逆の性質、主部展開（subject expansion）性も成り立つかどうか考えるのが合理的でしょう。すなわち、t ==> t'かつhas_type t' Tならばhas_type t Tは常に成り立つでしょうか。そうだと思うのなら、証明しなさい。そうでないと思うのなら、反例を挙げなさい。

(* FILL IN HERE *)☐

練習問題: ★★ (variation1)

評価関係に次のふたつの規則を追加したとします。

| ST_PredTrue :
(tm_pred tm_true) ==> (tm_pred tm_false)
| ST_PredFalse :
(tm_pred tm_false) ==> (tm_pred tm_true)

以下の性質のうち、この規則を追加しても依然として真であるのはどれでしょう。それぞれについて、「真のままである」か「偽になる」かを書きなさい。偽になる場合には反例を挙げなさい。

- stepの決定性

- 型のつく項に対するstepの正規化

- 進行

- 型保存

☐

練習問題: ★★ (variation2)

先程の問題とは別に、次の規則を型付け関係に追加したとしましょう。

| T_IfFunny : forall t2 t3,
has_type t2 ty_Nat ->
has_type (tm_if tm_true t2 t3) ty_Nat

以下のうち、この規則を追加しても依然として真であるのはどれでしょう。（上と同じスタイルで答えなさい。）

- stepの決定性

- 型のつく項に対するstepの正規化

- 進行

- 型保存

☐

練習問題: ★★ (variation3)

先程の問題とは別に、次の規則を型付け関係に追加したとしましょう。

| T_SuccBool : forall t,
has_type t ty_Bool ->
has_type (tm_succ t) ty_Bool

以下のうち、この規則を追加しても依然として真であるのはどれでしょう。（上と同じスタイルで答えなさい。）

- stepの決定性

- 型のつく項に対するstepの正規化

- 進行

- 型保存

☐

練習問題: ★★ (variation4)

先程の問題とは別に、次の規則をstep関係に追加したとしましょう。

| ST_Funny1 : forall t2 t3,
(tm_if tm_true t2 t3) ==> t3

上の性質のうち、この規則を追加すると偽になるのはどれでしょう。偽になるものについてそれぞれ反例を挙げなさい。

☐

練習問題: ★★ (variation5)

先程の問題とは別に、次の規則を追加したとしましょう。

| ST_Funny2 : forall t1 t2 t2' t3,
t2 ==> t2' ->
(tm_if t1 t2 t3) ==> (tm_if t1 t2' t3)

上の性質のうち、この規則を追加すると偽になるのはどれでしょう。偽になるものについてそれぞれ反例を挙げなさい。

☐

練習問題: ★★ (variation6)

先程の問題とは別に、次の規則を追加したとしましょう。

| ST_Funny3 :
(tm_pred tm_false) ==> (tm_pred (tm_pred tm_false))

上の性質のうち、この規則を追加すると偽になるのはどれでしょう。偽になるものについてそれぞれ反例を挙げなさい。

☐

練習問題: ★★ (variation7)

先程の問題とは別に、次の規則を追加したとしましょう。

| T_Funny4 :
has_type tm_zero ty_Bool

上の性質のうち、この規則を追加すると偽になるのはどれでしょう。偽になるものについてそれぞれ反例を挙げなさい。

☐

練習問題: ★★ (variation8)

先程の問題とは別に、次の規則を追加したとしましょう。

| T_Funny5 :
has_type (tm_pred tm_zero) ty_Bool

上の性質のうち、この規則を追加すると偽になるのはどれでしょう。偽になるものについてそれぞれ反例を挙げなさい。

☐

練習問題: ★★★, optional (more_variations)

上の問題と同様の練習問題を自分で作りなさい。さらに、上の性質を選択的に成り立たなくする方法、すなわち、上の性質のうちひとつだけを成り立たなるするよう定義を変更する方法を探しなさい。☐

練習問題: ★ (remove_predzero)

[]
*)

FILL IN HERE E_PredZeroには少し直感に反するところがあります。 0 の前者を 0 と定義するよりは、未定義とした方が意味があるように感じられるでしょう。これはstepの定義からE_PredZeroを取り除くだけで実現できるでしょうか？

(* FILL IN HERE *)☐

練習問題: ★★★★, optional (prog_pres_bigstep)

[]
*)

FILL IN HERE 評価関係をビッグステップスタイルで定義したとしましょう。その場合、進行と型保存性に当たるものとしては何が適切でしょうか。

(* FILL IN HERE *)☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Stlc_J: 単純型付きラムダ計算

Require Export Types_J.

単純型付きラムダ計算

単純型付きラムダ計算(Simply Typed Lambda-Calculus, STLC)は、関数抽象(functional abstraction)を具現する、小さな、核となる計算体系です。関数抽象は、ほとんどすべての実世界のプログラミング言語に何らかの形(関数、手続き、メソッド等)で現れます。

ここでは、この計算体系(構文、スモールステップ意味論、型付け規則)とその性質(進行と保存)の形式化を、これまでやったのとまったく同じパターンで行います。(扱うためにいくらかの作業が必要になる)新しい技術的挑戦は、すべて変数束縛(variable binding)と置換(substitution)の機構から生じます。

概観

STLC は基本型(base types)の何らかの集まりの上に構成されます。基本型はブール型、数値、文字列などです。実際にどの基本型を選択するかは問題ではありません。どう選択しても、言語の構成とその理論的性質はまったく同じように導かれます。これから、簡潔にするため、しばらくはBoolだけとしましょう。この章の終わりには、さらに基本型を追加する方法がわかるでしょう。また後の章では、純粋なSTLCに、対、レコード、サブタイプ、変更可能状態などの他の便利な構成要素をとり入れてよりリッチなものにします。

ブール値から始めて3つのものを追加します:

- 変数

- 関数抽象

- (関数)適用

これから、以下の抽象構文コンストラクタが出てきます(ここではこれを非形式的BNF記法で書き出します。後に形式化します。):

t ::= x                       変数
| \x:T.t1                 関数抽象
| t1 t2                   関数適用
| true                    定数 true
| false                   定数 false
| if t1 then t2 else t3   条件式

関数抽象\x:T.t1の\記号はよくギリシャ文字のラムダ(λ)で記述されます(これがラムダ計算の名前の由来です)。変数xは関数のパラメータ(parameter)、項t1は関数の本体(body)と呼ばれます。付記された:Tは関数が適用される引数の型を定めます。

例をいくつか:

- \x:Bool. xブール値の恒等関数。

- (\x:Bool. x) trueブール値trueに適用された、ブール値の恒等関数。

- \x:Bool. if x then false else trueブール値の否定関数。

- \x:Bool. trueすべての(ブール値の)引数に対してtrueを返す定数関数。

- \x:Bool. \y:Bool. x2つのブール値をとり、最初のものを返す2引数関数。(なお、Coqと同様、2引数関数は、実際には本体が1引数関数である1引数関数です。)

- (\x:Bool. \y:Bool. x) false true2つのブール値をとり、最初のものを返す2引数関数を、ブール値falseとtrueに適用したもの。なお、Coqと同様、関数適用は左結合です。つまり、この式は((\x:Bool. \y:Bool. x) false) trueと構文解析されます。

- \f:Bool->Bool. f (f true)(ブール値からブール値への)「関数」fを引数にとる高階関数。この高階関数は、fをtrueに適用し、その値にさらにfを適用します。

- (\f:Bool->Bool. f (f true)) (\x:Bool. false)上記高階関数を、常にfalseを返す定数関数に適用したもの。

最後のいくつかの例で示されたように、STLCは高階(higher-order)関数の言語です。他の関数を引数として取る関数や、結果として他の関数を返す関数を書き下すことができます。

別の注目点は、名前を持つ(named)関数を定義する基本構文を、STLCは何も持っていないことです。すべての関数は「名無し」(“anonymous”)です。後のMoreStlc_J章で、この体系に名前を持つ関数を追加することが簡単であることがわかるでしょう。実のところ、基本的な命名と束縛の機構はまったく同じです。

STLCの型にはBoolが含まれます。この型はブール値定数trueとfalse、および結果がブール値になるより複雑な計算の型です。それに加えて「関数型」(arrow types)があります。これは関数の型です。

T ::= Bool
| T1 -> T2

例えば:

- \x:Bool. falseは型Bool->Boolを持ちます。

- \x:Bool. xは型Bool->Boolを持ちます。

- (\x:Bool. x) trueは型Boolを持ちます。

- \x:Bool. \y:Bool. xは型Bool->Bool->Bool(つまりBool -> (Bool->Bool))を持ちます。

- (\x:Bool. \y:Bool. x) falseは型Bool->Boolを持ちます。

- (\x:Bool. \y:Bool. x) false trueは型Boolを持ちます。

- \f:Bool->Bool. f (f true)は型(Bool->Bool) -> Boolを持ちます。

- (\f:Bool->Bool. f (f true)) (\x:Bool. false)は型Boolを持ちます。

構文

Module STLC.

型

Inductive ty : Type :=
| ty_Bool  : ty
| ty_arrow : ty -> ty -> ty.

項

Inductive tm : Type :=
| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm
| tm_true : tm
| tm_false : tm
| tm_if : tm -> tm -> tm -> tm.

ここで注目すべきは、関数抽象\x:T.t(形式的にはtm_abs x T t)には常にパラメータの型(T)が付記されることです。これは Coq(あるいは他のML、Haskellといった関数型言語)と対照的です。それらは、付記がないものを型推論で補完します。

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app"
| Case_aux c "tm_abs" | Case_aux c "tm_true"
| Case_aux c "tm_false" | Case_aux c "tm_if" ].

いくつかの例...

Notation a := (Id 0).
Notation b := (Id 1).
Notation c := (Id 2).

idB = \a:Bool. a

Notation idB :=
(tm_abs a ty_Bool (tm_var a)).

idBB = \a:Bool->Bool. a

Notation idBB :=
(tm_abs a (ty_arrow ty_Bool ty_Bool) (tm_var a)).

idBBBB = \a:(Bool->Bool)->(Bool->Bool). a

Notation idBBBB :=
(tm_abs a (ty_arrow (ty_arrow ty_Bool ty_Bool)
(ty_arrow ty_Bool ty_Bool))
(tm_var a)).

k = \a:Bool. \b:Bool. a

Notation k := (tm_abs a ty_Bool (tm_abs b ty_Bool (tm_var a))).

(これらをDefinitionではなくNotationとすることで、autoに扱いやすくしています。)

操作的意味論

STLC項のスモールステップ意味論を定義するために、いつものように、値の集合を定義することから始めます。次に、自由変数(free variables)と置換(substitution)という、重大な概念を定義します。これらは関数適用式の簡約規則に使われます。そして最後に、スモールステップ関係自体を与えます。

値

STLCの値を定義するために、いくつかの場合を考えなければなりません。

最初に、言語のブール値については、状況は明確です:trueとfalseだけが値です。(if式は決して値ではありません。)

二番目に、関数適用は明らかに値ではありません。関数適用は関数が何らかの引数に対して呼ばれたことを表しているのですから、明らかにこれからやることが残っています。

三番目に、関数抽象については選択肢があります:

- \a:A.t1が値であるのは、t1が値であるときのみである、 とすることができます。つまり、関数の本体が(どのような引数に適用されるかわからない状態で可能な限り)簡約済みであるときのみ、ということです。

- あるいは、\a:A.t1は常に値である、とすることもできます。t1が値であるかどうかに関係なく、です。言いかえると、簡約は関数抽象で止まる、とすることです。

Coq は最初の選択肢を取っています。例えば、

Eval simpl in (fun a:bool => 3 + 4)

はfun a:bool => 7となります。しかし実際の関数型プログラミング言語のほとんどは、第二の選択肢を取っています。つまり、関数の本体の簡約は、関数が実際に引数に適用されたときにのみ開始されます。ここでは、同様に第二の選択肢を選びます。

最後に、関数抽象の中を簡約することを選択しなかったため、変数が値であるかをどうかを心配する必要はなくなります。なぜなら、プログラムの簡約は常に「外側から内側に」行われ、step関係は常に閉じた(自由変数を持たない)項だけを対象とするからです。

Inductive value : tm -> Prop :=
| v_abs : forall x T t,
value (tm_abs x T t)
| t_true :
value tm_true
| t_false :
value tm_false.

Hint Constructors value.

自由変数と置換

これから問題の核心に入ります: 項の変数を別の項で置換する操作です。

この操作は後で関数適用の操作的意味論を定義するために使います。関数適用では、関数本体の中の関数パラメータを引数項で置換することが必要になります。例えば、

(\x:Bool. if x then true else x) false

は、関数の本体のパラメータxをfalseで置換することで、falseに簡約されます。一般に、ある項tの変数xの出現を、与えらえた項sで置換できることが必要です。非形式的な議論では、これは通常[s/xt ] と書き、「tのxをsで置換する」と読みます。

いくつかの例を示します:

- [true / a(if a then a else false)] はif true then true else falseとなります。

- [true / aa] はtrueとなります。

- [true / a(if a then a else b)] はif true then true else bとなります。

- [true / ab] はbとなります。

- [true / afalse] はfalseとなります(何もしない置換です)。

- [true / a(:Bool. if y then a else false)] は\y:Bool. if y then true else falseとなります。

- [true / a(:Bool. a)] は\y:Bool. trueとなります。

- [true / a(:Bool. y)] は\y:Bool. yとなります。

- [true / a(:Bool. a)] は\a:Bool. aとなります。

最後の例はとても重要です。\a:Bool. aのaをtrueで置換したものは、\a:Bool. trueに「なりません」! 理由は、\a:Bool. aの本体のaは関数抽象で束縛されている(bound)からです。このaは新しいローカルな名前で、たまたまグローバルな名前aと同じ綴りであったものです。

以下が、非形式的な定義です...

[s/x]x = s
[s/x]y = y                                     if x <> y
[s/x](\x:T11.t12)   = \x:T11. t12
[s/x](\y:T11.t12)   = \y:T11. [s/x]t12         if x <> y
[s/x](t1 t2)        = ([s/x]t1) ([s/x]t2)
[s/x]true           = true
[s/x]false          = false
[s/x](if t1 then t2 else t3) =
if [s/x]t1 then [s/x]t2 else [s/x]t3

... そして形式的には:

Fixpoint subst (s:tm) (x:id) (t:tm) : tm :=
match t with
| tm_var x' => if beq_id x x' then s else t
| tm_abs x' T t1 => tm_abs x' T (if beq_id x x' then t1 else (subst s x t1))
| tm_app t1 t2 => tm_app (subst s x t1) (subst s x t2)
| tm_true => tm_true
| tm_false => tm_false
| tm_if t1 t2 t3 => tm_if (subst s x t1) (subst s x t2) (subst s x t3)
end.

技術的注釈: 置換は、もしs、つまり他の項の変数を置換する項が、それ自身に自由変数を含むときを考えると、定義がよりトリッキーなものになります。ここで興味があるのは閉じた項についてのstep関係の定義のみなので、そのさらなる複雑さは避けることができます。

簡約

STLCのスモールステップ簡約関係は、これまで見てきたものと同じパターンに従います。直観的には、関数適用を簡約するため、最初に左側をリテラル関数になるまで簡約します。次に左側(引数)を値になるまで簡約します。そして最後に関数の本体の束縛変数を引数で置換します。この最後の規則は、非形式的には次のように書きます:

(\a:T.t12) v2 ==> [v2/a]t12

これは伝統的にベータ簡約(“beta-reduction”)と呼ばれます。

非形式的に:

---------------------------                    (ST_AppAbs)
(\a:T.t12) v2 ==> [v2/a]t12

t1 ==> t1'
----------------                           (ST_App1)
t1 t2 ==> t1' t2

t2 ==> t2'
----------------                        (ST_App2)
v1 t2 ==> v1 t2'

(これに通常のブール値の規則をプラスします)。

形式的には:

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_AppAbs : forall x T t12 v2,
value v2 ->
(tm_app (tm_abs x T t12) v2) ==> (subst v2 x t12)
| ST_App1 : forall t1 t1' t2,
t1 ==> t1' ->
tm_app t1 t2 ==> tm_app t1' t2
| ST_App2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
tm_app v1 t2 ==> tm_app v1  t2'
| ST_IfTrue : forall t1 t2,
(tm_if tm_true t1 t2) ==> t1
| ST_IfFalse : forall t1 t2,
(tm_if tm_false t1 t2) ==> t2
| ST_If : forall t1 t1' t2 t3,
t1 ==> t1' ->
(tm_if t1 t2 t3) ==> (tm_if t1' t2 t3)

where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1"
| Case_aux c "ST_App2" | Case_aux c "ST_IfTrue"
| Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ].

Notation stepmany := (refl_step_closure step).
Notation "t1 '==>*' t2" := (stepmany t1 t2) (at level 40).

Hint Constructors step.

例

Lemma step_example1 :
(tm_app idBB idB) ==>* idB.
Proof.
eapply rsc_step.
apply ST_AppAbs.
apply v_abs.
simpl.
apply rsc_refl.  Qed.

Lemma step_example1' :
(tm_app idBB idB) ==>* idB.
Proof. normalize.  Qed.

Lemma step_example2 :
(tm_app idBB (tm_app idBB idB)) ==>* idB.
Proof.
eapply rsc_step.
apply ST_App2. auto.
apply ST_AppAbs. auto.
eapply rsc_step.
apply ST_AppAbs. simpl. auto.
simpl. apply rsc_refl.  Qed.

再び、上述のnormalizeタクティックを使って、証明を簡単にすることができます。

Lemma step_example2' :
(tm_app idBB (tm_app idBB idB)) ==>* idB.
Proof.
normalize.
Qed.

練習問題: ★★ (step_example3)

次の証明をnormalizeを使う方法と使わない方法の両方で行ないなさい。

Lemma step_example3 :
(tm_app (tm_app idBBBB idBB) idB)
==>* idB.
Proof.
(* FILL IN HERE *) Admitted.

☐

型付け

コンテキスト

問い: 項 “x y” の型は何でしょう？

答え: それはxとyの型に依存します!

つまり、項に型を付けるためには、その自由変数の型についてどういう仮定をしなければならないかを知る必要があります。

このために、3つのものの間の型付けジャッジメント(“typing judgment”)を用意します。これを非形式的にはGamma |- t : Tと記述します。ここでGammaは「型付けコンテキスト」(“typing context”)、つまり、変数から型への写像です。

モジュールにおける部分写像の定義は隠蔽します。なぜなら、実際には SfLib で定義されているからです。

Definition context := partial_map ty.

Module Context.

Definition partial_map (A:Type) := id -> option A.

Definition empty {A:Type} : partial_map A := (fun _ => None).

Definition extend {A:Type} (Gamma : partial_map A) (x:id) (T : A) :=
fun x' => if beq_id x x' then Some T else Gamma x'.

Lemma extend_eq : forall A (ctxt: partial_map A) x T,
(extend ctxt x T) x = Some T.
Proof.
intros. unfold extend. rewrite <- beq_id_refl. auto.
Qed.

Lemma extend_neq : forall A (ctxt: partial_map A) x1 T x2,
beq_id x2 x1 = false ->
(extend ctxt x2 T) x1 = ctxt x1.
Proof.
intros. unfold extend. rewrite H. auto.
Qed.

End Context.

型付け関係

非形式的に:

Gamma x = T
--------------                              (T_Var)
Gamma |- x : T

Gamma , x:T11 |- t12 : T12
----------------------------                       (T_Abs)
Gamma |- \x:T11.t12 : T11->T12

Gamma |- t1 : T11->T12
Gamma |- t2 : T11
----------------------                          (T_App)
Gamma |- t1 t2 : T12

--------------------                          (T_True)
Gamma |- true : Bool

---------------------                         (T_False)
Gamma |- false : Bool

Gamma |- t1 : Bool    Gamma |- t2 : T    Gamma |- t3 : T
--------------------------------------------------------          (T_If)
Gamma |- if t1 then t2 else t3 : T

記法Gamma , x:Tは「部分写像Gammaを拡張してxをTに写像するようにしたもの」を表します。

Inductive has_type : context -> tm -> ty -> Prop :=
| T_Var : forall Gamma x T,
Gamma x = Some T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
has_type (extend Gamma x T11) t12 T12 ->
has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T11 T12 Gamma t1 t2,
has_type Gamma t1 (ty_arrow T11 T12) ->
has_type Gamma t2 T11 ->
has_type Gamma (tm_app t1 t2) T12
| T_True : forall Gamma,
has_type Gamma tm_true ty_Bool
| T_False : forall Gamma,
has_type Gamma tm_false ty_Bool
| T_If : forall t1 t2 t3 T Gamma,
has_type Gamma t1 ty_Bool ->
has_type Gamma t2 T ->
has_type Gamma t3 T ->
has_type Gamma (tm_if t1 t2 t3) T.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs"
| Case_aux c "T_App" | Case_aux c "T_True"
| Case_aux c "T_False" | Case_aux c "T_If" ].

Hint Constructors has_type.

例

Example typing_example_1 :
has_type empty (tm_abs a ty_Bool (tm_var a)) (ty_arrow ty_Bool ty_Bool).
Proof.
apply T_Abs. apply T_Var. reflexivity.  Qed.

has_typeコンストラクタをヒントデータベースに追加したことから、これを auto は直接解くことができることに注意します。

Example typing_example_1' :
has_type empty (tm_abs a ty_Bool (tm_var a)) (ty_arrow ty_Bool ty_Bool).
Proof. auto.  Qed.

Hint Unfold beq_id beq_nat extend.

非形式的に書くと

empty |- \a:A. \b:A->A. b (b a))
: A -> (A->A) -> A.

となるものが次の例です:

Example typing_example_2 :
has_type empty
(tm_abs a ty_Bool
(tm_abs b (ty_arrow ty_Bool ty_Bool)
(tm_app (tm_var b) (tm_app (tm_var b) (tm_var a)))))
(ty_arrow ty_Bool (ty_arrow (ty_arrow ty_Bool ty_Bool) ty_Bool)).
Proof with auto using extend_eq.
apply T_Abs.
apply T_Abs.
eapply T_App. apply T_Var...
eapply T_App. apply T_Var...
apply T_Var...
Qed.

練習問題: ★★, optional

auto、eauto、eapplyを使わずに同じ結果を証明しなさい。

Example typing_example_2_full :
has_type empty
(tm_abs a ty_Bool
(tm_abs b (ty_arrow ty_Bool ty_Bool)
(tm_app (tm_var b) (tm_app (tm_var b) (tm_var a)))))
(ty_arrow ty_Bool (ty_arrow (ty_arrow ty_Bool ty_Bool) ty_Bool)).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★★ (typing_example_3)

次の型付けが成立することを形式的に証明しなさい:

empty |- (\a:Bool->B. \b:Bool->Bool. \c:Bool.
b (a c))
: T.

Example typing_example_3 :
exists T,
has_type empty
(tm_abs a (ty_arrow ty_Bool ty_Bool)
(tm_abs b (ty_arrow ty_Bool ty_Bool)
(tm_abs c ty_Bool
(tm_app (tm_var b) (tm_app (tm_var a) (tm_var c))))))
T.

Proof with auto.
(* FILL IN HERE *) Admitted.

☐

項が「型付けできない」ことを証明することもできます。例えば\a:Bool. \b:Bool, a bに型をつける型付けが存在しないこと、つまり、

~ exists T,
empty |- (\a:Bool. \b:Bool, a b) : T.

を形式的にチェックしましょう。

Example typing_nonexample_1 :
~ exists T,
has_type empty
(tm_abs a ty_Bool
(tm_abs b ty_Bool
(tm_app (tm_var a) (tm_var b))))
T.
Proof.
intros C. destruct C.

inversion H. subst. clear H.
inversion H5. subst. clear H5.
inversion H4. subst. clear H4.
inversion H2. subst. clear H2.
inversion H5. subst. clear H5.

inversion H1.  Qed.

練習問題: ★★★ (typing_nonexample_3)

別の型を持たない例:

~ (exists S, exists T,
empty |- (\a:S. a a) : T).

Example typing_nonexample_3 :
~ (exists S, exists T,
has_type empty
(tm_abs a S
(tm_app (tm_var a) (tm_var a)))
T).
Proof.
(* FILL IN HERE *) Admitted.

☐

練習問題: ★ (typing_statements)

以下のうち証明できるのものを挙げなさい。

- b:Bool |- \a:Bool.a : Bool->Bool

- exists T,  empty |- (\b:Bool->Bool. \a:Bool. b a) : T

- exists T,  empty |- (\b:Bool->Bool. \a:Bool. a b) : T

- exists S, a:S |- (\b:Bool->Bool. b) a : S

- exists S, exists T,  a:S |- (a a a) : T

☐

練習問題: ★, optional (more_typing_statements)

以下の命題のうち証明できるものを挙げなさい。証明できるものについては、存在限量された変数に入る具体的な値を示しなさい。

- exists T,  empty |- (\b:B->B->B. \a:B, b a) : T

- exists T,  empty |- (\a:A->B, \b:B-->C, \c:A, b (a c)):T

- exists S, exists U, exists T,  a:S, b:U |- \c:A. a (b c) : T

- exists S, exists T,  a:S |- \b:A. a (a b) : T

- exists S, exists U, exists T,  a:S |- a (\c:U. c a) : T

☐

性質

自由な出現

変数xが項 t に自由に出現する(appears free in a term t)とは、tがxの出現を含み、その出現がxのラベルが付けられた関数抽象のスコープ内にないことです。例えば:

- \x:T->U. x yにおいてyは自由に現れますがxはそうではありません。

- (\x:T->U. x y) xにおいてはxとyはともに自由に現れます。

- \x:T->U. \y:T. x yにおいては自由に現れる変数はありません。

Inductive appears_free_in : id -> tm -> Prop := | afi_var : forall x, appears_free_in x (tm_var x) | afi_app1 : forall x t1 t2, appears_free_in x t1 -> appears_free_in x (tm_app t1 t2) | afi_app2 : forall x t1 t2, appears_free_in x t2 -> appears_free_in x (tm_app t1 t2) | afi_abs : forall x y T11 t12, y <> x -> appears_free_in x t12 -> appears_free_in x (tm_abs y T11 t12) | afi_if1 : forall x t1 t2 t3, appears_free_in x t1 -> appears_free_in x (tm_if t1 t2 t3) | afi_if2 : forall x t1 t2 t3, appears_free_in x t2 -> appears_free_in x (tm_if t1 t2 t3) | afi_if3 : forall x t1 t2 t3, appears_free_in x t3 -> appears_free_in x (tm_if t1 t2 t3).

Tactic Notation “afi_cases” tactic(first) ident(c) := first; [ Case_aux c “afi_var” | Case_aux c “afi_app1” | Case_aux c “afi_app2” | Case_aux c “afi_abs” | Case_aux c “afi_if1” | Case_aux c “afi_if2” | Case_aux c “afi_if3” ].

Hint Constructors appears_free_in.

自由に現れる変数を持たない項を「閉じている」(closed)と言います。

Definition closed (t:tm) :=
forall x, ~ appears_free_in x t.

置換

最初に、自由変数と型付けコンテキストを結び付ける技術的な補題が必要になります。変数xが項tに自由に現れ、tがコンテキストGammaで型付けされるならば、Gammaはxに型を付けなければなりません。

Lemma free_in_context : forall x t T Gamma,
appears_free_in x t ->
has_type Gamma t T ->
exists T', Gamma x = Some T'.

「証明」:xがtに自由に現れることの証明についての帰納法によって、すべてのコンテキストGammaについて、tがGammaのもとで型付けされるならばGammaはxに型をつけることを示す。

- 最後の規則がafi_varの場合、t = xである。そして、tがGammaで型付けされるという仮定から、そのまま、Gammaでxに型付けされることが言える。

- 最後の規則がafi_app1の場合、t = t1 t2でxはt1に自由に出現する。tがGammaのもとで型付けされることから、型付け規則からt1も型付けされることになる。従って帰納仮定よりGammaはxに型を付ける。

- 他のほとんどの場合も同様である。xがtの部分項に自由に現れ、tがGammaで片付けされることから、xが出現しているtの部分項は同様にGammaで型付けされる。従って帰納仮定より求めるべき結果が得られる。

- 残るのは、最後の規則がafi_absの場合だけである。この場合、t = \y:T11.t12でxはt12に自由に現れる。またxはyと異なっている。前の場合との違いは、tはGammaのもとで型付けされているが、その本体t12は(Gamma, y:T11)のもとで型付けされているという点である。このため、帰納仮定は、拡張されたコンテキスト(Gamma, y:T11)でxに型付けされる、という主張になる。Gammaのもとでxに型が付けられるという結論を得るため、xとyが異なっているという点に注意して、補題extend_neqを使う。

Proof. intros. generalize dependent Gamma. generalize dependent T. afi_cases (induction H) Case; intros; try solve [inversion H0; eauto]. Case “afi_abs”. inversion H1; subst. apply IHappears_free_in in H7. apply not_eq_beq_id_false in H. rewrite extend_neq in H7; assumption. Qed.

次に、空コンテキストで型付けされる任意の項は閉じている(自由変数を持たない)、という事実を必要とします。

練習問題: ★★ (typable_empty__closed)

Corollary typable_empty__closed : forall t T,
has_type empty t T  ->
closed t.
Proof.
(* FILL IN HERE *) Admitted.

☐

しばしば、証明Gamma |- t : Tがあるとき、コンテキストGammaを別のコンテキストGamma'に置換する必要が出てきます。これはどのような場合に安全でしょうか？直観的には、tに自由に現れるすべての変数について、Gamma'がGammaと同じ型を割当てることが少なくとも必要です。実際、この条件だけが必要になります。

Lemma context_invariance : forall Gamma Gamma' t S,
has_type Gamma t S  ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x) ->
has_type Gamma' t S.

「証明」:Gamma |- t : Tの導出についての帰納法を使う。

- 導出の最後の規則がT_Varのとき、t = xかつGamma x = Tである。 仮定からGamma' x = Tであるから、T_VarよりGamma' |- t : Tとなる。

- 最後の規則がT_Absのとき、t = \y:T11. t12かつT = T11 -> T12かつGamma, y:T11 |- t12 : T12である。帰納法の仮定は、任意のコンテキストGamma''について、もしGamma, y:T11とGamma''がt12内のすべての自由変数に同じ型を割り当てるならば、t12はGamma''のもとで型T12を持つ、である。Gamma'を、t内の自由変数についてGammaと同じ割当てをするコンテキストとする。示すべきことはGamma' |- \y:T11. t12 : T11 -> T12である。 T_Absより、Gamma', y:T11 |- t12 : T12を示せば十分である。帰納仮定(ただしGamma'' = Gamma', y:T11とする)より、Gamma, y:T11とGamma', y:T11がt12内に自由に現れるすべての変数について割当てが一致することを示せば十分である。 t12に自由に出現する任意の変数はyであるか、それ以外の変数かである。Gamma, y:T11とGamma', y:T11は明らかにyについては一致する。それ以外の場合、t12に自由に出現するy以外の任意の変数はt = \y:T11. t12にも自由に現れることに注意すると、GammaとGamma'がそのような変数について割当てが一致するという仮定より、Gamma, y:T11とGamma', y:T11も一致する。

- 最後の規則がT_Appの場合、t = t1 t2かつGamma |- t1 : T2 -> TかつGamma |- t2 : T2である。帰納法の仮定の1つは、すべてのコンテキストGamma'について、Gamma'とGammaがt1のすべての自由変数について同じ割当てをするならば、Gamma'のもとでt1は型T2 -> Tを持つ、となる。t2についても同様の帰納仮定がある。証明すべきことは、Gamma'がGammaとt1 t2のすべての自由変数について同一の割当てをするという仮定の上で、Gamma'のもとでもt1 t2が型Tを持つ、ということである。T_Appより、t1とt2がそれぞれGamma'とGammaのもとで同じ型を持つことを示せば十分である。しかし、t1のすべての自由変数はt1 t2でも自由変数であり、t2の自由変数についても同様である。ゆえに、2つの帰納仮定から求める結果が得られる。

Proof with eauto. intros. generalize dependent Gamma’. has_type_cases (induction H) Case; intros; auto. Case “T_Var”. apply T_Var. rewrite <- H0... Case “T_Abs”. apply T_Abs. apply IHhas_type. intros x0 Hafi.

unfold extend. remember (beq_id x x0) as e. destruct e...

Case “T_App”. apply T_App with T11... Qed.

ついに、簡約が型を保存することの証明の概念的な核心です。つまり、「置換」が型を保存することを調べます。

非形式的には、置換補題(Substitution Lemma)と呼ばれる補題は次のことを主張します:項tが自由変数xを持ち、xが型Uを持つという仮定のもとでtに型Tが付けられるとする。また、別の項vについて、vが型Uを持つことが示されるとする。このとき、vはtの型付けに関するxについての上述の仮定を満たすことから、tにおけるそれぞれのxの出現をvで置換することはできるはずであり、その置換によって型がTのままである新しい項を得る。

「補題」: もしGamma,x:U |- t : Tかつ|- v : Uならば [Gamma |-v/xt : T].

Lemma substitution_preserves_typing : forall Gamma x U v t T,
has_type (extend Gamma x U) t T ->
has_type empty v U   ->
has_type Gamma (subst v x t) T.

補題の主張について技術的に巧妙な点の1つは、vに型Uを割当てるのが「空」コンテキストであることです。言い換えると、vが閉じていると仮定しています。この仮定はT_Absの場合の証明を(この場面でとりうる別の仮定であるGamma |- v : Uを仮定するのに比べて)大幅に簡単にします。なぜなら、コンテキスト不変補題(the context invariance lemma)が、どんなコンテキストでもvが型Uを持つことを示すからです。v内の自由変数がT-Absによってコンテキストに導入された変数と衝突することを心配する必要はありません。

「証明」:tについての帰納法によって、すべてのTとGammaについてGamma,x:U |- t : Tかつ|- v : Uならば、Gamma |- [v/xt : T]であることを証明する。

- tが変数のとき、tがxであるか否かによって2つの場合がある。

- t = xの場合、Gamma, x:U |- x : Tという事実から、U = Tになる。ここで示すべきことは、空コンテキストのもとでvが型U = Tという仮定の上で、Gammaのもとで[v/xx = v] が型Tを持つことである。これは、コンテキスト不変補題、つまり、閉じた項が空コンテキストのもとで型Tを持つならば、その項は任意のコンテキストのもとで型Tを持つ、ということから得られる。

- tがx以外の変数yである場合、yの型はGamma,x:UのもとでもGammaのもとでも変わらないということに注意するだけでよい。

- tが関数抽象\y:T11. t12のとき、帰納仮定から、すべてのGamma'とT'について、Gamma',x:U |- t12 : T'かつ|- v : UならばGamma' |- [v/xt12 : T’]となる。特にGamma,y:T11,x:U |- t12 : T12かつ|- v : UならばGamma,y:T11 |- [v/xt12 : T12] となる。xとyが同じ変数か否かでまた2つの場合がある。 最初にx = yとすると、置換の定義から[v/xt = t] である。これからGamma |- t : Tを示すだけで良い。しかし、Gamma,x:U |- t : Tであって、\y:T11. t12にyは自由に出現することはないから、コンテキスト不変補題からGamma |- t : Tとなる。 次にx <> yとする。型付け関係の反転から [Gamma,x:U,y:T11 |- t12 :T12] であり、これとコンテキスト不変補題からGamma,y:T11,x:U |- t12 : T12となる。これから帰納仮定を使って、Gamma,y:T11 |- [v/xt12 : T12] が得られる。T_AbsからGamma |- \y:T11. [v/xt12 : T11->T12] となり、置換の定義から(x <> yに注意すると)求めるGamma |- \y:T11. [v/xt12 : T11->T12] が得られる。

- tが関数適用t1 t2のときは、結果は置換の定義と帰納法の仮定から直ぐに 得られる。

- 他の場合は、関数適用の場合と同様である。

別の技術的な注: この証明は、型の導出についての帰納法ではなく項についての帰納法を使うことが議論をより簡単にするという、珍しいものです。この理由は、仮定has_type (extend Gamma x U) t Tがある意味で完全に一般化されていないからです。ある意味というのは、型関係の1つの「スロット」、つまりコンテキストが、単に1つの変数ではないということです。このことにより、Coq がもともと持っている帰納法のタクティックでは必要な帰納法の仮定が導かれません。これを回避することは可能ですが、そのために必要な一般化はちょっとトリッキーです。これに対して項tは完全に一般化されています。

Proof with eauto.
intros Gamma x U v t T Ht Hv.
generalize dependent Gamma. generalize dependent T.
tm_cases (induction t) Case; intros T Gamma H;

inversion H; subst; simpl...
Case "tm_var".
rename i into y. remember (beq_id x y) as e. destruct e.
SCase "x=y".
apply beq_id_eq in Heqe. subst.
rewrite extend_eq in H2.
inversion H2; subst. clear H2.
eapply context_invariance... intros x Hcontra.
destruct (free_in_context _ _ T empty Hcontra) as [T' HT']...
inversion HT'.
SCase "x<>y".
apply T_Var. rewrite extend_neq in H2...
Case "tm_abs".
rename i into y. apply T_Abs.
remember (beq_id x y) as e. destruct e.
SCase "x=y".
eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".
apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
Qed.

置換補題は一種の「交換性」(“commutation” property)と見なせます。直観的には、置換と型付けはどの順でやってもよいということを主張しています。(適切なコンテキストのもとで)項tとvに個別に型付けをしてから置換によって両者を組合せても良いし、置換を先にやって後から[v/xt ] に型をつけることもできます。どちらでも結果は同じです。

保存

さて、(型の)保存(preservation)を証明する道具立ては揃いました。保存とは、閉じた項tが型Tを持ち、t'への評価ステップを持つならば、t'はまた型Tを持つ閉じた項である、という性質です。言い換えると、スモールステップ評価関係は型を保存するということです。

Theorem preservation : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.

「証明」:|- t : Tの導出についての帰納法を使う。

- まず最後の規則がT_Var、T_Abs、T_True、T_Falseである場合は外して良い。なぜなら、これらの場合、tはステップを進むことができないからである。

- 導出の最後の規則がT_Appのとき、t = t1 t2である。 このとき、t1 t2がt'にステップを進めたことを示すのに使われた規則について、3つの場合が考えられる。

- t1 t2がST_App1によってステップを進めた場合、t1がステップを進めたものをt1'とする。すると帰納仮定よりt1'はt1と同じ型を持ち、したがって、t1' t2はt1 t2と同じ型を持つ。

- ST_App2の場合は同様である。

- t1 t2がST_AppAbsによってステップを進めた場合、t1 = \x:T11.t12であり、t1 t2はsubst t2 x t12にステップする。すると置換が型を保存するという事実から求める結果となる。

- 導出の最後の規則がT_Ifのとき、t = if t1 then t2 else t3であり、 やはりtのステップについて3つの場合がある。

- tがt2またはt3にステップした場合、結果は直ぐである。なぜならt2とt3はtと同じ型だからである。

- そうでない場合、tはST_Ifでステップする。このとき、 帰納法の仮定から直接求める結果が得られる。

Proof with eauto. remember (@empty ty) as Gamma. intros t t’ T HT. generalize dependent t’. has_type_cases (induction HT) Case; intros t’ HE; subst Gamma; subst; try solve [inversion HE; subst; auto]. Case “T_App”. inversion HE; subst...

SCase "ST_AppAbs".
apply substitution_preserves_typing with T11...
inversion HT1...

Qed.

練習問題: ★★, recommended (subject_expansion_stlc)

[]
*)

FILL IN HERE このファイルの前の練習問題で、算術式とブール式の簡単な言語についての主部展開性についてききました(訳注:実際には Types_J.v内の練習問題)。STLCでこの性質は成立するでしょうか？つまり、t ==> t'かつhas_type t' Tならばhas_type t Tということが常に言えるでしょうか？もしそうならば証明しなさい。そうでなければ、反例を挙げなさい。

(* FILL IN HERE *)☐

進行

最後に、「進行」定理(the progress theorem)は閉じた、型が付けられる項は行き詰まらないことを示します。つまり、型が付けられる項は、値であるか、または評価ステップを進むことができるか、どちらかです。

Theorem progress : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.

「証明」:|- t : Tの導出についての帰納法による。

- 導出の最後の規則はT_Varではありえない。なぜなら、 空コンテキストにおいて変数には型付けできないからである。

- T_True、T_False、T_Absの場合は自明である。 なぜなら、これらの場合tは値だからである。

- 導出の最後の規則がT_Appの場合、t = t1 t2であり、t1およびt2はどちらも空コンテキストで型付けされる。特に型T2があって、|- t1 : T2 -> Tかつ|- t2 : T2となる。帰納法の仮定から、t1は値であるか、評価ステップを進むことができる。

- t1が値のとき、t2を考えると、 帰納仮定からさらに値である場合と評価ステップを進む場合がある。

- t2が値のとき、t1は値で関数型であるから、ラムダ抽象である。 ゆえに、t1 t2はST_AppAbsでステップを進むことができる。

- そうでなければ、t2はステップを進むことができる。したがってST_App2でt1 t2もステップを進むことができる。

- t1がステップを進むことができるとき、ST_App1でt1 t2もステップを進むことができる。

- 導出の最後の規則がT_Ifのとき、t = if t1 then t2 else t3でt1は型Boolを持つ。帰納仮定よりt1は値かステップを進むことができるかどちらかである。

- t1が値のとき、その型がBoolであることからt1はtrueまたはfalseである。trueならばtはt2に進み、そうでなければt3に進む。

- そうでないとき、t1はステップを進むことができる。したがって(ST_Ifより)tもステップを進むことができる。

Proof with eauto. intros t T Ht. remember (@empty ty) as Gamma. has_type_cases (induction Ht) Case; subst Gamma... Case “T_Var”.

inversion H.

Case “T_App”.

right. destruct IHHt1...

SCase "t1 is a value".
destruct IHHt2...
SSCase "t2 is also a value".

inversion H; subst. exists (subst t2 x t)...
solve by inversion. solve by inversion.
SSCase "t2 steps".
destruct H0 as [t2' Hstp]. exists (tm_app t1 t2')...

SCase "t1 steps".
destruct H as [t1' Hstp]. exists (tm_app t1' t2)...

Case “T_If”. right. destruct IHHt1...

SCase "t1 is a value".

inversion H; subst. solve by inversion.
SSCase "t1 = true". eauto.
SSCase "t1 = false". eauto.

SCase "t1 also steps".
destruct H as [t1' Hstp]. exists (tm_if t1' t2 t3)...

Qed.

練習問題: ★★★, optional (progress_from_term_ind)

型についての帰納法ではなく項についての帰納法でも進行の証明ができることを示しなさい。

Theorem progress' : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.
Proof.
intros t.
tm_cases (induction t) Case; intros T Ht; auto.
(* FILL IN HERE *) Admitted.

☐

型の一意性

練習問題: ★★★ (types_unique)

STLCの別の好ましい性質は、型が唯一であることです。つまり、与えらえた項については(与えられたコンテキストで)高々1つの型しか型付けされません。

この主張を形式化し、証明しなさい。

(* FILL IN HERE *)

☐

さらなる練習問題

なにも見ることなく、単純型付きラムダ計算の進行定理と保存定理を書き下しなさい。

☐

STLCの評価関係に次の新しい規則を加えたとします:

| T_Strange : forall x t,
has_type empty (tm_abs x Bool t) Bool

この規則を加えても真であるSTLCの性質は以下のうちどれでしょうか？それぞれについて、「真のまま」または「偽に変わる」と書きなさい。偽に変わるものについては、反例を挙げなさい。

- stepの決定性

- 進行

- 保存

☐

step関係からST_App1規則を除いたとします。このとき前の練習問題の3つの性質のうち、偽になるものはどれでしょう？偽になるものについては、反例を挙げなさい。

☐

End STLC.

練習問題: 算術を持つSTLC

STLCが実際のプログラミング言語の核として機能することを見るため、数値についての具体的な基本型と定数、いくつかの基本操作を追加しましょう。

Module STLCArith.

構文と操作的意味

型について、自然数を基本型として加えます(そして簡潔さのためブール型を除きます)。

Inductive ty : Type :=
| ty_arrow : ty -> ty -> ty
| ty_Nat   : ty.

項について、自然数の定数、1つ前をとる関数、1つ後をとる関数、積算、ゼロか否かのテスト...を加えます。

Inductive tm : Type :=
| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm
| tm_nat  : nat -> tm
| tm_succ : tm -> tm
| tm_pred : tm -> tm
| tm_mult : tm -> tm -> tm
| tm_if0  : tm -> tm -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app"
| Case_aux c "tm_abs" | Case_aux c "tm_nat"
| Case_aux c "tm_succ" | Case_aux c "tm_pred"
| Case_aux c "tm_mult" | Case_aux c "tm_if0" ].

算術を拡張したSTLCの定義と性質の形式化を完成させなさい。特に:

- STLCについてここまでやってきたこと(定義から進行定理まで)の全体をコピーして、 ファイルのこの部分にペーストしなさい。

- subst操作とstep関係の定義を拡張して、算術の操作の適切な節を含むようにしなさい。

- オリジナルのSTLCの性質の証明を拡張して、新しい構文を扱うようにしなさい。 Coq がその証明を受理することを確認しなさい。

(* FILL IN HERE *)

☐

End STLCArith.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Typechecking_J: STLCの型チェッカ

Require Export Stlc_J.
Require Import Relations.

STLCのhas_type関係は(あるコンテキストのもとで)項が型に属するという意味を定義します。しかし、それ自身では、項に型付けができるかどうかの「チェック方法」は与えません。

幸いにも、has_typeを定義する規則は構文指向(syntax directed)です。項の形にそのまま従います。このことから、型付け規則を型チェック「関数」の節にそのまま変換することができます。この関数は、項とコンテキストをとり、その項の型を返すか、項が型付けできないという信号を出します。

Module STLCChecker.
Import STLC.

型を比較する

最初に、2つの型の等しさを比較する関数が必要です...

Fixpoint beq_ty (T1 T2:ty) : bool :=
match T1,T2 with
| ty_Bool, ty_Bool =>
true
| ty_arrow T11 T12, ty_arrow T21 T22 =>
andb (beq_ty T11 T21) (beq_ty T12 T22)
| _,_ =>
false
end.

... そして、beq_tyが返すブール値の結果と2つの入力が等しいという論理命題との間の、通常の双方向結合を確立します。

Lemma beq_ty_refl : forall T1,
beq_ty T1 T1 = true.
Proof.
intros T1. induction T1; simpl.
reflexivity.
rewrite IHT1_1. rewrite IHT1_2. reflexivity.  Qed.

Lemma beq_ty__eq : forall T1 T2,
beq_ty T1 T2 = true -> T1 = T2.
Proof with auto.
intros T1. induction T1; intros T2 Hbeq; destruct T2; inversion Hbeq.
Case "T1=ty_Bool".
reflexivity.
Case "T1=ty_arrow T1_1 T1_2".
apply andb_true in H0. destruct H0 as [Hbeq1 Hbeq2].
apply IHT1_1 in Hbeq1. apply IHT1_2 in Hbeq2. subst...  Qed.

型チェッカ

そしてこれが型チェッカです。与えられた項の構造をたどって調べ、Some TまたはNoneを返します。部分項の型を調べるために再帰呼び出しをするたびに、結果についてパターンマッチをして、Noneでないことを確認します。tm_appの場合はさらに、パターンマッチングで関数型の矢印の右側と左側を抽出します(そして関数の型がty_arrow T11 T12という形ではないときは失敗します(つまりNoneを返します))。

Fixpoint type_check (Gamma:context) (t:tm) : option ty :=
match t with
| tm_var x => Gamma x
| tm_abs x T11 t12 => match type_check (extend Gamma x T11) t12 with
| Some T12 => Some (ty_arrow T11 T12)
| _ => None
end
| tm_app t1 t2 => match type_check Gamma t1, type_check Gamma t2 with
| Some (ty_arrow T11 T12),Some T2 =>
if beq_ty T11 T2 then Some T12 else None
| _,_ => None
end
| tm_true => Some ty_Bool
| tm_false => Some ty_Bool
| tm_if x t f => match type_check Gamma x with
| Some ty_Bool =>
match type_check Gamma t, type_check Gamma f with
| Some T1, Some T2 =>
if beq_ty T1 T2 then Some T1 else None
| _,_ => None
end
| _ => None
end
end.

性質

この型チェックアルゴリズムが正しいことを検証するため、この関数がオリジナルのhas_type関係について健全(sound)で完全(complete)であることを示します。つまり、type_checkとhas_typeが同じ部分関数を定義することです。

Theorem type_checking_sound : forall Gamma t T,
type_check Gamma t = Some T -> has_type Gamma t T.
Proof with eauto.
intros Gamma t. generalize dependent Gamma.
tm_cases (induction t) Case; intros Gamma T Htc; inversion Htc.
Case "tm_var"...
Case "tm_app".
remember (type_check Gamma t1) as TO1.
remember (type_check Gamma t2) as TO2.
destruct TO1 as [T1|]; try solve by inversion;
destruct T1 as [|T11 T12]; try solve by inversion.
destruct TO2 as [T2|]; try solve by inversion.
remember (beq_ty T11 T2) as b.
destruct b; try solve by inversion.
symmetry in Heqb. apply beq_ty__eq in Heqb.
inversion H0; subst...
Case "tm_abs".
rename i into y. rename t into T1.
remember (extend Gamma y T1) as G'.
remember (type_check G' t0) as TO2.
destruct TO2; try solve by inversion.
inversion H0; subst...
Case "tm_true"...
Case "tm_false"...
Case "tm_if".
remember (type_check Gamma t1) as TOc.
remember (type_check Gamma t2) as TO1.
remember (type_check Gamma t3) as TO2.
destruct TOc as [Tc|]; try solve by inversion.
destruct Tc; try solve by inversion.
destruct TO1 as [T1|]; try solve by inversion.
destruct TO2 as [T2|]; try solve by inversion.
remember (beq_ty T1 T2) as b.
destruct b; try solve by inversion.
symmetry in Heqb. apply beq_ty__eq in Heqb.
inversion H0. subst. subst...
Qed.

Theorem type_checking_complete : forall Gamma t T,
has_type Gamma t T -> type_check Gamma t = Some T.
Proof with auto.
intros Gamma t T Hty.
has_type_cases (induction Hty) Case; simpl.
Case "T_Var"...
Case "T_Abs". rewrite IHHty...
Case "T_App".
rewrite IHHty1. rewrite IHHty2.
rewrite (beq_ty_refl T11)...
Case "T_True"...
Case "T_False"...
Case "T_If". rewrite IHHty1. rewrite IHHty2.
rewrite IHHty3. rewrite (beq_ty_refl T)...
Qed.

End STLCChecker.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

MoreStlc_J: 単純型付きラムダ計算についてさらに

Require Export Stlc_J.
Require Import Relations.

STLCの単純な拡張

単純型付きラムダ計算は理論的性質を興味深いものにするには十分な構造を持っていますが、まだプログラミング言語といえるようなものではありません。この章では、型レベルでの直接的な扱いがあるいくつもの馴染み深い機能を導入することで、実世界の言語とのギャップを埋め始めます。

数値

数値に関する型、定数、基本操作を追加することは容易です。Stlc_J章の前半と後半をくっつけるだけです。

let束縛

複雑な式を書くとき、部分式に名前をつけるのが便利なことがよくあります。同じことを繰り返すのを避けることができ、またしばしば可読性が向上します。ほとんどの言語はこのための1つ以上の方法を持っています。OCaml(および Coq)では、例えばlet x=t1 in t2と書くと「式t1を評価して、その結果を名前xに束縛してt2を評価する」ことを意味します。

ここで導入するlet束縛子はOCamlに従って値呼び(call-by-value)評価順序とします。つまり、let本体の評価が始まる前にlet束縛項は完全に評価されます。型付け規則T_Letは、letの型が次の手順で計算されることを示しています:まずlet束縛項の型の計算、次にその型の束縛によるコンテキストの拡張、さらにこの拡張されたコンテキストでのlet本体の型の計算をすると、それがlet式全体の型になります。

コースのこの時点では、新しい機能の定義のためにたくさんの日本語の文章を読み通すより、同じ情報を伝える規則を単に見る方が、おそらく簡単でしょう。以下がその規則です:

構文:

t ::=                項
| ...               (前と同じ他の項)
| let x=t in t      let束縛

簡約:

t1 ==> t1'
----------------------------------               (ST_Let1)
let x=t1 in t2 ==> let x=t1' in t2

----------------------------              (ST_LetValue)
let x=v1 in t2 ==> [v1/x] t2

型付け:

Gamma |- t1 : T1      Gamma , x:T1 |- t2 : T2
--------------------------------------------            (T_Let)
Gamma |- let x=t1 in t2 : T2

対

ここまでの関数プログラミングの例では、値の対(pairs)を頻繁に使ってきました。そのような対の型は直積型(product type)と呼ばれます。

対の形式化はほとんど議論する余地がないほど簡単です。しかし、共通パターンを強調するため、定義のいろいろな部分をちょっと見てみましょう。

Coqでは、対の構成要素を抽出する基本的な方法は、パターンマッチング(pattern matching)です。別の方法としては、fstとsnd、つまり、1番目と2番目の要素の射影操作を基本操作として持つ方法があります。お遊びで、直積をこの方法でやってみましょう。例えば、数値の対をとり、その和と差の対を返す関数の書き方は次の通りです:

\x:Nat*Nat.
let sum = x.fst + x.snd in
let diff = x.fst - x.snd in
(sum,diff)

これから、単純型付きラムダ計算に対を追加するには、2つの新しい項の形を追加することが含まれます。1つは対で(t1,t2)と書きます。もう1つは射影で、第1射影はt.fst、第2射影はt.sndと書きます。さらに1つの型コンストラクタT1*T2を追加します。これはT1とT2の直積と呼びます。

構文:

t ::=                項
| ...
| (t,t)             対
| t.fst             第1射影
| t.snd             第2射影

v ::=                値
| ...
| (v,v)             対値

T ::=                型
| ...
| T * T             直積型

評価については、対と射影がどう振る舞うかを規定するいくつかの新しい規則が必要です。

t1 ==> t1'
--------------------                        (ST_Pair1)
(t1,t2) ==> (t1',t2)

t2 ==> t2'
--------------------                        (ST_Pair2)
(v1,t2) ==> (v1,t2')

t1 ==> t1'
------------------                          (ST_Fst1)
t1.fst ==> t1'.fst

------------------                       (ST_FstPair)
(v1,v2).fst ==> v1

t1 ==> t1'
------------------                          (ST_Snd1)
t1.snd ==> t1'.snd

------------------                       (ST_SndPair)
(v1,v2).snd ==> v2

規則ST_FstPairとST_SndPairは、完全に評価された対が第1射影または第2射影に遭遇したとき、結果が対応する要素であることを規定します。合同規則ST_Fst1とST_Snd1は、射影の対象の項が完全に評価されきっていないとき、その簡約を認めるものです。ST_Pair1とST_Pair2は対の構成部分の評価です。最初に左の部分を評価し、それが値を持ったら、次に右の部分を評価します。これらの規則内でメタ変数vとtを使うことで現れる順番は、対を左から右の順で評価すること(left-to-right evaluation)を規定しています。(暗黙の慣習として、vやv1などのメタ変数は値のみを指すものとしています。)また値の定義に節を加え、(v1,v2)が値であることを規定しています。対値の要素自体が値でなければならないという事実は、関数の引数として渡された対が、関数の本体の実行が開始される前に完全に評価されることを保証します。

対と射影の型付け規則はそのまま直ぐに得られます。

Gamma |- t1 : T1       Gamma |- t2 : T2
---------------------------------------                 (T_Pair)
Gamma |- (t1,t2) : T1*T2

Gamma |- t1 : T11*T12
---------------------                           (T_Fst)
Gamma |- t1.fst : T11

Gamma |- t1 : T11*T12
---------------------                           (T_Snd)
Gamma |- t1.snd : T12

規則T_Pairは、t1が型T1を持ち、t2が型T2を持つならば、(t1,t2)が型T1*T2を持つことを言っています。逆に、規則T_FstとT_Sndは、t1が直積型T11*T12を持つ(つまり評価結果が対になる)ならば、射影の型はT11とT12になることを定めます。

直和

多くのプログラムでは2つの異なった形を持つ値を扱うことが求められます。例えばアカウント処理をするアプリケーションで名前か、「または」、IDナンバーで雇用者を認証するかもしれません。探索関数はマッチした値か、「または」、エラーコードを返すかもしれません。

これらは、(2項の)直和型(sum type)の例です。(2項)直和型は2つの与えられた型から抽出した値の集合にあたります。例えば

Nat + Bool

この型の要素を、それぞれの構成部分の型の要素にタグ付けする(tagging)ことで生成します。例えば、nがNatならばinl vはNat+Boolの要素です。同様に、bがBoolならばinr bはNat+Boolの要素です。タグの名前inlとinrは、これらのタグを関数と考えるところから出ています。

inl : Nat -> Nat + Bool
inr : Bool -> Nat + Bool

これらの関数は、NatまたはBoolの要素を直和型Nat+Boolの左部分または右部分に単射(“inject”)します。(しかし、実際にはこれらを関数としては扱いません。inlとinrはキーワードで、inl tとinr tは基本構文形であり、関数適用ではありません。この扱いによって、これらに特別な型付け規則を用意できるようになります。)

一般に、型T1 + T2の要素はT1の要素にinlをタグ付けしたものと、T2の要素にinrをタグ付けしたものから成ります。

直和型の要素を「使う」目的で、その分解のためにcase構文を導入します(これはCoqのmatchの非常に単純化された形です)。例えば、以下の手続きは、Nat+BoolをNatに変換します:

getNat =
\x:Nat+Bool.
case x of
inl n => n
| inr b => if b then 1 else 0

より形式的に...

構文:

t ::=                項
| ...
| inl T t           タグ付け(左)
| inr T t           タグ付け(右)
| case t of         case
inl x => t
| inr x => t

v ::=                値
| ...
| inl T v           タグ付き値(左)
| inr T v           タグ付き値(右)

T ::=                型
| ...
| T + T             直和型

評価:

t1 ==> t1'
----------------------                         (ST_Inl)
inl T t1 ==> inl T t1'

t1 ==> t1'
----------------------                         (ST_Inr)
inr T t1 ==> inr T t1'

t0 ==> t0'
-------------------------------------------       (ST_Case)
case t0 of inl x1 => t1 | inr x2 => t2 ==>
case t0' of inl x1 => t1 | inr x2 => t2

----------------------------------------------         (ST_CaseInl)
case (inl T v0) of inl x1 => t1 | inl x2 => t2
==>  [v0/x1] t1

----------------------------------------------         (ST_CaseInr)
case (inr T v0) of inl x1 => t1 | inl x2 => t2
==>  [v0/x2] t2

型付け:

Gamma |- t1 :  T1
----------------------------                       (T_Inl)
Gamma |- inl T2 t1 : T1 + T2

Gamma |- t1 : T2
----------------------------                       (T_Inr)
Gamma |- inr T1 t1 : T1 + T2

Gamma |- t0 : T1+T2
Gamma , x1:T1 |- t1 : T
Gamma , x2:T2 |- t2 : T
---------------------------------------------------           (T_Case)
Gamma |- case t0 of inl x1 => t1 | inr x2 => t2 : T

inlとinrの形に型を付記する理由は、型の一意性を保つためです。この情報がなければ、型推論規則T_Inlは、例えば、t1が型T1の要素であることを示した後、「任意の」型T2についてinl t1がT1 + T2の要素であることを導出できます。例えば、inl 5 : Nat + Natとinl 5 : Nat + Boolの両方(および無限に多数の他の型付け)が導出できます。この型の一意性の失敗は、型チェックアルゴリズムを、ここまでやってきたように「規則を下から上に読む」という単純な方法で構築することができなくなることを意味します。

この問題を扱うのにはいろいろな方法があります。簡単なものの1つは、ここで採用する方法ですが、単射を実行するときに直和型の「別の側」をプログラマが明示的に付記することを強制するというものです。これはプログラマにとってかなりヘビーウェイトです(そのため実際の言語は別の解法を採用しています)。しかし、理解と形式化は容易な方法です。

リスト

ここまで見てきた型付け機能は、Boolのような基本型(base types)と、古い型から新しい型を構築する->や*のような型コンストラクタ(type constructors)に分類できます。もう一つの有用な型コンストラクタがListです。すべての型Tについて、型List TはTから抽出したものを要素とする有限長リストを表します。

原理的には、リストの機構を使って、バリアントを定義したり、再帰型(recursive types)を定義したりすることができます。しかし、前者の詳細はここまで省略してきており、後者に意味を与えることは簡単ではありません。その代わりに、リストの特別な場合を直接議論します。

以下にリストの構文、意味、型付け規則を与えます。nilに対して明示的に型を付記することが必須であり、consには付記できないという点を除けば、ここで定義されたリストは本質的にCoqで構築したものと同じです。リストを分解するためにlcaseを使います。これは「空リストのheadは何か？」というような問題を扱うことを避けるためです。従って、例えば、数値リストの最初の2つの要素の和を計算する関数は次の通りです:

\x:List Nat.
lcase x of nil -> 0
| a::x' -> lcase x' of nil -> a
| b::x'' -> a+b

cons v1 v2が値というときには、v2もリストでなければなりません。値の形式的定義ではこのことを強制します。

構文:

t ::=                Terms
| ...
| nil T
| cons t t
| lcase t of nil -> t | x::x -> t

v ::=                Values
| ...
| nil T             nil value
| cons v v          cons value

T ::=                Types
| ...
| List T            list of Ts

簡約:

t1 ==> t1'
--------------------------                    (ST_Cons1)
cons t1 t2 ==> cons t1' t2

t2 ==> t2'
--------------------------                    (ST_Cons2)
cons v1 t2 ==> cons v1 t2'

t1 ==> t1'
----------------------------------------             (ST_Lcase1)
(lcase t1 of nil -> t2 | h::t -> t3) ==>
(lcase t1' of nil -> t2 | h::t -> t3)

---------------------------------------            (ST_LcaseNil)
(lcase nil T of nil -> t2 | h::t -> t3)
==> t2

----------------------------------------------       (ST_LcaseCons)
(lcase (cons vh vt) of nil -> t2 | h::t -> t3)
==> [vh/h,vt/t]t3

型付け:

-----------------------                       (T_Nil)
Gamma |- nil T : List T

Gamma |- t1 : T      Gamma |- t2 : List T
-----------------------------------------              (T_Cons)
Gamma |- cons t1 t2: List T

Gamma |- t1 : List T1
Gamma |- t2 : T
Gamma , h:T1, t:List T1 |- t3 : T
-------------------------------------------------           (T_Lcase)
Gamma |- (lcase t1 of nil -> t2 | h::t -> t3) : T

一般再帰

(Coqを含む)ほとんどのプログラミング言語に現れるもう1つの機構が、再帰関数を定義する機能です。例えば、階乗関数を次のように定義できるとよいと思うでしょう:

fact = \x:Nat.
if x=0 then 1 else x * (fact (pred x)))

しかし、これを形式化するには、なかなかの作業が必要になります。そうするには、「関数定義」(“function definitions”)の概念を導入し、stepの定義の中で、関数定義の「環境」(“environment”)を持ち回ることが必要になるでしょう。

ここでは、直接的に形式化する別の方法をとります。右辺に定義しようとしている識別子を含む再帰的定義を書く代わりに、不動点演算子(fixed-point operator)を定義することができます。不動点演算子は、簡約の過程で再帰的定義の右辺を遅延(lazy)して「展開」(“unfold”)するものです。

fact =
fix
(\f:Nat->Nat.
\x:Nat.
if x=0 then 1 else x * (f (pred x)))

直観的にはfixに渡される高階関数fはfact関数の生成器(generator)です。fが、factに求められる振る舞いをnまで近似する関数(つまり、n以下の入力に対して正しい結果を返す関数)に適用されるとき、fはより良い近似、つまり、n+1まで正しい答えを返す関数、を返します。fixをこの生成器に適用すると、生成器の不動点(fixed point)を返します。この不動点は、すべての入力nについて求められる振る舞いをする関数です。

(不動点(“fixed point”)という用語は通常の数学とまったく同じ意味で使っています。通常の数学では、関数fの不動点とは、f(x) = xとなる入力xのことです。これから、(いってみれば)型(Nat->Nat)->(Nat->Nat)を持つ関数Fの不動点は、F fがfと振る舞い同値である関数fです。)

構文:

t ::=                項
| ...
| fix t             不動点演算子

簡約:

t1 ==> t1'
------------------                       (ST_Fix1)
fix t1 ==> fix t1'

-------------------------------------------         (ST_FixAbs)
fix (\x:T1.t2) ==> [(fix(\x:T1.t2)) / x] t2

型付け:

Gamma |- t1 : T1->T1
--------------------                        (T_Fix)
Gamma |- fix t1 : T1

練習問題: ★ (halve_fix)

[]
*)

FILL IN HERE 次の再帰的定義をfixを用いた定義に直しなさい:

halve =
\x:Nat.
if x=0 then 0
else if (pred x)=0 then 0
else 1 + (halve (pred (pred x))))

(* FILL IN HERE *)☐

練習問題: ★, recommended (fact_steps)

[]
*)

FILL IN HERE 項fact 1が正規形まで簡約されるステップ列を書き下しなさい(ただし、算術演算については通常の簡約規則を仮定します)。

(* FILL IN HERE *)☐

任意のTについて型T->Tの関数の不動点が記述できる形ができたことから、驚くようなことが起こります。特に、すべての型が何らかの項に住まれている(inhabited)ということが導かれます。これを確認するため、すべての型Tについて、項

fix (\x:T.x)

が定義できることを見てみましょう。T_FixとT_Absから、この項は型Tを持ちます。ST_FixAbsより、この項を簡約すると何度やっても自分自身になります。したがって、この項はTの未定義要素(undefined element)です。

より有用なこととして、次はfixを使って2引数の再帰関数を定義する例です:

equal =
fix
(\eq:Nat->Nat->Bool.
\m:Nat. \n:Nat.
if m=0 then iszero n
else if n=0 then false
else eq (pred m) (pred n))

そして最後に、次はfixを使って再帰関数の対を定義する例です(この例は、規則T_Fixの型T1は関数型ではなくてもよいことを示しています):

evenodd =
fix
(\eo: (Nat->Bool * Nat->Bool).
let e = \n:Nat. if n=0 then true  else eo.snd (pred n) in
let o = \n:Nat. if n=0 then false else eo.fst (pred n) in
(e,o))

even = evenodd.fst
odd  = evenodd.snd

レコードとバリアント (Optional)

STLCの基本拡張の最後の例として、レコード(records)とその型をどのように形式化するかをちょっと見てみましょう。この拡張は概念的には対と直積型の真っ直ぐな一般化ですが、記法的にはちょっとたいへんです。このため、形式的な扱いは独立した章(Records_J)まで置いておきます。

この素材は以下の追加の練習問題には含まれません。必要ならば、とばしても斜め読みしても構いません。

Unit型

もう一つの便利な基本型は、MLファミリーの言語に特に見られるものですが、1要素の型Unitです。この型は要素を1つ持ちます。それは項定数unitです(先頭の文字は小文字のuです)。型付け規則はunitをUnitの要素と定めます。計算の結果として取りうる値の集合にもunitを加えます。実際、unitは型Unitの式の評価結果としてとり得る唯一の値です。

構文:

t ::=                項
| ...
| unit              unit値

v ::=                値
| ...
| unit              unit

T ::=                型
| ...
| Unit              Unit型

型付け:

--------------------                          (T_Unit)
Gamma |- unit : Unit

単に1つだけの要素を持つ型を定義することにわずらわされるのは、少々奇妙なことに見えるかもしれません。何と言っても、このような型の中の計算はどうでも良いものだけではないのでしょうか？

これは妥当な質問です。実際STLCではUnit型は特別、問題ではありません(ちょっと後でこの型のある使い道を見ることになりますが)。Unitが本当に便利なのはよりリッチな言語でいろいろな種類の副作用(side effects)を持つ場合です。例えば、変更可能な変数やポインタについての代入文や、例外その他のローカルではないコントロール機構を持つ場合、などです。そのような言語では、副作用のためだけに評価される式の(どうでもよい)結果のための型が便利なのです。

レコード

日常的なプログラミング言語のもう1つの馴染み深い構造が、レコード(records)です。直観的には、レコードは2種類の一般化の組み合わせによって得られます。1つは(2項だけではなく)n-項積です。もう1つはフィールドアクセスに(場所ではなく)ラベル(label)を使うことです。

構文:

t ::=                          項
| ...
| {i1=t1, ..., in=tn}         レコード
| t.i                         射影

v ::=                          値
| ...
| {i1=v1, ..., in=vn}         レコード値

T ::=                          型
| ...
| {i1:T1, ..., in:Tn}         レコード型

直観的には、この一般化はかなり明確です。しかし、ここで実際に記述したものはかなり非形式的であることは注意しておくべきです。特に、いろいろなところで、”...“を「これらを何個か」という意味で使っていますし、レコードに同じラベルが複数回出てきてはいけない、という通常の付加条件を明示的に述べることを省いています。より詳細な非形式的記法を考案することもできますが、それはかなりヘビーで、また定義の大事な点をわかりにくくすることになりかねません。このため、ここではちょっとルーズなまま残しておいて(とにかく、どちらにしろ非形式的なのです)、きっちり仕上げるのは別のところ(Records_J.v)でやります。

簡約:

ti ==> ti'
------------------------------------                  (ST_Rcd)
{i1=v1, ..., im=vm, in=ti, ...}
==> {i1=v1, ..., im=vm, in=ti', ...}

t1 ==> t1'
--------------                           (ST_Proj1)
t1.i ==> t1'.i

-------------------------                    (ST_ProjRcd)
{..., i=vi, ...}.i ==> vi

再び、これらの規則はちょっと非形式的です。例えば、最初の規則は「tiが値でないフィールドのうち最も左のもので、tiはti'にステップで進むならば、レコード全体のステップは...」と読まれることを意図しています。最後の規則では、i と呼ばれるフィールドは1つだけで、他のすべてのフィールドは値を持っていることを意図しています。

型付け:

Gamma |- t1 : T1     ...     Gamma |- tn : Tn
--------------------------------------------------            (T_Rcd)
Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}

Gamma |- t : {..., i:Ti, ...}
-----------------------------                      (T_Proj)
Gamma |- t.i : Ti

レコードのエンコード

上述の定義を精密にするにはいろいろな方法があります。

- 構文の形と推論規則を、上記の形になるべく近いまま直接形式化するという方法があります。 これは概念的に「直球」で、もし本当のコンパイラを作るならば、おそらくいちばん合っているでしょう。特に、形式化の中にエラーメッセージのプリントを含めることができるので、プログラマが理解するのが容易になるでしょう。しかし、規則の形式化版はまったくきれいにはなりません!

- レコードを表現する、よりスムーズな方法を探すことができます。 例えば、1つのコンストラクタでレコード全体を一度に作るのではなく、空レコードに対応する1つのコンストラクタと、存在するレコードに1つのフィールドを追加する別のコンストラクタの2つで表現するという方法があります。この方法は、レコードについての計算のメタ理論に一番の興味がある場合には正しい方法です。なぜなら、この方法をとると、きれいで優雅な定義と証明が得られるからです。ファイルRecords_J.vでは、この方法がどのように行えるかを示しています。

- 別の方法として、望むならば、レコードを形式化することを完全に避けることができます。 このためには、レコード記法は、対と直積型を含むより複雑な式の単なる非形式的な略記法である、と規定します。ここではこのアプローチのスケッチを与えます。

最初に、任意のサイズの組が対とunit値のネストでエンコードできることを確認します。対の記法(t1,t2)を混用するのを避けるため、組を書き下すためにはラベルを持たない中カッコ({..})を使います。これから、{}は0個組、{5}は一つ組、{5,6}は二つ組(おそらく対と同じ)、{5,6,7}は三つ組、等です。

{}                 ---->  unit
{t1, t2, ..., tn}  ---->  (t1, trest)
ただし {t2, ..., tn} ----> trest

同様に、組の型を直積型のネストでエンコードすることができます。

{}                 ---->  Unit
{T1, T2, ..., Tn}  ---->  T1 * TRest
ただし {T2, ..., Tn} ----> TRest

組のフィールドの射影演算は、第2射影の列に続く第1射影としてエンコードできます:

t.0        ---->  t.fst
t.(n+1)    ---->  (t.snd).n

次に、レコードラベルに何らかの全順序があり、そのため各ラベルに一意に自然数が関連づけられると仮定します。この数をラベルのポジション(position)と呼びます。例えば、以下のようにポジションが定められるとします:

LABEL   POSITION
a       0
b       1
c       2
...     ...
foo     1004
...     ...
bar     10562
...     ...

このポジションを、レコード値を組(つまりネストされた対)でエンコードするために使います。つまり、フィールドをそのポジションでソートします。例えば:

{a=5, b=6}      ---->   {5,6}
{a=5, c=7}      ---->   {5,unit,7}
{c=7, a=5}      ---->   {5,unit,7}
{c=5, b=3}      ---->   {unit,3,5}
{f=8,c=5,a=7}   ---->   {7,unit,5,unit,unit,8}
{f=8,c=5}       ---->   {unit,unit,5,unit,unit,8}

以下のことに注意します。各フィールドはそのラベルに関連づけられたポジションに現れます。また、組の大きさは、最大のポジションを持つラベルによって決定されます。そして、使われていないポジションはunitで埋められます。

レコードの型についてもまったくおなじことをします:

{a:Nat, b:Nat}      ---->   {Nat,Nat}
{c:Nat, a:Nat}      ---->   {Nat,Unit,Nat}
{f:Nat,c:Nat}       ---->   {Unit,Unit,Nat,Unit,Unit,Nat}

最後に、レコードの射影は適切なポジションについての組の射影でエンコードされます:

t.l  ---->  t.(position of l)

レコードのオリジナルの「直接の」表現に対するすべての型付け規則が、このエンコードで正しいことをチェックするのは難しいことではありません。(簡約規則は正しさを「ほぼ」確認できます。完全に、ではありません。なぜなら、フィールドの並べ直しのエンコードのためです。)

もちろん、ラベルbarを持つレコードをたまたま使ったときには、このエンコードはあまり効率的ではありません。しかしこの問題は見た目ほど深刻ではありません。もし、コンパイラがプログラム全体を同時に見ることができると仮定するなら、ラベルの番号づけをうまく選んで、一番よく使われるラベルに小さいポジションを与えることができます。実際、商用のコンパイラで本質的にこれをやっているものがあります!

バリアント

直積がレコードに一般化できたのと同様、直和は n-個のラベルを持った型「バリアント」(variants)に一般化できます。T1+T2の代わりに<l1:T1,l2:T2,...ln:Tn>のように書くことができます。ここでl1、l2、... はフィールドラベルで、インスタンスの構成と、case のラベルの両方に使われます。

n-個のバリアントは、リストや木構造のような任意の帰納的データ型をゼロから構築するのに必要なメカニズムのほとんどを与えます。唯一足りないのは、型定義の再帰です。ここではこの話題は扱いません。ただ、詳細な扱いはいろいろなテキストブックに書かれています。例えば “Types and Programming Languages” です。

拡張を形式化する

拡張(オプションの1つを除く)の形式化は読者に残してあります。項と型の構文の必要な拡張は提示しておきました。また、読者が、自分の定義が期待された通りに動作するかをテストすることができるように、いくつかの例を示しておきました。読者は定義の残りの部分を埋め、それに合わせて証明を拡張しなさい。(訳注：節構成がまぎらわしいですが、この章のここ以降はすべてこの練習問題の内部のようです。埋めるのはその中の「ここを埋めなさい」という部分です。なお、以下の記述はCoq記述内の埋め込みコメントを読まないと理解できない部分があると思いますが、HTML化したものでは、埋め込みコメントが表示されていないかもしれません。その場合はHTML化前のCoqソースを見てください。)

よい戦略は、ファイルの最初から最後までを1パスで行おうとせずに、複数回のパスで拡張項目を一つづつやることです。定義または証明のそれぞれについて、提示されたパーツを注意深く読むことから始めなさい。その際に、ハイレベルの直観についてはStlc_J章のテキストを参照し、詳細の機構については、埋め込まれたコメントを参照しなさい。

拡張を試みる良い順番は以下の順でしょう:

- 最初に数値(なぜなら、馴染み深く簡単なので)

- 直積

- let (束縛を含むので)

- 直和 (より複雑な束縛を含むので)

- リスト (さらに複雑な束縛を含むので)

- fix

Module STLCExtended.

構文と操作的意味

Inductive ty : Type :=
| ty_arrow : ty -> ty -> ty
| ty_prod  : ty -> ty -> ty
| ty_sum   : ty -> ty -> ty
| ty_List  : ty -> ty
| ty_Nat   : ty.

Tactic Notation "ty_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ty_arrow"
| Case_aux c "ty_prod" | Case_aux c "ty_sum"
| Case_aux c "ty_List" | Case_aux c "ty_Nat" ].

Inductive tm : Type :=

(* 拡張されていないSTLC *)

| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm

(* 対 *)

| tm_pair : tm -> tm -> tm
| tm_fst : tm -> tm
| tm_snd : tm -> tm

(* 直和 *)

| tm_inl : ty -> tm -> tm
| tm_inr : ty -> tm -> tm
| tm_case : tm -> id -> tm -> id -> tm -> tm

(* 例えば、[case t0 of inl x1 => t1 | inr x2 => t2] *)

(* リスト *)

| tm_nil : ty -> tm
| tm_cons : tm -> tm -> tm
| tm_lcase : tm -> tm -> id -> id -> tm -> tm

(* 例えば、[lcase t1 of | nil -> t2 | x::y -> t3] *)

(* 数値 *)

| tm_nat : nat -> tm
| tm_succ : tm -> tm
| tm_pred : tm -> tm
| tm_mult : tm -> tm -> tm
| tm_if0  : tm -> tm -> tm -> tm

(* let *)

| tm_let : id -> tm -> tm -> tm

(* 例えば、[let x = t1 in t2] *)

(* fix *)

| tm_fix  : tm -> tm.

なお、簡潔にするため、ブール値をなくし、その代わりゼロテストと条件分岐を組み合わせたif0構文を提供してきています。つまり、

if x = 0 then ... else ...

と書く代わりに、次のように書きます:

if0 x then ... else ...

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app" | Case_aux c "tm_abs"
| Case_aux c "tm_pair" | Case_aux c "tm_fst" | Case_aux c "tm_snd"
| Case_aux c "tm_inl" | Case_aux c "tm_inr" | Case_aux c "tm_case"
| Case_aux c "tm_nil" | Case_aux c "tm_cons" | Case_aux c "tm_lcase"
| Case_aux c "tm_nat" | Case_aux c "tm_succ" | Case_aux c "tm_pred"
| Case_aux c "tm_mult" | Case_aux c "tm_if0"
| Case_aux c "tm_let" | Case_aux c "tm_fix" ].

置換

Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
match t with
| tm_var y =>
if beq_id x y then s else t
| tm_abs y T t1 =>
tm_abs y T (if beq_id x y then t1 else (subst x s t1))
| tm_app t1 t2 =>
tm_app (subst x s t1) (subst x s t2)
(* FILL IN HERE *)

(* ここを埋めなさい *)

| _ => t

(* ...そして上の行を消しなさい。 *)

end.

簡約

次にこの言語の値を定義します。

Inductive value : tm -> Prop :=
| v_abs : forall x T11 t12,
value (tm_abs x T11 t12)
(* FILL IN HERE *)

(* ここを埋めなさい *)

.

Hint Constructors value.

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_AppAbs : forall x T11 t12 v2,
value v2 ->
(tm_app (tm_abs x T11 t12) v2) ==> (subst x v2 t12)
| ST_App1 : forall t1 t1' t2,
t1 ==> t1' ->
(tm_app t1 t2) ==> (tm_app t1' t2)
| ST_App2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
(tm_app v1 t2) ==> (tm_app v1 t2')
(* FILL IN HERE *)

(* ここを埋めなさい *)

where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2"
(* FILL IN HERE *)

(* ここを埋めなさい *)

].

Notation stepmany := (refl_step_closure step).
Notation "t1 '==>*' t2" := (stepmany t1 t2) (at level 40).

Hint Constructors step.

型付け

Definition context := partial_map ty.

次に型付け規則を定義します。上述の推論規則のほとんど直接の転写です。

Inductive has_type : context -> tm -> ty -> Prop :=

| T_Var : forall Gamma x T,
Gamma x = Some T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
has_type (extend Gamma x T11) t12 T12 ->
has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T1 T2 Gamma t1 t2,
has_type Gamma t1 (ty_arrow T1 T2) ->
has_type Gamma t2 T1 ->
has_type Gamma (tm_app t1 t2) T2
(* FILL IN HERE *)

(* ここを埋めなさい *)

.

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
(* FILL IN HERE *)

(* ここを埋めなさい *)

].

この節では上述の例(および追加のいくつか)の形式化版を示します。最初の方のものは、特定の拡張項目に焦点を当てています。ファイルの後の方の、その拡張項目について証明を拡張するところに進む前に、これらの例を使って拡張項目についての自分の定義が適切かを確認することができます。後の方の例はいろいろな拡張項目をまとめて必要とします。すべての定義を埋めた後、これらの例に戻ってみる必要があるでしょう。

Module Examples.

準備

最初に、いくつか変数名を定義しましょう:

Notation a := (Id 0).
Notation f := (Id 1).
Notation g := (Id 2).
Notation l := (Id 3).
Notation k := (Id 6).
Notation i1 := (Id 7).
Notation i2 := (Id 8).
Notation x := (Id 9).
Notation y := (Id 10).
Notation processSum := (Id 11).
Notation n := (Id 12).
Notation eq := (Id 13).
Notation m := (Id 14).
Notation evenodd := (Id 15).
Notation even := (Id 16).
Notation odd := (Id 17).
Notation eo := (Id 18).

次に、Coq にちょっと手を入れて、型の導出の検索を自動化します。詳細を理解する必要はまったくありません。ざっと眺めておけば、もしautoに独自の拡張をしなければならなくなったとき、何を調べれば良いかがわかるでしょう。

以下のHint宣言は、次のように言っています:autoが(has_type G (tm_app e1 e2) T)という形のゴールに到達したときは常に、eapply T_Appを考えなさい。この結果、中間的な型 T1 の存在変数が残ります。(コメントになっている)lcaseについても同様です。その存在変数は、e1とe2の型導出の探索の仮定で具体化されます。またヒントに、等号による比較の形のゴールを解く場合に「より困難なことを試しなさい」ということも追加します。これは、T_Var(これは事前条件に等号による比較を含みます)を自動的に使用するのに便利です。

Hint Extern 2 (has_type _ (tm_app _ _) _) =>
eapply T_App; auto.

(* 型関係に[T_Lcase]を定義した後では、次の部分のコメントをはずすのが良いでしょう。 *)

(*
Hint Extern 2 (has_type _ (tm_lcase _ _ _ _ _) _) =>
eapply T_Lcase; auto.
*)

Hint Extern 2 (_ = _) => compute; reflexivity.

数値

Module Numtest.

if0 (pred (succ (pred (2 * 0)))) then 5 else 6

Definition test :=
tm_if0
(tm_pred
(tm_succ
(tm_pred
(tm_mult
(tm_nat 2)
(tm_nat 0)))))
(tm_nat 5)
(tm_nat 6).

auto 10.
Qed.

Example numtest_reduces :
test ==>* tm_nat 5.
Proof.
unfold test. normalize.
Qed.
*)

動くだけ定義が十分に行えたと思ったなら、以降のExampleのコメントをはずしなさい。

(*
Example typechecks :
has_type (@empty ty) test ty_Nat.
Proof.
unfold test.
(* この型導出は非常に深く、そのため[auto]の最大探索深度を、
デフォルトの5から10に上げなければなりません。 *)
auto 10.
Qed.

Example numtest_reduces :
test ==>* tm_nat 5.
Proof.
unfold test. normalize.
Qed.
*)

End Numtest.

直積

Module Prodtest.

((5,6),7).fst.snd

Definition test :=
tm_snd
(tm_fst
(tm_pair
(tm_pair
(tm_nat 5)
(tm_nat 6))
(tm_nat 7))).

(*
Example typechecks :
has_type (@empty ty) test ty_Nat.
Proof. unfold test. eauto 15. Qed.

Example reduces :
test ==>* tm_nat 6.
Proof. unfold test. normalize. Qed.
*)

End Prodtest.

let

Module LetTest.

let x = pred 6 in succ x

Definition test :=
tm_let
x
(tm_pred (tm_nat 6))
(tm_succ (tm_var x)).

(*
Example typechecks :
has_type (@empty ty) test ty_Nat.
Proof. unfold test. eauto 15. Qed.

Example reduces :
test ==>* tm_nat 6.
Proof. unfold test. normalize. Qed.
*)

End LetTest.

直和

Module Sumtest1.

[case (inl Nat 5) ofinl x => x| inr y => y]

Definition test :=
tm_case (tm_inl ty_Nat (tm_nat 5))
x (tm_var x)
y (tm_var y).

(*
Example typechecks :
has_type (@empty ty) test ty_Nat.
Proof. unfold test. eauto 15. Qed.

Example reduces :
test ==>* (tm_nat 5).
Proof. unfold test. normalize. Qed.
*)

End Sumtest1.

Module Sumtest2.

[let processSum =:Nat+Nat.case x ofinl n => ninr n => if0 n then 1 else 0 in(processSum (inl Nat 5), processSum (inr Nat 5))]

Definition test :=
tm_let
processSum
(tm_abs x (ty_sum ty_Nat ty_Nat)
(tm_case (tm_var x)
n (tm_var n)
n (tm_if0 (tm_var n) (tm_nat 1) (tm_nat 0))))
(tm_pair
(tm_app (tm_var processSum) (tm_inl ty_Nat (tm_nat 5)))
(tm_app (tm_var processSum) (tm_inr ty_Nat (tm_nat 5)))).

(*
Example typechecks :
has_type (@empty ty) test (ty_prod ty_Nat ty_Nat).
Proof. unfold test. eauto 15. Qed.

Example reduces :
test ==>* (tm_pair (tm_nat 5) (tm_nat 0)).
Proof. unfold test. normalize. Qed.
*)

End Sumtest2.

リスト

Module ListTest.

[let l = cons 5 (cons 6 (nil Nat)) inlcase l ofnil => 0| x::y => x*x]

Definition test :=
tm_let l
(tm_cons (tm_nat 5) (tm_cons (tm_nat 6) (tm_nil ty_Nat)))
(tm_lcase (tm_var l)
(tm_nat 0)
x y (tm_mult (tm_var x) (tm_var x))).

(*
Example typechecks :
has_type (@empty ty) test ty_Nat.
Proof. unfold test. eauto 20. Qed.

Example reduces :
test ==>* (tm_nat 25).
Proof. unfold test. normalize. Qed.
*)

End ListTest.

fix

Module FixTest1.

[fact := fix(:nat->nat.:nat.if a=0 then 1 else a * (f (pred a)))]

Definition fact :=
tm_fix
(tm_abs f (ty_arrow ty_Nat ty_Nat)
(tm_abs a ty_Nat
(tm_if0
(tm_var a)
(tm_nat 1)
(tm_mult
(tm_var a)
(tm_app (tm_var f) (tm_pred (tm_var a))))))).

(ワーニング:factの型チェックが通るかもしれませんが、それでもいくつかの規則が間違ったままです。)

(*
Example fact_typechecks :
has_type (@empty ty) fact (ty_arrow ty_Nat ty_Nat).
Proof. unfold fact. auto 10.
Qed.
*)

(*
Example fact_example:
(tm_app fact (tm_nat 4)) ==>* (tm_nat 24).
Proof. unfold fact. normalize. Qed.
*)

End FixTest1.

Module FixTest2.

[map :=:nat->nat.fix(:nat->nat.:nat.case l of|☐ ->☐ | x::l -> (g x)::(f l))]

Definition map :=
tm_abs g (ty_arrow ty_Nat ty_Nat)
(tm_fix
(tm_abs f (ty_arrow (ty_List ty_Nat) (ty_List ty_Nat))
(tm_abs l (ty_List ty_Nat)
(tm_lcase (tm_var l)
(tm_nil ty_Nat)
a l (tm_cons (tm_app (tm_var g) (tm_var a))
(tm_app (tm_var f) (tm_var l))))))).

Example map_typechecks :
has_type empty map
(ty_arrow (ty_arrow ty_Nat ty_Nat)
(ty_arrow (ty_List ty_Nat)
(ty_List ty_Nat))).
Proof. unfold map. auto 10. Qed.

Example map_example :
tm_app (tm_app map (tm_abs a ty_Nat (tm_succ (tm_var a))))
(tm_cons (tm_nat 1) (tm_cons (tm_nat 2) (tm_nil ty_Nat)))
==>* (tm_cons (tm_nat 2) (tm_cons (tm_nat 3) (tm_nil ty_Nat))).
Proof. unfold map. normalize. Qed.
*)

(*
(* 上記の最後の [Hint Extern] のコメントが外されていることを確認すること... *)
Example map_typechecks :
has_type empty map
(ty_arrow (ty_arrow ty_Nat ty_Nat)
(ty_arrow (ty_List ty_Nat)
(ty_List ty_Nat))).
Proof. unfold map. auto 10. Qed.

Example map_example :
tm_app (tm_app map (tm_abs a ty_Nat (tm_succ (tm_var a))))
(tm_cons (tm_nat 1) (tm_cons (tm_nat 2) (tm_nil ty_Nat)))
==>* (tm_cons (tm_nat 2) (tm_cons (tm_nat 3) (tm_nil ty_Nat))).
Proof. unfold map. normalize. Qed.
*)

End FixTest2.

Module FixTest3.

[equal =fix(:Nat->Nat->Bool.:Nat. :Nat.if0 m then (if0 n then 1 else 0)else if0 n then 0else eq (pred m) (pred n))]

Definition equal :=
tm_fix
(tm_abs eq (ty_arrow ty_Nat (ty_arrow ty_Nat ty_Nat))
(tm_abs m ty_Nat
(tm_abs n ty_Nat
(tm_if0 (tm_var m)
(tm_if0 (tm_var n) (tm_nat 1) (tm_nat 0))
(tm_if0 (tm_var n)
(tm_nat 0)
(tm_app (tm_app (tm_var eq)
(tm_pred (tm_var m)))
(tm_pred (tm_var n)))))))).

(*
Example equal_typechecks :
has_type (@empty ty) equal (ty_arrow ty_Nat (ty_arrow ty_Nat ty_Nat)).
Proof. unfold equal. auto 10.
Qed.
*)

(*
Example equal_example1:
(tm_app (tm_app equal (tm_nat 4)) (tm_nat 4)) ==>* (tm_nat 1).
Proof. unfold equal. normalize. Qed.
*)

(*
Example equal_example2:
(tm_app (tm_app equal (tm_nat 4)) (tm_nat 5)) ==>* (tm_nat 0).
Proof. unfold equal. normalize. Qed.
*)

End FixTest3.

Module FixTest4.

[let evenodd =fix(: (Nat->Nat * Nat->Nat).let e = :Nat. if0 n then 1 else eo.snd (pred n) inlet o = :Nat. if0 n then 0 else eo.fst (pred n) in(e,o)) inlet even = evenodd.fst inlet odd = evenodd.snd in(even 3, even 4)]

Definition eotest :=
tm_let evenodd
(tm_fix
(tm_abs eo (ty_prod (ty_arrow ty_Nat ty_Nat) (ty_arrow ty_Nat ty_Nat))
(tm_pair
(tm_abs n ty_Nat
(tm_if0 (tm_var n)
(tm_nat 1)
(tm_app (tm_snd (tm_var eo)) (tm_pred (tm_var n)))))
(tm_abs n ty_Nat
(tm_if0 (tm_var n)
(tm_nat 0)
(tm_app (tm_fst (tm_var eo)) (tm_pred (tm_var n))))))))
(tm_let even (tm_fst (tm_var evenodd))
(tm_let odd (tm_snd (tm_var evenodd))
(tm_pair
(tm_app (tm_var even) (tm_nat 3))
(tm_app (tm_var even) (tm_nat 4))))).

(*
Example eotest_typechecks :
has_type (@empty ty) eotest (ty_prod ty_Nat ty_Nat).
Proof. unfold eotest. eauto 30.
Qed.
*)

(*
Example eotest_example1:
eotest ==>* (tm_pair (tm_nat 0) (tm_nat 1)).
Proof. unfold eotest. normalize. Qed.
*)

End FixTest4.

End Examples.

このシステムの進行と保存の証明は、純粋な単純型付きラムダ計算のものと本質的に同じです(もちろんいくらか長くはなりますが)。

進行

Theorem progress : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.
Proof with eauto.

(* 定理: empty |- t : T と仮定する。すると次のいずれかである:
1. t は値、または
2. ある t' について t ==> t'
証明: 与えられた型導出についての帰納法によって。 *)

intros t T Ht.
remember (@empty ty) as Gamma.
generalize dependent HeqGamma.
has_type_cases (induction Ht) Case; intros HeqGamma; subst.
Case "T_Var".

(* 与えられた型導出の最後の規則が [T_Var] ではあり得ない。
なぜなら、この規則では [empty |- x : T] にならないので
(コンテキストが empty ではない)。*)

inversion H.
Case "T_Abs".

(* もし [T_Abs] が最後の規則ならば、[t = tm_abs x T11 t12] となるが、
これは値である。 *)

left...
Case "T_App".

(* 最後の規則が T_App ならば、[t = t1 t2] である。規則の形から
[empty |- t1 : T1 -> T2]
[empty |- t2 : T1]
となる。帰納法の仮定から、t1 と t2 のそれぞれは値であるかステップを進むことができる。 *)

right.
destruct IHHt1; subst...
SCase "t1 is a value".
destruct IHHt2; subst...
SSCase "t2 is a value".

(* [t1] と [t2] がどちらも値のとき、[t1 = tm_abs x T11 t12] となる。
なぜなら関数抽象は、関数型を持つ唯一の値であるから。しかし、[ST_AppAbs]より
[(tm_abs x T11 t12) t2 ==> subst x t2 t12] となる。 *)

inversion H; subst; try (solve by inversion).
exists (subst x t2 t12)...
SSCase "t2 steps".

(* もし [t1] が値で [t2 ==> t2'] ならば、
[ST_App2]より [t1 t2 ==> t1 t2'] である。 *)

destruct H0 as [t2' Hstp]. exists (tm_app t1 t2')...
SCase "t1 steps".

(* 最後に、もし [t1 ==> t1'] ならば、
[ST_App1] より [t1 t2 ==> t1' t2] である。 *)

destruct H as [t1' Hstp]. exists (tm_app t1' t2)...
(* FILL IN HERE *)

(* ここを埋めなさい *)

Qed.

コンテキスト不変性

Inductive appears_free_in : id -> tm -> Prop :=
| afi_var : forall x,
appears_free_in x (tm_var x)
| afi_app1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)
| afi_app2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)
| afi_abs : forall x y T11 t12,
y <> x  ->
appears_free_in x t12 ->
appears_free_in x (tm_abs y T11 t12)
(* FILL IN HERE *)

(* ここを埋めなさい *)

.

Hint Constructors appears_free_in.

Lemma context_invariance : forall Gamma Gamma' t S,
has_type Gamma t S  ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x)  ->
has_type Gamma' t S.
Proof with eauto.
intros. generalize dependent Gamma'.
has_type_cases (induction H) Case;
intros Gamma' Heqv...
Case "T_Var".
apply T_Var... rewrite <- Heqv...
Case "T_Abs".
apply T_Abs... apply IHhas_type. intros y Hafi.
unfold extend. remember (beq_id x y) as e.
destruct e...
(* FILL IN HERE *)

(* ここを埋めなさい *)

Qed.

Lemma free_in_context : forall x t T Gamma,
appears_free_in x t ->
has_type Gamma t T ->
exists T', Gamma x = Some T'.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
has_type_cases (induction Htyp) Case; inversion Hafi; subst...
Case "T_Abs".
destruct IHHtyp as [T' Hctx]... exists T'.
unfold extend in Hctx.
apply not_eq_beq_id_false in H2. rewrite H2 in Hctx...
(* FILL IN HERE *)

(* ここを埋めなさい *)

Qed.

保存

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S  ->
has_type empty v U   ->
has_type Gamma (subst x v t) S.
Proof with eauto.

(* 定理: もし Gamma,x:U |- t : S かつ empty |- v : U ならば、
Gamma |- (subst x v t) S. である。 *)

intros Gamma x U v t S Htypt Htypv.
generalize dependent Gamma. generalize dependent S.

(* 証明: t についての帰納法を使う。ほとんどの場合は、帰納仮定から直接示される。
tm_var と tm_abs だけが例外である。
前者は自動化できない。変数がどのように相互作用するか推論しなければならないからである。 *)

tm_cases (induction t) Case;
intros S Gamma Htypt; simpl; inversion Htypt; subst...
Case "tm_var".
simpl. rename i into y.

(* もし t = y ならば、次が成立する:
[empty |- v : U] and
[Gamma,x:U |- y : S]
そして、inversion から [extend Gamma x U y = Some S] となる。
示したいのは [Gamma |- subst x v y : S] である。

考慮するのは2つの場合、[x=y] の場合と [x<>y] の場合である。 *)

remember (beq_id x y) as e. destruct e.
SCase "x=y".

(* もし [x = y] ならば、[U = S] であり、また [subst x v y = v] である。
これから実際に示さなければならないことは、
もし [empty |- v : U] ならば [Gamma |- v : U] である、ということである。
この定理のより一般化されたバージョンを既に証明している。それはコンテキスト不変性である。 *)

apply beq_id_eq in Heqe. subst.
unfold extend in H1. rewrite <- beq_id_refl in H1.
inversion H1; subst. clear H1.
eapply context_invariance...
intros x Hcontra.
destruct (free_in_context _ _ S empty Hcontra) as [T' HT']...
inversion HT'.
SCase "x<>y".

(* もし [x <> y] ならば、[Gamma y = Some S] で、置換は何も影響しない。
[T_Var] より [Gamma |- y : S] を示すことができる。 *)

apply T_Var... unfold extend in H1. rewrite <- Heqe in H1...
Case "tm_abs".
rename i into y. rename t into T11.

(* もし [t = tm_abs y T11 t0] ならば、次が成立する:
[Gamma,x:U |- tm_abs y T11 t0 : T11->T12]
[Gamma,x:U,y:T11 |- t0 : T12]
[empty |- v : U]
帰納仮定より、すべての S Gamma について
[Gamma,x:U |- t0 : S -> Gamma |- subst x v t0 S] となる。

次の計算ができる:
subst x v t = tm_abs y T11 (if beq_id x y
then t0
else subst x v t0)
そして、示すべきことは [Gamma |- subst x v t : T11->T12] である。
[T_Abs] を使うためには、残っているのは次を示すことである:
[Gamma,y:T11 |- if beq_id x y then t0 else subst x v t0 : T12]
2つの場合、[x = y] の場合と [x <> y] の場合を考える。
*)

apply T_Abs...
remember (beq_id x y) as e. destruct e.
SCase "x=y".

(* もし [x = y] ならば、置換は何も影響しない。
コンテキスト不変性より [Gamma,y:U,y:T11] と [Gamma,y:T11]
が同値であることが示される。前者のコンテキストが [t0 : T12] を示すことから、
後者についても同じことが言える。 *)

eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".

(* もし [x <> y] ならば、帰納仮定とコンテキスト不変性より次が示される:
[Gamma,x:U,y:T11 |- t0 : T12]       =>
[Gamma,y:T11,x:U |- t0 : T12]       =>
[Gamma,y:T11 |- subst x v t0 : T12] *)

apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
(* FILL IN HERE *)

(* ここを埋めなさい *)

Qed.

Theorem preservation : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.
Proof with eauto.
intros t t' T HT.

(* 定理: もし [empty |- t : T] かつ [t ==> t'] ならば、[empty |- t' : T] である。 *)

remember (@empty ty) as Gamma. generalize dependent HeqGamma.
generalize dependent t'.

(* 証明: 与えられた型導出についての帰納法を使う。ほとんどの場合は、
[T_Var] と [T_Abs] の矛盾である(contradictory ([T_Var], [T_Abs]))。
興味深いものだけを示す。 *)

has_type_cases (induction HT) Case;
intros t' HeqGamma HE; subst; inversion HE; subst...
Case "T_App".

(* もし最後の規則が [T_App] ならば、[t = t1 t2] である。
[t ==> t'] を示すのに使うことができる規則は3つ、[ST_App1]、[ST_App2]、[ST_AppAbs]
である。最初の2つについては、結果は帰納仮定から直ぐに導かれる。 *)

inversion HE; subst...
SCase "ST_AppAbs".

(* 3つ目の場合、
[t1 = tm_abs x T11 t12]
かつ
[t2 = v2]
と仮定する。示すべきは [empty |- subst x v2 t12 : T2] である。
仮定から
[empty |- tm_abs x T11 t12 : T1->T2]
であり、inversion から
[x:T1 |- t12 : T2]
となる。
substitution_preserves_typing を既に証明しており、また仮定から
[empty |- v2 : T1]
である。これで証明された。 *)

apply substitution_preserves_typing with T1...
inversion HT1...
(* FILL IN HERE *)

(* ここを埋めなさい *)

Qed.

☐

End STLCExtended.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Records_J: STLCにレコードを追加する

Require Export Stlc_J.
Require Import Relations.

レコードを追加する

MoreStlc_J.vで、レコードを、直積のネストされた使用の構文糖衣として扱う方法を見ました。これは簡単な例にはよいです。しかし、エンコードは非形式的です。(現実的に、もしこの方法でレコードを本当に扱うならパーサ内で実行されることになりますが、パーサはここでは省いています。)そしていずれにしろ、あまり効率的ではありません。これから、レコードを言語の第一級(first-class)のメンバーとしてはどのように扱えるのか見るのも興味があるところです。

前の非形式的定義を思い出してみましょう:

構文:

t ::=                          項:
| ...
| {i1=t1, ..., in=tn}         レコード
| t.i                         射影

v ::=                          値:
| ...
| {i1=v1, ..., in=vn}         レコード値

T ::=                          型:
| ...
| {i1:T1, ..., in:Tn}         レコード型

簡約:

ti ==> ti'                            (ST_Rcd)
--------------------------------------------------------------------
{i1=v1, ..., im=vm, in=tn, ...} ==> {i1=v1, ..., im=vm, in=tn', ...}

t1 ==> t1'
--------------                        (ST_Proj1)
t1.i ==> t1'.i

-------------------------                (ST_ProjRcd)
{..., i=vi, ...}.i ==> vi

型付け:

Gamma |- t1 : T1     ...     Gamma |- tn : Tn
--------------------------------------------------         (T_Rcd)
Gamma |- {i1=t1, ..., in=tn} : {i1:T1, ..., in:Tn}

Gamma |- t : {..., i:Ti, ...}
-----------------------------                   (T_Proj)
Gamma |- t.i : Ti

レコードを形式化する

Module STLCExtendedRecords.

構文と操作的意味

レコード型の構文を形式化する最も明らかな方法はこうです:

Module FirstTry.

Definition alist (X : Type) := list (id * X).

Inductive ty : Type :=
| ty_base     : id -> ty
| ty_arrow    : ty -> ty -> ty
| ty_rcd      : (alist ty) -> ty.

残念ながら、ここで Coq の限界につきあたりました。この型は期待する帰納原理を自動的には提供してくれないのです。ty_rcdの場合の帰納法の仮定はリストのty要素について何の情報も提供してくれないのです。このせいで、行いたい証明に対してこの型は役に立たなくなっています。

forall t : ty, P t
*)

(* Check ty_ind.
====>
ty_ind :
forall P : ty -> Prop,
(forall i : id, P (ty_base i)) ->
(forall t : ty, P t -> forall t0 : ty, P t0 -> P (ty_arrow t t0)) ->
(forall a : alist ty, P (ty_rcd a)) ->    (* ??? *)
forall t : ty, P t
*)

End FirstTry.

より良い帰納法の原理をCoqから取り出すこともできます。しかしそれをやるための詳細はあまりきれいではありません。またCoqが単純なInductive定義に対して自動生成したものほど直観的でもありません。

幸い、レコードについて、別の、ある意味より単純でより自然な形式化方法があります。既存のlist型の代わりに、型の構文にリストのコンストラクタ(“nil”と”cons”)を本質的に含めてしまうという方法です。

Inductive ty : Type :=
| ty_base : id -> ty
| ty_arrow : ty -> ty -> ty
| ty_rnil : ty
| ty_rcons : id -> ty -> ty -> ty.

Tactic Notation "ty_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ty_base" | Case_aux c "ty_arrow"
| Case_aux c "ty_rnil" | Case_aux c "ty_rcons" ].

同様に、項のレベルで、空レコードに対応するコンストラクタtm_rnilと、フィールドのリストの前に1つのフィールドを追加するコンストラクタtm_rconsを用意します。

Inductive tm : Type :=
| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm

(* レコード *)

| tm_proj : tm -> id -> tm
| tm_rnil :  tm
| tm_rcons : id -> tm -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app" | Case_aux c "tm_abs"
| Case_aux c "tm_proj" | Case_aux c "tm_rnil" | Case_aux c "tm_rcons" ].

Some variables, for examples...

いくつかの変数、例えば...

Notation a := (Id 0).
Notation f := (Id 1).
Notation g := (Id 2).
Notation l := (Id 3).
Notation A := (ty_base (Id 4)).
Notation B := (ty_base (Id 5)).
Notation k := (Id 6).
Notation i1 := (Id 7).
Notation i2 := (Id 8).

{ i1:A }

(* Check (ty_rcons i1 A ty_rnil). *)

{ i1:A->B, i2:A }

(* Check (ty_rcons i1 (ty_arrow A B)
(ty_rcons i2 A ty_rnil)). *)

Well-Formedness(正しい形をしていること、整式性)

レコードの抽象構文を(リストから nil/cons 構成に)一般化すると、次のような奇妙な型を書くことがができるようになります。

Definition weird_type := ty_rcons X A B.

ここでレコード型の「後部」は実際にはレコード型ではありません!

以降で型ジャッジメントを、weird_typeのようなill-formedの(正しくない形の)型が項に割当てられないように構成します。これをサポートするために、レコード型と項を識別するためのrecord_tyとrecord_tm、およびill-formedの型を排除するためのwell_formed_tyを定義します。

最初に、型がレコード型なのは、それの一番外側のレベルがty_rnilとty_rconsだけを使って構築されたもののときです。

Inductive record_ty : ty -> Prop :=
| rty_nil :
record_ty ty_rnil
| rty_cons : forall i T1 T2,
record_ty (ty_rcons i T1 T2).

同様に、項がレコード項であるのは、tm_rnilとtm_rconsから構築されたもののときです。

Inductive record_tm : tm -> Prop :=
| rtm_nil :
record_tm tm_rnil
| rtm_cons : forall i t1 t2,
record_tm (tm_rcons i t1 t2).

record_tyとrecord_tmは再帰的ではないことに注意します。両者は、一番外側のコンストラクタだけをチェックします。一方well_formed_tyは型全体がwell-formedか(正しい形をしているか)、つまり、レコードのすべての後部(ty_rconsの第2引数)がレコードであるか、を検証します。

もちろん、型だけでなく項についても、ill-formedの可能性を考慮しなければなりません。しかし、別途well_formed_tmを用意しなくても、ill-formed項は型チェックが排除します。なぜなら、型チェックが既に項の構成を調べるからです。

LATER : should they fill in part of this as an exercise? Wedidn’t give rules for it above

(訳注：この”LATER”部分が誰向けに何を言おうとしているのかはっきりしないので、訳さずに残しておきました。)

Inductive well_formed_ty : ty -> Prop :=
| wfty_base : forall i,
well_formed_ty (ty_base i)
| wfty_arrow : forall T1 T2,
well_formed_ty T1 ->
well_formed_ty T2 ->
well_formed_ty (ty_arrow T1 T2)
| wfty_rnil :
well_formed_ty ty_rnil
| wfty_rcons : forall i T1 T2,
well_formed_ty T1 ->
well_formed_ty T2 ->
record_ty T2 ->
well_formed_ty (ty_rcons i T1 T2).

Hint Constructors record_ty record_tm well_formed_ty.

置換

Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
match t with
| tm_var y => if beq_id x y then s else t
| tm_abs y T t1 =>  tm_abs y T (if beq_id x y then t1 else (subst x s t1))
| tm_app t1 t2 => tm_app (subst x s t1) (subst x s t2)
| tm_proj t1 i => tm_proj (subst x s t1) i
| tm_rnil => tm_rnil
| tm_rcons i t1 tr1 => tm_rcons i (subst x s t1) (subst x s tr1)
end.

簡約

次に言語の値を定義します。レコードが値であるのは、そのフィールドがすべて値であるときです。

Inductive value : tm -> Prop :=
| v_abs : forall x T11 t12,
value (tm_abs x T11 t12)
| v_rnil : value tm_rnil
| v_rcons : forall i v1 vr,
value v1 ->
value vr ->
value (tm_rcons i v1 vr).

Hint Constructors value.

レコード型またはレコード項から1つのフィールドを取り出すユーティリティ関数です:

Fixpoint ty_lookup (i:id) (Tr:ty) : option ty :=
match Tr with
| ty_rcons i' T Tr' => if beq_id i i' then Some T else ty_lookup i Tr'
| _ => None
end.

Fixpoint tm_lookup (i:id) (tr:tm) : option tm :=
match tr with
| tm_rcons i' t tr' => if beq_id i i' then Some t else tm_lookup i tr'
| _ => None
end.

step関数は(射影規則について)項レベルのlookup関数を使います。一方、型レベルのlookupはhas_typeで必要になります。

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_AppAbs : forall x T11 t12 v2,
value v2 ->
(tm_app (tm_abs x T11 t12) v2) ==> (subst x v2 t12)
| ST_App1 : forall t1 t1' t2,
t1 ==> t1' ->
(tm_app t1 t2) ==> (tm_app t1' t2)
| ST_App2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
(tm_app v1 t2) ==> (tm_app v1 t2')
| ST_Proj1 : forall t1 t1' i,
t1 ==> t1' ->
(tm_proj t1 i) ==> (tm_proj t1' i)
| ST_ProjRcd : forall tr i vi,
value tr ->
tm_lookup i tr = Some vi ->
(tm_proj tr i) ==> vi
| ST_Rcd_Head : forall i t1 t1' tr2,
t1 ==> t1' ->
(tm_rcons i t1 tr2) ==> (tm_rcons i t1' tr2)
| ST_Rcd_Tail : forall i v1 tr2 tr2',
value v1 ->
tr2 ==> tr2' ->
(tm_rcons i v1 tr2) ==> (tm_rcons i v1 tr2')

where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2"
| Case_aux c "ST_Proj1" | Case_aux c "ST_ProjRcd"
| Case_aux c "ST_Rcd_Head" | Case_aux c "ST_Rcd_Tail" ].

Notation stepmany := (refl_step_closure step).
Notation "t1 '==>*' t2" := (stepmany t1 t2) (at level 40).

Hint Constructors step.

型付け

Definition context := partial_map ty.

次に型付け規則を定義します。これは上述の推論規則をほぼそのまま転写したものです。大きな違いはwell_formed_tyの使用だけです。非形式的な表記では、well-formedレコード型だけを許す文法を使ったので、別のチェックを用意する必要はありませんでした。

ここでは、has_type Gamma t Tが成立するときは常にwell_formed_ty Tが成立するようにしたいところです。つまり、has_typeは項にill-formed型を割当てることはないようにするということです。このことを後で実際に証明します。

しかしながらhas_typeの定義を、well_formed_tyを不必要に使って取り散らかしたくはありません。その代わりwell_formed_tyによるチェックを必要な所だけに配置します。ここで、必要な所というのは、has_typeの帰納的呼び出しによっても未だ型のwell-formed性のチェックが行われていない所のことです。

例えば、T_Varの場合、well_formed_ty Tをチェックします。なぜなら、Tの形がwell-formedであることを調べる帰納的なhas_typeの呼び出しがないからです。同様にT_Absの場合、well_formed_ty T11の証明を必要とします。なぜなら、has_typeの帰納的呼び出しはT12がwell-formedであることだけを保証するからです。

読者が記述しなければならない規則の中でwell_formed_tyチェックが必要なのは、tm_nilの場合だけです。

Inductive has_type : context -> tm -> ty -> Prop :=
| T_Var : forall Gamma x T,
Gamma x = Some T ->
well_formed_ty T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
well_formed_ty T11 ->
has_type (extend Gamma x T11) t12 T12 ->
has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T1 T2 Gamma t1 t2,
has_type Gamma t1 (ty_arrow T1 T2) ->
has_type Gamma t2 T1 ->
has_type Gamma (tm_app t1 t2) T2

| T_Proj : forall Gamma i t Ti Tr,
has_type Gamma t Tr ->
ty_lookup i Tr = Some Ti ->
has_type Gamma (tm_proj t i) Ti
| T_RNil : forall Gamma,
has_type Gamma tm_rnil ty_rnil
| T_RCons : forall Gamma i t T tr Tr,
has_type Gamma t T ->
has_type Gamma tr Tr ->
record_ty Tr ->
record_tm tr ->
has_type Gamma (tm_rcons i t tr) (ty_rcons i T Tr).

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
| Case_aux c "T_Proj" | Case_aux c "T_RNil" | Case_aux c "T_RCons" ].

例

練習問題: ★★ (examples)

証明を完成させなさい。

証明の中ではCoq の自動化機能を自由に使って構いません。しかし、もし型システムがどのように動作するか確信できていないなら、最初に基本機能(特にeapplyではなくapply)を使った証明を行い、次に自動化を使ってその証明を圧縮するのがよいかもしれません。

Lemma typing_example_2 :
has_type empty
(tm_app (tm_abs a (ty_rcons i1 (ty_arrow A A)
(ty_rcons i2 (ty_arrow B B)
ty_rnil))
(tm_proj (tm_var a) i2))
(tm_rcons i1 (tm_abs a A (tm_var a))
(tm_rcons i2 (tm_abs a B (tm_var a))
tm_rnil)))
(ty_arrow B B).
Proof.
(* FILL IN HERE *) Admitted.

次の事実(あるいはすぐ上の事実も!)の証明を始める前に、それが何を主張しているかを確認しなさい。

Example typing_nonexample :
~ exists T,
has_type (extend empty a (ty_rcons i2 (ty_arrow A A)
ty_rnil))
(tm_rcons i1 (tm_abs a B (tm_var a)) (tm_var a))
T.
Proof.
(* FILL IN HERE *) Admitted.

Example typing_nonexample_2 : forall y,
~ exists T,
has_type (extend empty y A)
(tm_app (tm_abs a (ty_rcons i1 A ty_rnil)
(tm_proj (tm_var a) i1))
(tm_rcons i1 (tm_var y) (tm_rcons i2 (tm_var y) tm_rnil)))
T.
Proof.
(* FILL IN HERE *) Admitted.

型付けの性質

このシステムの進行と保存の証明は、純粋な単純型付きラムダ計算のものと本質的に同じです。しかし、レコードについての技術的補題を追加する必要があります。

Well-Formedness

Lemma wf_rcd_lookup : forall i T Ti,
well_formed_ty T ->
ty_lookup i T = Some Ti ->
well_formed_ty Ti.
Proof with eauto.
intros i T.
ty_cases (induction T) Case; intros; try solve by inversion.
Case "ty_rcons".
inversion H. subst. unfold ty_lookup in H0.
remember (beq_id i i0) as b. destruct b; subst...
inversion H0. subst...  Qed.

Lemma step_preserves_record_tm : forall tr tr',
record_tm tr ->
tr ==> tr' ->
record_tm tr'.
Proof.
intros tr tr' Hrt Hstp.
inversion Hrt; subst; inversion Hstp; subst; auto.
Qed.

Lemma has_type__wf : forall Gamma t T,
has_type Gamma t T -> well_formed_ty T.
Proof with eauto.
intros Gamma t T Htyp.
has_type_cases (induction Htyp) Case...
Case "T_App".
inversion IHHtyp1...
Case "T_Proj".
eapply wf_rcd_lookup...
Qed.

フィールドのルックアップ

補題: もしempty |- v : Tで、かつty_lookup i TがSome Tiを返すならば,tm_lookup i vはある項tiについてSome tiを返す。ただし、has_type empty ti Tiとなる。

証明: 型の導出Htypについての帰納法で証明する。ty_lookup i T = Some Tiであることから、Tはレコード型でなければならない。このこととvが値であることから、ほとんどの場合は精査で除去でき、T_RConsの場合だけが残る。

型導出の最後のステップがT_RConsによるものであるとき、あるi0、t、tr、T、Trについてt = tm_rcons i0 t trかつT = ty_rcons i0 T Trである。

このとき2つの可能性が残る。i0 = iか、そうでないかである。

- i = i0のとき、ty_lookup i (ty_rcons i0 T Tr) = Some TiからT = Tiとなる。これからt自身が定理を満たすことが言える。

- 一方、i <> i0とする。すると

ty_lookup i T = ty_lookup i Tr

かつ

tm_lookup i t = tm_lookup i tr

となる。これから、帰納法の仮定より結果が得られる。

Lemma lookup_field_in_value : forall v T i Ti,
value v ->
has_type empty v T ->
ty_lookup i T = Some Ti ->
exists ti, tm_lookup i v = Some ti /\ has_type empty ti Ti.
Proof with eauto.
intros v T i Ti Hval Htyp Hget.
remember (@empty ty) as Gamma.
has_type_cases (induction Htyp) Case; subst; try solve by inversion...
Case "T_RCons".
simpl in Hget. simpl. destruct (beq_id i i0).
SCase "i is first".
simpl. inversion Hget. subst.
exists t...
SCase "get tail".
destruct IHHtyp2 as [vi [Hgeti Htypi]]...
inversion Hval... Qed.

進行

Theorem progress : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.
Proof with eauto.

intros t T Ht.
remember (@empty ty) as Gamma.
generalize dependent HeqGamma.
has_type_cases (induction Ht) Case; intros HeqGamma; subst.
Case "T_Var".

inversion H.
Case "T_Abs".

left...
Case "T_App".

right.
destruct IHHt1; subst...
SCase "t1 is a value".
destruct IHHt2; subst...
SSCase "t2 is a value".

inversion H; subst; try (solve by inversion).
exists (subst x t2 t12)...
SSCase "t2 steps".

destruct H0 as [t2' Hstp]. exists (tm_app t1 t2')...
SCase "t1 steps".

destruct H as [t1' Hstp]. exists (tm_app t1' t2)...
Case "T_Proj".

right. destruct IHHt...
SCase "rcd is value".

destruct (lookup_field_in_value _ _ _ _ H0 Ht H) as [ti [Hlkup _]].
exists ti...
SCase "rcd_steps".

destruct H0 as [t' Hstp]. exists (tm_proj t' i)...
Case "T_RNil".

left...
Case "T_RCons".

destruct IHHt1...
SCase "head is a value".
destruct IHHt2; try reflexivity.
SSCase "tail is a value".

left...
SSCase "tail steps".

right. destruct H2 as [tr' Hstp].
exists (tm_rcons i t tr')...
SCase "head steps".

right. destruct H1 as [t' Hstp].
exists (tm_rcons i t' tr)...  Qed.

コンテキスト不変性

Inductive appears_free_in : id -> tm -> Prop :=
| afi_var : forall x,
appears_free_in x (tm_var x)
| afi_app1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)
| afi_app2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)
| afi_abs : forall x y T11 t12,
y <> x  ->
appears_free_in x t12 ->
appears_free_in x (tm_abs y T11 t12)
| afi_proj : forall x t i,
appears_free_in x t ->
appears_free_in x (tm_proj t i)
| afi_rhead : forall x i ti tr,
appears_free_in x ti ->
appears_free_in x (tm_rcons i ti tr)
| afi_rtail : forall x i ti tr,
appears_free_in x tr ->
appears_free_in x (tm_rcons i ti tr).

Hint Constructors appears_free_in.

Lemma context_invariance : forall Gamma Gamma' t S,
has_type Gamma t S  ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x)  ->
has_type Gamma' t S.
Proof with eauto.
intros. generalize dependent Gamma'.
has_type_cases (induction H) Case;
intros Gamma' Heqv...
Case "T_Var".
apply T_Var... rewrite <- Heqv...
Case "T_Abs".
apply T_Abs... apply IHhas_type. intros y Hafi.
unfold extend. remember (beq_id x y) as e.
destruct e...
Case "T_App".
apply T_App with T1...
Case "T_RCons".
apply T_RCons...  Qed.

Lemma free_in_context : forall x t T Gamma,
appears_free_in x t ->
has_type Gamma t T ->
exists T', Gamma x = Some T'.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
has_type_cases (induction Htyp) Case; inversion Hafi; subst...
Case "T_Abs".
destruct IHHtyp as [T' Hctx]... exists T'.
unfold extend in Hctx.
apply not_eq_beq_id_false in H3. rewrite H3 in Hctx...
Qed.

保存

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S  ->
has_type empty v U   ->
has_type Gamma (subst x v t) S.
Proof with eauto.

intros Gamma x U v t S Htypt Htypv.
generalize dependent Gamma. generalize dependent S.

tm_cases (induction t) Case;
intros S Gamma Htypt; simpl; inversion Htypt; subst...
Case "tm_var".
simpl. rename i into y.

remember (beq_id x y) as e. destruct e.
SCase "x=y".

apply beq_id_eq in Heqe. subst.
unfold extend in H0. rewrite <- beq_id_refl in H0.
inversion H0; subst. clear H0.
eapply context_invariance...
intros x Hcontra.
destruct (free_in_context _ _ S empty Hcontra) as [T' HT']...
inversion HT'.
SCase "x<>y".

apply T_Var... unfold extend in H0. rewrite <- Heqe in H0...
Case "tm_abs".
rename i into y. rename t into T11.

apply T_Abs...
remember (beq_id x y) as e. destruct e.
SCase "x=y".

eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".

apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
Case "tm_rcons".
apply T_RCons... inversion H7; subst; simpl...
Qed.

Theorem preservation : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.
Proof with eauto.
intros t t' T HT.

remember (@empty ty) as Gamma. generalize dependent HeqGamma.
generalize dependent t'.

has_type_cases (induction HT) Case;
intros t' HeqGamma HE; subst; inversion HE; subst...
Case "T_App".

inversion HE; subst...
SCase "ST_AppAbs".

apply substitution_preserves_typing with T1...
inversion HT1...
Case "T_Proj".

destruct (lookup_field_in_value _ _ _ _ H2 HT H)
as [vi [Hget Htyp]].
rewrite H4 in Hget. inversion Hget. subst...
Case "T_RCons".

apply T_RCons... eapply step_preserves_record_tm...
Qed.

☐

End STLCExtendedRecords.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

References_J: 変更可能な参照の型付け

Require Export Smallstep_J.

ここまでは、いろいろな「純粋な」(pure)言語機能を考えてきました。関数抽象、数値やブール値などの基本型、レコードやバリアントのような構造型などです。これらの機能はほとんどのプログラミング言語のバックボーンを構成しています。その言語の中にはHaskellのような純粋な関数型言語、MLのような「ほとんど関数型の」(“mostly functional”)言語、Cのような命令型言語、Javaのようなオブジェクト指向言語を含みます。

ほとんどの実際のプログラミング言語は、ここまで使ってきた単純な意味論の枠組みでは記述できない様々な「不純な」(impure)機能も持っています。特に、これらの言語では項を評価することで、単に結果を得る他に、変更可能な変数(あるいは参照セル、配列、変更可能なレコードフィールド、等)に代入したり、ファイルや画面やネットワークに入出力したり、例外やジャンプ、継続によってローカルな枠を越えて制御を移したり、プロセス間の同期や通信を行ったりします。プログラミング言語についての文献では、これらの計算の副作用(“side effects”)はより一般に計算作用(computational effects)と参照されます。

この章では、ここまで学習してきた計算体系に一つの計算作用「変更可能な参照」を追加する方法を見ます。主要な拡張は、記憶(store、あるいはヒープ(heap))を明示的に扱うことです。この拡張は直接的に定義できます。一番興味深い部分は、型保存定理の主張のために必要なリファインメント(refinement)です。

定義

ほとんどすべてのプログラミング言語が、記憶に以前に置かれた内容を変更する何らかの代入操作を持っています(Coqの内部言語は稀な例外です!)。

いくつかの言語(特にMLやその親戚)では、名前束縛の機構と代入の機構を区別しています。「値」として数値5を持つ変数xを持つことも、現在の内容が5である変更可能なセルへの参照(reference、またはポインタ(pointer))を値とする変数yを持つこともできます。この2つは別のものです。プログラマにも両者の違いは見ることができます。xと別の数を足すことは可能ですが、それをxに代入することはできません。yを直接使って、yが指すセルに別の値を代入することが(y:=84と書くことで)できます。しかし、この値は+のような操作の引数として直接使うことはできません。その代わり、現在の内容を得るために明示的に参照を手繰る(dereference、逆参照する)ことが必要です。これを!yと書きます。

他のほとんどの言語、特にJavaを含むCファミリーのメンバーのすべてでは、すべての変数名は変更可能なセルを指します。そして、現在の値を得るための変数の逆参照操作は暗黙に行われます。

形式的な学習の目的には、この2つの機構を分離しておいた方が便利です。この章の進行は、MLのやり方にほとんど従います。ここでやったことをCのような言語に適用するのは、分離していたものを一緒にすることと、逆参照のような操作を明示的なものから暗黙のものにするという単純な問題です。

この章では、自然数を持つ単純型付きラムダ計算に変更可能な参照を追加すること学習します。

構文

Module STLCRef.

参照についての基本操作はアロケート(allocation)、逆参照(dereferencing)、代入(assignment)です。

- 参照をアロケートするには、ref演算子を使います。 これにより新しいセルに初期値が設定されます。例えばref 5は値5を格納した新しいセルを生成し、そのセルへの参照に評価されます。

- セルの現在の値を読むためには、逆参照演算子!を使います。 例えば!(ref 5)は5に評価されます。

- セルに格納された値を変更するには、代入演算子を使います。rが参照ならば、r := 7はrによって参照されるセルに値7を格納します。しかしr := 7はどうでも良い値unitに評価されます。この演算子はセルの内容を変更するという副作用のためだけに存在します。

型

自然数の上の単純型付きラムダ計算から始めます。基本の自然数型と関数型に参照を扱う2つの型を追加する必要があります。第一に「Unit型」です。これは代入演算子の結果の型として使います。それから参照型(reference types)を追加します。

Tが型のとき、Ref Tは型Tの値を持つセルを指す参照の型です。

T ::= Nat
| Unit
| T -> T
| Ref T

Inductive ty : Type :=
| ty_Nat   : ty
| ty_Unit  : ty
| ty_arrow : ty -> ty -> ty
| ty_Ref   : ty -> ty.

項

変数、関数抽象、関数適用、自然数に関する項、unitの他に、変更可能な参照を扱うために4種類の項を追加する必要があります:

t ::= ...              Terms
| ref t              allocation
| !t                 dereference
| t := t             assignment
| l                  location

Inductive tm  : Type :=

| tm_var    : id -> tm
| tm_app    : tm -> tm -> tm
| tm_abs    : id -> ty -> tm -> tm
| tm_nat    : nat -> tm
| tm_succ   : tm -> tm
| tm_pred   : tm -> tm
| tm_mult   : tm -> tm -> tm
| tm_if0    : tm -> tm -> tm -> tm

| tm_unit   : tm
| tm_ref    : tm -> tm
| tm_deref  : tm -> tm
| tm_assign : tm -> tm -> tm
| tm_loc    : nat -> tm.

直観的には...

- ref t(形式的にはtm_ref t)は値tが格納された新しい参照セルをアロケートし、 新しくアロケートされたセルの場所(location)を評価結果とします。

- !t(形式的にはtm_deref t)はtで参照されるセルの内容を評価結果とします。

- t1 := t2(形式的にはtm_assign t1 t2)はt1で参照されるセルにt2を代入します。

- l(形式的にはtm_loc l)は場所lのセルの参照です。場所については後で議論します。

非形式的な例では、MoreStlc_J章で行ったSTLCの拡張も自由に使います。しかし、証明を小さく保つため、ここでそれらを再度形式化することに煩わされることはしません。やろうと思えばそうすることは簡単です。なぜなら、それらの拡張と参照とには興味深い相互作用はないからです。

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app"
| Case_aux c "tm_abs" | Case_aux c "tm_zero"
| Case_aux c "tm_succ" | Case_aux c "tm_pred"
| Case_aux c "tm_mult" | Case_aux c "tm_if0"
| Case_aux c "tm_unit" | Case_aux c "tm_ref"
| Case_aux c "tm_deref" | Case_aux c "tm_assign"
| Case_aux c "tm_loc" ].

Module ExampleVariables.

Definition x := Id 0.
Definition y := Id 1.
Definition r := Id 2.
Definition s := Id 3.

End ExampleVariables.

型付け (プレビュー)

非形式的には、アロケーション、逆参照、代入の型付け規則は以下のようになります:

Gamma |- t1 : T1
------------------------                         (T_Ref)
Gamma |- ref t1 : Ref T1

Gamma |- t1 : Ref T11
---------------------                         (T_Deref)
Gamma |- !t1 : T11

Gamma |- t1 : Ref T11
Gamma |- t2 : T11
------------------------                      (T_Assign)
Gamma |- t1 := t2 : Unit

場所についての規則はもう少し仕掛けが必要になり、それが他の規則にいくらかの変更を求めることになります。これについては後にまた戻ってきます。

値と置換

関数抽象と数値に加えて、新たに2種類の値を持ちます: unit値と場所です。

Inductive value : tm -> Prop :=
| v_abs  : forall x T t,
value (tm_abs x T t)
| v_nat : forall n,
value (tm_nat n)
| v_unit :
value tm_unit
| v_loc : forall l,
value (tm_loc l).

Hint Constructors value.

新しい項の構文を扱うための置換の拡張は直接的です。

Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
match t with
| tm_var x'       =>
if beq_id x x' then s else t
| tm_app t1 t2    =>
tm_app (subst x s t1) (subst x s t2)
| tm_abs x' T t1  =>
if beq_id x x' then t else tm_abs x' T (subst x s t1)
| tm_nat n        =>
t
| tm_succ t1      =>
tm_succ (subst x s t1)
| tm_pred t1      =>
tm_pred (subst x s t1)
| tm_mult t1 t2   =>
tm_mult (subst x s t1) (subst x s t2)
| tm_if0 t1 t2 t3 =>
tm_if0 (subst x s t1) (subst x s t2) (subst x s t3)
| tm_unit         =>
t
| tm_ref t1       =>
tm_ref (subst x s t1)
| tm_deref t1     =>
tm_deref (subst x s t1)
| tm_assign t1 t2 =>
tm_assign (subst x s t1) (subst x s t2)
| tm_loc _        =>
t
end.

プラグマティクス(語用論)

副作用と順次処理

代入式の結果がつまらない値unitであるという事実によって、順次処理(sequencing)のうまい略記が可能になります。例えば、

(\x:Unit. !r) (r := succ(!r)).

の略記として

r:=succ(!r); !r

と書くことができます。これは2つの式を順番に評価するという作用を持ち、2つ目の式の値を返します。1つ目の式の型をUnitに限定することで、1つ目の値を捨てることができるのは本当にそれがつまらない値であることが保証されているときだけになり、型チェッカで馬鹿なエラーをチェックするのに役立ちます。

なお、もし2つ目の式もまた代入ならば、2つの式の列全体の型がUnitになります。これから、より長い代入の列を作るために別の;の左側に置いても問題ありません:

r:=succ(!r); r:=succ(!r); r:=succ(!r); r:=succ(!r); !r

形式的には、順次処理を”derived form”として導入します。この”derived form”は、関数抽象と関数適用に展開されます。

Definition tm_seq t1 t2 :=
tm_app (tm_abs (Id 0) ty_Unit t2) t1.

参照と別名付け

rに束縛される参照(reference)と、この参照によって指されているセル(cell)の違いを心に留めておく必要があります。

例えばrを別の変数sに束縛することでrのコピーを作るとすると、コピーされるのは参照だけで、セルの中身自身ではありません。

例えば、次の式を評価します:

let r = ref 5 in
let s = r in
s := 82;
(!r)+1

するとその後でrによって参照されたセルは値82を格納している状態になります。一方、式全体の結果は83になります。参照rとsは同じセルの別名(aliases)と言われます。

別名を付けられる能力があることによって、参照を持つプログラムに関する推論は、きわめてトリッキーになります。例えば、式

r := 5; r := !s

はrに5を代入し、直ぐにそれをsの現在の値で上書きします。これは、単一の代入

r := !s

と完全に同じ作用をします。ただし、「rとsがたまたま同じセルの別名であるという状況でない限り」、です!

共有状態

もちろん、別名も、参照を便利なものにする大きな部分です。特に参照は、プログラムの異なる部分の間の暗黙の通信チャンネル(“implicit communication channels”)、つまり共有状態(shared state)としてはたらきます。例えば、参照セルと、その内容を扱う2つの関数を定義するとします:

let c = ref 0 in
let incc = \_:Unit. (c := succ (!c); !c) in
let decc = \_:Unit. (c := pred (!c); !c) in
...

ここで、それぞれ引数の型はUnitなので、inccとdeccの定義において関数抽象は関数本体に特に有用な情報を提供しないことに注意します(束縛変数名にワイルドカード_を使っているのは、このことを合図したものです)。そうではなく、関数抽象の目的は関数本体の実行を「遅く」するためです。関数抽象は値であることから、2つのletは単に2つの関数を名前inccとdeccに束縛するだけで、実際にcを増やしたり減らしたりはしません。後に、これらの関数の1つを呼び出すたびに、その本体が1度実行されcについて対応する変更が行われます。こういった関数はしばしば thunk と呼ばれます。

これらの宣言のコンテキストで、inccを呼ぶとcが変更されますが、これはdeccを呼ぶことで確認できます。例えば...を(incc unit; incc unit; decc unit)に換えると、プログラム全体の結果は1になります。

オブジェクト

もう一歩進んで、c、incc、deccを生成し、inccとdeccをレコードにパッケージ化し、このレコードを返す「関数」を記述することもできます:

newcounter =
\_:Unit.
let c = ref 0 in
let incc = \_:Unit. (c := succ (!c); !c) in
let decc = \_:Unit. (c := pred (!c); !c) in
{i=incc, d=decc}

このとき、newcounterを呼ぶたびに、同じ記憶セルcのアクセスを共有する2つの関数の新たなレコードが得られます。newcounterを呼び出す側はこの記憶セルには直接手が届きませんが、2つの関数を呼ぶことで間接的に影響を及ぼすことができます。言い換えると、簡単な形のオブジェクト(object)を作ったのです。

let c1 = newcounter unit in
let c2 = newcounter unit in
// ここで2つの別個の記憶セルをアロケートしたことに注意!
let r1 = c1.i unit in
let r2 = c2.i unit in
r2  // 1 を返します。2ではありません!

最初の2つのletが完了し3つ目が始まろうとする時点の記憶の中身を(紙の上に)描きなさい。

(* FILL IN HERE *)

☐

参照と合成型

参照セルの中身は数値でなければならないわけではありません。上で定義したプリミティブによって、任意の型の値への参照を作ることができます。その任意の型の中には関数型も含まれます。例えば、関数への参照を使って、数値の配列の(あまり効率的でない)実装をすることができます。以下の通りです。型Ref (Nat->Nat)をNatArrayと書きます。

MoreStlc_J章でのequal関数を思い出してください:

equal =
fix
(\eq:Nat->Nat->Bool.
\m:Nat. \n:Nat.
if m=0 then iszero n
else if n=0 then false
else eq (pred m) (pred n))

このとき、新しい配列を作るために、参照セルをアロケートし、そのセルに関数を入れます。その関数はインデックスを与えられると常に0を返します。

newarray = \_:Unit. ref (\n:Nat.0)

配列の要素をとりだすためには、その関数を求められたインデックスに適用するだけです。

lookup = \a:NatArray. \n:Nat. (!a) n

このエンコードの興味深いところはupdate関数です。update関数は、配列、インデックス、そのインデックスの場所に格納する新しい値をとり、新しい関数を生成し(そしてそれを参照に格納し)ます。その関数は、この特定のインデックスの値を尋かれたときにはupdateに与えられた新しい値を返します。他のインデックスについては、以前にその参照に格納されていた関数にまかせます。

update = \a:NatArray. \m:Nat. \v:Nat.
let oldf = !a in
a := (\n:Nat. if equal m n then v else oldf n);

別の参照を含む値への参照もまたとても有用です。これにより、変更可能なリストや木などのデータ構造が定義できるようになります。

もしupdateを次のようによりコンパクトに定義したとします。

update = \a:NatArray. \m:Nat. \v:Nat.
a := (\n:Nat. if equal m n then v else (!a) n)

これは前の定義と同じように振る舞うでしょうか？

(* FILL IN HERE *)

☐

null参照

ここで定義した参照と、C言語スタイルの変更可能な変数にはもう一つの違いがあります。Cのような言語では、ヒープへのポインタを持つ変数は値NULLを持つことがあります。そのような「nullポインタ」の逆参照はエラーで、例外になったり(Java)、プログラムが停止したり(C)します。

Cのような言語ではnullポインタは重大な問題を起こします。任意のポインタがnullになる可能性があるという事実は、任意の逆参照操作が潜在的に失敗の可能性を持つということです。しかしMLのような言語でも、時には正しいポインタを持つことを許すことも許さないこともできるようにしたい場合があります。幸い、参照の基本メカニズムを拡張しなくてもこれは実現できます。MoreStlc_J章で導入された直和型によってそれが可能になります。

最初に、直和を使って、Lists_J章で導入したoption型に対応するものを構築します。Option TをUnit + Tの略記法として定義します。

すると、「nullになり得るTへの参照」は単に型Ref (Option T)の要素となります。

ガベージコレクション

参照の形式化に移る前に述べておくべき最後の問題が、記憶のデアロケーション(de-allocation)です。参照セルが必要なくなったときにそれを解放する何らかのプリミティブを提供していません。その代わり、多くの近代的な言語(MLとJavaを含む)のように、実行時システムがガベージコレクション(garbage collection)を行うことに頼っています。ガベージコレクションはプログラムから到達しなくなったセルを集め再利用するものです。

これは言語デザインの上で単なる趣味の問題ではありません。明示的なデアロケーション操作が存在した場合、型安全性を保つのが極度に困難になるのです。その理由はよく知られたダングリング参照(dangling reference)問題です。数値を持つセルをアロケートし、何かのデータ構造にそれへの参照を持たせ、それをしばらく利用し、そしてそれをデアロケートし、ブール値を持つ新しいセルをアロケートします。このとき同じ記憶が再利用されるかもしれません。すると、同じ記憶セルに2つの名前があることになります。1つはRef Nat型で、もう1つはRef Bool型です。

このことがどのように型安全性の破壊につながるのか示しなさい。

(* FILL IN HERE *)

☐

場所(Locations)

参照の扱いについての一番巧妙な面は、操作的振る舞いをどのように形式化するかを考えるときに現れます。それが何故かを見る1つの方法は、「何が型Ref Tの値であるべきか？」と問うことです。考慮すべき重要な点は、ref演算子の評価は何かを(つまり記憶のアロケートを)「行わ」なければならず、操作の結果はこの記憶への参照とならなければならないということです。

それでは、参照とは何でしょうか？

ほとんどのプログラミング言語の実装では、実行時の記憶は本質的にはバイト(byte)の(大きな)配列です。実行時システムは、この配列のどの部分が現在使用されているかを常に監視しています。新しい参照セルをアロケートしなければならないとき、記憶の自由範囲から十分な大きさのセグメント(整数セルには4バイト、Floatのセルには8バイト、等)をアロケートします。このセグメントに「使用中」のマークをして、新しくアロケートされた領域のインデックス(典型的には32ビットまたは64ビットの整数)を返却します。参照とはこのインデックスのことです。

現在の目的のためには、これほど具体的である必要はありません。記憶を、バイトではなく「値」の配列と考え、異なる値の実行時表現のサイズの違いは捨象します。すると参照は、単に記憶へのインデックスになります。(望むならば、これらのインデックスが数値であるという事実さえも捨象することができます。しかし、Coqで形式化する目的のためには、数値を使った方が若干便利です。)この抽象度であることを強調するため、これ以降、用語として、「参照」や「ポインタ」の代わりに「場所」(location)を使います。

この方法で場所を抽象的に扱うことで、Cのような低レベルの言語で見られる「ポインタ算術」(pointer arithmetic)をモデル化することができなくなります。この制約は意図的なものです。ポインタ算術は時には非常に便利です。特にガベージコレクタのような低レベルのサービスを実装するときなどです。しかし、ほとんどの型システムではポインタ算術を追跡することができません。記憶の場所nにfloatが格納されていることを知っても、場所n+4の型について何も意味のあることはわかりません。Cにおいては、ポインタ算術は型安全性破壊の悪名高き温床です。

記憶(Stores)

IMPのスモールステップ操作的意味論では、ステップ関係は、実行されるプログラムに加えて補助的な状態を持ちまわる必要があったことを思い出して下さい。同様に、STLCに参照セルを追加すると、参照セルの内容を追跡するために記憶を持ち回る必要が出てきます。

IMPの状態で使ったのと同じ関数表現を再利用することもできます。しかし、この章での証明をするためには、記憶を単に値の「リスト」として表現した方が実際は便利です。(この表現を以前には使えなかった理由は、IMPでは、プログラムはいつでも任意の場所を変更することができるので、状態はいつでも任意の変数を値に写像することができるようになっていないといけなかったからです。しかし、STLCに参照を追加したものでは、参照セルを作る唯一の方法はtm_ref t1を使うことです。ここでtm_ref t1はt1の値を新しい参照セルに置き、評価結果として新しく生成された参照セルの場所を返します。この式を評価するときには、記憶を表現するリストの最後に新しい参照セルを追加すればよいのです。)

Definition store := list tm.

記憶stの場所nのセルの値をとりだすために、store_lookup n stを使います。インデックスが大きすぎるときにはnthにデフォルト値を与えなければならないことに注意します。(実際には大きすぎるインデックスを与えることは行いません。ただ、そうであることを証明することはもちろんちょっと作業をしなければなりません!。)

Definition store_lookup (n:nat) (st:store) :=
nth n st tm_unit.

記憶に新しい参照セルを追加するために、snocを使います。

Fixpoint snoc {A:Type} (l:list A) (x:A) : list A :=
match l with
| nil    => x :: nil
| h :: t => h :: snoc t x
end.

snocについていくつか退屈な補題が必要です。証明は決まりきった帰納法です。

Lemma length_snoc : forall A (l:list A) x,
length (snoc l x) = S (length l).
Proof.
induction l; intros; [ auto | simpl; rewrite IHl; auto ]. Qed.

Lemma nth_lt_snoc : forall A (l:list A) x d n,
n < length l ->
nth n l d = nth n (snoc l x) d.
Proof.
induction l as [|a l']; intros; try solve by inversion.
Case "l = a :: l'".
destruct n; auto.
simpl. apply IHl'.
simpl in H. apply lt_S_n in H. assumption.
Qed.

Lemma nth_eq_snoc : forall A (l:list A) x d,
nth (length l) (snoc l x) d = x.
Proof.
induction l; intros; [ auto | simpl; rewrite IHl; auto ].
Qed.

記憶を更新するために、replace関数を使います。この関数は特定のインデックスのセルの中身を置き換えます。

Fixpoint replace {A:Type} (n:nat) (x:A) (l:list A) : list A :=
match l with
| nil    => nil
| h :: t =>
match n with
| O    => x :: t
| S n' => h :: replace n' x t
end
end.

もちろん、replaceについてもいくつか退屈な補題が必要です。証明は、また、かなりそのままです。

Lemma replace_nil : forall A n (x:A),
replace n x [] = [].
Proof.
destruct n; auto.
Qed.

Lemma length_replace : forall A n x (l:list A),
length (replace n x l) = length l.
Proof with auto.
intros A n x l. generalize dependent n.
induction l; intros n.
destruct n...
destruct n...
simpl. rewrite IHl...
Qed.

Lemma lookup_replace_eq : forall l t st,
l < length st ->
store_lookup l (replace l t st) = t.
Proof with auto.
intros l t st.
unfold store_lookup.
generalize dependent l.
induction st as [|t' st']; intros l Hlen.
Case "st = []".
inversion Hlen.
Case "st = t' :: st'".
destruct l; simpl...
apply IHst'. simpl in Hlen. omega.
Qed.

Lemma lookup_replace_neq : forall l1 l2 t st,
l1 <> l2 ->
store_lookup l1 (replace l2 t st) = store_lookup l1 st.
Proof with auto.
unfold store_lookup.
induction l1 as [|l1']; intros l2 t st Hneq.
Case "l1 = 0".
destruct st.
SCase "st = []". rewrite replace_nil...
SCase "st = _ :: _". destruct l2... contradict Hneq...
Case "l1 = S l1'".
destruct st as [|t2 st2].
SCase "st = []". destruct l2...
SCase "st = t2 :: st2".
destruct l2...
simpl; apply IHl1'...
Qed.

簡約

次に、操作的意味を記憶を考慮した形に拡張します。式を評価した結果は一般には評価したときの記憶の中身に依存するので、評価規則は項だけでなく記憶も引数としてとらなければなりません。さらに、項の評価は記憶に副作用を起こし、それが後の別の項の評価に影響を及ぼすので、評価規則は新しい値を返す必要があります。これから、1ステップ評価関係の形はt ==> t'からt / st ==> t' / st'に変わります。ここでstとst'は記憶の開始状態と終了状態です。

この変更を達成するため、最初に、既存のすべての評価規則に記憶を拡張する必要があります:

value v2
-------------------------------------               (ST_AppAbs)
(\a:T.t12) v2 / st ==> [v2/a]t12 / st

t1 / st ==> t1' / st'
---------------------------                      (ST_App1)
t1 t2 / st ==> t1' t2 / st'

value v1     t2 / st ==> t2' / st'
----------------------------------                  (ST_App2)
v1 t2 / st ==> v1 t2' / st'

ここで最初の規則は記憶を変えずに返すことに注意します。関数適用はそれ自体は副作用を持ちません。残りの2つの規則は単に副作用を前提から結論に伝播します。

さて、ref式の評価結果は新しい場所です。これが項の構文と値の集合に場所を含めた理由です。

これは重要なことですが、項の構文のこの拡張は、「プログラマ」が明示的に具体的場所を含む項を書くことを意図したものではありません。そのような項は評価の中間結果だけに現れます。これは最初は奇妙に見えるかもしれません。しかしこれは、評価のすべてのステップの結果を変形された項で表現するという設計判断に、実に自然に馴染むのです。もし評価に対して、より「機械に近い」(“machine-like”)モデル、例えば束縛された識別子の値を格納する明示的なスタックを選んだならば、許される値の集合に場所を追加したアイデアはおそらくより明確になるでしょう。

この拡張構文に関して、場所と記憶を扱う新しい言語要素についての評価規則を述べることができます。最初に、逆参照式!t1の評価のため、t1を値になるまで簡約しなければなりません:

t1 / st ==> t1' / st'
-----------------------                       (ST_Deref)
!t1 / st ==> !t1' / st'

t1の簡約が終わったならば、!lという形の式が得られるはずです。ここでlは何らかの場所です。(関数やunitなどの他の種類の値を逆参照しようとする項は、エラーです。現在アロケートされた記憶のサイズ|st|より大きな場所を逆参照しようとする項も同様です。この場合、評価規則は単に行き詰まります。後に確立する型安全性は、型付けがされた項がこの方法で間違った振る舞いをすることがないことを保証します。)

l < |st|
----------------------------------           (ST_DerefLoc)
!(loc l) / st ==> lookup l st / st

次に、代入式t1:=t2を評価するため、最初にt1が値(場所)になるまで評価し、次にt2が(任意の種類の)値になるまで評価します:

t1 / st ==> t1' / st'
-----------------------------------               (ST_Assign1)
t1 := t2 / st ==> t1' := t2 / st'

t2 / st ==> t2' / st'
---------------------------------                (ST_Assign2)
v1 := t2 / st ==> v1 := t2' / st'

t1とt2が終わったならば、l:=v2という形の式が得られます。この式の実行として、記憶を、場所lにv2が格納されるように更新します:

l < |st|
-------------------------------------               (ST_Assign)
loc l := v2 / st ==> unit / [v2/l]st

記法[v2/lst] は「lをv2に写像し、他の場所はstと同じものに写像する記憶」を意味します。(この評価ステップの結果の項は単にunitであることに注意します。興味深い結果は更新された記憶です。)

最後に、ref t1という形の式を評価するために、最初にt1が値になるまで評価します:

t1 / st ==> t1' / st'
-----------------------------                      (ST_Ref)
ref t1 / st ==> ref t1' / st'

次にref自体を評価するため、現在の記憶の最後の新しい場所を選びます。つまり、場所|st|です。そして新しい値v1についてstを拡張した新しい記憶を与えます。

--------------------------------               (ST_RefValue)
ref v1 / st ==> loc |st| / st,v1

このステップの結果の値は新しくアロケートされた場所自身です。(形式的にはst,v1はsnoc st v1を意味します。)

これらの評価規則はどのようなガベージコレクションも行わないことに注意します。単に評価が進むにつれて記憶が限りなく大きくなることとします。これは評価結果の正しさには影響しません(とにかく「ガベージ」の定義は、まさに記憶のもはや到達できない部分なので、評価の上で以降何の役割も演じられません)。しかしこれは、洗練された評価器ならばガベージとなったものの場所を再利用して実行を続けることができる場面で、素朴な実装はメモリを使い果たす可能性があることを意味します。

形式的には...

Reserved Notation "t1 '/' st1 '==>' t2 '/' st2"
(at level 40, st1 at level 39, t2 at level 39).

Inductive step : tm * store -> tm * store -> Prop :=
| ST_AppAbs : forall x T t12 v2 st,
value v2 ->
tm_app (tm_abs x T t12) v2 / st ==> subst x v2 t12 / st
| ST_App1 : forall t1 t1' t2 st st',
t1 / st ==> t1' / st' ->
tm_app t1 t2 / st ==> tm_app t1' t2 / st'
| ST_App2 : forall v1 t2 t2' st st',
value v1 ->
t2 / st ==> t2' / st' ->
tm_app v1 t2 / st ==> tm_app v1 t2'/ st'
| ST_SuccNat : forall n st,
tm_succ (tm_nat n) / st ==> tm_nat (S n) / st
| ST_Succ : forall t1 t1' st st',
t1 / st ==> t1' / st' ->
tm_succ t1 / st ==> tm_succ t1' / st'
| ST_PredNat : forall n st,
tm_pred (tm_nat n) / st ==> tm_nat (pred n) / st
| ST_Pred : forall t1 t1' st st',
t1 / st ==> t1' / st' ->
tm_pred t1 / st ==> tm_pred t1' / st'
| ST_MultNats : forall n1 n2 st,
tm_mult (tm_nat n1) (tm_nat n2) / st ==> tm_nat (mult n1 n2) / st
| ST_Mult1 : forall t1 t2 t1' st st',
t1 / st ==> t1' / st' ->
tm_mult t1 t2 / st ==> tm_mult t1' t2 / st'
| ST_Mult2 : forall v1 t2 t2' st st',
value v1 ->
t2 / st ==> t2' / st' ->
tm_mult v1 t2 / st ==> tm_mult v1 t2' / st'
| ST_If0 : forall t1 t1' t2 t3 st st',
t1 / st ==> t1' / st' ->
tm_if0 t1 t2 t3 / st ==> tm_if0 t1' t2 t3 / st'
| ST_If0_Zero : forall t2 t3 st,
tm_if0 (tm_nat 0) t2 t3 / st ==> t2 / st
| ST_If0_Nonzero : forall n t2 t3 st,
tm_if0 (tm_nat (S n)) t2 t3 / st ==> t3 / st
| ST_RefValue : forall v1 st,
value v1 ->
tm_ref v1 / st ==> tm_loc (length st) / snoc st v1
| ST_Ref : forall t1 t1' st st',
t1 / st ==> t1' / st' ->
tm_ref t1 /  st ==> tm_ref t1' /  st'
| ST_DerefLoc : forall st l,
l < length st ->
tm_deref (tm_loc l) / st ==> store_lookup l st / st
| ST_Deref : forall t1 t1' st st',
t1 / st ==> t1' / st' ->
tm_deref t1 / st ==> tm_deref t1' / st'
| ST_Assign : forall v2 l st,
value v2 ->
l < length st ->
tm_assign (tm_loc l) v2 / st ==> tm_unit / replace l v2 st
| ST_Assign1 : forall t1 t1' t2 st st',
t1 / st ==> t1' / st' ->
tm_assign t1 t2 / st ==> tm_assign t1' t2 / st'
| ST_Assign2 : forall v1 t2 t2' st st',
value v1 ->
t2 / st ==> t2' / st' ->
tm_assign v1 t2 / st ==> tm_assign v1 t2' / st'

where "t1 '/' st1 '==>' t2 '/' st2" := (step (t1,st1) (t2,st2)).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1"
| Case_aux c "ST_App2" | Case_aux c "ST_SuccNat"
| Case_aux c "ST_Succ" | Case_aux c "ST_PredNat"
| Case_aux c "ST_Pred" | Case_aux c "ST_MultNats"
| Case_aux c "ST_Mult1" | Case_aux c "ST_Mult2"
| Case_aux c "ST_If0" | Case_aux c "ST_If0_Zero"
| Case_aux c "ST_If0_Nonzero" | Case_aux c "ST_RefValue"
| Case_aux c "ST_Ref" | Case_aux c "ST_DerefLoc"
| Case_aux c "ST_Deref" | Case_aux c "ST_Assign"
| Case_aux c "ST_Assign1" | Case_aux c "ST_Assign2" ].

Hint Constructors step.

Definition stepmany := (refl_step_closure step).
Notation "t1 '/' st '==>*' t2 '/' st'" := (stepmany (t1,st) (t2,st'))
(at level 40, st at level 39, t2 at level 39).

自由変数のコンテキストはSTLCのものと完全に同じで、識別子から型への部分関数です。

Definition context := partial_map ty.

記憶の型付け

参照に適用するように構文と評価規則を拡張したので、最後の仕事は新しい言語要素に対する型付け規則を書き下すこと、そして、もちろん、それが健全であることをチェックすることです。自然と、キーとなる問題は「場所の型は何か？」になります。

何よりもまず、プログラマが実際に書く項の型チェックの目的のためには、この問題に答える必要は「ない」ことに注意しましょう。具体的な場所定数は評価の中間結果の項にのみ現れます。プログラマが書く言語の中には含まれません。すると、場所の型を決める必要があるのは、評価列の途中にある時だけです。例えば、進行補題や保存補題を適用しようとする時です。これから、通常、型付けはプログラムの「静的」性質と考えますが、場所の型付けについてはプログラムの「動的」進行にも依存するとして、意味があります。

まず、具体的場所を含む項を評価するとき、結果の型は開始時の記憶の中身に依存することに注意します。例えば、記憶が[unit, unit] のとき項!(loc 1)を評価するならば、結果はunitです。記憶が[unit, \x:Unit.x] のとき同じ項を評価すると、結果は\x:Unit.xです。前者の記憶に関して、場所1は型Unitを持ち、後者の記憶に関しては型Unit->Unitを持ちます。これらのことから、場所の型付け規則の最初の試みとして、直ぐに次のものが考えられます:

Gamma |- lookup  l st : T1
----------------------------
Gamma |- loc l : Ref T1

つまり、場所lの型を見付けるために、記憶内のlの現在の中身を探索し、その中身の型を計算するものです。するとこの場所の型はRef T1になります。

この方法から始めましたが、整合的な状態に逹するまでもうちょっと進んでみる必要があります。事実上、記憶に依存した項の型を作ることで、型付け関係を、(コンテキスト、項、型の間の)3項関係から(コンテキスト、記憶、項、型の間の)4項関係に変更したことになります。記憶は、直観的には、項の型を計算するコンテキストの一部であることから、この4項関係を書くとき、記憶を|-記号の左側に書くことにしましょう:Gamma; st |- t : T.すると、参照に型付けする規則は次の形になります:

Gamma; st |- lookup l st : T1
--------------------------------
Gamma; st |- loc l : Ref T1

そして残りの型付け規則のすべては記憶について同様の拡張がされます。他の規則は記憶に対して何も特別なことをする必要はありません。単に前提から結論に渡すだけです。

しかしながら、この規則について2つの問題があります。1つは、型チェックはかなり非効率的です。なぜなら場所lの型の計算にはlの現在の中身vの型の計算が含まれています。もしlが項tに何回も現れるときには、tの型導出を構成する過程の中でvの型を何回も再計算することになります。下手をするとv自体が場所を含んでいるかもしれません。すると毎回その型を計算しなければなりません。

2つ目は、上記の場所についての型付け規則では、記憶が循環(cycle)を含んでいるとき何も導出できません。例えば、記憶：

[\x:Nat. (!(loc 1)) x, \x:Nat. (!(loc 0)) x]

について、場所0の有限な型導出は存在しません。

評価するとこの特定の循環記憶を生成する項を見つけられますか？

☐

2つの問題はどちらも、上記の場所についての型付け規則が、項の中に記述があるたびに場所の型を再計算することが必要であるという事実から生じます。しかしこれは、直観的に、必要であるべきではありません。とにかく、場所が最初に生成されたとき、そこに格納された初期値の型はわかっています。特定の場所に格納される値の型は「決して変化しない」という不変条件が定められていると仮定しましょう。つまり、この場所に後に別の値を格納することがあったとしても、その値は常に初期値と同じ型を持つ、ということです。言い換えると、記憶のすべての場所に対して、それがアロケートされたときに決まる1つの確定した型を常に記憶しているということです。すると、これらの意図した型を記憶型付け(store typing)としてまとめることができます。これは、場所を型に写像する有限関数です。

通常通り、更新についてのこの「保守的」型付け制約は、行き詰まることなく完全に評価できるいくつかのプログラムを ill-typed として除外します。

記憶について行ったのと同様に、記憶型を単に型のリストで表現します。インデックスiの型はセルiに格納された値の型を記録したものです。

Definition store_ty := list ty.

store_ty_lookup関数は、特定のインデックスの型をとりだします。

Definition store_ty_lookup (n:nat) (ST:store_ty) :=
nth n ST ty_Unit.

記憶stを記述する記憶型付けSTが与えられ、そこである項tが評価されると仮定します。すると、tの結果の型をstを直接見ることなく計算するのにSTを使うことができます。例えば、もしSTが[Unit, Unit->Unit] ならば、!(loc 1)が型Unit->Unitを持つとすぐに推論できるでしょう。より一般に、場所の型付け規則は記憶型付けの点から再構成され、次のようになります:

l < |ST|
-------------------------------------
Gamma; ST |- loc l : Ref (lookup l ST)

つまり、lが正しい場所である限りは(つまりSTの長さ未満の場合は)、lの型をSTから調べ上げるだけで計算することができます。型付けはやはり4項関係ですが、それは具体的記憶ではなく、記憶型付けがパラメータになります。型付け規則の残りも、同様に記憶型付けを引数とします。

型付け関係

ついに参照を持つSTLCについての型付け関係を与えることができます。また、基本の(数値とUnitを持つ)STLCに追加する規則を与えます。

l < |ST|
--------------------------------------              (T_Loc)
Gamma; ST |- loc l : Ref (lookup l ST)

Gamma; ST |- t1 : T1
----------------------------                     (T_Ref)
Gamma; ST |- ref t1 : Ref T1

Gamma; ST |- t1 : Ref T11
-------------------------                       (T_Deref)
Gamma; ST |- !t1 : T11

Gamma; ST |- t1 : Ref T11
Gamma; ST |- t2 : T11
-----------------------------                    (T_Assign)
Gamma; ST |- t1 := t2 : Unit

Inductive has_type : context -> store_ty -> tm -> ty -> Prop :=
| T_Var : forall Gamma ST x T,
Gamma x = Some T ->
has_type Gamma ST (tm_var x) T
| T_Abs : forall Gamma ST x T11 T12 t12,
has_type (extend Gamma x T11) ST t12 T12 ->
has_type Gamma ST (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T1 T2 Gamma ST t1 t2,
has_type Gamma ST t1 (ty_arrow T1 T2) ->
has_type Gamma ST t2 T1 ->
has_type Gamma ST (tm_app t1 t2) T2
| T_Nat : forall Gamma ST n,
has_type Gamma ST (tm_nat n) ty_Nat
| T_Succ : forall Gamma ST t1,
has_type Gamma ST t1 ty_Nat ->
has_type Gamma ST (tm_succ t1) ty_Nat
| T_Pred : forall Gamma ST t1,
has_type Gamma ST t1 ty_Nat ->
has_type Gamma ST (tm_pred t1) ty_Nat
| T_Mult : forall Gamma ST t1 t2,
has_type Gamma ST t1 ty_Nat ->
has_type Gamma ST t2 ty_Nat ->
has_type Gamma ST (tm_mult t1 t2) ty_Nat
| T_If0 : forall Gamma ST t1 t2 t3 T,
has_type Gamma ST t1 ty_Nat ->
has_type Gamma ST t2 T ->
has_type Gamma ST t3 T ->
has_type Gamma ST (tm_if0 t1 t2 t3) T
| T_Unit : forall Gamma ST,
has_type Gamma ST tm_unit ty_Unit
| T_Loc : forall Gamma ST l,
l < length ST ->
has_type Gamma ST (tm_loc l) (ty_Ref (store_ty_lookup l ST))
| T_Ref : forall Gamma ST t1 T1,
has_type Gamma ST t1 T1 ->
has_type Gamma ST (tm_ref t1) (ty_Ref T1)
| T_Deref : forall Gamma ST t1 T11,
has_type Gamma ST t1 (ty_Ref T11) ->
has_type Gamma ST (tm_deref t1) T11
| T_Assign : forall Gamma ST t1 t2 T11,
has_type Gamma ST t1 (ty_Ref T11) ->
has_type Gamma ST t2 T11 ->
has_type Gamma ST (tm_assign t1 t2) ty_Unit.

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
| Case_aux c "T_Nat" | Case_aux c "T_Succ" | Case_aux c "T_Pred"
| Case_aux c "T_Mult" | Case_aux c "T_If0"
| Case_aux c "T_Unit" | Case_aux c "T_Loc"
| Case_aux c "T_Ref" | Case_aux c "T_Deref"
| Case_aux c "T_Assign" ].

もちろん、これらの型付け規則が評価結果を正確に予言できるのは、評価の間使われる具体的な記憶が、型チェックの目的で仮定する記憶型付けに整合しているときだけです。このただし書きは、STLCにおける自由変数と丁度同じ状況です。STLCでは、置換補題から、Gamma |- t : Tのとき、t内の自由変数をGamma内にリストアップされた型の値で置換することで型Tの閉じた項を得ることができます。そして、型保存定理より、この閉じた項は、もし必要なら型Tの最終結果に評価されます。(後に、記憶と記憶型付けについての同様の直観をどのように形式化するかを見ます。)

しかしながら、プログラムが実際に書く項の型チェックをする目的からは、どのような記憶型付けを使うべきかを推測するには、何もトリッキーなことは必要ありません。具体的場所定数は、評価の中間結果の項にのみ現れることを思い出してください。それはプログラマが書く言語ではありません。これから、プログラマが書く項は、ただ「空の」記憶型付けによって型チェックできます。評価が進み新しい場所が生成されるにつれ、新しくアロケートされたセルに置かれた初期値の型を見ることで、記憶型付けをどのように拡張したら良いかを常に見ることができるようになります。この直観は以下で型保存定理の主張として形式化されます。

最後の仕事は、標準的な型安全性が参照を追加したSTLCでも成立することをチェックすることです。進行定理(「型付けできる項は行き詰まらない」)が主張でき、ほとんどSTLCと同じように証明できます。証明に、新しい言語要素を扱ういくつかの場合を単に追加すれば良いのです。保存定理はもうちょっとやりがいがあります。それでは早速、見てみましょう。

型付けできる記憶

評価関係と型付け関係の両者を拡張した(評価関係については初期記憶と最終記憶を、型付け関係については記憶型付けを)ことから、保存定理の主張は、これらのパラメータを含むように変えなければなりません。しかしながら明らかに、記憶と記憶型付けを、その両者の関係について何も言わずにただ追加することはできません:

Theorem preservation_wrong1 : forall ST T t st t' st',
has_type empty ST t T ->
t / st ==> t' / st' ->
has_type empty ST t' T.
Admitted.

もし記憶内の値の型についてのいくつかの仮定の上で型チェックを行い、その後、その仮定をやぶる記憶のもとで評価をしたならば、結果は悲惨なものになるでしょう。記憶stが記憶型付けSTのもとで「型付けできる」(well typed)とは、stのそれぞれの場所lの項がSTの場所lの型を持つことです。閉じた項だけが場所に格納されていることから(なぜでしょう？)、それらは空コンテキストで型付けすれば十分です。以下のstore_well_typedの定義はそれを形式化したものです。

Definition store_well_typed (ST:store_ty) (st:store) :=
length ST = length st /\
(forall l, l < length st ->
has_type empty ST (store_lookup l st) (store_ty_lookup l ST)).

非形式的には、store_well_typed ST stをST |- stと書きます。

直観的に、記憶stが記憶型付けSTと整合的であるのは、記憶内のすべての値が記憶型付けに定められた型を持っていることです。(唯一の巧妙な点は、記憶内の値を型付けするとき、ほとんど同じ記憶型付けを型付け関係に提供することです!このことは、循環を持つ記憶に型付けすることを可能にします。)

ST1 |- stとST2 |- stの両者を成立させる記憶stおよび相異なる記憶型付けST1とST2を見つけられますか？

(* FILL IN HERE *)

☐

ここまで来ると求められる保存性に近いものを主張することができます：

Theorem preservation_wrong2 : forall ST T t st t' st',
has_type empty ST t T ->
t / st ==> t' / st' ->
store_well_typed ST st ->
has_type empty ST t' T.
Admitted.

この主張は、アロケーション規則ST_RefValueを除くすべての評価規則について成立します。問題は、この規則は初期記憶より大きな領域の記憶を必要とすることから、上記主張の結論が成立しなくなることです。もしst'が新しい場所lについての束縛を含むなら、lはSTの領域に含まれないことから、(間違いなくlに言及している)t'はSTのもとで型付けできなくなります。

記憶型付けを拡張する

明らかに、記憶は評価が進むにつれてサイズを増大させる可能性があることから、記憶型付けも同様にサイズを増大できるようにする必要があります。これから以下の定義が導かれます。記憶型付けST'がSTを拡張する(extends)とは、ST'が単にSTの最後にいくつかの新しい型を追加したものであることです。

Inductive extends : store_ty -> store_ty -> Prop :=
| extends_nil  : forall ST',
extends ST' nil
| extends_cons : forall x ST' ST,
extends ST' ST ->
extends (x::ST') (x::ST).

Hint Constructors extends.

拡張されたコンテキストについてのいくつかの技術的補題が必要です。

最初に、拡張された記憶型付けから型を探索すると、オリジナルと同じ結果を返します:

Lemma extends_lookup : forall l ST ST',
l < length ST ->
extends ST' ST ->
store_ty_lookup l ST' = store_ty_lookup l ST.
Proof with auto.
intros l ST ST' Hlen H.
generalize dependent ST'. generalize dependent l.
induction ST as [|a ST2]; intros l Hlen ST' HST'.
Case "nil". inversion Hlen.
Case "cons". unfold store_ty_lookup in *.
destruct ST' as [|a' ST'2].
SCase "ST' = nil". inversion HST'.
SCase "ST' = a' :: ST'2".
inversion HST'; subst.
destruct l as [|l'].
SSCase "l = 0"...
SSCase "l = S l'". simpl. apply IHST2...
simpl in Hlen; omega.
Qed.

次に、ST'がSTを拡張するなら、ST'の長さはST以上です。

Lemma length_extends : forall l ST ST',
l < length ST ->
extends ST' ST ->
l < length ST'.
Proof with eauto.
intros. generalize dependent l. induction H0; intros l Hlen.
inversion Hlen.
simpl in *.
destruct l; try omega.
apply lt_n_S. apply IHextends. omega.
Qed.

最後に、snoc ST TはSTを拡張し、また拡張関係(extends)は反射的です。

Lemma extends_snoc : forall ST T,
extends (snoc ST T) ST.
Proof with auto.
induction ST; intros T...
simpl...
Qed.

Lemma extends_refl : forall ST,
extends ST ST.
Proof.
induction ST; auto.
Qed.

保存、最終的に

ついに、型保存性の最後の正しい主張ができます:

Definition preservation_theorem := forall ST t t' T st st',
has_type empty ST t T ->
store_well_typed ST st ->
t / st ==> t' / st' ->
exists ST',
(extends ST' ST /\
has_type empty ST' t' T /\
store_well_typed ST' st').

保存定理は、新しい項t'の型付けができる、STを拡張する(つまり、すべての古い場所の値についてSTと一致する)「何らかの」記憶型付けST'が存在することを主張するだけであることに注意します。この定理は具体的にST'が何であるかは示しません。もちろん直観的にはST'は、STであるか、そうでなければ拡張された記憶snoc st v1の値V1の型T1についてのsnoc ST T1であることは明らかです。しかしこれを明示的に述べようとすると、定理の主張がいたずらに複雑になります(これによってより有用になることは何もありません)。上記のより弱いバージョンでも繰り返し「クランクを回す」のに適切な形をしており(なぜなら結論が仮定を含意するため)、すべての評価ステップの「列」が型付け可能性を保存することが導かれます。この定理と進行性を組み合わせることで、「型付けできるプログラムはエラーにならない」という通常の保証が得られます。

これを証明するために、いつもの通りいくつかの補題が必要になります。

置換補題

最初に、標準的な置換補題の簡単な拡張が必要です。これはSTLCの置換補題の証明で使ったコンテキスト不変条件と同じ機構にさらに追加するものです。

Inductive appears_free_in : id -> tm -> Prop :=
| afi_var : forall x,
appears_free_in x (tm_var x)
| afi_app1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)
| afi_app2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)
| afi_abs : forall x y T11 t12,
y <> x  ->
appears_free_in x t12 ->
appears_free_in x (tm_abs y T11 t12)
| afi_succ : forall x t1,
appears_free_in x t1 ->
appears_free_in x (tm_succ t1)
| afi_pred : forall x t1,
appears_free_in x t1 ->
appears_free_in x (tm_pred t1)
| afi_mult1 : forall x t1 t2,
appears_free_in x t1 ->
appears_free_in x (tm_mult t1 t2)
| afi_mult2 : forall x t1 t2,
appears_free_in x t2 ->
appears_free_in x (tm_mult t1 t2)
| afi_if0_1 : forall x t1 t2 t3,
appears_free_in x t1 ->
appears_free_in x (tm_if0 t1 t2 t3)
| afi_if0_2 : forall x t1 t2 t3,
appears_free_in x t2 ->
appears_free_in x (tm_if0 t1 t2 t3)
| afi_if0_3 : forall x t1 t2 t3,
appears_free_in x t3 ->
appears_free_in x (tm_if0 t1 t2 t3)
| afi_ref : forall x t1,
appears_free_in x t1 -> appears_free_in x (tm_ref t1)
| afi_deref : forall x t1,
appears_free_in x t1 -> appears_free_in x (tm_deref t1)
| afi_assign1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_assign t1 t2)
| afi_assign2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_assign t1 t2).

Tactic Notation "afi_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "afi_var"
| Case_aux c "afi_app1" | Case_aux c "afi_app2" | Case_aux c "afi_abs"
| Case_aux c "afi_succ" | Case_aux c "afi_pred"
| Case_aux c "afi_mult1" | Case_aux c "afi_mult2"
| Case_aux c "afi_if0_1" | Case_aux c "afi_if0_2" | Case_aux c "afi_if0_3"
| Case_aux c "afi_ref" | Case_aux c "afi_deref"
| Case_aux c "afi_assign1" | Case_aux c "afi_assign2" ].

Hint Constructors appears_free_in.

Lemma free_in_context : forall x t T Gamma ST,
appears_free_in x t ->
has_type Gamma ST t T ->
exists T', Gamma x = Some T'.
Proof with eauto.
intros. generalize dependent Gamma. generalize dependent T.
afi_cases (induction H) Case;
intros; (try solve [ inversion H0; subst; eauto ]).
Case "afi_abs".
inversion H1; subst.
apply IHappears_free_in in H8.
apply not_eq_beq_id_false in H.
rewrite extend_neq in H8; assumption.
Qed.

Lemma context_invariance : forall Gamma Gamma' ST t T,
has_type Gamma ST t T ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x) ->
has_type Gamma' ST t T.
Proof with eauto.
intros.
generalize dependent Gamma'.
has_type_cases (induction H) Case; intros...
Case "T_Var".
apply T_Var. symmetry. rewrite <- H...
Case "T_Abs".
apply T_Abs. apply IHhas_type; intros.
unfold extend.
remember (beq_id x x0) as e; destruct e...
apply H0. apply afi_abs. apply beq_id_false_not_eq... auto.
Case "T_App".
eapply T_App.
apply IHhas_type1...
apply IHhas_type2...
Case "T_Mult".
eapply T_Mult.
apply IHhas_type1...
apply IHhas_type2...
Case "T_If0".
eapply T_If0.
apply IHhas_type1...
apply IHhas_type2...
apply IHhas_type3...
Case "T_Assign".
eapply T_Assign.
apply IHhas_type1...
apply IHhas_type2...
Qed.

Lemma substitution_preserves_typing : forall Gamma ST x s S t T,
has_type empty ST s S ->
has_type (extend Gamma x S) ST t T ->
has_type Gamma ST (subst x s t) T.
Proof with eauto.
intros Gamma ST x s S t T Hs Ht.
generalize dependent Gamma. generalize dependent T.
tm_cases (induction t) Case; intros T Gamma H;
inversion H; subst; simpl...
Case "tm_var".
rename i into y.
remember (beq_id x y) as eq; destruct eq; subst.
SCase "x = y".
apply beq_id_eq in Heqeq; subst.
rewrite extend_eq in H3.
inversion H3; subst.
eapply context_invariance...
intros x Hcontra.
destruct (free_in_context _ _ _ _ _ Hcontra Hs) as [T' HT'].
inversion HT'.
SCase "x <> y".
apply T_Var.
rewrite extend_neq in H3...
Case "tm_abs". subst.
rename i into y.
remember (beq_id x y) as eq; destruct eq.
SCase "x = y".
apply beq_id_eq in Heqeq; subst.
apply T_Abs. eapply context_invariance...
intros. apply extend_shadow.
SCase "x <> x0".
apply T_Abs. apply IHt.
eapply context_invariance...
intros. unfold extend.
remember (beq_id y x0) as e. destruct e...
apply beq_id_eq in Heqe; subst.
rewrite <- Heqeq...
Qed.

代入は記憶型付けを保存する

次に、記憶中のセルの中身を適切な型を持つ新しい値で置き換えたときに、記憶の全体的な型を変えないことを示す必要があります。(これは、ST_Assign規則に必要になります。)

Lemma assign_pres_store_typing : forall ST st l t,
l < length st ->
store_well_typed ST st ->
has_type empty ST t (store_ty_lookup l ST) ->
store_well_typed ST (replace l t st).
Proof with auto.
intros ST st l t Hlen HST Ht.
inversion HST; subst.
split. rewrite length_replace...
intros l' Hl'.
remember (beq_nat l' l) as ll'; destruct ll'.
Case "l' = l".
apply beq_nat_eq in Heqll'; subst.
rewrite lookup_replace_eq...
Case "l' <> l".
symmetry in Heqll'; apply beq_nat_false in Heqll'.
rewrite lookup_replace_neq...
rewrite length_replace in Hl'.
apply H0...
Qed.

記憶についての弱化

最後に、記憶型付けについての補題が必要です。その補題とは、記憶型付けが新しい場所について拡張されたときに、拡張された記憶型付けがオリジナルと同じ項に同じ型をつけることを主張するものです。

(この補題はstore_weakening(記憶弱化)と呼ばれます。なぜなら、証明論で見られる弱化(“weakening”)補題と似ているからです。証明論の弱化補題は、ある理論に新しい仮定を追加しても証明可能な定理が減ることはないことを言うものです。)

Lemma store_weakening : forall Gamma ST ST' t T,
extends ST' ST ->
has_type Gamma ST t T ->
has_type Gamma ST' t T.
Proof with eauto.
intros. has_type_cases (induction H0) Case; eauto.
Case "T_Loc".
erewrite <- extends_lookup...
apply T_Loc.
eapply length_extends...
Qed.

記憶がある記憶型付けのもとで型付けできるとき、新しい項tを拡張した記憶も、記憶型付けを項tの型について拡張したもののもとで型付けできることを、store_weakening補題を使って示すことができます。

Lemma store_well_typed_snoc : forall ST st t1 T1,
store_well_typed ST st ->
has_type empty ST t1 T1 ->
store_well_typed (snoc ST T1) (snoc st t1).
Proof with auto.
intros.
unfold store_well_typed in *.
inversion H as [Hlen Hmatch]; clear H.
rewrite !length_snoc.
split...
Case "types match.".
intros l Hl.
unfold store_lookup, store_ty_lookup.
apply le_lt_eq_dec in Hl; destruct Hl as [Hlt | Heq].
SCase "l < length st".
apply lt_S_n in Hlt.
rewrite <- !nth_lt_snoc...
apply store_weakening with ST. apply extends_snoc.
apply Hmatch...
rewrite Hlen...
SCase "l = length st".
inversion Heq.
rewrite nth_eq_snoc.
rewrite <- Hlen. rewrite nth_eq_snoc...
apply store_weakening with ST... apply extends_snoc.
Qed.

保存!

さて、準備が整いました。保存の証明は実際本当に簡単です。

Theorem preservation : forall ST t t' T st st',
has_type empty ST t T ->
store_well_typed ST st ->
t / st ==> t' / st' ->
exists ST',
(extends ST' ST /\
has_type empty ST' t' T /\
store_well_typed ST' st').
Proof with eauto using store_weakening, extends_refl.
remember (@empty ty) as Gamma.
intros ST t t' T st st' Ht.
generalize dependent t'.
has_type_cases (induction Ht) Case; intros t' HST Hstep;
subst; try (solve by inversion); inversion Hstep; subst;
try (eauto using store_weakening, extends_refl).
Case "T_App".
SCase "ST_AppAbs". exists ST.
inversion Ht1; subst.
split; try split... eapply substitution_preserves_typing...
SCase "ST_App1".
eapply IHHt1 in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
SCase "ST_App2".
eapply IHHt2 in H5...
inversion H5 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Case "T_Succ".
SCase "ST_Succ".
eapply IHHt in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Case "T_Pred".
SCase "ST_Pred".
eapply IHHt in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Case "T_Mult".
SCase "ST_Mult1".
eapply IHHt1 in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
SCase "ST_Mult2".
eapply IHHt2 in H5...
inversion H5 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Case "T_If0".
SCase "ST_If0_1".
eapply IHHt1 in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'... split...
Case "T_Ref".
SCase "ST_RefValue".
exists (snoc ST T1).
inversion HST; subst.
split.
apply extends_snoc.
split.
replace (ty_Ref T1)
with (ty_Ref (store_ty_lookup (length st) (snoc ST T1))).
apply T_Loc.
rewrite <- H. rewrite length_snoc. omega.
unfold store_ty_lookup. rewrite <- H. rewrite nth_eq_snoc...
apply store_well_typed_snoc; assumption.
SCase "ST_Ref".
eapply IHHt in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Case "T_Deref".
SCase "ST_DerefLoc".
exists ST. split; try split...
destruct HST as [_ Hsty].
replace T11 with (store_ty_lookup l ST).
apply Hsty...
inversion Ht; subst...
SCase "ST_Deref".
eapply IHHt in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Case "T_Assign".
SCase "ST_Assign".
exists ST. split; try split...
eapply assign_pres_store_typing...
inversion Ht1; subst...
SCase "ST_Assign1".
eapply IHHt1 in H0...
inversion H0 as [ST' [Hext [Hty Hsty]]].
exists ST'...
SCase "ST_Assign2".
eapply IHHt2 in H5...
inversion H5 as [ST' [Hext [Hty Hsty]]].
exists ST'...
Qed.

[] *)

ここを埋めなさい。 保存補題の非形式的証明を注意深く記述しなさい。T_App、T_Deref、T_Assign、T_Refの場合に特に集中しなさい。

☐

進行

幸いにも、このシステムの進行はかなり簡単に証明できます。証明は、STLCの進行の証明とほとんど同じです。いくつかの新しい構文要素について新しい場合を追加するだけです。

Theorem progress : forall ST t T st,
has_type empty ST t T ->
store_well_typed ST st ->
(value t \/ exists t', exists st', t / st ==> t' / st').
Proof with eauto.
intros ST t T st Ht HST. remember (@empty ty) as Gamma.
has_type_cases (induction Ht) Case; subst; try solve by inversion...
Case "T_App".
right. destruct IHHt1 as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve by inversion.
destruct IHHt2 as [Ht2p | Ht2p]...
SSCase "t2 steps".
inversion Ht2p as [t2' [st' Hstep]].
exists (tm_app (tm_abs x T t) t2'). exists st'...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_app t1' t2). exists st'...
Case "T_Succ".
right. destruct IHHt as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve [ inversion Ht ].
SSCase "t1 is a tm_nat".
exists (tm_nat (S n)). exists st...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_succ t1'). exists st'...
Case "T_Pred".
right. destruct IHHt as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve [inversion Ht ].
SSCase "t1 is a tm_nat".
exists (tm_nat (pred n)). exists st...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_pred t1'). exists st'...
Case "T_Mult".
right. destruct IHHt1 as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve [inversion Ht1].
destruct IHHt2 as [Ht2p | Ht2p]...
SSCase "t2 is a value".
inversion Ht2p; subst; try solve [inversion Ht2].
exists (tm_nat (mult n n0)). exists st...
SSCase "t2 steps".
inversion Ht2p as [t2' [st' Hstep]].
exists (tm_mult (tm_nat n) t2'). exists st'...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_mult t1' t2). exists st'...
Case "T_If0".
right. destruct IHHt1 as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve [inversion Ht1].
destruct n.
SSCase "n = 0". exists t2. exists st...
SSCase "n = S n'". exists t3. exists st...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_if0 t1' t2 t3). exists st'...
Case "T_Ref".
right. destruct IHHt as [Ht1p | Ht1p]...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_ref t1'). exists st'...
Case "T_Deref".
right. destruct IHHt as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve by inversion.
eexists. eexists. apply ST_DerefLoc...
inversion Ht; subst. inversion HST; subst.
rewrite <- H...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_deref t1'). exists st'...
Case "T_Assign".
right. destruct IHHt1 as [Ht1p|Ht1p]...
SCase "t1 is a value".
destruct IHHt2 as [Ht2p|Ht2p]...
SSCase "t2 is a value".
inversion Ht1p; subst; try solve by inversion.
eexists. eexists. apply ST_Assign...
inversion HST; subst. inversion Ht1; subst.
rewrite H in H5...
SSCase "t2 steps".
inversion Ht2p as [t2' [st' Hstep]].
exists (tm_assign t1 t2'). exists st'...
SCase "t1 steps".
inversion Ht1p as [t1' [st' Hstep]].
exists (tm_assign t1' t2). exists st'...
Qed.

Section RefsAndNontermination.
Import ExampleVariables.

単純型付きラムダ計算が正規化性を持つことを見ました。つまり、型付けされるすべての項は有限回のステップで値に簡約されるということです。参照を加えたSTLCではどうでしょうか？驚くべきことに、参照を追加したことで、正規化性は成立しなくなります。参照を持つSTLCの型付けされる項で、正規形に逹することなく永遠に簡約を続けられる項が存在します!

そのような項をどのように構成したらよいでしょうか？一番のアイデアは、自分自身を呼ぶ関数を作る、ということです。最初に参照セルに格納された別の関数を呼ぶ関数を作ります。トリックは、その後で自分自身への参照を持ち込むことです!

(\r:Ref (Unit -> Unit).
r := (\x:Unit.(!r) unit); (!r) unit)
(ref (\x:Unit.unit))

最初に、ref (\x:Unit.unit)が型Unit -> Unitのセルへの参照を作ります。次にこの参照を、ある関数に引数として渡します。その関数は、引数を名前rに束縛し、そして引数に関数 (:Unit.(!r)unit) を代入するものです。ここで関数 (:Unit.(!r) unit) は、引数を無視してrに格納された関数を引数unitに適用するものです。しかしもちろん、rに格納された関数とは自分自身です!玉が転がり出すために、最後にこの関数を(! r) unitに適用することで実行を開始します。

Definition loop_fun :=
tm_abs x ty_Unit (tm_app (tm_deref (tm_var r)) tm_unit).

Definition loop :=
tm_app
(tm_abs r (ty_Ref (ty_arrow ty_Unit ty_Unit))
(tm_seq (tm_assign (tm_var r) loop_fun)
(tm_app (tm_deref (tm_var r)) tm_unit)))
(tm_ref (tm_abs x ty_Unit tm_unit)).

この項は型付けされます:

Lemma loop_typeable : exists T, has_type empty [] loop T.
Proof with eauto.
eexists. unfold loop. unfold loop_fun.
eapply T_App...
eapply T_Abs...
eapply T_App...
eapply T_Abs. eapply T_App. eapply T_Deref. eapply T_Var.
unfold extend. simpl. reflexivity. auto.
eapply T_Assign.
eapply T_Var. unfold extend. simpl. reflexivity.
eapply T_Abs.
eapply T_App...
eapply T_Deref. eapply T_Var. reflexivity.
Qed.

項が発散することを形式的に示すために、最初に1ステップ簡約関係のstep_closure(ステップ閉包)==>+を定義します。これは1ステップ簡約の反射的なステップ閉包(==>*と書いてきたもの)とほとんど同じですが、反射的ではないという点が違います。つまり、t ==>+ t'はtからt'へ1以上のステップの簡約で到達できることを意味します。

Inductive step_closure {X:Type} (R: relation X) : X -> X -> Prop :=
| sc_one  : forall (x y : X),
R x y -> step_closure R x y
| sc_step : forall (x y z : X),
R x y ->
step_closure R y z ->
step_closure R x z.

Definition stepmany1 := (step_closure step).
Notation "t1 '/' st '==>+' t2 '/' st'" := (stepmany1 (t1,st) (t2,st'))
(at level 40, st at level 39, t2 at level 39).

さて、式loopが式!(loc 0) unitとサイズ1の記憶[(loc 0) / rloop_fun] に簡約されることを示すことができます。

便宜上、normalizeタクティックの若干の変種であるreduceを導入します。これは、ゴールがそれ以上簡約できなくなるまで待つのではなく、各ステップでゴールをrsc_reflを使って解こうとします。もちろん、全体としてのポイントはloopが正規化されないことです。このため、前のnormalizeタクティックでは簡約を永遠に続ける無限ループに陥るだけです!

Ltac print_goal := match goal with |- ?x => idtac x end.
Ltac reduce :=
repeat (print_goal; eapply rsc_step ;
[ (eauto 10; fail) | (instantiate; compute)];
try solve [apply rsc_refl]).

Lemma loop_steps_to_loop_fun :
loop / [] ==>*
tm_app (tm_deref (tm_loc 0)) tm_unit / [subst r (tm_loc 0) loop_fun].
Proof with eauto.
unfold loop.
reduce.
Qed.

最後に、後者の式は2ステップで自分自身に簡約されます!

Lemma loop_fun_step_self :
tm_app (tm_deref (tm_loc 0)) tm_unit / [subst r (tm_loc 0) loop_fun] ==>+
tm_app (tm_deref (tm_loc 0)) tm_unit / [subst r (tm_loc 0) loop_fun].
Proof with eauto.
unfold loop_fun; simpl.
eapply sc_step. apply ST_App1...
eapply sc_one. compute. apply ST_AppAbs...
Qed.

上述のアイデアを使って、参照を持つSTLCで階乗関数を実装しなさい。(それが階乗として振る舞うことを形式的に証明する必要はありません。ただ、以下の例を使って、実装したものを引数4に適用したときに正しい結果を返すことを確認しなさい。)

Definition factorial : tm :=
(* FILL IN HERE *) admit.

Lemma factorial_type : has_type empty [] factorial (ty_arrow ty_Nat ty_Nat).
Proof with eauto.
(* FILL IN HERE *) Admitted.

もし定義が正しいのならば、以下の例のコメントを外してみなさい。証明はreduceタクティックを使って完全自動で行われるはずです。

☐

チャレンジ問題: 上述の形式化を修正して、ガベージコレクションを考慮したものにしなさい。そして、それについて、自分が証明すべきと思う何らかの良い性質を持つことを証明しなさい。

☐

End RefsAndNontermination.
End STLCRef.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Subtyping_J :サブタイプ

Require Export MoreStlc_J.

概念

さて、サブタイプ(subtyping)の学習に入ります。サブタイプはおそらく、近年設計されたプログラミング言語で使われる静的型システムの最も特徴的な機能です。

動機付けのための例

レコードを持つ単純型付きラムダ計算では、項

(\r:{y:Nat}. (r.y)+1) {x=10,y=11}

は型付けできません。なぜなら、これはフィールドが1つのレコードを引数としてとる関数に2つのフィールドを持つレコードが与えられている部分を含んでいて、一方、T_App規則は関数の定義域の型は引数の型に完全に一致することを要求するからです。

しかしこれは馬鹿らしいことです。実際には関数に、必要とされるものより良い引数を与えているのです!この関数の本体がレコード引数rに対して行うことができることはおそらく、そのフィールドyを射影することだけです。型から許されることは他にはありません。すると、他にxフィールドが存在するか否かは何の違いもないはずです。これから、直観的に、この関数は少なくともyフィールドは持つ任意のレコード値に適用可能であるべきと思われます。

同じことを別の観点から見ると、より豊かなフィールドを持つレコードは、そのサブセットのフィールドだけを持つレコードと「任意のコンテキストで少なくとも同等の良さである」と言えるでしょう。より長い(多いフィールドを持つ)レコード型の任意の値は、より短かいレコード型が求められるコンテキストで「安全に」(safely)使えるという意味においてです。コンテキストがより短かい型のものを求めているときに、より長い型のものを与えた場合、何も悪いことは起こらないでしょう(形式的には、プログラムは行き詰まることはないでしょう)。

ここではたらいている一般原理はサブタイプ(付け)(subtyping)と呼ばれます。型Tの値が求められている任意のコンテキストで型Sの値が安全に使えるとき、「SはTのサブタイプである」と言い、非形式的にS <: Tと書きます。サブタイプの概念はレコードだけではなく、関数、対、など言語のすべての型コンストラクタに適用されます。

サブタイプとオブジェクト指向言語

サブタイプは多くのプログラミング言語で重要な役割を演じます。特に、オブジェクト指向言語のサブクラス(subclassing)の概念と近い関係にあります。

(JavaやC#等の)オブジェクトはレコードと考えることができます。いくつかのフィールドは関数(「メソッド」)で、いくつかのフィールドはデータ値(「フィールド」または「インスタンス変数」)です。オブジェクトoのメソッドmを引数a1..anのもとで呼ぶことは、oからmフィールドを射影として抽出して、それをa1..anに適用することです。

オブジェクトの型はクラス(class)またはインターフェース(interface)として与えることができます。この両者はどちらも、どのメソッドとどのデータフィールドをオブジェクトが提供するかを記述します。

クラスやインターフェースは、サブクラス(subclass)関係やサブインターフェース(subinterface)関係で関係づけられます。サブクラス(またはサブインターフェース)に属するオブジェクトには、スーパークラス(またはスーパーインターフェース)に属するオブジェクトのメソッドとフィールドのすべての提供することが求められ、おそらくそれに加えてさらにいくつかのものを提供します。

サブクラス(またはサブインターフェース)のオブジェクトをスーパークラス(またはスーパーインターフェース)のオブジェクトの場所で使えるという事実は、複雑なライブラリの構築にきわめて便利なほどの柔軟性を提供します。例えば、Javaの Swingフレームワークのようなグラフィカルユーザーインターフェースツールキットは、スクリーンに表示できユーザとインタラクションできるグラフィカルな表現を持つすべてのオブジェクトに共通のフィールドとメソッドを集めた、抽象インターフェースComponentを定義するでしょう。そのようなオブジェクトの例としては、典型的なGUIのボタン、チェックボックス、スクロールバーなどがあります。この共通インターフェースのみに依存するメソッドは任意のそれらのオブジェクトに適用できます。

もちろん、実際のオブジェクト指向言語はこれらに加えてたくさんの他の機能を持っています。フィールドは更新できます。フィールドとメソッドはprivateと宣言できます。クラスはまた、オブジェクトを構成しそのメソッドをインプリメントするのに使われる「コード」を与えます。そしてサブクラスのコードは「継承」を通じてスーパークラスのコードと協調します。クラスは、静的なメソッドやフィールド、イニシャライザ、等々を持つことができます。

ものごとを単純なまま進めるために、これらの問題を扱うことはしません。実際、これ以上オブジェクトやクラスについて話すことはありません。(もし興味があるなら、 Types and Programming Languages にたくさんの議論があります。)その代わり、STLCの単純化された設定のもとで、サブクラス/サブインターフェース関係の背後にある核となる概念について学習します。

包摂規則

この章のゴールは(直積を持つ)単純型付きラムダ計算にサブタイプを追加することです。これは2つのステップから成ります:

- 型の間の二項サブタイプ関係(subtype relation)を定義します。

- 型付け関係をサブタイプを考慮した形に拡張します。

2つ目のステップは実際はとても単純です。型付け関係にただ1つの規則だけを追加します。その規則は、包摂規則(rule of subsumption)と呼ばれます:

Gamma |- t : S     S <: T
-------------------------                      (T_Sub)
Gamma |- t : T

この規則は、直観的には、項について知っている情報のいくらかを「忘れる」ことができると言っています。

例えば、tが2つのフィールドを持つレコード(例えば、S = {x:A->A, y:B->B})で、フィールドの1つを忘れることにした(T = {y:B->B})とします。するとtを、1フィールドのレコードを引数としてとる関数に渡すことができるようになります。

サブタイプ関係

最初のステップ、関係S <: Tの定義にすべてのアクションがあります。定義のそれぞれを見てみましょう。

直積型

最初に、直積型です。ある一つの対が他の対より「良い」とは、それぞれの成分が他の対の対応するものより良いことです。

S1 <: T1    S2 <: T2
--------------------                        (S_Prod)
S1*S2 <: T1*T2

関数型

次の型を持つ2つの関数fとgがあるとします：

f : C -> {x:A,y:B}
g : (C->{y:B}) -> D

つまり、fは型{x:A,y:B}のレコードを引数とする関数であり、gは引数として、型{y:B}のレコードを引数とする関数をとる高階関数です。(そして、レコードのサブタイプについてはまだ議論していませんが、{x:A,y:B}は{y:B}のサブタイプであるとします。)すると、関数適用g fは、両者の型が正確に一致しないにもかかわらず安全です。なぜなら、gがfについて行うことができるのは、fを(型Cの)ある引数に適用することだけだからです。その結果は実際には2フィールドのレコードになります。ここでgが期待するのは1つのフィールドを持つレコードだけです。しかしこれは安全です。なぜならgがすることができるのは、わかっている1つのフィールドを射影することだけで、それは存在する2つのフィールドの1つだからです。

この例から、関数型のサブタイプ規則が以下のようになるべきということが導かれます。2つの関数型がサブタイプ関係にあるのは、その結果が次の条件のときです:

S2 <: T2
----------------                        (S_Arrow2)
S1->S2 <: S1->T2

これを一般化して、2つの関数型のサブタイプ関係を、引数の条件を含めた形にすることが、同様にできます:

T1 <: S1    S2 <: T2
--------------------                      (S_Arrow)
S1->S2 <: T1->T2

ここで注意するのは、引数の型はサブタイプ関係が逆向きになることです。S1->S2がT1->T2のサブタイプであると結論するためには、T1がS1のサブタイプでなければなりません。関数型のコンストラクタは最初の引数について反変(contravariant)であり、二番目の引数について共変(covariant)であると言います。

直観的には、型S1->S2の関数fがあるとき、fは型S1の要素を引数にとることがわかります。明らかにfはS1の任意のサブタイプT1の要素をとることもできます。fの型は同時にfが型S2の要素を返すことも示しています。この値がS2の任意のスーパータイプT2に属することも見ることができます。つまり、型S1->S2の任意の関数fは、型T1->T2を持つと見ることもできるということです。

Top

サブタイプ関係の最大要素を定めることは自然です。他のすべての型のスーパータイプであり、すべての(型付けできる)値が属する型です。このために言語に新しい一つの型定数Topを追加し、Topをサブタイプ関係の他のすべての型のスーパータイプとするサブタイプ規則を定めます:

--------                             (S_Top)
S <: Top

Top型はJavaやC#におけるObject型に対応するものです。

構造規則

サブタイプ関係の最後に、2つの「構造規則」(“structural rules”)を追加します。これらは特定の型コンストラクタからは独立したものです。推移律(rule of transitivity)は、直観的には、SがUよりも良く、UがTよりも良ければ、SはTよりも良いというものです...

S <: U    U <: T
----------------                        (S_Trans)
S <: T

... そして反射律(rule of reflexivity)は、任意の型はそれ自身と同じ良さを持つというものです。

------                              (S_Refl)
T <: T

レコード

レコード型のサブタイプは何でしょうか？

レコード型のサブタイプについての基本的直観は、「より小さな」レコードの場所で「より大きな」レコードを使うことは常に安全だということです。つまり、レコード型があるとき、さらにフィールドを追加したものは常にサブタイプになるということです。もしあるコードがフィールドxとyを持つレコードを期待していたとき、レコードx、y、zを持つレコードを受けとることは完璧に安全です。zフィールドは単に無視されるだけでしょう。例えば次の通りです。

{x:Nat,y:Bool} <: {x:Nat}
{x:Nat} <: {}

これはレコードの”width subtyping”(幅サブタイプ)として知られます。

レコードの1つのフィールドの型をそのサブタイプで置き換えることでも、レコードのサブタイプを作ることができます。もしあるコードが型Tのフィールドxを持つレコードを待っていたとき、型Sが型Tのサブタイプである限りは、型Sのフィールドxを持つレコードが来ることはハッピーです。例えば次の通りです。

{a:{x:Nat}} <: {a:{}}

これは”depth subtyping”(深さサブタイプ)として知られています。

最後に、レコードのフィールドは特定の順番で記述されますが、その順番は実際には問題ではありません。例えば次の通りです。

{x:Nat,y:Bool} <: {y:Bool,x:Nat}

これは”permutation subtyping”(順列サブタイプ)として知られています。

これらをレコードについての単一のサブタイプ規則に形式化することをやってみましょう。次の通りです:

for each jk in j1..jn,
exists ip in i1..im, such that
jk=ip and Sp <: Tk
----------------------------------                    (S_Rcd)
{i1:S1...im:Sm} <: {j1:T1...jn:Tn}

つまり、左のレコードは(少なくとも)右のレコードのフィールドラベルをすべて持ち、両者で共通するフィールドはサブタイプ関係になければならない、ということです。しかしながら、この規則はかなり重くて読むのがたいへんです。ここでは、3つのより簡単な規則に分解します。この3つはS_Transを使うことで結合することができ、同じ作用をすることができます。

最初に、レコード型の最後にフィールドを追加したものはサブタイプになります:

n > m
---------------------------------                 (S_RcdWidth)
{i1:T1...in:Tn} <: {i1:T1...im:Tm}

S_RcdWidthを使うと、複数のフィールドを持つレコードについて、前方のフィールドを残したまま後方のフィールドを落とすことができます。この規則で例えば{y:B, x:A} <: {y:B}が示されます。

二つ目に、レコード型の構成要素の内部にサブタイプ規則を適用できます:

S1 <: T1  ...  Sn <: Tn
----------------------------------               (S_RcdDepth)
{i1:S1...in:Sn} <: {i1:T1...in:Tn}

例えばS_RcdDepthとS_RcdWidthを両方使って{y:{z:B}, x:A} <: {y:{}}を示すことができます。

三つ目に、フィールドの並べ替えを可能にする必要があります。念頭に置いてきた例は{x:A,y:B} <: {y:B}でした。これはまだ達成されていませんでした。S_RcdDepthとS_RcdWidthだけでは、レコード型の「後」からフィールドを落とすことしかできません。これから次の規則が必要です:

{i1:S1...in:Sn} is a permutation of {i1:T1...in:Tn}
---------------------------------------------------        (S_RcdPerm)
{i1:S1...in:Sn} <: {i1:T1...in:Tn}

さらなる例です:

- {x:A,y:B}<:{y:B,x:A}.

- {}->{j:A} <: {k:B}->Top

- Top->{k:A,j:B} <: C->{j:B}

なお、実際の言語ではこれらのサブタイプ規則のすべてを採用しているとは限らないことは、注記しておくべきでしょう。例えばJavaでは:

- サブクラスではスーパークラスのメソッドの引数または結果の型を変えることはできません (つまり、depth subtypingまたは関数型サブタイプのいずれかができないということです。どちらかは見方によります)。

- それぞれのクラスは(直上の)スーパークラスを1つだけ持ちます(クラスの「単一継承」 (“single inheritance”)です)。

- 各クラスのメンバー(フィールドまたはメソッド)は1つだけインデックスを持ち、 サブクラスでメンバーが追加されるたびに新しいインデックスが「右に」追加されます(つまり、クラスには並び換えがありません)。

- クラスは複数のインターフェースをインプリメントできます。これは インターフェースの「多重継承」(“multiple inheritance”)と呼ばれます(つまり、インターフェースには並び換えがあります)。

直積と Top によるレコード (optional)

これらすべてをどのように形式化するかは、レコードとその型をどのように形式化するかに、まさに依存しています。もしこれらを核言語の一部として扱うならば、そのためのサブタイプ規則を書き下す必要があります。ファイルRecordSub_J.vで、この拡張がどのようにはたらくかを示します。

一方、もしそれらをパーサで展開される派生形として扱うならば、新しい規則は何も必要ありません。直積とUnit型のサブタイプについての既存の規則が、このエンコードによるレコードのサブタイプに関する妥当な規則になっているかをチェックすれば良いだけです。このために、前述のエンコードをわずかに変更する必要があります。組のエンコードのベースケースおよびレコードのエンコードの “don’t care” プレースホルダとして、Unitの代わりにTopを使います。すると:

{a:Nat, b:Nat} ----> {Nat,Nat}       つまり (Nat,(Nat,Top))
{c:Nat, a:Nat} ----> {Nat,Top,Nat}   つまり (Nat,(Top,(Nat,Top)))

レコード値のエンコードは何も変更しません。このエンコードで上述のサブタイプ規則が成立することをチェックするのは容易です(そしてタメになります)。この章の残りでは、このアプローチを追求します。

中核部の定義

STLCに必要となる重要な拡張を既に概観してきました:(1)サブタイプ関係を追加し、(2)型関係に包摂規則を拡張することです。すべてがスムースにいくように、前の章の表現にいくらかの技術的改善を行います。定義の残りは – 特に言語の構文と操作的意味は – 前の章で見たものと同じです。最初に同じ部分をやってみましょう。

よりおもしろい例のために、純粋STLCに非常に小さな拡張を行います。String、Person、Window等のような、任意の「基本型」の集合を追加します。これらの型の定数を追加したり、その型の上の操作を追加したりすることをわざわざやりませんが、そうすることは簡単です。

この章の残りでは、基本型、ブール型、関数型、UnitとTopのみ形式化し、直積型は練習問題にします。

Inductive ty : Type :=
| ty_Top   : ty
| ty_Bool  : ty
| ty_base  : id -> ty
| ty_arrow : ty -> ty -> ty
| ty_Unit  : ty
.

Tactic Notation "ty_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ty_Top" | Case_aux c "ty_Bool"
| Case_aux c "ty_base" | Case_aux c "ty_arrow"
| Case_aux c "ty_Unit" |
].

Inductive tm : Type :=
| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm
| tm_true : tm
| tm_false : tm
| tm_if : tm -> tm -> tm -> tm
| tm_unit : tm
.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app"
| Case_aux c "tm_abs" | Case_aux c "tm_true"
| Case_aux c "tm_false" | Case_aux c "tm_if"
| Case_aux c "tm_unit"
].

包摂の定義は、いつものSTLCと同様です。

Fixpoint subst (s:tm) (x:id) (t:tm) : tm :=
match t with
| tm_var y =>
if beq_id x y then s else t
| tm_abs y T t1 =>
tm_abs y T (if beq_id x y then t1 else (subst s x t1))
| tm_app t1 t2 =>
tm_app (subst s x t1) (subst s x t2)
| tm_true =>
tm_true
| tm_false =>
tm_false
| tm_if t1 t2 t3 =>
tm_if (subst s x t1) (subst s x t2) (subst s x t3)
| tm_unit =>
tm_unit
end.

value(値)の定義やstep関係の定義と同様です。

Inductive value : tm -> Prop :=
| v_abs : forall x T t,
value (tm_abs x T t)
| t_true :
value tm_true
| t_false :
value tm_false
| v_unit :
value tm_unit
.

Hint Constructors value.

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_AppAbs : forall x T t12 v2,
value v2 ->
(tm_app (tm_abs x T t12) v2) ==> (subst v2 x t12)
| ST_App1 : forall t1 t1' t2,
t1 ==> t1' ->
(tm_app t1 t2) ==> (tm_app t1' t2)
| ST_App2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
(tm_app v1 t2) ==> (tm_app v1  t2')
| ST_IfTrue : forall t1 t2,
(tm_if tm_true t1 t2) ==> t1
| ST_IfFalse : forall t1 t2,
(tm_if tm_false t1 t2) ==> t2
| ST_If : forall t1 t1' t2 t3,
t1 ==> t1' ->
(tm_if t1 t2 t3) ==> (tm_if t1' t2 t3)
where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1"
| Case_aux c "ST_App2" | Case_aux c "ST_IfTrue"
| Case_aux c "ST_IfFalse" | Case_aux c "ST_If"
].

Hint Constructors step.

サブタイプ

さて、おもしろい所にやって来ました。サブタイプ関係の定義から始め、その重要な技術的性質を調べます。

定義

サブタイプの定義は、動機付けの議論のところで概観した通りです。

Inductive subtype : ty -> ty -> Prop :=
| S_Refl : forall T,
subtype T T
| S_Trans : forall S U T,
subtype S U ->
subtype U T ->
subtype S T
| S_Top : forall S,
subtype S ty_Top
| S_Arrow : forall S1 S2 T1 T2,
subtype T1 S1 ->
subtype S2 T2 ->
subtype (ty_arrow S1 S2) (ty_arrow T1 T2)
.

なお、基本型については特別な規則は何ら必要ありません。基本型は自動的に(S_Reflより)自分自身のサブタイプであり、(S_Topより)Topのサブタイプでもあります。そしてこれが必要な全てです。

Hint Constructors subtype.

Tactic Notation "subtype_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "S_Refl" | Case_aux c "S_Trans"
| Case_aux c "S_Top" | Case_aux c "S_Arrow"
].

サブタイプの例と練習問題

Module Examples.

Notation x := (Id 0).
Notation y := (Id 1).
Notation z := (Id 2).

Notation A := (ty_base (Id 6)).
Notation B := (ty_base (Id 7)).
Notation C := (ty_base (Id 8)).

Notation String := (ty_base (Id 9)).
Notation Float := (ty_base (Id 10)).
Notation Integer := (ty_base (Id 11)).

(この練習問題は、少なくともファイルのここまでに、直積型を言語に追加した後で行ってください。)

レコードを対でエンコードするときに、以下のレコード型を表す直積型を定義しなさい。

Person   := { name : String }
Student  := { name : String ;
gpa  : Float }
Employee := { name : String ;
ssn  : Integer }

Definition Person : ty :=
(* FILL IN HERE *) admit.
Definition Student : ty :=
(* FILL IN HERE *) admit.
Definition Employee : ty :=
(* FILL IN HERE *) admit.

Example sub_student_person :
subtype Student Person.
Proof.
(* FILL IN HERE *) Admitted.

Example sub_employee_person :
subtype Employee Person.
Proof.
(* FILL IN HERE *) Admitted.

☐

Example subtyping_example_0 :
subtype (ty_arrow C Person)
(ty_arrow C ty_Top).

Proof.
apply S_Arrow.
apply S_Refl. auto.
Qed.

以下の事実のほとんどは、Coqで証明するのは簡単です。練習問題の効果を十分に得るために、どうやって証明するか自分が理解していることを紙に証明を書いて確認しなさい。

Example subtyping_example_1 :
subtype (ty_arrow ty_Top Student)
(ty_arrow (ty_arrow C C) Person).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Example subtyping_example_2 :
subtype (ty_arrow ty_Top Person)
(ty_arrow Person ty_Top).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

End Examples.

型S、T、U、VがありS <: TかつU <: Vとします。このとき以下のサブタイプ関係の主張のうち、正しいものはどれでしょうか？それぞれの後に「真」または「偽」と書きなさい。(ここで、A、B、Cは基本型とします。)

- T->S <: T->S

- Top->U <: S->Top

- (C->C) -> (A*B)  <:  (C->C) -> (Top*B)

- T->T->U <: S->S->V

- (T->T)->U <: (S->S)->V

- ((T->S)->T)->U <: ((S->T)->S)->V

- S*V <: T*U

☐

以下の主張のうち正しいものはどれでしょうか？それぞれについて「真」または「偽」と書きなさい。

forall S T,
S <: T  ->
S->S   <:  T->T

forall S T,
S <: A->A ->
exists T,
S = T->T  /\  T <: A

forall S T1 T1,
S <: T1 -> T2 ->
exists S1 S2,
S = S1 -> S2  /\  T1 <: S1  /\  S2 <: T2

exists S,
S <: S->S

exists S,
S->S <: S

forall S T2 T2,
S <: T1*T2 ->
exists S1 S2,
S = S1*S2  /\  S1 <: T1  /\  S2 <: T2

☐

以下のうち真であるものはどれで、偽であるものはどれでしょうか？

- 他のすべての型のスーパータイプである型がある。

- 他のすべての型のサブタイプである型がある。

- 他のすべての対型のスーパータイプである対型がある。

- 他のすべての対型のサブタイプである対型がある。

- 他のすべての関数型のスーパータイプである関数型がある。

- 他のすべての関数型のサブタイプである関数型がある。

- サブタイプ関係による、同一型を含まない無限降鎖(infinite descending chain)がある。 つまり型の無限列S0、S1、... があり、すべてのSiは異なり、そして各S(i+1)はS(i)のサブタイプである。

- サブタイプ関係による、同一型を含まない無限昇鎖(infinite ascending chain)がある。 つまり型の無限列S0、S1、... があり、すべてのSiは異なり、そして各S(i+1)はS(i)のスーパータイプである。

☐

次の主張は真でしょうか偽でしょうか？自分の答えを簡単に説明しなさい。

forall T,
~(exists n, T = ty_base n) ->
exists S,
S <: T  /\  S <> T

☐

- 次の表明を真にする最小の型Tは何でしょうか？ (ここで「最小」とはサブタイプ関係においてです。)

empty |- (\p:T*Top. p.fst) ((\z:A.z), unit) : A->A

- 同じ表明を真にする最大の型Tは何でしょうか？

☐

- 次の表明を真にする最小の型Tは何でしょうか？

empty |- (\p:(A->A * B->B). p) ((\z:A.z), (\z:B.z)) : T

- 同じ表明を真にする最大の型Tは何でしょうか？

☐

- 次の表明を真にする最小の型Tは何でしょうか？

a:A |- (\p:(A*T). (p.snd) (p.fst)) (a , \z:A.z) : A

- 同じ表明を真にする最大の型Tは何でしょうか？

☐

- 次の表明を真にする最小の型Tは何でしょうか？

exists S,
empty |- (\p:(A*T). (p.snd) (p.fst)) : S

- 同じ表明を真にする最大の型Tは何でしょうか？

☐

次の表明を真にする最小の型Tは何でしょうか？

exists S, exists t,
empty |- (\x:T. x x) t : S

☐

次の表明を真にする最小の型Tは何でしょうか？

empty |- (\x:Top. x) ((\z:A.z) , (\z:B.z)) : T

☐

レコード型{x:A, y:C->C}はいくつのスーパータイプを持つでしょうか？つまり、いくつの異なる型Tが{x:A, y:C->C} <: Tを満たすでしょうか?(ここで、2つの型が異なるとは、その記述が異なることとします。たとえ両者が相互にサブタイプであってもです。例えば、{x:A,y:B}と{y:B,x:A}は異なります。)

☐

型付け

型付け関係の変更は、包摂規則T_Subの追加だけです。

Definition context := id -> (option ty).
Definition empty : context := (fun _ => None).
Definition extend (Gamma : context) (x:id) (T : ty) :=
fun x' => if beq_id x x' then Some T else Gamma x'.

Inductive has_type : context -> tm -> ty -> Prop :=

| T_Var : forall Gamma x T,
Gamma x = Some T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
has_type (extend Gamma x T11) t12 T12 ->
has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T1 T2 Gamma t1 t2,
has_type Gamma t1 (ty_arrow T1 T2) ->
has_type Gamma t2 T1 ->
has_type Gamma (tm_app t1 t2) T2
| T_True : forall Gamma,
has_type Gamma tm_true ty_Bool
| T_False : forall Gamma,
has_type Gamma tm_false ty_Bool
| T_If : forall t1 t2 t3 T Gamma,
has_type Gamma t1 ty_Bool ->
has_type Gamma t2 T ->
has_type Gamma t3 T ->
has_type Gamma (tm_if t1 t2 t3) T
| T_Unit : forall Gamma,
has_type Gamma tm_unit ty_Unit

| T_Sub : forall Gamma t S T,
has_type Gamma t S ->
subtype S T ->
has_type Gamma t T.

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs"
| Case_aux c "T_App" | Case_aux c "T_True"
| Case_aux c "T_False" | Case_aux c "T_If"
| Case_aux c "T_Unit"
| Case_aux c "T_Sub" ].

型付けの例

Module Examples2.
Import Examples.

以下の練習問題は言語に直積を追加した後に行いなさい。それぞれの非形式的な型付けジャッジメントについて、Coqで形式的主張を記述し、それを証明しなさい。

(* FILL IN HERE *)

☐

(* FILL IN HERE *)

☐

(* FILL IN HERE *)

☐

End Examples2.

性質

チェックしたいシステムの根本的性質はいつもと同じく、進行と保存です。STLCに参照を拡張したものとは違い、サブタイプを考慮しても、これらの主張を変化させる必要はありません。ただし、それらの証明はもうちょっと複雑になります。

サブタイプの反転補題(Inversion Lemmas)

型付け関係の性質を見る前に、サブタイプ関係の2つの重要な構造的性質を記しておかなければなりません:

- BoolはBoolの唯一のサブタイプです

- 関数型のすべてのサブタイプは関数型です

これらは反転補題(inversion lemmas)と呼ばれます。これは、後の証明でもともとのinversionタクティックと同じ役目をするためです。つまり、サブタイプ関係の主張S <: Tの導出が存在するという仮定と、SやTの形についてのいくつかの制約が与えられたとき、それぞれの補題は、SとTの形、および両者の構成要素間のサブタイプ関係の存在について、より多くのことが言えるためには、S <: Tの導出がどういう形でなければならないかを提示するからです。

Lemma sub_inversion_Bool : forall U,
subtype U ty_Bool ->
U = ty_Bool.
Proof with auto.
intros U Hs.
remember ty_Bool as V.
(* FILL IN HERE *) Admitted.

Lemma sub_inversion_arrow : forall U V1 V2,
subtype U (ty_arrow V1 V2) ->
exists U1, exists U2,
U = (ty_arrow U1 U2) /\ (subtype V1 U1) /\ (subtype U2 V2).
Proof with eauto.
intros U V1 V2 Hs.
remember (ty_arrow V1 V2) as V.
generalize dependent V2. generalize dependent V1.
(* FILL IN HERE *) Admitted.

☐

正準形(Canonical Forms)

最初に、進行定理の証明はそれほど変わらないことを見ます。1つだけ小さなリファインメントが必要です。問題となる項が関数適用t1 t2でt1とt2が両方とも値の場合を考えるとき、t1がラムダ抽象の形をしており、そのためST_AppAbs簡約規則が適用できることを確認する必要があります。もともとのSTLCでは、これは明らかです。t1が関数型T11->T12を持ち、また、関数型の値を与える規則が1つだけ、つまり規則T_Absだけであり、そしてこの規則の結論部の形から、t1は関数型にならざるを得ない、ということがわかります。

サブタイプを持つSTLCにおいては、この推論はそのままうまく行くわけではありません。その理由は、値が関数型を持つことを示すのに使える規則がもう1つあるからです。包摂規則です。幸い、このことが大きな違いをもたらすことはありません。もしGamma |- t1 : T11->T12を示すのに使われた最後の規則が包摂規則だった場合、導出のその前の部分で、同様にt1が主部(項の部分)である導出があり、帰納法により一番最初にはT_Absが使われたことが推論できるからです。

推論のこの部分は次の補題にまとめられています。この補題は、関数型の可能な正準形(“canonical forms”、つまり値)を示します。

Lemma canonical_forms_of_arrow_types : forall Gamma s T1 T2,
has_type Gamma s (ty_arrow T1 T2) ->
value s ->
exists x, exists S1, exists s2,
s = tm_abs x S1 s2.
Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

同様に、型Boolの正準形は定数trueとfalseです。

Lemma canonical_forms_of_Bool : forall Gamma s,
has_type Gamma s ty_Bool ->
value s ->
(s = tm_true \/ s = tm_false).
Proof with eauto.
intros Gamma s Hty Hv.
remember ty_Bool as T.
has_type_cases (induction Hty) Case; try solve by inversion...
Case "T_Sub".
subst. apply sub_inversion_Bool in H. subst...
Qed.

進行

進行性の証明は純粋なSTLCとほぼ同様に進みます。ただ何箇所かで正準形補題を使うことを除けば...

「定理」(進行): 任意の項tと型Tについて、もしempty |- t : Tならばtは値であるか、ある項t'についてt ==> t'である。

「証明」:tとTが与えられ、empty |- t : Tとする。型付けの導出についての帰納法で進める。

(最後の規則が)T_Abs、T_Unit、T_True、T_Falseのいずれかの場合は、自明である。なぜなら、関数抽象、unit、true、falseは既に値だからである。T_Varであることはありえない。なぜなら、変数は空コンテキストで型付けできないからである。残るのはより興味深い場合である:

- 型付け導出の最後のステップで規則T_Appが使われた場合、 項t1、t2と型T1、T2が存在してt = t1 t2、T = T2、empty |- t1 : T1 -> T2、empty |- t2 : T1となる。さらに帰納法の仮定から、t1は値であるかステップを進めることができ、t2も値であるかステップを進めることができる。このとき、3つの場合がある:

- ある項t1'についてt1 ==> t1'とする。このときST_App1よりt1 t2 ==> t1' t2である。

- t1が値であり、ある項t2'についてt2 ==> t2'とする。 このとき規則ST_App2よりt1 t2 ==> t1 t2'となる。なぜならt1が値だからである。

- 最後にt1とt2がどちらも値とする。補題canonical_forms_for_arrow_typesより、t1はあるx、S1、s2について\x:S1.s2という形である。しかしするとt2が値であることから、ST_AppAbsより(\x:S1.s2) t2 ==> [t2/xs2] となる。

- 導出の最後のステップで規則T_Ifが使われた場合、項t1、t2、t3があってt = if t1 then t2 else t3となり、empty |- t1 : Boolかつempty |- t2 : Tかつempty |- t3 : Tである。さらに、帰納法の仮定よりt1は値であるかステップを進めることができる。

- もしt1が値ならば、ブール値についての正準形補題よりt1 = trueまたはt1 = falseである。どちらの場合でも、規則ST_IfTrueまたはST_IfFalseを使うことによってtはステップを進めることができる。

- もしt1がステップを進めることができるならば、 規則ST_Ifよりtもまたステップを進めることができる。

- 導出の最後のステップが規則T_Subによる場合、型SがあってS <: Tかつempty |- t : Sとなっている。求める結果は型付け導出の帰納法の仮定そのものである。

Theorem progress : forall t T, has_type empty t T -> value t / exists t’, t ==> t’. Proof with eauto. intros t T Ht. remember empty as Gamma. revert HeqGamma. has_type_cases (induction Ht) Case; intros HeqGamma; subst... Case “T_Var”. inversion H. Case “T_App”. right. destruct IHHt1; subst... SCase “t1 is a value”. destruct IHHt2; subst... SSCase “t2 is a value”. destruct (canonical_forms_of_arrow_types empty t1 T1 T2) as [x [S1 [t12 Heqt1]]]... subst. exists (subst t2 x t12)... SSCase “t2 steps”. destruct H0 as [t2’ Hstp]. exists (tm_app t1 t2’)... SCase “t1 steps”. destruct H as [t1’ Hstp]. exists (tm_app t1’ t2)... Case “T_If”. right. destruct IHHt1. SCase “t1 is a value”... assert (t1 = tm_true / t1 = tm_false) by (eapply canonical_forms_of_Bool; eauto). inversion H0; subst... destruct H. rename x into t1’. eauto.

Qed.

型付けの反転補題

保存定理の証明はサブタイプを追加したことでやはり少し複雑になります。その理由は、上述の「サブタイプの反転補題」と同様に、純粋なSTLCでは「定義から自明」であった(したがってinversionタクティックからすぐに得られた)のに、サブタイプがあることで本当の証明が必要になった、型付け関係についてのいくつもの事実があるからです。サブタイプがある場合、同じhas_typeの主張を導出するのに複数の方法があるのです。

以下の「反転補題」(“inversion lemma”)は、もし、関数抽象の型付け主張Gamma |- \x:S1.t2 : Tの導出があるならば、その導出の中に本体t2の型を与える部分が含まれている、ということを言うものです。

「補題」: もしGamma |- \x:S1.t2 : Tならば、型S2が存在してGamma, x:S1 |- t2 : S2かつS1 -> S2 <: Tとなる。

(この補題は「Tはそれ自身が関数型である」とは言っていないことに注意します。そうしたいところですが、それは成立しません!)

「証明」:Gamma、x、S1、t2、Tを補題の主張に記述された通りとする。Gamma |- \x:S1.t2 : Tの導出についての帰納法で証明する。T_VarとT_Appの場合はあり得ない。これらは構文的に関数抽象の形の項に型を与えることはできないからである。

- 導出の最後のステップ使われた規則がT_Absの場合、型T12が存在してT = S1 -> T12かつGamma,x:S1 |- t2 : T12である。S2としてT12をとると、S_ReflよりS1 -> T12 <: S1 -> T12となり、求める性質が成立する。

- 導出の最後のステップ使われた規則がT_Subの場合、型Sが存在してS <: TかつGamma |- \x:S1.t2 : Sとなる。型付け導出の帰納仮定より、型S2が存在してS1 -> S2 <: SかつGamma, x:S1 |- t2 : S2である。このS2を採用すれば、S1 -> S2 <: TであるからS_Transより求める性質が成立する。

Lemma typing_inversion_abs : forall Gamma x S1 t2 T, has_type Gamma (tm_abs x S1 t2) T -> (exists S2, subtype (ty_arrow S1 S2) T / has_type (extend Gamma x S1) t2 S2). Proof with eauto. intros Gamma x S1 t2 T H. remember (tm_abs x S1 t2) as t. has_type_cases (induction H) Case; inversion Heqt; subst; intros; try solve by inversion. Case “T_Abs”. exists T12... Case “T_Sub”. destruct IHhas_type as [S2 [Hsub Hty]]... Qed.

同様に...

Lemma typing_inversion_var : forall Gamma x T,
has_type Gamma (tm_var x) T ->
exists S,
Gamma x = Some S /\ subtype S T.
Proof with eauto.
intros Gamma x T Hty.
remember (tm_var x) as t.
has_type_cases (induction Hty) Case; intros;
inversion Heqt; subst; try solve by inversion.
Case "T_Var".
exists T...
Case "T_Sub".
destruct IHHty as [U [Hctx HsubU]]... Qed.

Lemma typing_inversion_app : forall Gamma t1 t2 T2,
has_type Gamma (tm_app t1 t2) T2 ->
exists T1,
has_type Gamma t1 (ty_arrow T1 T2) /\
has_type Gamma t2 T1.
Proof with eauto.
intros Gamma t1 t2 T2 Hty.
remember (tm_app t1 t2) as t.
has_type_cases (induction Hty) Case; intros;
inversion Heqt; subst; try solve by inversion.
Case "T_App".
exists T1...
Case "T_Sub".
destruct IHHty as [U1 [Hty1 Hty2]]...
Qed.

Lemma typing_inversion_true : forall Gamma T,
has_type Gamma tm_true T ->
subtype ty_Bool T.
Proof with eauto.
intros Gamma T Htyp. remember tm_true as tu.
has_type_cases (induction Htyp) Case;
inversion Heqtu; subst; intros...
Qed.

Lemma typing_inversion_false : forall Gamma T,
has_type Gamma tm_false T ->
subtype ty_Bool T.
Proof with eauto.
intros Gamma T Htyp. remember tm_false as tu.
has_type_cases (induction Htyp) Case;
inversion Heqtu; subst; intros...
Qed.

Lemma typing_inversion_if : forall Gamma t1 t2 t3 T,
has_type Gamma (tm_if t1 t2 t3) T ->
has_type Gamma t1 ty_Bool
/\ has_type Gamma t2 T
/\ has_type Gamma t3 T.
Proof with eauto.
intros Gamma t1 t2 t3 T Hty.
remember (tm_if t1 t2 t3) as t.
has_type_cases (induction Hty) Case; intros;
inversion Heqt; subst; try solve by inversion.
Case "T_If".
auto.
Case "T_Sub".
destruct (IHHty H0) as [H1 [H2 H3]]...
Qed.

Lemma typing_inversion_unit : forall Gamma T,
has_type Gamma tm_unit T ->
subtype ty_Unit T.
Proof with eauto.
intros Gamma T Htyp. remember tm_unit as tu.
has_type_cases (induction Htyp) Case;
inversion Heqtu; subst; intros...
Qed.

型付けについての反転補題と関数型の間のサブタイプの反転補題は「結合補題」(“combination lemma”)としてまとめることができます。この補題は以下で実際に必要になるものを示します。

Lemma abs_arrow : forall x S1 s2 T1 T2,
has_type empty (tm_abs x S1 s2) (ty_arrow T1 T2) ->
subtype T1 S1
/\ has_type (extend empty x S1) s2 T2.
Proof with eauto.
intros x S1 s2 T1 T2 Hty.
apply typing_inversion_abs in Hty.
destruct Hty as [S2 [Hsub Hty]].
apply sub_inversion_arrow in Hsub.
destruct Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
inversion Heq; subst...  Qed.

コンテキスト不変性

コンテキスト不変性補題は、純粋のSTLCと同じパターンをとります。

Inductive appears_free_in : id -> tm -> Prop :=
| afi_var : forall x,
appears_free_in x (tm_var x)
| afi_app1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)
| afi_app2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)
| afi_abs : forall x y T11 t12,
y <> x  ->
appears_free_in x t12 ->
appears_free_in x (tm_abs y T11 t12)
| afi_if1 : forall x t1 t2 t3,
appears_free_in x t1 ->
appears_free_in x (tm_if t1 t2 t3)
| afi_if2 : forall x t1 t2 t3,
appears_free_in x t2 ->
appears_free_in x (tm_if t1 t2 t3)
| afi_if3 : forall x t1 t2 t3,
appears_free_in x t3 ->
appears_free_in x (tm_if t1 t2 t3)
.

Hint Constructors appears_free_in.

Lemma context_invariance : forall Gamma Gamma' t S,
has_type Gamma t S  ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x)  ->
has_type Gamma' t S.
Proof with eauto.
intros. generalize dependent Gamma'.
has_type_cases (induction H) Case;
intros Gamma' Heqv...
Case "T_Var".
apply T_Var... rewrite <- Heqv...
Case "T_Abs".
apply T_Abs... apply IHhas_type. intros x0 Hafi.
unfold extend. remember (beq_id x x0) as e.
destruct e...
Case "T_App".
apply T_App with T1...
Case "T_If".
apply T_If...

Qed.

Lemma free_in_context : forall x t T Gamma,
appears_free_in x t ->
has_type Gamma t T ->
exists T', Gamma x = Some T'.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
has_type_cases (induction Htyp) Case;
subst; inversion Hafi; subst...
Case "T_Abs".
destruct (IHHtyp H4) as [T Hctx]. exists T.
unfold extend in Hctx. apply not_eq_beq_id_false in H2.
rewrite H2 in Hctx...  Qed.

置換

置換補題(substitution lemma)は純粋なSTLCと同じ流れで証明されます。唯一の大きな変更点は、いくつかの場所で、部分項が型を持つことについての仮定から構造的情報を抽出するために、Coqのinversionタクティックを使う代わりに上で証明した反転補題を使うことです。

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S  ->
has_type empty v U   ->
has_type Gamma (subst v x t) S.
Proof with eauto.
intros Gamma x U v t S Htypt Htypv.
generalize dependent S. generalize dependent Gamma.
tm_cases (induction t) Case; intros; simpl.
Case "tm_var".
rename i into y.
destruct (typing_inversion_var _ _ _ Htypt)
as [T [Hctx Hsub]].
unfold extend in Hctx.
remember (beq_id x y) as e. destruct e...
SCase "x=y".
apply beq_id_eq in Heqe. subst.
inversion Hctx; subst. clear Hctx.
apply context_invariance with empty...
intros x Hcontra.
destruct (free_in_context _ _ S empty Hcontra)
as [T' HT']...
inversion HT'.
Case "tm_app".
destruct (typing_inversion_app _ _ _ _ Htypt)
as [T1 [Htypt1 Htypt2]].
eapply T_App...
Case "tm_abs".
rename i into y. rename t into T1.
destruct (typing_inversion_abs _ _ _ _ _ Htypt)
as [T2 [Hsub Htypt2]].
apply T_Sub with (ty_arrow T1 T2)... apply T_Abs...
remember (beq_id x y) as e. destruct e.
SCase "x=y".
eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".
apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
Case "tm_true".
assert (subtype ty_Bool S)
by apply (typing_inversion_true _ _  Htypt)...
Case "tm_false".
assert (subtype ty_Bool S)
by apply (typing_inversion_false _ _  Htypt)...
Case "tm_if".
assert (has_type (extend Gamma x U) t1 ty_Bool
/\ has_type (extend Gamma x U) t2 S
/\ has_type (extend Gamma x U) t3 S)
by apply (typing_inversion_if _ _ _ _ _ Htypt).
destruct H as [H1 [H2 H3]].
apply IHt1 in H1. apply IHt2 in H2. apply IHt3 in H3.
auto.
Case "tm_unit".
assert (subtype ty_Unit S)
by apply (typing_inversion_unit _ _  Htypt)...
Qed.

保存

(型の)保存の証明は以前の章とほとんど同じです。適切な場所で置換補題を使い、型付け仮定から構造的情報を抽出するために上述の反転補題をまた使います。

「定理」(保存)：t、t'が項でTが型であり、empty |- t : Tかつt ==> t'ならば、empty |- t' : Tである。

「証明」:tとTがempty |- t : Tであるとする。証明は、t'を特化しないまま型付け導出の構造に関する帰納法で進める。(最後の規則が)T_Abs、T_Unit、T_True、T_Falseの場合は考えなくて良い。なぜなら関数抽象と定数はステップを進めないからである。T_Varも考えなくて良い。なぜならコンテキストが空だからである。

- もし導出の最後のステップの規則がT_Appならば、 項t1``t2と型T1``T2が存在して、t = t1 t2、T = T2、empty |- t1 : T1 -> T2、empty |- t2 : T1である。 ステップ関係の定義から、t1 t2がステップする方法は3通りである。ST_App1とST_App2の場合、型付け導出の帰納仮定とT_Appより求める結果がすぐに得られる。 t1 t2のステップがST_AppAbsによるとする。するとある型Sと項t12についてt1 = \x:S.t12であり、かつt' = [t2/xt12] である。 補題abs_arrowより、T1 <: Sかつx:S1 |- s2 : T2となる。すると置換補題(substitution_preserves_typing)より、empty |- [t2/xt12 : T2] となるがこれが求める結果である。

- もし導出の最後のステップで使う規則がT_Ifならば、 項t1、t2、t3が存在してt = if t1 then t2 else t3かつempty |- t1 : Boolかつempty |- t2 : Tかつempty |- t3 : Tとなる。さらに帰納法の仮定より、もしt1がステップしてt1'に進むならばempty |- t1' : Boolである。t ==> t'を示すために使われた規則によって、3つの場合がある。

- t ==> t'が規則ST_Ifによる場合、t' = if t1' then t2 else t3かつt1 ==> t1'となる。帰納法の仮定よりempty |- t1' : Boolとなり、これからT_Ifよりempty |- t' : Tとなる。

- t ==> t'が規則ST_IfTrueまたはST_IfFalseによる場合、t' = t2またはt' = t3であり、仮定からempty |- t' : Tとなる。

- もし導出の最後のステップで使う規則がT_Subならば、 型Sが存在してS <: Tかつempty |- t : Sとなる。型付け導出についての帰納法の仮定とT_Subの適用から結果がすぐに得られる。☐

Theorem preservation : forall t t’ T, has_type empty t T -> t ==> t’ -> has_type empty t’ T. Proof with eauto. intros t t’ T HT. remember empty as Gamma. generalize dependent HeqGamma. generalize dependent t’. has_type_cases (induction HT) Case; intros t’ HeqGamma HE; subst; inversion HE; subst... Case “T_App”. inversion HE; subst... SCase “ST_AppAbs”. destruct (abs_arrow _ _ _ _ _ HT1) as [HA1 HA2]. apply substitution_preserves_typing with T... Qed.

型付けの練習問題

この問題の各部分は、Unitとサブタイプを持つSTLCの定義を変更する別々の方法を導きます。(これらの変更は累積的ではありません。各部分はいずれも元々の言語から始まります。)各部分について、(進行、保存の)性質のうち偽になるものをリストアップしなさい。偽になる性質について、反例を示しなさい。

- 次の型付け規則を追加する:

Gamma |- t : S1->S2
S1 <: T1      T1 <: S1     S2 <: T2
-----------------------------------              (T_Funny1)
Gamma |- t : T1->T2

- 次の簡約規則を追加する:

------------------                     (ST_Funny21)
unit ==> (\x:Top. x)

- 次のサブタイプ規則を追加する:

--------------                        (S_Funny3)
Unit <: Top->Top

- 次のサブタイプ規則を追加する:

--------------                        (S_Funny4)
Top->Top <: Unit

- 次の評価規則を追加する:

-----------------                      (ST_Funny5)
(unit t) ==> (t unit)

- 上と同じ評価規則と新たな型付け規則を追加する:

-----------------                      (ST_Funny5)
(unit t) ==> (t unit)

----------------------                    (T_Funny6)
empty |- Unit : Top->Top

- 関数型のサブタイプ規則を次のものに変更する:

S1 <: T1       S2 <: T2
-----------------------                    (S_Arrow')
S1->S2 <: T1->T2

☐

練習問題: 直積の追加

定義したシステムに対、射影、直積型を追加することは比較的簡単な問題です。次の拡張を行いなさい:

- tyとtmの定義に、対のコンストラクタ、第1射影、第2射影、直積型を追加しなさい。 (ty_casesとtm_casesに対応する場合を追加することを忘れないこと。)

- 自明な方法で、well-formedness 関係を拡張しなさい。

- 操作的意味に前の章と同様の簡約規則を拡張しなさい。

- サブタイプ関係に次の規則を拡張しなさい:

S1 <: T1     S2 <: T2
---------------------                     (Sub_Prod)
S1 * S2 <: T1 * T2

- 型付け関係に、前の章と同様の、対と射影の規則を拡張しなさい。

- 進行および保存の証明、およびそのための補題を、 新しい構成要素を扱うように拡張しなさい。(完全に新しいある補題を追加する必要もあるでしょう。)☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

RecordSub_J: レコードのサブタイプ

Require Export MoreStlc_J.

中核部の定義

構文

Inductive ty : Type :=

| ty_Top   : ty
| ty_base  : id -> ty
| ty_arrow : ty -> ty -> ty

| ty_rnil : ty
| ty_rcons : id -> ty -> ty -> ty.

Tactic Notation "ty_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ty_Top" | Case_aux c "ty_base" | Case_aux c "ty_arrow"
| Case_aux c "ty_rnil" | Case_aux c "ty_rcons" ].

Inductive tm : Type :=

| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm
| tm_proj : tm -> id -> tm

| tm_rnil :  tm
| tm_rcons : id -> tm -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app" | Case_aux c "tm_abs"
| Case_aux c "tm_proj" | Case_aux c "tm_rnil" | Case_aux c "tm_rcons" ].

Well-Formedness

Inductive record_ty : ty -> Prop :=
| rty_nil :
record_ty ty_rnil
| rty_cons : forall i T1 T2,
record_ty (ty_rcons i T1 T2).

Inductive record_tm : tm -> Prop :=
| rtm_nil :
record_tm tm_rnil
| rtm_cons : forall i t1 t2,
record_tm (tm_rcons i t1 t2).

Inductive well_formed_ty : ty -> Prop :=
| wfty_Top :
well_formed_ty ty_Top
| wfty_base : forall i,
well_formed_ty (ty_base i)
| wfty_arrow : forall T1 T2,
well_formed_ty T1 ->
well_formed_ty T2 ->
well_formed_ty (ty_arrow T1 T2)
| wfty_rnil :
well_formed_ty ty_rnil
| wfty_rcons : forall i T1 T2,
well_formed_ty T1 ->
well_formed_ty T2 ->
record_ty T2 ->
well_formed_ty (ty_rcons i T1 T2).

Hint Constructors record_ty record_tm well_formed_ty.

置換

Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
match t with
| tm_var y => if beq_id x y then s else t
| tm_abs y T t1 =>  tm_abs y T (if beq_id x y then t1 else (subst x s t1))
| tm_app t1 t2 => tm_app (subst x s t1) (subst x s t2)
| tm_proj t1 i => tm_proj (subst x s t1) i
| tm_rnil => tm_rnil
| tm_rcons i t1 tr2 => tm_rcons i (subst x s t1) (subst x s tr2)
end.

簡約

Inductive value : tm -> Prop :=
| v_abs : forall x T t,
value (tm_abs x T t)
| v_rnil : value tm_rnil
| v_rcons : forall i v vr,
value v ->
value vr ->
value (tm_rcons i v vr).

Hint Constructors value.

Fixpoint ty_lookup (i:id) (Tr:ty) : option ty :=
match Tr with
| ty_rcons i' T Tr' => if beq_id i i' then Some T else ty_lookup i Tr'
| _ => None
end.

Fixpoint tm_lookup (i:id) (tr:tm) : option tm :=
match tr with
| tm_rcons i' t tr' => if beq_id i i' then Some t else tm_lookup i tr'
| _ => None
end.

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_AppAbs : forall x T t12 v2,
value v2 ->
(tm_app (tm_abs x T t12) v2) ==> (subst x v2 t12)
| ST_App1 : forall t1 t1' t2,
t1 ==> t1' ->
(tm_app t1 t2) ==> (tm_app t1' t2)
| ST_App2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
(tm_app v1 t2) ==> (tm_app v1  t2')
| ST_Proj1 : forall tr tr' i,
tr ==> tr' ->
(tm_proj tr i) ==> (tm_proj tr' i)
| ST_ProjRcd : forall tr i vi,
value tr ->
tm_lookup i tr = Some vi    ->
(tm_proj tr i) ==> vi
| ST_Rcd_Head : forall i t1 t1' tr2,
t1 ==> t1' ->
(tm_rcons i t1 tr2) ==> (tm_rcons i t1' tr2)
| ST_Rcd_Tail : forall i v1 tr2 tr2',
value v1 ->
tr2 ==> tr2' ->
(tm_rcons i v1 tr2) ==> (tm_rcons i v1 tr2')

where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2"
| Case_aux c "ST_Proj1" | Case_aux c "ST_ProjRcd" | Case_aux c "ST_Rcd"
| Case_aux c "ST_Rcd_Head" | Case_aux c "ST_Rcd_Tail" ].

Hint Constructors step.

サブタイプ

おもしろい部分に来ました。サブタイプ関係を定義し、その重要な技術的性質のいくつかを調べることから始めます。

サブタイプの定義は、本質的には、動機付けの議論で概観した通りです。ただ、いくつかの規則に付加条件として well-formedness を追加する必要があります。

Inductive subtype : ty -> ty -> Prop :=

| S_Refl : forall T,
well_formed_ty T ->
subtype T T
| S_Trans : forall S U T,
subtype S U ->
subtype U T ->
subtype S T
| S_Top : forall S,
well_formed_ty S ->
subtype S ty_Top
| S_Arrow : forall S1 S2 T1 T2,
subtype T1 S1 ->
subtype S2 T2 ->
subtype (ty_arrow S1 S2) (ty_arrow T1 T2)

| S_RcdWidth : forall i T1 T2,
well_formed_ty (ty_rcons i T1 T2) ->
subtype (ty_rcons i T1 T2) ty_rnil
| S_RcdDepth : forall i S1 T1 Sr2 Tr2,
subtype S1 T1 ->
subtype Sr2 Tr2 ->
record_ty Sr2 ->
record_ty Tr2 ->
subtype (ty_rcons i S1 Sr2) (ty_rcons i T1 Tr2)
| S_RcdPerm : forall i1 i2 T1 T2 Tr3,
well_formed_ty (ty_rcons i1 T1 (ty_rcons i2 T2 Tr3)) ->
i1 <> i2 ->
subtype (ty_rcons i1 T1 (ty_rcons i2 T2 Tr3))
(ty_rcons i2 T2 (ty_rcons i1 T1 Tr3)).

Hint Constructors subtype.

Tactic Notation "subtype_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "S_Refl" | Case_aux c "S_Trans" | Case_aux c "S_Top"
| Case_aux c "S_Arrow" | Case_aux c "S_RcdWidth"
| Case_aux c "S_RcdDepth" | Case_aux c "S_RcdPerm" ].

Module Examples.

Notation x := (Id 0).
Notation y := (Id 1).
Notation z := (Id 2).
Notation j := (Id 3).
Notation k := (Id 4).
Notation i := (Id 5).
Notation A := (ty_base (Id 6)).
Notation B := (ty_base (Id 7)).
Notation C := (ty_base (Id 8)).

Definition ty_rcd_j  :=
(ty_rcons j (ty_arrow B B) ty_rnil).
Definition ty_rcd_kj :=
ty_rcons k (ty_arrow A A) ty_rcd_j.

Example subtyping_example_0 :
subtype (ty_arrow C ty_rcd_kj)
(ty_arrow C ty_rnil).

Proof.
apply S_Arrow.
apply S_Refl. auto.
unfold ty_rcd_kj, ty_rcd_j. apply S_RcdWidth; auto.
Qed.

以下の事実のほとんどはCoqで証明することは簡単です。練習問題の効果を最大にするため、どのように証明するかを理解していることを紙の上でも確認しなさい!

Example subtyping_example_1 :
subtype ty_rcd_kj ty_rcd_j.

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Example subtyping_example_2 :
subtype (ty_arrow ty_Top ty_rcd_kj)
(ty_arrow (ty_arrow C C) ty_rcd_j).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Example subtyping_example_3 :
subtype (ty_arrow ty_rnil (ty_rcons j A ty_rnil))
(ty_arrow (ty_rcons k B ty_rnil) ty_rnil).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Example subtyping_example_4 :
subtype (ty_rcons x A (ty_rcons y B (ty_rcons z C ty_rnil)))
(ty_rcons z C (ty_rcons y B (ty_rcons x A ty_rnil))).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Definition tm_rcd_kj :=
(tm_rcons k (tm_abs z A (tm_var z))
(tm_rcons j (tm_abs z B (tm_var z))
tm_rnil)).

End Examples.

Well-Formedness

Lemma subtype__wf : forall S T,
subtype S T ->
well_formed_ty T /\ well_formed_ty S.
Proof with eauto.
intros S T Hsub.
subtype_cases (induction Hsub) Case;
intros; try (destruct IHHsub1; destruct IHHsub2)...
Case "S_RcdPerm".
split... inversion H. subst. inversion H5...  Qed.

Lemma wf_rcd_lookup : forall i T Ti,
well_formed_ty T ->
ty_lookup i T = Some Ti ->
well_formed_ty Ti.
Proof with eauto.
intros i T.
ty_cases (induction T) Case; intros; try solve by inversion.
Case "ty_rcons".
inversion H. subst. unfold ty_lookup in H0.
remember (beq_id i i0) as b. destruct b; subst...
inversion H0. subst...  Qed.

フィールド参照

サブタイプがあることで、レコードマッチング補題はいくらか複雑になります。それには2つの理由があります。1つはレコード型が対応する項の正確な構造を記述する必要がなくなることです。2つ目は、has_typeの導出に関する帰納法を使う推論が一般には難しくなることです。なぜなら、has_typeが構文指向ではなくなるからです。

Lemma rcd_types_match : forall S T i Ti,
subtype S T ->
ty_lookup i T = Some Ti ->
exists Si, ty_lookup i S = Some Si /\ subtype Si Ti.
Proof with (eauto using wf_rcd_lookup).
intros S T i Ti Hsub Hget. generalize dependent Ti.
subtype_cases (induction Hsub) Case; intros Ti Hget;
try solve by inversion.
Case "S_Refl".
exists Ti...
Case "S_Trans".
destruct (IHHsub2 Ti) as [Ui Hui]... destruct Hui.
destruct (IHHsub1 Ui) as [Si Hsi]... destruct Hsi.
exists Si...
Case "S_RcdDepth".
rename i0 into k.
unfold ty_lookup. unfold ty_lookup in Hget.
remember (beq_id i k) as b. destruct b...
SCase "i = k -- we're looking up the first field".
inversion Hget. subst. exists S1...
Case "S_RcdPerm".
exists Ti. split.
SCase "lookup".
unfold ty_lookup. unfold ty_lookup in Hget.
remember (beq_id i i1) as b. destruct b...
SSCase "i = i1 -- we're looking up the first field".
remember (beq_id i i2) as b. destruct b...
SSSCase "i = i2 - -contradictory".
destruct H0.
apply beq_id_eq in Heqb. apply beq_id_eq in Heqb0.
subst...
SCase "subtype".
inversion H. subst. inversion H5. subst...  Qed.

練習問題: ★★★ (rcd_types_match_informal)

rcd_types_match補題の非形式的証明を注意深く記述しなさい。

(* FILL IN HERE *)

☐

反転補題

練習問題: ★★★, optional (sub_inversion_arrow)

Lemma sub_inversion_arrow : forall U V1 V2,
subtype U (ty_arrow V1 V2) ->
exists U1, exists U2,
(U=(ty_arrow U1 U2)) /\ (subtype V1 U1) /\ (subtype U2 V2).
Proof with eauto.
intros U V1 V2 Hs.
remember (ty_arrow V1 V2) as V.
generalize dependent V2. generalize dependent V1.
(* FILL IN HERE *) Admitted.

型付け

Definition context := id -> (option ty).
Definition empty : context := (fun _ => None).
Definition extend (Gamma : context) (x:id) (T : ty) :=
fun x' => if beq_id x x' then Some T else Gamma x'.

Inductive has_type : context -> tm -> ty -> Prop :=
| T_Var : forall Gamma x T,
Gamma x = Some T ->
well_formed_ty T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
well_formed_ty T11 ->
has_type (extend Gamma x T11) t12 T12 ->
has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T1 T2 Gamma t1 t2,
has_type Gamma t1 (ty_arrow T1 T2) ->
has_type Gamma t2 T1 ->
has_type Gamma (tm_app t1 t2) T2
| T_Proj : forall Gamma i t T Ti,
has_type Gamma t T ->
ty_lookup i T = Some Ti ->
has_type Gamma (tm_proj t i) Ti

| T_Sub : forall Gamma t S T,
has_type Gamma t S ->
subtype S T ->
has_type Gamma t T

| T_RNil : forall Gamma,
has_type Gamma tm_rnil ty_rnil
| T_RCons : forall Gamma i t T tr Tr,
has_type Gamma t T ->
has_type Gamma tr Tr ->
record_ty Tr ->
record_tm tr ->
has_type Gamma (tm_rcons i t tr) (ty_rcons i T Tr).

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
| Case_aux c "T_Proj" | Case_aux c "T_Sub"
| Case_aux c "T_RNil" | Case_aux c "T_RCons" ].

Module Examples2.
Import Examples.

Example typing_example_0 :
has_type empty
(tm_rcons k (tm_abs z A (tm_var z))
(tm_rcons j (tm_abs z B (tm_var z))
tm_rnil))
ty_rcd_kj.

Proof.
(* FILL IN HERE *) Admitted.

☐

Example typing_example_1 :
has_type empty
(tm_app (tm_abs x ty_rcd_j (tm_proj (tm_var x) j))
(tm_rcd_kj))
(ty_arrow B B).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Example typing_example_2 :
has_type empty
(tm_app (tm_abs z (ty_arrow (ty_arrow C C) ty_rcd_j)
(tm_proj (tm_app (tm_var z)
(tm_abs x C (tm_var x)))
j))
(tm_abs z (ty_arrow C C) tm_rcd_kj))
(ty_arrow B B).

Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

End Examples2.

Well-Formedness

Lemma has_type__wf : forall Gamma t T,
has_type Gamma t T -> well_formed_ty T.
Proof with eauto.
intros Gamma t T Htyp.
has_type_cases (induction Htyp) Case...
Case "T_App".
inversion IHHtyp1...
Case "T_Proj".
eapply wf_rcd_lookup...
Case "T_Sub".
apply subtype__wf in H.
destruct H...
Qed.

Lemma step_preserves_record_tm : forall tr tr',
record_tm tr ->
tr ==> tr' ->
record_tm tr'.
Proof.
intros tr tr' Hrt Hstp.
inversion Hrt; subst; inversion Hstp; subst; eauto.
Qed.

フィールド参照

Lemma lookup_field_in_value : forall v T i Ti,
value v ->
has_type empty v T ->
ty_lookup i T = Some Ti ->
exists vi, tm_lookup i v = Some vi /\ has_type empty vi Ti.
Proof with eauto.
remember empty as Gamma.
intros t T i Ti Hval Htyp. revert Ti HeqGamma Hval.
has_type_cases (induction Htyp) Case; intros; subst; try solve by inversion.
Case "T_Sub".
apply (rcd_types_match S) in H0... destruct H0 as [Si [HgetSi Hsub]].
destruct (IHHtyp Si) as [vi [Hget Htyvi]]...
Case "T_RCons".
simpl in H0. simpl. simpl in H1.
remember (beq_id i i0) as b. destruct b.
SCase "i is first".
inversion H1. subst. exists t...
SCase "i in tail".
destruct (IHHtyp2 Ti) as [vi [get Htyvi]]...
inversion Hval...  Qed.

進行

練習問題: ★★★ (canonical_forms_of_arrow_types)

Lemma canonical_forms_of_arrow_types : forall Gamma s T1 T2,
has_type Gamma s (ty_arrow T1 T2) ->
value s ->
exists x, exists S1, exists s2,
s = tm_abs x S1 s2.
Proof with eauto.
(* FILL IN HERE *) Admitted.

☐

Theorem progress : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.
Proof with eauto.
intros t T Ht.
remember empty as Gamma.
revert HeqGamma.
has_type_cases (induction Ht) Case;
intros HeqGamma; subst...
Case "T_Var".
inversion H.
Case "T_App".
right.
destruct IHHt1; subst...
SCase "t1 is a value".
destruct IHHt2; subst...
SSCase "t2 is a value".
destruct (canonical_forms_of_arrow_types empty t1 T1 T2)
as [x [S1 [t12 Heqt1]]]...
subst. exists (subst x t2 t12)...
SSCase "t2 steps".
destruct H0 as [t2' Hstp]. exists (tm_app t1 t2')...
SCase "t1 steps".
destruct H as [t1' Hstp]. exists (tm_app t1' t2)...
Case "T_Proj".
right. destruct IHHt...
SCase "rcd is value".
destruct (lookup_field_in_value t T i Ti) as [t' [Hget Ht']]...
SCase "rcd_steps".
destruct H0 as [t' Hstp]. exists (tm_proj t' i)...
Case "T_RCons".
destruct IHHt1...
SCase "head is a value".
destruct IHHt2...
SSCase "tail steps".
right. destruct H2 as [tr' Hstp].
exists (tm_rcons i t tr')...
SCase "head steps".
right. destruct H1 as [t' Hstp].
exists (tm_rcons i t' tr)...  Qed.

進行の非形式的証明:

定理： 任意の項tと型Tについて、empty |- t : Tならば、tは値であるか、ある項t'についてt ==> t'である。

証明 :tとTがempty |- t : Tを満たすとする。型付け導出についての帰納法を使う。T_AbsとT_RNilの場合は自明である。それは、関数抽象と{}は常に値だからである。T_Varの場合は考えなくて良い。なぜなら変数は空コンテキストで型付けできないからである。

- 型付け導出の最後のステップがT_Appの適用だった場合、 項t1``t2と型T1``T2があってt = t1 t2、T = T2、empty |- t1 : T1 -> T2、empty |- t2 : T1となる。 これらの型付け導出の帰納法の仮定より、t1は値であるかステップを進めることができ、またt2は値であるかステップを進めることができる。それぞれの場合を考える:

- ある項t1'についてt1 ==> t1'とする。 するとST_App1よりt1 t2 ==> t1' t2である。

- そうでないならばt1は値である。

- ある項t2'についてt2 ==> t2'とする。 するとt1が値であることから規則ST_App2によりt1 t2 ==> t1 t2'となる。

- そうでなければt2は値である。補題canonical_forms_for_arrow_typesにより、 あるx、S1、s2についてt1 = \x:S1.s2である。するとt2が値であることから、ST_AppAbsにより(\x:S1.s2) t2 ==> [t2/xs2] となる。

- 導出の最後のステップがT_Projの適用だった場合、 項tr、型Tr、ラベルiが存在してt = tr.i、empty |- tr : Tr、ty_lookup i Tr = Some Tとなる。 導出の一部である型付け導出の帰納仮定より、trは値であるかステップを進むことができる。もしある項tr'についてtr ==> tr'ならば、規則ST_Proj1よりtr.i ==> tr'.iとなる。 そうでなければ、trは値である。この場合、補題lookup_field_in_valueにより項tiが存在してtm_lookup i tr = Some tiとなる。これから、規則ST_ProjRcdよりtr.i ==> tiとなる。

- 導出の最後のステップがT_Subの適用だった場合、 型Sが存在してS <: Tかつempty |- t : Sとなる。導出の一部である型付け導出の帰納法の仮定から求める結果がすぐに得られる。

- 導出の最後のステップがT_RConsの適用だった場合、 項t1``tr、型T1 Tr、ラベルiが存在してt = {i=t1, tr}、T = {i:T1, Tr}、record_tm tr、record_tm Tr、empty |- t1 : T1、empty |- tr : Trとなる。 これらの型付け導出についての帰納法の仮定より、t1は値であるか、ステップを進めることができ、trは値であるかステップを進めることができることが言える。それそれの場合を考える:

- ある項t1'についてt1 ==> t1'とする。 すると規則ST_Rcd_Headから{i=t1, tr} ==> {i=t1', tr}となる。

- そうではないとき、t1は値である。

- ある項tr'についてtr ==> tr'とする。 するとt1が値であることから、規則ST_Rcd_Tailより{i=t1, tr} ==> {i=t1, tr'}となる。

- そうではないとき、trも値である。すると、v_rconsから{i=t1, tr}は値である。

反転補題

Lemma typing_inversion_var : forall Gamma x T,
has_type Gamma (tm_var x) T ->
exists S,
Gamma x = Some S /\ subtype S T.
Proof with eauto.
intros Gamma x T Hty.
remember (tm_var x) as t.
has_type_cases (induction Hty) Case; intros;
inversion Heqt; subst; try solve by inversion.
Case "T_Var".
exists T...
Case "T_Sub".
destruct IHHty as [U [Hctx HsubU]]... Qed.

Lemma typing_inversion_app : forall Gamma t1 t2 T2,
has_type Gamma (tm_app t1 t2) T2 ->
exists T1,
has_type Gamma t1 (ty_arrow T1 T2) /\
has_type Gamma t2 T1.
Proof with eauto.
intros Gamma t1 t2 T2 Hty.
remember (tm_app t1 t2) as t.
has_type_cases (induction Hty) Case; intros;
inversion Heqt; subst; try solve by inversion.
Case "T_App".
exists T1...
Case "T_Sub".
destruct IHHty as [U1 [Hty1 Hty2]]...
assert (Hwf := has_type__wf _ _ _ Hty2).
exists U1...  Qed.

Lemma typing_inversion_abs : forall Gamma x S1 t2 T,
has_type Gamma (tm_abs x S1 t2) T ->
(exists S2, subtype (ty_arrow S1 S2) T
/\ has_type (extend Gamma x S1) t2 S2).
Proof with eauto.
intros Gamma x S1 t2 T H.
remember (tm_abs x S1 t2) as t.
has_type_cases (induction H) Case;
inversion Heqt; subst; intros; try solve by inversion.
Case "T_Abs".
assert (Hwf := has_type__wf _ _ _ H0).
exists T12...
Case "T_Sub".
destruct IHhas_type as [S2 [Hsub Hty]]...
Qed.

Lemma typing_inversion_proj : forall Gamma i t1 Ti,
has_type Gamma (tm_proj t1 i) Ti ->
exists T, exists Si,
ty_lookup i T = Some Si /\ subtype Si Ti /\ has_type Gamma t1 T.
Proof with eauto.
intros Gamma i t1 Ti H.
remember (tm_proj t1 i) as t.
has_type_cases (induction H) Case;
inversion Heqt; subst; intros; try solve by inversion.
Case "T_Proj".
assert (well_formed_ty Ti) as Hwf.
SCase "pf of assertion".
apply (wf_rcd_lookup i T Ti)...
apply has_type__wf in H...
exists T. exists Ti...
Case "T_Sub".
destruct IHhas_type as [U [Ui [Hget [Hsub Hty]]]]...
exists U. exists Ui...  Qed.

Lemma typing_inversion_rcons : forall Gamma i ti tr T,
has_type Gamma (tm_rcons i ti tr) T ->
exists Si, exists Sr,
subtype (ty_rcons i Si Sr) T /\ has_type Gamma ti Si /\
record_tm tr /\ has_type Gamma tr Sr.
Proof with eauto.
intros Gamma i ti tr T Hty.
remember (tm_rcons i ti tr) as t.
has_type_cases (induction Hty) Case;
inversion Heqt; subst...
Case "T_Sub".
apply IHHty in H0.
destruct H0 as [Ri [Rr [HsubRS [HtypRi HtypRr]]]].
exists Ri. exists Rr...
Case "T_RCons".
assert (well_formed_ty (ty_rcons i T Tr)) as Hwf.
SCase "pf of assertion".
apply has_type__wf in Hty1.
apply has_type__wf in Hty2...
exists T. exists Tr...  Qed.

Lemma abs_arrow : forall x S1 s2 T1 T2,
has_type empty (tm_abs x S1 s2) (ty_arrow T1 T2) ->
subtype T1 S1
/\ has_type (extend empty x S1) s2 T2.
Proof with eauto.
intros x S1 s2 T1 T2 Hty.
apply typing_inversion_abs in Hty.
destruct Hty as [S2 [Hsub Hty]].
apply sub_inversion_arrow in Hsub.
destruct Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
inversion Heq; subst...  Qed.

コンテキスト不変性

Inductive appears_free_in : id -> tm -> Prop :=
| afi_var : forall x,
appears_free_in x (tm_var x)
| afi_app1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)
| afi_app2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)
| afi_abs : forall x y T11 t12,
y <> x  ->
appears_free_in x t12 ->
appears_free_in x (tm_abs y T11 t12)
| afi_proj : forall x t i,
appears_free_in x t ->
appears_free_in x (tm_proj t i)
| afi_rhead : forall x i t tr,
appears_free_in x t ->
appears_free_in x (tm_rcons i t tr)
| afi_rtail : forall x i t tr,
appears_free_in x tr ->
appears_free_in x (tm_rcons i t tr).

Hint Constructors appears_free_in.

Lemma context_invariance : forall Gamma Gamma' t S,
has_type Gamma t S  ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x)  ->
has_type Gamma' t S.
Proof with eauto.
intros. generalize dependent Gamma'.
has_type_cases (induction H) Case;
intros Gamma' Heqv...
Case "T_Var".
apply T_Var... rewrite <- Heqv...
Case "T_Abs".
apply T_Abs... apply IHhas_type. intros x0 Hafi.
unfold extend. remember (beq_id x x0) as e.
destruct e...
Case "T_App".
apply T_App with T1...
Case "T_RCons".
apply T_RCons...  Qed.

Lemma free_in_context : forall x t T Gamma,
appears_free_in x t ->
has_type Gamma t T ->
exists T', Gamma x = Some T'.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
has_type_cases (induction Htyp) Case; subst; inversion Hafi; subst...
Case "T_Abs".
destruct (IHHtyp H5) as [T Hctx]. exists T.
unfold extend in Hctx. apply not_eq_beq_id_false in H3.
rewrite H3 in Hctx...  Qed.

保存

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S  ->
has_type empty v U   ->
has_type Gamma (subst x v t) S.
Proof with eauto.
intros Gamma x U v t S Htypt Htypv.
generalize dependent S. generalize dependent Gamma.
tm_cases (induction t) Case; intros; simpl.
Case "tm_var".
rename i into y.
destruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub]].
unfold extend in Hctx.
remember (beq_id x y) as e. destruct e...
SCase "x=y".
apply beq_id_eq in Heqe. subst.
inversion Hctx; subst. clear Hctx.
apply context_invariance with empty...
intros x Hcontra.
destruct (free_in_context _ _ S empty Hcontra) as [T' HT']...
inversion HT'.
SCase "x<>y".
destruct (subtype__wf _ _ Hsub)...
Case "tm_app".
destruct (typing_inversion_app _ _ _ _ Htypt) as [T1 [Htypt1 Htypt2]].
eapply T_App...
Case "tm_abs".
rename i into y. rename t into T1.
destruct (typing_inversion_abs _ _ _ _ _ Htypt)
as [T2 [Hsub Htypt2]].
destruct (subtype__wf _ _ Hsub) as [Hwf1 Hwf2].
inversion Hwf2. subst.
apply T_Sub with (ty_arrow T1 T2)... apply T_Abs...
remember (beq_id x y) as e. destruct e.
SCase "x=y".
eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".
apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
Case "tm_proj".
destruct (typing_inversion_proj _ _ _ _ Htypt)
as [T [Ti [Hget [Hsub Htypt1]]]]...
Case "tm_rnil".
eapply context_invariance...
intros y Hcontra. inversion Hcontra.
Case "tm_rcons".
destruct (typing_inversion_rcons _ _ _ _ _ Htypt) as
[Ti [Tr [Hsub [HtypTi [Hrcdt2 HtypTr]]]]].
apply T_Sub with (ty_rcons i Ti Tr)...
apply T_RCons...
SCase "record_ty Tr".
apply subtype__wf in Hsub. destruct Hsub. inversion H0...
SCase "record_tm (subst x v t2)".
inversion Hrcdt2; subst; simpl...  Qed.

Theorem preservation : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.
Proof with eauto.
intros t t' T HT.
remember empty as Gamma. generalize dependent HeqGamma.
generalize dependent t'.
has_type_cases (induction HT) Case;
intros t' HeqGamma HE; subst; inversion HE; subst...
Case "T_App".
inversion HE; subst...
SCase "ST_AppAbs".
destruct (abs_arrow _ _ _ _ _ HT1) as [HA1 HA2].
apply substitution_preserves_typing with T...
Case "T_Proj".
destruct (lookup_field_in_value _ _ _ _ H2 HT H)
as [vi [Hget Hty]].
rewrite H4 in Hget. inversion Hget. subst...
Case "T_RCons".
eauto using step_preserves_record_tm.  Qed.

preservationの非形式的証明:

定理:t、t'が項でTが型でありempty |- t : Tかつt ==> t'ならば、empty |- t' : Tである。

証明:tとTがempty |- t : Tであるとする。t'を特化しないまま、型付け導出の構造についての帰納法で証明を進める。T_Varの場合は前と同様考える必要はない。コンテキストが空だからである。

- もし導出の最後ステップで使った規則がT_Appならば、 項t1``t2と型T1``T2があり、t = t1 t2、T = T2、empty |- t1 : T1 -> T2、empty |- t2 : T1である。 ステップ関係の定義を見ることにより、t1 t2がステップを進める方法は3通りであることがわかる。ST_App1とST_App2の場合は型付け導出の帰納法の仮定とT_Appを使うことで、すぐに証明が完了する。 そうではなくST_AppAbsによりt1 t2がステップを進めるとする。すると、ある型Sと項t12についてt1 = \x:S.t12かつt' = [t2/xt12]となる。 補題abs_arrowより、T1 <: Sかつx:S1 |- s2 : T2であるから、補題substitution_preserves_typingよりempty |- [t2/xt12 : T2]となり、これが求める結果である。

- もし導出の最後ステップで使った規則がT_Projならば、 項tr、型Tr、ラベルiが存在してt = tr.iかつempty |- tr : Trかつty_lookup i Tr = Some Tとなる。 型付け導出の帰納仮定より、任意の項tr'について、tr ==> tr'ならばempty |- tr' Trである。ステップ関係の定義より、射影がステップを進める方法は2つである。ST_Proj1の場合は帰納仮定からすぐに証明される。 そうではなくtr.iのステップがST_ProjRcdによる場合、trは値であり、ある項viがあってtm_lookup i tr = Some viかつt' = viとなる。しかし補題lookup_field_in_valueよりempty |- vi : Tiとなるが、これが求める結果である。

- もし導出の最後ステップで使った規則がT_Subならば、型Sが存在してS <: Tかつempty |- t : Sとなる。型付け導出の帰納法の仮定とT_Subの適用により結果がすぐに得られる。

- もし導出の最後ステップで使った規則がT_RConsならば、 項t1``tr、型T1 Tr、ラベルiが存在してt = {i=t1, tr}、T = {i:T1, Tr}、record_tm tr、record_tm Tr、empty |- t1 : T1、empty |- tr : Trとなる。 ステップ関係の定義より、tはST_Rcd_HeadまたはST_Rcd_Tailによってステップを進めたはずである。ST_Rcd_Headの場合、t1の型付け導出についての帰納仮定とT_RConsより求める結果が得られる。ST_Rcd_Tailの場合、trの型付け導出についての帰納仮定、T_RCons、およびstep_preserves_record_tm補題の使用から求める結果が得られる。

練習問題: ★★, optional (variations)

この問題のそれぞれの部分は、レコードとサブタイプを持つSTLCの定義を変更する別々の方法を表しています。(これらの変更は累積的ではありません。それぞれの部分はもともとの言語から始めます。)それぞれの部分について、(進行、保存の)性質のうち成立するものをリストアップしなさい。また、成立しない性質について、反例を挙げなさい。

- 次の型付け規則を追加する:

Gamma |- t : S1->S2
S1 <: T1      T1 <: S1     S2 <: T2
-----------------------------------              (T_Funny1)
Gamma |- t : T1->T2

- 次の簡約規則を追加する:

------------------                     (ST_Funny21)
{} ==> (\x:Top. x)

- 次のサブタイプ規則を追加する:

--------------                        (S_Funny3)
{} <: Top->Top

- 次のサブタイプ規則を追加する:

--------------                        (S_Funny4)
Top->Top <: {}

- 次の評価規則を追加する:

-----------------                      (ST_Funny5)
({} t) ==> (t {})

- 上と同じ評価規則と新しい型付け規則を追加する:

-----------------                      (ST_Funny5)
({} t) ==> (t {})

----------------------                    (T_Funny6)
empty |- {} : Top->Top

- 関数型についてのサブタイプ規則を次のものに変更する:

S1 <: T1       S2 <: T2
-----------------------                    (S_Arrow')
S1->S2 <: T1->T2

☐

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Norm_J: STLCの正規化

Require Import Stlc_J.
Require Import Relations.

(この章はオプションです。)

この章では、単純型付きラムダ計算の別の基本的な理論的性質を検討します。型付けされるプログラムは有限回のステップで停止することが保証されるという事実です。つまり、すべての型付けされた項は正規化可能(normalizable)です。

ここまで考えてきた型安全性とは異なり、正規化性は本格的なプログラミング言語には拡張されません。なぜなら、本格的な言語ではほとんどの場合、単純型付きラムダ計算に、(MoreStlc_J章で議論したような)一般再帰や再帰型が拡張され、停止しないプログラムが書けるようになっているからです。しかし、正規化性の問題は「型のレベル」で再度現れます。それが現れるのは、F_ωのようなラムダ計算の多相バージョンの、メタ理論を考えるときです。F_ωでは、型の言語は単純型付きラムダ計算のコピーを効果的に包括しており、型チェックアルゴリズムの停止性は、型の式の「正規化」操作が停止することが保証されていることに依拠しています。

正規化の証明を学習する別の理由は、それが、(ここでやっているように)論理的関係の基本的証明テクニックを含むような型理論の文献において、見るべき一番美しい—そして刺激的な—数学だからです。

ここで考える計算は、基本型boolと対を持つ単純型付きラムダ計算です。ここではboolを未解釈基本型として扱う基本ラムダ計算項の処理を細部まで示します。ブール演算と対の拡張は読者に残しておきます。基本計算においてさえ、正規化は証明が完全に自明ということはありません。なぜなら、項の各簡約は部分項のリデックスを複製することがあるからです。

練習問題: ★

型付けされた項のサイズについての素直な帰納法で正規化性を証明しようとしたとき、どこで失敗するでしょうか？

(* FILL IN HERE *)

☐

言語

関係する言語の定義から始めます。MoreStlc_J章のものと同様です。そして、型の保存とステップの決定性を含む結果も成立します。(進行は使いません。)正規化の節まで飛ばしても構いません...

構文と操作的意味

Inductive ty : Type :=
| ty_Bool : ty
| ty_arrow : ty -> ty -> ty
| ty_prod  : ty -> ty -> ty
.

Tactic Notation "ty_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ty_Bool" | Case_aux c "ty_arrow" | Case_aux c "ty_prod" ].

Inductive tm : Type :=

| tm_var : id -> tm
| tm_app : tm -> tm -> tm
| tm_abs : id -> ty -> tm -> tm

| tm_pair : tm -> tm -> tm
| tm_fst : tm -> tm
| tm_snd : tm -> tm

| tm_true : tm
| tm_false : tm
| tm_if : tm -> tm -> tm -> tm.

Tactic Notation "tm_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "tm_var" | Case_aux c "tm_app" | Case_aux c "tm_abs"
| Case_aux c "tm_pair" | Case_aux c "tm_fst" | Case_aux c "tm_snd"
| Case_aux c "tm_true" | Case_aux c "tm_false" | Case_aux c "tm_if" ].

置換

Fixpoint subst (x:id) (s:tm) (t:tm) : tm :=
match t with
| tm_var y => if beq_id x y then s else t
| tm_abs y T t1 =>  tm_abs y T (if beq_id x y then t1 else (subst x s t1))
| tm_app t1 t2 => tm_app (subst x s t1) (subst x s t2)
| tm_pair t1 t2 => tm_pair (subst x s t1) (subst x s t2)
| tm_fst t1 => tm_fst (subst x s t1)
| tm_snd t1 => tm_snd (subst x s t1)
| tm_true => tm_true
| tm_false => tm_false
| tm_if t0 t1 t2 => tm_if (subst x s t0) (subst x s t1) (subst x s t2)
end.

簡約

Inductive value : tm -> Prop :=
| v_abs : forall x T11 t12,
value (tm_abs x T11 t12)
| v_pair : forall v1 v2,
value v1 ->
value v2 ->
value (tm_pair v1 v2)
| v_true : value tm_true
| v_false : value tm_false
.

Hint Constructors value.

Reserved Notation "t1 '==>' t2" (at level 40).

Inductive step : tm -> tm -> Prop :=
| ST_AppAbs : forall x T11 t12 v2,
value v2 ->
(tm_app (tm_abs x T11 t12) v2) ==> (subst x v2 t12)
| ST_App1 : forall t1 t1' t2,
t1 ==> t1' ->
(tm_app t1 t2) ==> (tm_app t1' t2)
| ST_App2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
(tm_app v1 t2) ==> (tm_app v1 t2')

| ST_Pair1 : forall t1 t1' t2,
t1 ==> t1' ->
(tm_pair t1 t2) ==> (tm_pair t1' t2)
| ST_Pair2 : forall v1 t2 t2',
value v1 ->
t2 ==> t2' ->
(tm_pair v1 t2) ==> (tm_pair v1 t2')
| ST_Fst : forall t1 t1',
t1 ==> t1' ->
(tm_fst t1) ==> (tm_fst t1')
| ST_FstPair : forall v1 v2,
value v1 ->
value v2 ->
(tm_fst (tm_pair v1 v2)) ==> v1
| ST_Snd : forall t1 t1',
t1 ==> t1' ->
(tm_snd t1) ==> (tm_snd t1')
| ST_SndPair : forall v1 v2,
value v1 ->
value v2 ->
(tm_snd (tm_pair v1 v2)) ==> v2

| ST_IfTrue : forall t1 t2,
(tm_if tm_true t1 t2) ==> t1
| ST_IfFalse : forall t1 t2,
(tm_if tm_false t1 t2) ==> t2
| ST_If : forall t0 t0' t1 t2,
t0 ==> t0' ->
(tm_if t0 t1 t2) ==> (tm_if t0' t1 t2)

where "t1 '==>' t2" := (step t1 t2).

Tactic Notation "step_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "ST_AppAbs" | Case_aux c "ST_App1" | Case_aux c "ST_App2"
| Case_aux c "ST_Pair1" | Case_aux c "ST_Pair2"
| Case_aux c "ST_Fst" | Case_aux c "ST_FstPair"
| Case_aux c "ST_Snd" | Case_aux c "ST_SndPair"
| Case_aux c "ST_IfTrue" | Case_aux c "ST_IfFalse" | Case_aux c "ST_If" ].

Notation stepmany := (refl_step_closure step).
Notation "t1 '==>*' t2" := (stepmany t1 t2) (at level 40).

Hint Constructors step.

Notation step_normal_form := (normal_form step).

Lemma value__normal : forall t, value t -> step_normal_form t.
Proof with eauto.
intros t H; induction H; intros [t' ST]; inversion ST...
Qed.

型付け

Definition context := partial_map ty.

Inductive has_type : context -> tm -> ty -> Prop :=

| T_Var : forall Gamma x T,
Gamma x = Some T ->
has_type Gamma (tm_var x) T
| T_Abs : forall Gamma x T11 T12 t12,
has_type (extend Gamma x T11) t12 T12 ->
has_type Gamma (tm_abs x T11 t12) (ty_arrow T11 T12)
| T_App : forall T1 T2 Gamma t1 t2,
has_type Gamma t1 (ty_arrow T1 T2) ->
has_type Gamma t2 T1 ->
has_type Gamma (tm_app t1 t2) T2

| T_Pair : forall Gamma t1 t2 T1 T2,
has_type Gamma t1 T1 ->
has_type Gamma t2 T2 ->
has_type Gamma (tm_pair t1 t2) (ty_prod T1 T2)
| T_Fst : forall Gamma t T1 T2,
has_type Gamma t (ty_prod T1 T2) ->
has_type Gamma (tm_fst t) T1
| T_Snd : forall Gamma t T1 T2,
has_type Gamma t (ty_prod T1 T2) ->
has_type Gamma (tm_snd t) T2

| T_True : forall Gamma,
has_type Gamma tm_true ty_Bool
| T_False : forall Gamma,
has_type Gamma tm_false ty_Bool
| T_If : forall Gamma t0 t1 t2 T,
has_type Gamma t0 ty_Bool ->
has_type Gamma t1 T ->
has_type Gamma t2 T ->
has_type Gamma (tm_if t0 t1 t2) T
.

Hint Constructors has_type.

Tactic Notation "has_type_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "T_Var" | Case_aux c "T_Abs" | Case_aux c "T_App"
| Case_aux c "T_Pair" | Case_aux c "T_Fst" | Case_aux c "T_Snd"
| Case_aux c "T_True" | Case_aux c "T_False" | Case_aux c "T_If" ].

Hint Extern 2 (has_type _ (tm_app _ _) _) => eapply T_App; auto.
Hint Extern 2 (_ = _) => compute; reflexivity.

コンテキスト不変性

Inductive appears_free_in : id -> tm -> Prop :=
| afi_var : forall x,
appears_free_in x (tm_var x)
| afi_app1 : forall x t1 t2,
appears_free_in x t1 -> appears_free_in x (tm_app t1 t2)
| afi_app2 : forall x t1 t2,
appears_free_in x t2 -> appears_free_in x (tm_app t1 t2)
| afi_abs : forall x y T11 t12,
y <> x  ->
appears_free_in x t12 ->
appears_free_in x (tm_abs y T11 t12)

| afi_pair1 : forall x t1 t2,
appears_free_in x t1 ->
appears_free_in x (tm_pair t1 t2)
| afi_pair2 : forall x t1 t2,
appears_free_in x t2 ->
appears_free_in x (tm_pair t1 t2)
| afi_fst : forall x t,
appears_free_in x t ->
appears_free_in x (tm_fst t)
| afi_snd : forall x t,
appears_free_in x t ->
appears_free_in x (tm_snd t)

| afi_if0 : forall x t0 t1 t2,
appears_free_in x t0 ->
appears_free_in x (tm_if t0 t1 t2)
| afi_if1 : forall x t0 t1 t2,
appears_free_in x t1 ->
appears_free_in x (tm_if t0 t1 t2)
| afi_if2 : forall x t0 t1 t2,
appears_free_in x t2 ->
appears_free_in x (tm_if t0 t1 t2)
.

Hint Constructors appears_free_in.

Definition closed (t:tm) :=
forall x, ~ appears_free_in x t.

Lemma context_invariance : forall Gamma Gamma' t S,
has_type Gamma t S  ->
(forall x, appears_free_in x t -> Gamma x = Gamma' x)  ->
has_type Gamma' t S.
Proof with eauto.
intros. generalize dependent Gamma'.
has_type_cases (induction H) Case;
intros Gamma' Heqv...
Case "T_Var".
apply T_Var... rewrite <- Heqv...
Case "T_Abs".
apply T_Abs... apply IHhas_type. intros y Hafi.
unfold extend. remember (beq_id x y) as e.
destruct e...
Case "T_Pair".
apply T_Pair...
Case "T_If".
eapply T_If...
Qed.

Lemma free_in_context : forall x t T Gamma,
appears_free_in x t ->
has_type Gamma t T ->
exists T', Gamma x = Some T'.
Proof with eauto.
intros x t T Gamma Hafi Htyp.
has_type_cases (induction Htyp) Case; inversion Hafi; subst...
Case "T_Abs".
destruct IHHtyp as [T' Hctx]... exists T'.
unfold extend in Hctx.
apply not_eq_beq_id_false in H2. rewrite H2 in Hctx...
Qed.

Corollary typable_empty__closed : forall t T,
has_type empty t T  ->
closed t.
Proof.
intros. unfold closed. intros x H1.
destruct (free_in_context _ _ _ _ H1 H) as [T' C].
inversion C.  Qed.

保存

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S  ->
has_type empty v U   ->
has_type Gamma (subst x v t) S.
Proof with eauto.

intros Gamma x U v t S Htypt Htypv.
generalize dependent Gamma. generalize dependent S.

tm_cases (induction t) Case;
intros S Gamma Htypt; simpl; inversion Htypt; subst...
Case "tm_var".
simpl. rename i into y.

remember (beq_id x y) as e. destruct e.
SCase "x=y".

apply beq_id_eq in Heqe. subst.
unfold extend in H1. rewrite <- beq_id_refl in H1.
inversion H1; subst. clear H1.
eapply context_invariance...
intros x Hcontra.
destruct (free_in_context _ _ S empty Hcontra) as [T' HT']...
inversion HT'.
SCase "x<>y".

apply T_Var... unfold extend in H1. rewrite <- Heqe in H1...
Case "tm_abs".
rename i into y. rename t into T11.

apply T_Abs...
remember (beq_id x y) as e. destruct e.
SCase "x=y".

eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".

apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
Qed.

Theorem preservation : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.
Proof with eauto.
intros t t' T HT.

remember (@empty ty) as Gamma. generalize dependent HeqGamma.
generalize dependent t'.

has_type_cases (induction HT) Case;
intros t' HeqGamma HE; subst; inversion HE; subst...
Case "T_App".

inversion HE; subst...
SCase "ST_AppAbs".

apply substitution_preserves_typing with T1...
inversion HT1...
Case "T_Fst".
inversion HT...
Case "T_Snd".
inversion HT...
Qed.

☐

決定性

Lemma step_deterministic :
partial_function step.
Proof with eauto.
unfold partial_function.
(* FILL IN HERE *)

ここを埋めなさい

Admitted.

正規化

ここからが本当の正規化の証明です。

ゴールはすべての型付けされた項が正規形になることを証明することです。実際のところ、もうちょっと強いことを証明した方が便利です。つまり、すべての型付けされた項が値になるということです。この強い方は、いずれにしろ弱い方から進行補題を使って得ることができますが(なぜでしょう？)、最初から強い方を証明すれば進行性は必要ありません。そして、進行性を再び証明することは上では行いませんでした。

これがキーとなる定義です:

Definition halts  (t:tm) : Prop :=  exists t', t ==>* t' /\  value t'.

あたりまえの事実:

Lemma value_halts : forall v, value v -> halts v.
Proof.
intros v H. unfold halts.
exists v. split.
apply rsc_refl.
assumption.
Qed.

正規化の証明のキーとなる問題は、(多くの帰納法による証明と同様に)十分な強さの帰納法の仮定を見つけることです。このために、それぞれの型Tに対して型Tの閉じた項の集合R_Tを定義することから始めます。これらの集合を関係Rを使って定め、tがR_Tの要素であることをR T tと書きます。(集合R_Tはしばしば飽和集合(saturated sets)あるいは簡約可能性候補(reducibility candidates)と呼ばれます。)

基本言語に対するRの定義は以下の通りです:

- R bool tとは、tが型boolの閉じた項でtが値になることである

- R (T1 -> T2) tとは、tが型T1 -> T2の閉じた項で、tが値になり、かつ、R T1 sとなる任意の項sについて、R T2 (t s)となることである。

この定義は必要な強化された帰納法の仮定を与えます。最初のゴールはすべてのプログラム(つまり、基本型のすべての閉じた項)が停止することを示すことです。しかし、基本型の閉じた項は関数型の部分項を含むこともできるので、これらについても性質を知ることが必要です。さらに、これらの部分項が停止することを知るだけでは不十分です。なぜなら、正規化された関数を正規化された引数へ適用すると置換が行われるため、さらに評価ステップが発生する可能性があるからです。これから関数型の項についてより強い条件が必要です。つまり、自分自身が停止するだけでなく、停止する引数に適用されると停止する結果にならなければならないという条件です。

Rの形は論理的関係(logical relations)証明テクニックの特徴です。(ここで扱うのは単項関係のみなので、おそらく論理的述語(logical predicates)という方がより適切でしょう。)型Aのすべての閉じた項についてある性質Pを証明したい場合、型についての帰納法により、型Aのすべての項が性質Pを「持ち」、型A->Aのすべての項が性質Pを「保存し」、型(A->A)->(A->A)のすべての項が性質Pを「保存することを保存し」、...ということを証明していきます。このために型をインデックスとする述語の族を定義します。基本型Aに対しては、述語は単にPです。関数型に対しては、述語は、その関数が入力の型の述語を満たす値を出力の型の述語を満たす値に写像することを言うものです。

CoqでRの定義を形式化しようとするとき、問題が生じます。一番自明な形式化は、次のようなパラメータ化された Inductive による命題でしょう：

Inductive R : ty -> tm -> Prop :=
| R_bool : forall b t, has_type empty t ty_Bool ->
halts t ->
R ty_Bool t
| R_arrow : forall T1 T2 t, has_type empty t (ty_arrow T1 T2) ->
halts t ->
(forall s, R T1 s -> R T2 (tm_app t s)) ->
R (ty_arrow T1 T2) t.

残念ながらCoqはこの定義を受け付けません。なぜなら帰納的定義の_strict positivity requirement_を満たさないからです。strict positivity requirement_とは、定義される型がコンストラクタ引数の型の矢印の左に現れてはいけないというものです。ここで、この規則を破っているのは、``R_arrow``の第3引数、すなわち、``(forall s, R T1 s -> R TS (tm_app t s))``の、特に``R T1 s``の部分です。(一番外側のコンストラクタ引数を分離している矢印は規則の対象外です。そうでなければ、純粋な帰納的述語はまったく定義できません!)この規則がある理由は、正ではない再帰(non-positive recursion)を使って定義された型は停止しない関数を作るのに使うことができ、それがCoqの論理的健全性を脅かすからです。ここで定義しようとしている関係が完全に問題ないものであるにもかかわらず、strict positivity requirement_のテストを通らないので、Coqはこれを拒否します。

幸い、Fixpointを使うとRが定義できます:

Fixpoint R (T:ty) (t:tm) {struct T} : Prop :=
has_type empty t T /\ halts t /\
(match T with
| ty_Bool  => True
| ty_arrow T1 T2 => (forall s, R T1 s -> R T2 (tm_app t s))
(* FILL IN HERE *)

ここを埋めなさい

| ty_prod T1 T2 => False
end).

この定義からすぐに導かれることとして、すべての集合R_Tについて、そのすべての要素は停止して値となり、また型Tについて閉じていることが言えます:

Lemma R_halts : forall {T} {t}, R T t -> halts t.
Proof.
intros. destruct T; unfold R in H; inversion H; inversion H1;  assumption.
Qed.

Lemma R_typable_empty : forall {T} {t}, R T t -> has_type empty t T.
Proof.
intros. destruct T; unfold R in H; inversion H; inversion H1; assumption.
Qed.

さて、メインの結果に進みます。すべての型Tの項がR_Tの要素であることを示すことです。R_haltsと組み合わせると、すべての型付けされる項は停止して値になることが示されます。

一種の強保存性を示す予備的補題から始めます。R_Tの要素であるか否かは評価によって「不変」(invariant)であるという補題です。この性質は両方向が必要です。つまり、R_Tの項がステップを進めてもR_Tにあることを示すことと、ステップ後R_Tの要素になる任意の項が最初からR_Tであることを示すことです。

一番最初に、簡単な予備的補題です。前向き方法については、言語が決定性を持つという事実に証明が依存していることに注意します。この補題は非決定的な言語でも成立するかもしれませんが、証明はより難しくなるでしょう!

Lemma step_preserves_halting : forall t t', (t ==> t') -> (halts t <-> halts t').
Proof.
intros t t' ST.  unfold halts.
split.
Case "->".
intros [t'' [STM V]].
inversion STM; subst.
apply ex_falso_quodlibet.  apply value__normal in V. unfold normal_form in V. apply V. exists t'. auto.
rewrite (step_deterministic _ _ _ ST H). exists t''. split; assumption.
Case "<-".
intros [t'0 [STM V]].
exists t'0. split; eauto.
Qed.

さてメインの補題ですが、2つの方向に対応する2つの部分から成ります。それぞれは型Tの構造についての帰納法で進みます。事実、ここでは型の有限性を本質的な部分で使っています。

ステップを進んだ結果がR_Tの要素であるためには型Tを持つことが必要です。このことは、前向き方向については、もともとの型保存から得られます。

Lemma step_preserves_R : forall T t t', (t ==> t') -> R T t -> R T t'.
Proof.
induction T;  intros t t' E Rt; unfold R; fold R; unfold R in Rt; fold R in Rt;
destruct Rt as [typable_empty_t [halts_t RRt]].

split. eapply preservation; eauto.
split. apply (step_preserves_halting _ _ E); eauto.
auto.

split. eapply preservation; eauto.
split. apply (step_preserves_halting _ _ E); eauto.
intros.
eapply IHT2.
apply  ST_App1. apply E.
apply RRt; auto.
(* FILL IN HERE *)

ここを埋めなさい

Admitted.

複数ステップへの一般化については自明です:

Lemma stepmany_preserves_R : forall T t t',
(t ==>* t') -> R T t -> R T t'.
Proof.
intros T t t' STM; induction STM; intros.
assumption.
apply IHSTM. eapply step_preserves_R. apply H. assumption.
Qed.

逆向き方向については、tがステップ前に型Tを持つという事実を追加の仮定として加える必要があります。

Lemma step_preserves_R' : forall T t t',
has_type empty t T -> (t ==> t') -> R T t' -> R T t.
Proof.
(* FILL IN HERE *)

ここを埋めなさい

Admitted.

Lemma stepmany_preserves_R' : forall T t t',
has_type empty t T -> (t ==>* t') -> R T t' -> R T t.
Proof.
intros T t t' HT STM.
induction STM; intros.
assumption.
eapply step_preserves_R'.  assumption. apply H. apply IHSTM.
eapply preservation;  eauto. auto.
Qed.

これから、型Tのすべての項がR_Tに含まれることを示すことに取りかかります。ここで使う帰納法は型付け導出についてのものです(もし、型付け導出の帰納法と全く関係がない型付けされた項についての証明があったら、驚くでしょう!)。ここで技術的に難しいのは、関数抽象の場合だけです。帰納法で議論していることから、項tm_abs x T1 t2がR_(T1->T2)に属していることを示すことにはt2がR_(T2)に属するという帰納法の仮定を含みます。しかしR_(T2)は「閉じた」項の集合である一方、t2はxを自由変数として含む可能性があるので、これは筋が通りません。

この問題は帰納法の仮定を適度に一般化するという標準的なトリックを使うことで解決されます。閉じた項を含む主張を証明する代わりに、開いた項tのすべての閉じたインスタンス(instances)をカバーするように一般化します。非形式的には、補題の主張は次のようになります:

もしx1:T1,..xn:Tn |- t : Tかつ、v1,...,vnがR T1 v1,R T2 v2, ...,R Tn vnとなる値ならば、R T ([v1/x1``v2/x2...vn/xnt)] である。

証明は、型付けx1:T1,..xn:Tn |- t : Tの導出についての帰納法で進みます。一番興味深いのは、関数抽象の場合です。

多重置換、多重拡張、インスタンス化

しかしながら、主張と補題の証明の形式化に進む前に、項tの多重置換(multiple_substitutions)と型付けコンテキストの多重拡張(multiple_ extensions)についての事実を扱う、ある(かなり退屈な)機構を構築する必要があります。特に、置換が現れる順序とそれらの相互関係を正確にする必要があります。これらの詳細は非形式的な紙の証明では単に省略されるのが通常です。しかしもちろん、Coqはそうはしません。ここでは閉じた項を置換していることから、1つの置換が他の置換によってできた項に影響するかどうかを心配する必要はありません。しかしそれでも置換の順序については考慮する必要があります。なぜなら、x1,...xnに同じ識別子が複数回出現しそれらが違うviやTiと関連付けされている可能性があるからです。

すべてを正確にするために、環境は左から右へ拡張されることとし、多重置換は右から左へ実行されることとします。これが整合的であることを見るために、...,y:bool,...,y:nat,...と書かれる環境と、対応する...[(tm_bool true)/y...(tm_nat 3)/y...t]と書かれる項の置換があるとします。環境は左から右に拡張されることから、y:natはy:boolを隠します。置換は右から左に実行されることから、(tm_nat 3)/yが最初に実行され、(tm_bool true)/yは何の作用もしません。これから置換は項の型を正しく保存します。

このポイントを覚えておくと、次の定義が理解できます。

多重置換(multisubstitution)は置換のリストの適用結果です。置換のリストは環境と呼ばれます(environment)。

Definition env := list (id * tm).

Fixpoint msubst (ss:env) (t:tm) {struct ss} : tm :=
match ss with
| nil => t
| ((x,s)::ss') => msubst ss' (subst x s t)
end.

(識別子、型)の対のリストを使った型付けコンテキストの継続的拡張についても同様の機構が必要です。この型付けコンテキストを「型割当て」(type assignment)と呼びます。

Definition tass := list (id * ty).

Fixpoint mextend (Gamma : context) (xts : tass) :=
match xts with
| nil => Gamma
| ((x,v)::xts') => extend (mextend Gamma xts') x v
end.

環境と型割当てに同様にはたらくいくつかの簡単な操作が必要です。

Fixpoint lookup {X:Set} (k : id) (l : list (id * X)) {struct l} : option X :=
match l with
| nil => None
| (j,x) :: l' =>
if beq_id j k then Some x else lookup k l'
end.

Fixpoint drop {X:Set} (n:id) (nxs:list (id * X)) {struct nxs} : list (id * X) :=
match nxs with
| nil => nil
| ((n',x)::nxs') => if beq_id n' n then drop n nxs' else (n',x)::(drop n nxs')
end.

インスタンス化(instantiation)は型割当てと値環境を同じ定義域で結合します。この定義域の要素はRに含まれます。

Inductive instantiation :  tass -> env -> Prop :=
| V_nil : instantiation nil nil
| V_cons : forall x T v c e, value v -> R T v -> instantiation c e -> instantiation ((x,T)::c) ((x,v)::e).

これから、これらの定義についてのいろいろな性質を証明します。

置換についてのさらなる事実

最初に(もともとの)置換について、ある追加の補題が必要です。

Lemma vacuous_substitution : forall  t x,
~ appears_free_in x t  ->
forall t', subst x t' t = t.
Proof with eauto.
(* FILL IN HERE *)

ここを埋めなさい

Admitted.

Lemma subst_closed: forall t,
closed t  ->
forall x t', subst x t' t = t.
Proof.
intros. apply vacuous_substitution. apply H.  Qed.

Lemma subst_not_afi : forall t x v, closed v ->  ~ appears_free_in x (subst x v t).
Proof with eauto.
unfold closed, not.
tm_cases (induction t) Case; intros x v P A; simpl in A.
Case "tm_var".
remember (beq_id x i) as e; destruct e...
inversion A; subst. rewrite <- beq_id_refl in Heqe; inversion Heqe.
Case "tm_app".
inversion A; subst...
Case "tm_abs".
remember (beq_id x i) as e; destruct e...
apply beq_id_eq in Heqe; subst. inversion A; subst...
inversion A; subst...
Case "tm_pair".
inversion A; subst...
Case "tm_fst".
inversion A; subst...
Case "tm_snd".
inversion A; subst...
Case "tm_true".
inversion A.
Case "tm_false".
inversion A.
Case "tm_if".
inversion A; subst...
Qed.

Lemma duplicate_subst : forall t' x t v,
closed v -> subst x t (subst x v t') = subst x v t'.
Proof.
intros. eapply vacuous_substitution. apply subst_not_afi.  auto.
Qed.

Lemma swap_subst : forall t x x1 v v1, x <> x1 -> closed v -> closed v1 ->
subst x1 v1 (subst x v t) = subst x v (subst x1 v1 t).
Proof with eauto.
tm_cases (induction t) Case; intros; simpl.
Case "tm_var".
remember (beq_id x i) as e; destruct e; remember (beq_id x1 i) as e; destruct e.
apply  beq_id_eq in Heqe. apply beq_id_eq in Heqe0. subst.
apply ex_falso_quodlibet...
apply beq_id_eq in Heqe; subst.  simpl.
rewrite <- beq_id_refl.  apply subst_closed...
apply beq_id_eq in Heqe0; subst.  simpl.
rewrite <- beq_id_refl. rewrite subst_closed...
simpl. rewrite <- Heqe. rewrite <- Heqe0...
(* FILL IN HERE *)

ここを埋めなさい

Admitted.

多重置換の性質

Lemma msubst_closed: forall t, closed t -> forall ss, msubst ss t = t.
Proof.
induction ss.
reflexivity.
destruct a. simpl. rewrite subst_closed; assumption.
Qed.

閉じた環境とは、閉じた項のみを含む環境です。

Fixpoint closed_env (env:env) {struct env} :=
match env with
| nil => True
| (x,t)::env' => closed t /\ closed_env env'
end.

次は、閉じた項についてのmsubstがどのようにsubstや各項の形に分配されるかを特徴づける一連の補題です。

Lemma subst_msubst: forall env x v t, closed v -> closed_env env ->
msubst env (subst x v t) = subst x v (msubst (drop x env) t).
Proof.
induction env0; intros.
auto.
destruct a. simpl.
inversion H0. fold closed_env in H2.
remember (beq_id i x) as e; destruct e.
apply  beq_id_eq in Heqe; subst.
rewrite duplicate_subst; auto.
symmetry in Heqe. apply beq_id_false_not_eq in Heqe.
simpl. rewrite swap_subst; eauto.
Qed.

Lemma msubst_var:  forall ss x, closed_env ss ->
msubst ss (tm_var x) =
match lookup x ss with
| Some t => t
| None => tm_var x
end.
Proof.
induction ss; intros.
reflexivity.
destruct a.
simpl. destruct (beq_id i x).
apply msubst_closed. inversion H; auto.
apply IHss. inversion H; auto.
Qed.

Lemma msubst_abs: forall ss x T t,
msubst ss (tm_abs x T t) = tm_abs x T (msubst (drop x ss) t).
Proof.
induction ss; intros.
reflexivity.
destruct a.
simpl. destruct (beq_id i x); simpl; auto.
Qed.

Lemma msubst_app : forall ss t1 t2, msubst ss (tm_app t1 t2) = tm_app (msubst ss t1) (msubst ss t2).
Proof.
induction ss; intros.
reflexivity.
destruct a.
simpl. rewrite <- IHss. auto.
Qed.

他の項コンストラクタに対しても同様の関数が必要になるでしょう。

(* FILL IN HERE *)

ここを埋めなさい

多重拡張の性質

型割当てのふるまいを、対応するコンテキストのふるまいと結合する必要があります。

Lemma mextend_lookup : forall (c : tass) (x:id), lookup x c = (mextend empty c) x.
Proof.
induction c; intros.
auto.
destruct a. unfold lookup, mextend, extend. destruct (beq_id i x); auto.
Qed.

Lemma mextend_drop : forall (c: tass) Gamma x x',
mextend Gamma (drop x c) x' = if beq_id x x' then Gamma x' else mextend Gamma c x'.
induction c; intros.
destruct (beq_id x x'); auto.
destruct a. simpl.
remember (beq_id i x) as e; destruct e.
apply beq_id_eq in Heqe; subst. rewrite IHc.
remember (beq_id x x') as e; destruct e.  auto. unfold extend. rewrite <- Heqe. auto.
simpl.  unfold extend.  remember (beq_id i x') as e; destruct e.
apply beq_id_eq in Heqe0; subst.
remember (beq_id x x') as e; destruct e.
apply beq_id_eq in Heqe0; subst.  rewrite <- beq_id_refl in Heqe.  inversion Heqe.
auto.
auto.
Qed.

インスタンス化の性質

以下は簡単です。

Lemma instantiation_domains_match: forall {c} {e},
instantiation c e -> forall {x} {T}, lookup x c = Some T -> exists t, lookup x e = Some t.
Proof.
intros c e V. induction V; intros x0 T0 C.
solve by inversion .
simpl in *.
destruct (beq_id x x0); eauto.
Qed.

Lemma instantiation_env_closed : forall c e,  instantiation c e -> closed_env e.
Proof.
intros c e V; induction V; intros.
econstructor.
unfold closed_env. fold closed_env.
split.  eapply typable_empty__closed. eapply R_typable_empty. eauto.
auto.
Qed.

Lemma instantiation_R : forall c e, instantiation c e ->
forall x t T, lookup x c = Some T ->
lookup x e = Some t -> R T t.
Proof.
intros c e V. induction V; intros x' t' T' G E.
solve by inversion.
unfold lookup in *.  destruct (beq_id x x').
inversion G; inversion E; subst.  auto.
eauto.
Qed.

Lemma instantiation_drop : forall c env,
instantiation c env -> forall x, instantiation (drop x c) (drop x env).
Proof.
intros c e V. induction V.
intros.  simpl.  constructor.
intros. unfold drop. destruct (beq_id x x0); auto. constructor; eauto.
Qed.

stepmany(==>*)についての合同補題

これらのいくつかだけが必要になります。必要が生じた時点で追加しなさい。

Lemma stepmany_App2 : forall v t t',
value v -> (t ==>* t') -> (tm_app v t) ==>* (tm_app v t').
Proof.
intros v t t' V STM. induction STM.
apply rsc_refl.
eapply rsc_step.
apply ST_App2; eauto.  auto.
Qed.

(* FILL IN HERE *)

ここを埋めなさい

R補題

最後にすべてをまとめます。

置換についての型付けの保存についてのキーとなる補題は、多重置換に対応する形にすることができます:

Lemma msubst_preserves_typing : forall c e,
instantiation c e ->
forall Gamma t S, has_type (mextend Gamma c) t S ->
has_type Gamma (msubst e t) S.
Proof.
induction 1; intros.
simpl in H. simpl. auto.
simpl in H2.  simpl.
apply IHinstantiation.
eapply substitution_preserves_typing; eauto.
apply (R_typable_empty H0).
Qed.

そして一番最後に、メインの補題です。

Lemma msubst_R : forall c env t T,
has_type (mextend empty c) t T -> instantiation c env -> R T (msubst env t).
Proof.
intros c env0 t T HT V.
generalize dependent env0.

remember (mextend empty c) as Gamma.
assert (forall x, Gamma x = lookup x c).
intros. rewrite HeqGamma. rewrite mextend_lookup. auto.
clear HeqGamma.
generalize dependent c.
has_type_cases (induction HT) Case; intros.

Case "T_Var".
rewrite H0 in H. destruct (instantiation_domains_match V H) as [t P].
eapply instantiation_R; eauto.
rewrite msubst_var.  rewrite P. auto. eapply instantiation_env_closed; eauto.

Case "T_Abs".
rewrite msubst_abs.

assert (WT: has_type empty (tm_abs x T11 (msubst (drop x env0) t12)) (ty_arrow T11 T12)).
eapply T_Abs. eapply msubst_preserves_typing.  eapply instantiation_drop; eauto.
eapply context_invariance.  apply HT.
intros.
unfold extend. rewrite mextend_drop. remember (beq_id x x0) as e; destruct e.  auto.
rewrite H.
clear - c Heqe. induction c.
simpl.  rewrite <- Heqe.  auto.
simpl. destruct a.  unfold extend. destruct (beq_id i x0); auto.
unfold R. fold R. split.
auto.
split. apply value_halts. apply v_abs.
intros.
destruct (R_halts H0) as [v [P Q]].
pose proof (stepmany_preserves_R _ _ _ P H0).
apply stepmany_preserves_R' with (msubst ((x,v)::env0) t12).
eapply T_App. eauto.
apply R_typable_empty; auto.
eapply rsc_trans.  eapply stepmany_App2; eauto.
eapply rsc_R.
simpl.  rewrite subst_msubst.
eapply ST_AppAbs; eauto.
eapply typable_empty__closed.
apply (R_typable_empty H1).
eapply instantiation_env_closed; eauto.
eapply (IHHT ((x,T11)::c)).
intros. unfold extend, lookup. destruct (beq_id x x0); auto.
constructor; auto.

Case "T_App".
rewrite msubst_app.
destruct (IHHT1 c H env0 V) as [_ [_ P1]].
pose proof (IHHT2 c H env0 V) as P2.  fold R in P1.  auto.

(* FILL IN HERE *)

ここを埋めなさい

Admitted.

正規化定理

Theorem normalization : forall t T, has_type empty t T -> halts t.
Proof.
intros.
replace t with (msubst nil t).
eapply R_halts.
eapply msubst_R; eauto. instantiate (2:= nil). eauto.
eapply V_nil.
auto.
Qed.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

UseTactics_J:Coq用タクティックライブラリのご紹介

Coqはビルトインのタクティックの集合を持っています。reflexivity、intros、inversionなどです。これらのタクティックだけで証明を構成することは可能ですが、より強力なタクティックの集合を使うことで、生産性を飛躍的に上げることができます。この章では、とても便利なのに、いろいろな理由でデフォルトのCoqでは用意されていないたくさんのタクティックを説明します。それらのタクティックは、LibTactics_J.vファイルに定義されています。

Require Import LibTactics_J.

注記: SSReflect は強力なタクティックを提供する別のパッケージです。ライブラリ”LibTactics”は”SSReflect”と次の2点で異なります:

- “SSReflect”は主として数学の定理を証明するために開発されました。 一方、”LibTactics”は主としてプログラミング言語の定理の証明のために開発されました。特に”LibTactics”は、”SSReflect”パッケージには対応するものがない、いくつもの有用なタクティックを提供します。

- “SSReflect”はタクティックの提示方法を根底から考え直しています。 一方、”LibTactics”はCoqタクティックの伝統的提示方法をほとんど崩していません。このことからおそらく”LibTactics”の方が”SSReflect”よりとっつきやすいと思われます。

この章は”LibTactics”ライブラリの最も便利な機能に焦点を当てたチュートリアルです。”LibTactics”のすべての機能を示すことを狙ってはいません。タクティックの完全なドキュメンテーションはソースファイルLibTactics_J.vにあります。さらに、タクティックのはたらきを見せるデモは、ファイルLibTacticsDemos_J.vにあります。(訳注:原文ファイル群にも LibTacticsDemos.v は含まれていません。このファイル名でネット検索してみてください。)

タクティックの説明にはほとんど、「ソフトウェアの基礎」(“Software Foundations”)のコースの主要な章から抽出した例を使います。タクティックのいろいろな使い方を説明するために、ゴールを複製するタクティックを使います。より詳しく言うと、dupは現在のゴールを2つにコピーします。またdup nはゴールのn個のコピーを作ります。

導入と場合分けについてのタクティック

この節では、以下のタクティックを説明します:

- introv:仮定に名前をつける時間を省くのに使います

- inverts:inversionタクティックの改良です

- cases:情報を失わずに場合分けします

- cases_if:ifの引数について自動的に場合分けします

タクティックintrov

Module IntrovExamples.
Require Import Stlc_J.
Import Imp_J STLC.

タクティックintrovは、定理の変数を自動的に導入し、生成される仮定に明示的に名前を付けます。次の例では、決定性の主張に関する変数c、st、st1、st2には明示的に命名する必要はありません。これらは補題の主張の中で既に名前が付けられているからです。これに対して、2つの仮定E1とE2には名前をつけると便利です。

Theorem ceval_deterministic: forall c st st1 st2,
c / st || st1 ->
c / st || st2 ->
st1 = st2.
Proof.
introv E1 E2.
Admitted.

仮定に名前をつける必要がない場合には、引数なしでintrovを呼ぶことができます。

Theorem ceval_and_ceval_step_coincide: forall c st st',
c / st || st'
<-> exists i, ceval_step st c i = Some st'.
Proof.
introv.
Admitted.

タクティックintrovはforallと->が交互に現れる主張にも適用できます。

Theorem ceval_deterministic': forall c st st1,
(c / st || st1) -> forall st2, (c / st || st2) -> st1 = st2.
Proof.
introv E1 E2.
Admitted.

introsと同様、introvも、構造化パターンを引数にとることができます。

Theorem ceval_step__ceval: forall c st st',
(exists i, ceval_step st c i = Some st') ->
c / st || st'.
Proof.
introv [i E].

Admitted.

注記: タクティックintrovは、定義をunfoldしないと仮定が出てこない場合にも使うことができます。

End IntrovExamples.

タクティックinverts

Module InvertsExamples.
Require Import Stlc_J Equiv_J Imp_J.
Import STLC.

Coqのinversionタクティックは3つの点で十分なものだと言えません。1つ目は、inversionは、substで置換して消してしまいたいような、たくさんの等式を生成することです。2つ目は、仮定に意味のない名前を付けることです。3つ目は、inversion Hは、ほとんどの場合Hを後で使うことはないにもかかわらず、コンテキストからHを消去しないことです。タクティックinvertsはこの3つの問題すべてを扱います。このタクティックは、タクティックinversionにとって代わることを意図したものです。

次の例は、タクティックinverts Hが、置換を適切に行う以外はinversion Hと同様にはたらくことを示しています。

Theorem skip_left: forall c,
cequiv (SKIP; c) c.
Proof.
introv. split; intros H.
dup.

inversion H. subst. inversion H2. subst. assumption.

inverts H. inverts H2. assumption.
Admitted.

次にもう少し興味深い例を見てみましょう。

Theorem ceval_deterministic: forall c st st1 st2,
c / st || st1  ->
c / st || st2 ->
st1 = st2.
Proof.
introv E1 E2. generalize dependent st2.
(ceval_cases (induction E1) Case); intros st2 E2.
admit. admit.
dup.
inversion E2. subst. admit.
inverts E2. admit.
Admitted.

タクティックinverts H as.はinverts Hと同様ですが、次の点が違います。inverts H as.では、生成される変数と仮定がコンテキストではなくゴールに置かれます。この戦略により、これらの変数と仮定にintrosやintrovを使って明示的に名前を付けることができるようになります。

Theorem ceval_deterministic': forall c st st1 st2,
c / st || st1  ->
c / st || st2 ->
st1 = st2.
Proof.
introv E1 E2. generalize dependent st2.
(ceval_cases (induction E1) Case); intros st2 E2;
inverts E2 as.
Case "E_Skip". reflexivity.
Case "E_Ass".

subst n.
reflexivity.
Case "E_Seq".

intros st3 Red1 Red2.
assert (st' = st3) as EQ1.
SCase "Proof of assertion". apply IHE1_1; assumption.
subst st3.
apply IHE1_2. assumption.
Case "E_IfTrue".
SCase "b1 evaluates to true".

intros.
apply IHE1. assumption.
SCase "b1 evaluates to false (contradiction)".
intros.
rewrite H in H5. inversion H5.

Admitted.

inversionを使ったとするとゴールが1つだけできる場合に、invertsをinverts H as H1 H2 H3の形で呼ぶことができます。このとき新しい仮定はH1、H2、H3と名付けられます。言い換えると、タクティックinverts H as H1 H2 H3は、invert H; introv H1 H2 H3と同じです。例を示します。

Theorem skip_left': forall c,
cequiv (SKIP; c) c.
Proof.
introv. split; intros H.
inverts H as U V.
inverts U. assumption.
Admitted.

より複雑な例です。特に、invertされた仮定の名前を再利用できることを示しています。

Example typing_nonexample_1 :
~ exists T,
has_type empty
(tm_abs a ty_Bool
(tm_abs b ty_Bool
(tm_app (tm_var a) (tm_var b))))
T.
Proof.
dup 3.

intros C. destruct C.
inversion H. subst. clear H.
inversion H5. subst. clear H5.
inversion H4. subst. clear H4.
inversion H2. subst. clear H2.
inversion H5. subst. clear H5.
inversion H1.

intros C. destruct C.
inverts H as H1.
inverts H1 as H2.
inverts H2 as H3.
inverts H3 as H4.
inverts H4.

intros C. destruct C.
inverts H as H.
inverts H as H.
inverts H as H.
inverts H as H.
inverts H.
Qed.

End InvertsExamples.

注意: 稀に、仮定HをinvertするときにHをコンテキストから除去したくない場合があります。その場合には、タクティックinverts keep Hを使うことができます。キーワードkeepは仮定をコンテキストに残せということを示しています。

タクティックcasesとcases_if

Module CasesExample.
Require Import Stlc_J.
Import STLC.

タクティックcases Eは、remember E as x; destruct xの略記法です。しかしそれだけでなく、rememberが生成する等式の右辺と左辺を逆にしたものを生成します。例えば、casesは、等式true = beq_id k1 k2ではなく等式beq_id k1 k2 = trueを作ります。なぜなら、true = beq_id k1 k2は読むのにかなり不自然な形だからです。タクティックcases E as Hの形にすると、生成された等式に名前を付けることができます。

注記:casesはcase_eqにかなり近いです。rememberおよびcase_eqとの互換性のために、ライブラリ”LibTactics”にはcases'というタクティックが用意されています。cases'はrememberおよびcase_eqとまったく同じ等式を生成します。つまり、beq_id k1 k2 = trueではなくtrue = beq_id k1 k2という形の等式です。次の例は、タクティックcases' E as Hの振る舞いを表しています。

Theorem update_same : forall x1 k1 k2 (f : state),
f k1 = x1 ->
(update f k1 x1) k2 = f k2.
Proof.
intros x1 k1 k2 f Heq.
unfold update. subst.
dup.

remember (beq_id k1 k2) as b. destruct b.
apply beq_id_eq in Heqb. subst. reflexivity.
reflexivity.

cases' (beq_id k1 k2) as E.
apply beq_id_eq in E. subst. reflexivity.
reflexivity.
Qed.

タクティックcases_ifはゴールまたはコンテキストのifの引数として現れる式Eに対してcases Eを呼びます。このため、タクティックcases_ifを使うと、ゴールに既に現れている式をコピーする必要がなくなります。先と同様、互換性のため、ライブラリにはcases_if'というタクティックが用意されています。またcases_if' as Hという形で、生成される等式に名前をつけることができます。

Theorem update_same' : forall x1 k1 k2 (f : state),
f k1 = x1 ->
(update f k1 x1) k2 = f k2.
Proof.
intros x1 k1 k2 f Heq.
unfold update. subst.

cases_if' as E.
apply beq_id_eq in E. subst. reflexivity.
reflexivity.
Qed.

End CasesExample.

n-引数論理演算のためのタクティック

Coqは and と or を2引数コンストラクタ/\および\/でコード化するため、N個の事実についての and や or の扱いがとても面倒なものになります。このため、”LibTactics”では n個の and と or を直接サポートするタクティックを提供します。さらに、n個の存在限量に対する直接的サポートも提供します。

この節では以下のタクティックを説明します:

- splits:n個の and を分解します

- branch:n個の or を分解します

- exists:n個の存在限量の証明をします。

Module NaryExamples. Require Import References_J SfLib_J. Import STLCRef.

タクティックsplits

タクティックsplitsは、n個の命題の and に適用され、n個のサブゴールを作ります。例えば、ゴールG1 /\ G2 /\ G3を3つのサブゴールG1、G2、G3に分解します。

Lemma demo_splits : forall n m,
n > 0 /\ n < m /\ m < n+10 /\ m <> 3.
Proof.
intros. splits.
Admitted.

タクティックbranch

タクティックbranch kは n個の or の証明に使うことができます。例えば、ゴールがG1 \/ G2 \/ G3という形のとき、タクティックbranch 2はG2だけをサブゴールとします。次の例はbranchタクティックの振る舞いを表しています。

Lemma demo_branch : forall n m,
n < m \/ n = m \/ m < n.
Proof.
intros.
destruct (lt_eq_lt_dec n m) as [[H1|H2]|H3].
branch 1. apply H1.
branch 2. apply H2.
branch 3. apply H3.
Qed.

タクティックexists

ライブラリ “LibTactics” は n個の存在限量についての記法を用意しています。例えば、exists x, exists y, exists z, Hと書く代わりにexists x y z, Hと書くことができます。同様に、ライブラリはn引数のタクティックexists a b cを提供します。これは、exists a; exists b; exists cの略記法です。次の例はn個の存在限量についての記法とタクティックを表しています。

Theorem progress : forall ST t T st,
has_type empty ST t T ->
store_well_typed ST st ->
value t \/ exists t' st', t / st ==> t' / st'.

Proof with eauto.
intros ST t T st Ht HST. remember (@empty ty) as Gamma.
(has_type_cases (induction Ht) Case); subst; try solve by inversion...
Case "T_App".
right. destruct IHHt1 as [Ht1p | Ht1p]...
SCase "t1 is a value".
inversion Ht1p; subst; try solve by inversion.
destruct IHHt2 as [Ht2p | Ht2p]...
SSCase "t2 steps".
inversion Ht2p as [t2' [st' Hstep]].
exists (tm_app (tm_abs x T t) t2') st'...

Admitted.

注記: n個の存在限量についての同様の機能が標準ライブラリのモジュールCoq.Program.Syntaxで提供されています。ただ、このモジュールのものは限量対象が4つまでしか対応していませんが、LibTacticsは10個までサポートしています。

End NaryExamples.

等式を扱うタクティック

他の対話的証明支援器と比べたCoqの大きな弱点の一つは、等式に関する推論のサポートが比較的貧弱なことです。次に説明するタクティックは、等式を扱う証明記述を簡単にすることを狙ったものです。

この節で説明するタクティックは次のものです:

- asserts_rewrite: 書き換えのための等式を導入します

- cuts_rewrite: サブゴールが交換される以外は同じです

- substs:substタクティックを改良します

- fequals:f_equalタクティックを改良します

- applys_eq: 仮定P x zを使って、等式y = zを自動生成し、P x yを証明します

Module EqualityExamples.

タクティックasserts_rewriteとcuts_rewrite

タクティックasserts_rewrite (E1 = E2)はゴール内のE1をE2で置換し、ゴールE1 = E2を生成します。

Theorem mult_0_plus : forall n m : nat,
(0 + n) * m = n * m.
Proof.
dup.

intros n m.
assert (H: 0 + n = n). reflexivity. rewrite -> H.
reflexivity.

intros n m.
asserts_rewrite (0 + n = n).
reflexivity.
reflexivity.
Qed.

注記:asserts_rewrite (E1 = E2) in Hと書いた場合、

ゴールの代わりに仮定Hを書き換えます。

タクティックcuts_rewrite (E1 = E2)はasserts_rewrite (E1 = E2)と同様ですが、等式E1 = E2が最初のサブゴールになります。

Theorem mult_0_plus' : forall n m : nat,
(0 + n) * m = n * m.
Proof.
intros n m.
cuts_rewrite (0 + n = n).
reflexivity.
reflexivity.
Qed.

より一般には、タクティックasserts_rewriteとcuts_rewriteは補題を引数としてとることができます。例えばasserts_rewrite (forall a b, a*(S b) = a*b+a)と書くことができます。この記法はaやbが大きな項であるとき便利です。その大きな項を繰り返さずに済むからです。

Theorem mult_0_plus'' : forall u v w x y z: nat,
(u + v) * (S (w * x + y)) = z.
Proof.
intros. asserts_rewrite (forall a b, a*(S b) = a*b+a).

Admitted.

タクティックsubsts

タクティックsubstsはsubstと同様ですが、substと違い、ゴールがx = f xのような「循環する等式」を含むときも失敗しません。

Lemma demo_substs : forall x y (f:nat->nat),
x = f x -> y = x -> y = f x.
Proof.
intros. substs.
assumption.
Qed.

タクティックfequals

タクティックfequalsはf_equalと同様ですが、生成される自明なサブゴールを直接解決してしまう点が違います。さらに、タクティックfequalsはタプル間の等式の扱いが強化されています。

Lemma demo_fequals : forall (a b c d e : nat) (f : nat->nat->nat->nat->nat),
a = 1 -> b = e -> e = 2 ->
f a b c d = f 1 2 c 4.
Proof.
intros. fequals.

Admitted.

タクティックapplys_eq

タクティックapplys_eqはeapplyの変種で、単一化できない部分項間の等式を導入します。例えば、ゴールが命題P x yで、P x zが成立するという仮定Hがあるとします。またyとzが等しいことが証明できることはわかっているとします。すると、タクティックassert_rewrite (y = z)を呼び、ゴールをP x zに変えることができます。しかしこれには、yとzの値のコピー&ペーストが必要になります。タクティックapplys_eqを使うと、この場合applys_eq H 1とできます。すると、ゴールは証明され、サブゴールy = zが残ります。applys_eqの引数の値1は、P x yの右から1番目の引数についての等式を導入したいことを表します。以下の3つの例は、それぞれapplys_eq H 1、applys_eq H 2、applys_eq H 1 2を呼んだときの振る舞いを示します。

Axiom big_expression_using : nat->nat.

Lemma demo_applys_eq_1 : forall (P:nat->nat->Prop) x y z,
P x (big_expression_using z) ->
P x (big_expression_using y).
Proof.
introv H. dup.

assert (Eq: big_expression_using y = big_expression_using z).
admit.
rewrite Eq. apply H.

applys_eq H 1.
admit.
Qed.

もしミスマッチがPの第2引数ではなく第1引数だった場合には、applys_eq H 2と書きます。出現は右からカウントされることを思い出してください。

Lemma demo_applys_eq_2 : forall (P:nat->nat->Prop) x y z,
P (big_expression_using z) x ->
P (big_expression_using y) x.
Proof.
introv H. applys_eq H 2.
Admitted.

2つの引数にミスマッチがある場合、2つの等式が欲しくなります。そのためには、applys_eq H 1 2とできます。より一般に、タクティックapplys_eqは1つの補題と自然数の列を引数としてとります。

Lemma demo_applys_eq_3 : forall (P:nat->nat->Prop) x1 x2 y1 y2,
P (big_expression_using x2) (big_expression_using y2) ->
P (big_expression_using x1) (big_expression_using y1).
Proof.
introv H. applys_eq H 1 2.

Admitted.

End EqualityExamples.

便利な略記法をいくつか

チュートリアルのこの節では、証明記述をより短かく、より読みやすくするのに役立つタクティックをいくつか紹介します:

- unfolds(引数なし): 先頭の定義を unfold します

- false: ゴールをFalseで置換します

- gen:dependent generalizeの略記法です

- skip: サブゴールをスキップします(存在変数と組み合わせて使います)

- sort: 証明コンテキストの下の命題を動かします

タクティックunfolds

Module UnfoldsExample.
Require Import Hoare_J.

タクティックunfolds(引数なし) はゴールの先頭の定数を unfold します。このタクティックは定数を明示的に指名する手間を省きます。

Lemma bexp_eval_true : forall b st,
beval st b = true -> (bassn b) st.
Proof.
intros b st Hbe. dup.

unfold bassn. assumption.

unfolds. assumption.
Qed.

注記: タクティックhnfはすべての先頭の定数をunfoldしますが、これと対照的にunfoldsは1つだけunfoldします。

注記: タクティックunfolds in Hは仮定Hの先頭の定義をunfoldします。

End UnfoldsExample.

タクティックfalseとtryfalse

タクティックfalseは任意のゴールをFalseに置換します。簡単に言うと、apply ex_falso_quodlibetの略記法です。さらにfalseは、不条理な仮定(Falseや0 = S nなど)や矛盾した仮定(x = trueとx = falseなど)を含むゴールを証明します。

Lemma demo_false :
forall n, S n = 1 -> n = 0.
Proof.
intros. destruct n. reflexivity. false.
Qed.

タクティックtryfalseはtry solve [false] の略記法です。このタクティックはゴールの矛盾を探します。タクティックtryfalseは一般に場合分けの後で呼ばれます。

Lemma demo_tryfalse :
forall n, S n = 1 -> n = 0.
Proof.
intros. destruct n; tryfalse. reflexivity.
Qed.

タクティックgen

タクティックgenはgeneralize dependentの略記法です。たくさんの引数を一度に受けます。このタクティックはgen x y zという形で呼びます。

Module GenExample.
Require Import Stlc_J.
Import STLC.

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S ->
has_type empty v U ->
has_type Gamma (subst v x t) S.
Proof.
dup.

intros Gamma x U v t S Htypt Htypv.
generalize dependent S. generalize dependent Gamma.
induction t; intros; simpl.
admit. admit. admit. admit. admit. admit.

introv Htypt Htypv. gen S Gamma.
induction t; intros; simpl.
admit. admit. admit. admit. admit. admit.
Qed.

End GenExample.

タクティックskip、skip_rewrite、skip_goal

サブゴールをadmitできることは証明を構成するうえでとても便利です。証明の一番興味深いケースに最初にフォーカスできるようになるからです。タクティックskipはadmitと似ていますが、証明が存在変数を含む場合にも機能します。存在変数とは、?24のように名前がクエスチョンマークから始まる変数で、典型的にはeapplyによって導入されるものであったことを思い出してください。

Module SkipExample.
Require Import Stlc_J.
Import STLC.

Example astep_example1 :
(APlus (ANum 3) (AMult (ANum 3) (ANum 4))) / empty_state ==>a* (ANum 15).
Proof.
eapply rsc_step. skip.
eapply rsc_step. skip. skip.

Admitted.

タクティックskip H: Pは仮定H: Pをコンテキストに追加します。このときに命題Pが真かどうかのチェックはしません。このタクティックは、事実を、証明を後回しにして利用するのに便利です。注意:skip H: Pは単にassert (H:P). skip.の略記法です。

Theorem demo_skipH : True.
Proof.
skip H: (forall n m : nat, (0 + n) * m = n * m).
Admitted.

タクティックskip_rewrite (E1 = E2)はゴールのE1をE2で置換します。このときにE1が実際にE2と等しいかはチェックしません。

Theorem mult_0_plus : forall n m : nat,
(0 + n) * m = n * m.
Proof.
dup.

intros n m.
assert (H: 0 + n = n). skip. rewrite -> H.
reflexivity.

intros n m.
skip_rewrite (0 + n = n).
reflexivity.
Qed.

注記: タクティックskip_rewriteは実際はasserts_rewriteと同じように補題を引数としてとることができます。

タクティックskip_goalは現在のゴールを仮定として追加します。このごまかしは帰納法による証明の構造の構成の際に、帰納法の仮定がより小さい引数だけに適用されるかを心配しないで済むため有用です。skip_goalを使うことで、証明を次の2ステップで構成できます：最初に、帰納法の仮定の細部の調整に時間を浪費せずに、主要な議論が通るかをチェックし、その後、帰納法の仮定の呼び出しの調整にフォーカスするというステップです。

Theorem ceval_deterministic: forall c st st1 st2,
c / st || st1 ->
c / st || st2 ->
st1 = st2.
Proof.

skip_goal.

introv E1 E2. gen st2.
(ceval_cases (induction E1) Case); introv E2; inverts E2 as.
Case "E_Skip". reflexivity.
Case "E_Ass".
subst n.
reflexivity.
Case "E_Seq".
intros st3 Red1 Red2.
assert (st' = st3) as EQ1.
SCase "Proof of assertion".

eapply IH. eapply E1_1. eapply Red1.
subst st3.

eapply IH. eapply E1_2. eapply Red2.

Admitted.

End SkipExample.

タクティックsort

Module SortExamples.
Require Import Imp_J.

タクティックsortは証明コンテキストを再構成し、変数が上に仮定が下になるようにします。これにより、証明コンテキストはより読みやすくなります。

Theorem ceval_deterministic: forall c st st1 st2,
c / st || st1 ->
c / st || st2 ->
st1 = st2.
Proof.
intros c st st1 st2 E1 E2.
generalize dependent st2.
(ceval_cases (induction E1) Case); intros st2 E2; inverts E2.
admit. admit.
sort.
Admitted.

End SortExamples.

高度な補題具体化のためのタクティック

この最後の節では、補題に引数のいくつかを与え、他の引数は明示化しないままで、補題を具体化するメカニズムについて記述します。具体値を与えられない変数は存在変数となり、具体化が与えられない事実はサブゴールになります。

注記: この具体化メカニズムは「暗黙の引数」メカニズムをはるかに超越する能力を提供します。この節で記述する具体化メカニズムのポイントは、どれだけの ‘_’記号を書かなければならないかの計算に時間を使わなくてよくなることです。

この節では、Coq の便利な連言(and)と存在限量の分解機構を使います。簡単に言うと、introsやdestructは[H1 [H2 [H3 [H4 H5]]]]の略記法としてパターン(H1 & H2 & H3 & H4 & H5)をとることができます。例えばdestruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub].]はdestruct (typing_inversion_var _ _ _ Htypt) as (T & Hctx & Hsub).と書くことができます。

letsのはたらき

利用したい補題(または仮定)がある場合、大抵、この補題に明示的に引数を与える必要があります。例えば次のような形です:destruct (typing_inversion_var _ _ _ Htypt) as (T & Hctx & Hsub).何回も’_’記号を書かなければならないのは面倒です。何回書くかを計算しなければならないだけでなく、このことで証明記述がかなり汚なくもなります。タクティックletsを使うことで、次のように簡単に書くことができます:lets (T & Hctx & Hsub): typing_inversion_var Htypt.

簡単に言うと、このタクティックletsは補題のたくさんの変数や仮定を特定します。記法はlets I: E0 E1 .. ENという形です。そうすると事実E0に引数E1からENを与えてIという名前の仮定を作ります。すべての引数を与えなければならないわけではありませんが、与えなければならない引数は、正しい順番で与えなければなりません。このタクティックは、与えられた引数を使って補題をどうしたら具体化できるかを計算するために、型の上の first-match アルゴリズムを使います。

Module ExamplesLets.
Require Import Subtyping_J.

Axiom typing_inversion_var : forall (G:context) (x:id) (T:ty),
has_type G (tm_var x) T ->
exists S, G x = Some S /\ subtype S T.

最初に、型がhas_type G (tm_var x) Tである仮定Hを持つとします。タクティックlets K: typing_inversion_var Hを呼ぶことで補題typing_inversion_varを結論として得ることができます。以下の通りです。

Lemma demo_lets_1 : forall (G:context) (x:id) (T:ty),
has_type G (tm_var x) T -> True.
Proof.
intros G x T H. dup.

lets K: typing_inversion_var H.
destruct K as (S & Eq & Sub).
admit.

lets (S & Eq & Sub): typing_inversion_var H.
admit.

Qed.

今、G、x、Tの値を知っていて、Sを得たいとします。また、サブゴールとしてhas_type G (tm_var x) Tが生成されていたとします。typing_inversion_varの残った引数のすべてをサブゴールとして生成したいことを示すために、’_’を三連した記号___を使います。(後に、___を書くのを避けるためにforwardsという略記用タクティックを導入します。)

Lemma demo_lets_2 : forall (G:context) (x:id) (T:ty), True.
Proof.
intros G x T.
lets (S & Eq & Sub): typing_inversion_var G x T ___.
Admitted.

通常、has_type G (tm_var x) Tを証明するのに適したコンテキストGと型Tは1つだけしかないので、実はGとTを明示的に与えることに煩わされる必要はありません。lets (S & Eq & Sub): typing_inversion_var xとすれば十分です。このとき、変数GとTは存在変数を使って具体化されます。

Lemma demo_lets_3 : forall (x:id), True.
Proof.
intros x.
lets (S & Eq & Sub): typing_inversion_var x ___.
Admitted.

より極端に、typing_inversion_varの具体化のために引数をまったく与えないこともできます。この場合、3つの単一化変数が導入されます。

Lemma demo_lets_4 : True.
Proof.
lets (S & Eq & Sub): typing_inversion_var ___.
Admitted.

注意:letsに補題の名前だけを引数として与えた場合、その補題が証明コンテキストに追加されるだけで、その引数を具体化しようとすることは行いません。

Lemma demo_lets_5 : True.
Proof.
lets H: typing_inversion_var.
Admitted.

letsの最後の便利な機能は ‘_’ を2つ続けた記号__です。これを使うと、いくつかの引数が同じ型を持つとき引数を1つスキップできます。以下の例は、mを値3に具体化したい一方、nは存在変数を使って具体化したい場面です。

Lemma demo_lets_underscore :
(forall n m, n <= m -> n < m+1) -> True.
Proof.
intros H.

lets K: H 3.
clear K.

lets K: H __ 3.
clear K.
Admitted.

注意: 証明記述の中でHの名前を言う必要がないとき、lets H: E0 E1 E2の代わりにlets: E0 E1 E2と書くことができます。

注意: タクティックletsは5つまでの引数をとることができます。5個を越える引数を与えることができる場合に、別の構文があります。キーワード>>から始まるリストを使ったものです。例えばlets H: (>> E0 E1 E2 E3 E4 E5 E6 E7 E8 E9 10)と書きます。

End ExamplesLets.

applys、forwards、specializesのはたらき

タクティックapplys、forwards、specializesはletsを特定の用途に使う場面での略記法です。

- forwardsは補題のすべての引数を具体化する略記法です。 より詳しくは、forwards H: E0 E1 E2 E3はlets H: E0 E1 E2 E3 ___と同じです。ここで___の意味は前に説明した通りです。

- applysは、letsの高度な具体化モードにより補題を構築し、 それをすぐに使うことにあたります。これから、applys E0 E1 E2 E3は、lets H: E0 E1 E2 E3の後eapply H、clear Hと続けることと同じです。

- specializesは、コンテキストの仮定を特定の引数でその場で具体化することの略記法です。 より詳しくは、specializes H E0 E1はlets H': H E0 E1の後clear H、rename H' into Hと続けることと同じです。

applysの使用例は以下で出てきます。specializesとforwardsの使用例は、チュートリアルファイルUseAuto_J.vにいくつか含まれています。

具体化の例

Module ExamplesInstantiations.
Require Import Subtyping_J.

以下の証明では、いくつかの場所でletsがdestructの代わりに、applysがapplyの代わりに使われます。その場所は “old:”で始まるコメントで示されています。letsを使う練習問題も示されています。

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S ->
has_type empty v U ->
has_type Gamma (subst v x t) S.
Proof with eauto.
intros Gamma x U v t S Htypt Htypv.
generalize dependent S. generalize dependent Gamma.
(tm_cases (induction t) Case); intros; simpl.
Case "tm_var".
rename i into y.

(* old: destruct (typing_inversion_var _ _ _ Htypt) as [T [Hctx Hsub]].*)

lets (T&Hctx&Hsub): typing_inversion_var Htypt.
unfold extend in Hctx.
remember (beq_id x y) as e. destruct e...
SCase "x=y".
apply beq_id_eq in Heqe. subst.
inversion Hctx; subst. clear Hctx.
apply context_invariance with empty...
intros x Hcontra.

(* old: destruct (free_in_context _ _ S empty Hcontra) as [T' HT']... *)

lets [T' HT']: free_in_context S empty Hcontra...
inversion HT'.
Case "tm_app".

(* 練習問題: 次の[destruct]を[lets]に換えなさい *)

(* old: destruct (typing_inversion_app _ _ _ _ Htypt) as [T1 [Htypt1 Htypt2]].
eapply T_App... *)

(* FILL IN HERE *) admit.

Case "tm_abs".
rename i into y. rename t into T1.

(* old: destruct (typing_inversion_abs _ _ _ _ _ Htypt). *)

lets (T2&Hsub&Htypt2): typing_inversion_abs Htypt.

(* old: apply T_Sub with (ty_arrow T1 T2)... *)

applys T_Sub (ty_arrow T1 T2)...
apply T_Abs...
remember (beq_id x y) as e. destruct e.
SCase "x=y".
eapply context_invariance...
apply beq_id_eq in Heqe. subst.
intros x Hafi. unfold extend.
destruct (beq_id y x)...
SCase "x<>y".
apply IHt. eapply context_invariance...
intros z Hafi. unfold extend.
remember (beq_id y z) as e0. destruct e0...
apply beq_id_eq in Heqe0. subst.
rewrite <- Heqe...
Case "tm_true".
lets: typing_inversion_true Htypt...
Case "tm_false".
lets: typing_inversion_false Htypt...
Case "tm_if".
lets (Htyp1&Htyp2&Htyp3): typing_inversion_if Htypt...
Case "tm_unit".

(* old: assert (subtype ty_Unit S) by apply (typing_inversion_unit _ _ Htypt)... *)

lets: typing_inversion_unit Htypt...

Qed.

End ExamplesInstantiations.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

UseAuto_J: Coqの証明自動化の理論と実際

機械がチェックした証明においては、細部の一つ一つの正しさが確認されています。これが巨大な証明記述にもなります。幸い、Coqは証明探索メカニズムと決定手続きを持っていて、それにより証明の小さな部分を自動合成することができます。自動化は設定を適切に行えば非常に強力です。この章の目的は自動化の扱い方の基本を説明することです。

この章は2つの部分から成ります。第一部は証明探索(“proof search”)と呼ばれる一般的メカニズムに焦点を当てます。簡単に言うと、証明探索は、証明が終わるまで、単純に補題と仮定を可能なすべての方法で適用してみようとします。第二部は決定手続き(“decision procedures”)について記述します。それらは、Coqの論理の特定の断片についての証明課題を解くことを得意とするタクティックです。

この章の例には、自動化の特定の側面を示す小さな補題から、「ソフトウェアの基礎」(SoftwareFoundations)の他の部分から抽出した大きな例までを含みます。大きな例においては、ライブラリLibTactics_J.vのタクティックが使用されます。それらのタクティックについてはUseTactics_J.v章に記述されています。(この章の後半を理解するにはUseTactics_J.v章を読んでおくべきです。しかし、前半は他の知識を必要としません。)

Require Import LibTactics_J.

証明探索の基本性質

証明探索のアイデアは、補題や仮定を適用するタクティックの列を、例えばautoのような1つのタクティックで置き換えることです。この形の証明自動化で、たくさんの作業を省くことができます。典型的には証明記述ははるかに短くなり、またその記述は典型的にはより変更に強いものになります。もし定義に何か小さな変更をした場合、自動化を使った証明はおそらく何の変更も必要ありません。もちろん、自動化の使い過ぎはよいことではありません。証明記述が証明の主要議論をもはや記録していないときには、定義の変更で証明が成立しなくなったときに、直すことは難しくなります。全体として、自動化の適度の利用は大きな勝利です。証明の構築と、その後のメンテナンスの時間を、ともに大きく減らすことができます。

証明探索の強さ

これから4つの証明探索のタクティックを勉強します:auto、eauto、iauto、jautoです。タクティックautoとeautoはCoqのビルトインです。タクティックiautoはビルトインのタクティックtry solve [intuition eauto]の略記法です。タクティックjautoはライブラリLibTactics_Jに定義されています。このタクティックは単にeautoを呼ぶ前にゴールにある前処理を行います。この章のゴールは証明探索の一般原理を説明し、与えられたゴールを解くために上述の4つのタクティックのうちどれが一番適当かを推測する経験則を示すことです。

証明探索は効率と表現力の妥協案です。つまり、どれだけ複雑なゴールを解くことができるか、と、タクティックが停止するまでにどれだけの時間を必要とするかのトレードオフです。タクティックautoは、基本タクティックreflexivity、assumption、applyだけを使って証明を構築します。タクティックeautoはこれに加えてeapplyも使います。タクティックjautoはeautoを拡張して、コンテキストに現れる連言(and結合)と存在限量を展開することができるようにしています。タクティックiautoは連言(and結合)、選言(or結合)、否定を非常に賢い方法で扱います。しかしながらiautoはコンテキストから存在限量を展開することはできません。さらに、iautoはゴールがいくつかの選言を含む場合にとても遅くなるのが普通です。

注意するべきは、証明探索は書き換えステップ(タクティックrewrite、subst)、任意のデータ構造や述語についての場合分け分析(タクティックdestruct、inversion)、帰納法による証明(タクティックinduction)のいずれも実行しないことです。そのため証明探索は、実際は証明のたくさんの枝の最後のステップを自動化することを意図したものです。証明の全体構造を発見することはできません。

基本

タクティックautoは、intros、apply、assumption、reflexivityの列で証明できるゴールを証明することができます。以下で2つの例を示します。1つ目の例はautoがreflexivityをいつでも呼べることを示します。実際、autoは常に最初にreflexivityを適用しようとします。

Lemma solving_by_reflexivity :
2 + 3 = 5.
Proof. auto. Qed.

2つ目の例はapplyを2回続けて呼ぶ必要がある証明です。ゴールは、任意のnについてQ nならばP nであり、かつ任意のnについてQ nが成立するならば、P 2が成立する、というものです。

Lemma solving_by_apply : forall (P Q : nat->Prop),
(forall n, Q n -> P n) ->
(forall n, Q n) ->
P 2.
Proof. auto. Qed.

autoに、どのような証明を見つけたのか教えてもらうことができます。そのためには、autoの代わりにinfo autoとして呼びます。

Lemma solving_by_apply' : forall (P Q : nat->Prop),
(forall n, Q n -> P n) ->
(forall n, Q n) ->
P 2.
Proof. info auto. Qed.

タクティックautoはapplyを呼ぶことがありますが、eapplyは呼びません。そのためautoは、証明のゴールから直接具体化できない補題は使うことができません。そのような補題を使うためにはタクティックeautoを呼ぶ必要があります。eautoはeapplyを呼ぶことができます。

以下の例では、最初の仮定は、あるmについてQ mが真のとき、P nが真であると主張しています。そして、ゴールはQ 1ならばP 2を証明することです。この含意は、仮定の中のmを値1で具体化することから得られます。次の証明記述はeautoが証明に成功し、一方autoはそうではないことを示します。

Lemma solving_by_eapply : forall (P Q : nat->Prop),
(forall n m, Q m -> P n) ->
Q 1 -> P 2.
Proof. auto. eauto. Qed.

注記: 同様に、info eautoを使うとeautoが何を見つけたかを知ることができます。

連言

ここまで、eautoがeapplyを使えるという意味でautoより強いことを見てきました。同様に、ここでは、jautoとiautoが連言に対してより優れたサポートをしているという点で、autoやeautoより強いことを見ます。

タクティックautoとeautoはF /\ F'という形のゴールを証明できます。ここでFとF'は2つの命題で、両者とも現在のコンテキストですぐに証明できるものです。次はその例です。

Lemma solving_conj_goal : forall (P : nat->Prop) (F : Prop),
(forall n, P n) -> F -> F /\ P 2.
Proof. auto. Qed.

しかしながら、仮定が連言の場合、autoとeautoはこの連言を使うことができません。eautoがとても複雑なゴールを証明できるのに、「F /\ F'ならばF」を証明できないことに、最初はとても驚きます。タクティックiautoとjautoはコンテキストの連言を分解することができます。次はその例です。

Lemma solving_conj_hyp : forall (F F' : Prop),
F /\ F' -> F.
Proof. auto. eauto. jauto.  Qed.

タクティックjautoは、最初にjauto_setという前処理のタクティックを呼び、その後eautoを呼ぶように作られています。これから、jautoがどうはたらくかを理解するためには、タクティックjauto_setを直接呼んでみるのが良いでしょう。

Lemma solving_conj_hyp' : forall (F F' : Prop),
F /\ F' -> F.
Proof. intros. jauto_set. eauto. Qed.

次はiautoとjautoで解けるより複雑なゴールです。

Lemma solving_conj_more : forall (P Q R : nat->Prop) (F : Prop),
(F /\ (forall n m, (Q m /\ R n) -> P n)) ->
(F -> R 2) ->
Q 1 ->
P 2 /\ F.
Proof. jauto.  Qed.

iautoとjautoの戦略は、トップレベルの連言をグローバルに解析し、その後eautoを呼ぶというものです。このため、全称限量子を持つ仮定の、結論部の連言を扱うのが苦手です。次の例は、Coqの証明探索メカニズムの一般的な弱点を示しています。

Lemma solving_conj_hyp_forall : forall (P Q : nat->Prop),
(forall n, P n /\ Q n) -> P 2.
Proof.
auto. eauto. iauto. jauto.

intros. destruct (H 2). auto.
Qed.

この状況にはちょっとがっかりします。というのは、ほとんど同じである次のゴールは自動証明できるのです。唯一の違いは、全称限量子が連言のそれぞれに別々に付けられていることです。

Lemma solved_by_jauto : forall (P Q : nat->Prop) (F : Prop),
(forall n, P n) /\ (forall n, Q n) -> P 2.
Proof. jauto.  Qed.

選言

タクティックautoとeautoはゴールに現れる選言を扱うことができます。

Lemma solving_disj_goal : forall (F F' : Prop),
F -> F \/ F'.
Proof. auto. Qed.

しかし、コンテキストに現れる選言についての推論を自動化できるのはiautoだけです。例えば、iautoは 「F \/ F'ならばF' \/ F」を証明できます。

Lemma solving_disj_hyp : forall (F F' : Prop),
F \/ F' -> F' \/ F.
Proof. auto. eauto. jauto. iauto. Qed.

より一般に、iautoは連言、選言、否定の複雑な組み合わせを扱うことができます。次はその例です。

Lemma solving_tauto : forall (F1 F2 F3 : Prop),
((~F1 /\ F3) \/ (F2 /\ ~F3)) ->
(F2 -> F1) ->
(F2 -> F3) ->
~F2.
Proof. iauto. Qed.

しかしながら、iautoが選言の場合分けを自動実行する能力には、悪い面もあります。iautoは非常に遅くなることがあるのです。コンテキストが数個の選言を含む仮定を持つとき、iautoは通常、その指数の数のサブゴールを作り、その1つ1つについてeautoを呼びます。iautoと比べたjautoの長所は、このような場合分けをする時間を費さないことです。

存在限量

タクティックeauto、iauto、jautoは結論部が存在限量であるゴールを証明することができます。例えばゴールがexists x, f xのとき、タクティックeautoはxの場所に存在変数を導入します。それを?25としましょう。残ったゴールはf ?25になります。そしてeautoは、?25を何らかの適当な値で具体化することで、これを解こうとします。例えば、仮定f 2があるならば、変数?25を2で置換してゴールが解決されます。以下の通りです。

Lemma solving_exists_goal : forall (f : nat->Prop),
f 2 -> exists x, f x.
Proof.
auto.
eauto.
Qed.

証明探索の他のタクティックと比べたjautoの主な長所は、存在限量された、つまりexists x, Pという形の 「仮定」を使える点です。

Lemma solving_exists_hyp : forall (f g : nat->Prop),
(forall x, f x -> g x) ->
(exists a, f a) ->
(exists a, g a).
Proof.
auto. eauto. iauto.
jauto.

Qed.

否定

タクティックautoとeautoは、否定の扱いに関して制限があります。これは主に、否定(~ Pと記述される)がP -> Falseと定義されているのに、この定義の展開が自動では行われないことに関係しています。次の例を見てください。

Lemma negation_study_1 : forall (P : nat->Prop),
P 0 -> (forall x, ~ P x) -> False.
Proof.
intros P H0 HX.
eauto.
unfold not in *. eauto.
Qed.

このため、タクティックiautoとjautoは前処理の中でunfold not in *を組織的に呼びます。これにより、iauto、jautoは上記のゴールをすぐに解決できます。

Lemma negation_study_2 : forall (P : nat->Prop),
P 0 -> (forall x, ~ P x) -> False.
Proof. jauto.  Qed.

(定義の展開に関する証明探索の振る舞いについては後でまた議論します。)

等式

Coq の証明探索機能は等式を扱うのが不得意です。反射律、対称律といった基本的操作は行うことができますが、それぐらいです。以下はautoが解くことができる簡単な例です。最初にsymmetryを呼び、その後仮定を適用します。

Lemma equality_by_auto : forall (f g : nat->Prop),
(forall x, f x = g x) -> g 2 = f 2.
Proof. auto. Qed.

等式についてのより高度な推論を自動化するためには、むしろタクティックcongruenceを使うべきです。これについてはこの章の終わりの「決定手続き」節で説明します。

証明探索はどのようにはたらくか

探索の深さ

タクティックautoは次のようにはたらきます。最初にreflexivityとassumptionを試してみます。もしどちらかがゴールを解いたならば仕事は完了です。そうでないときautoは、エラーにならずにゴールに適用できる仮定のうち、一番最後に導入されたものを適用することを試みます。この適用によりサブゴールが生成されます。このあと2つの場合があります。もし生成されたサブゴールがすべてautoの再帰的呼び出しにより解かれた場合、それで終了です。そうではなく、生成されたサブゴール中にautoが解けないものが1つでもある場合、やり直して、最後から2番目に導入された仮定を適用しようとします。同様のやり方を、証明を発見するか、適用する仮定がなくなるかするまで続けます。

autoタクティックの実行の際のバックトラックプロセスを明確に理解しておくことはとても重要です。そうしないと、autoの振る舞いにはかなり当惑します。例えば、autoは次の自明なものを解くことができません。

Lemma search_depth_0 :
True /\ True /\ True /\ True /\ True /\ True.
Proof.
auto.
Admitted.

このゴールにautoが失敗する理由は、連言の数が多すぎることです。もしこれが5個だったら、autoは証明に成功したでしょう。しかし6個は多過ぎなのです。タクティックautoは補題と仮定の数を制限することで、証明探索がいつかは停止することを保証しています。デフォルトではステップの最大数は5です。制限を別の値にするには、例えばauto 6と書くと、証明探索は最大6ステップまでになります。例えばauto 6は上記の補題を解くことができるでしょう。(同様に、eauto 6やintuition eauto 6として呼ぶことができます。)auto nの引数nは探索の深さ(“search depth”)と呼ばれます。タクティックautoは単にauto 5の略記法として定義されています。

auto nの振る舞いは次のように要約されます。最初にゴールをreflexivityとassumptionを使って解こうとします。もし失敗したときは、仮定(またはヒントデータベースに登録された補題)を適用しようとします。これによりいくつものサブゴールが生成されます。このそれぞれのサブゴールに対してタクティックauto (n-1)が呼ばれます。もしすべてのサブゴールが解かれたならば処理は完了です。そうでなければ、auto nは別の仮定を適用しようとします。

この過程は、auto nはauto (n-1)を呼び、次にauto (n-1)はauto (n-2)を呼び... と続きます。タクティックauto 0が適用を試みるのはreflexivityとassumptionだけで、補題を適用しようとすることはありません。これは全体として、指定されたステップ数の上限値に逹したときには、autoタクティックは探索を中止し、バックトラックして別のパスを調べることを意味します。

次の補題には1つだけ証明があり、それは3ステップです。このため、auto nは、nが3以上の時これを証明し、3未満のときは証明できません。

Lemma search_depth_1 : forall (P : nat->Prop),
P 0 ->
(P 0 -> P 1) ->
(P 1 -> P 2) ->
(P 2).
Proof.
auto 0.
auto 1.
auto 2.
auto 3.

Qed.

この例を次のように一般化することができます。すべてのkについて、P kがP (k-1)から導出されると仮定します。また、P 0が成立するとします。タクティックauto、つまりauto 5と同じですが、これは5未満のすべてのkの値についてP kを導出することができます。例えばautoはP 4を証明できます。

Lemma search_depth_3 : forall (P : nat->Prop),
(P 0) ->
(forall k, P (k-1) -> P k) ->
(P 4).
Proof. auto. Qed.

しかし、P 5を証明するためには、少なくともauto 6を呼ぶ必要があります。

Lemma search_depth_4 : forall (P : nat->Prop),
(P 0) ->
(forall k, P (k-1) -> P k) ->
(P 5).
Proof. auto. auto 6. Qed.

autoが限られた深さで証明を探すことから、autoがゴールFもF'も証明できるのにF /\ F'を証明できない、という場合があります。次の例では、autoはP 4を証明できますが、P 4 /\ P 4を証明できません。なぜなら連言を分解するには1ステップ必要だからです。この連言を証明するためには、探索の深さを増やして少なくともauto 6を使う必要があります。

Lemma search_depth_5 : forall (P : nat->Prop),
(P 0) ->
(forall k, P (k-1) -> P k) ->
(P 4 /\ P 4).
Proof. auto. auto 6. Qed.

バックトラック

前の節で、各ステップでautoが適用できる仮定が唯一である証明を考えてきました。一般には、autoの各ステップでいくつかの選択肢がある場合があります。autoの戦略は、すべての可能性を(深さ優先探索によって)試してみる、というものです。

どのように自動証明がはたらくかを示すために、前の例を拡張して、P kがP (k+1)からも導出できるとします。この仮定を追加したことで、autoが各ステップで考慮する新たな選択肢が提供されます。

証明探索で考慮するすべてのステップをトレースすることができる特別なコマンドがあります。そのトレースを見るためには、debug eautoと書きます。(ある理由から、コマンドdebug autoは存在しないため、代わりにコマンドdebug eautoを使う必要があります。)

Lemma working_of_auto_1 : forall (P : nat->Prop),
(P 0) ->
(forall k, P (k+1) -> P k) ->
(forall k, P (k-1) -> P k) ->
(P 2).

Proof. intros P H1 H2 H3.  eauto. Qed.

debug eautoの出力メッセージは次の通りです。

depth=5
depth=4 apply H3
depth=3 apply H3
depth=3 exact H1

depth はeauto nが呼ばれるnの値を示します。メッセージに見られるタクティックは、eautoが最初にすることはH3を適用してみることであることを示します。H3の適用の結果、ゴールP 1はゴールP 2に代わります。すると、再度H3が適用され、ゴールP 1がP 2に代わります。この時点でゴールは仮定H1と一致します。

この場合、eautoは非常にラッキーだったようです。仮定H2を一度も使ってみようとすることもありませんでした。理由は、autoは常に最後に導入された仮定を最初に試してみることと、ゴールにおいてH3はH2より後で導入された仮定であることです。それでは、仮定H2とH3を入れ替えるとどうなるか見てみましょう。

Lemma working_of_auto_2 : forall (P : nat->Prop),
(P 0) ->
(forall k, P (k-1) -> P k) ->
(forall k, P (k+1) -> P k) ->
(P 2).
Proof. intros P H1 H3 H2.  eauto. Qed.

このとき、出力メッセージは証明探索がたくさんの可能性を調べることを示唆しています。debug eautoをinfo eautoに替えると、eautoが見つける証明は実際に単純なものではないことを見ることができます。

apply H2; apply H3; apply H3; apply H3; exact H1

この証明は、証明課題P 3を調べます。たとえそれが何の役にも立たなくてもです。以下に描かれた木は自動証明が通ったすべてのゴールを記述しています。

|5||4||3||2||1||0| -- 以下で、タブは深さを示しています

[P 2]
-> [P 3]
-> [P 4]
-> [P 5]
-> [P 6]
-> [P 7]
-> [P 5]
-> [P 4]
-> [P 5]
-> [P 3]
--> [P 3]
-> [P 4]
-> [P 5]
-> [P 3]
-> [P 2]
-> [P 3]
-> [P 1]
-> [P 2]
-> [P 3]
-> [P 4]
-> [P 5]
-> [P 3]
-> [P 2]
-> [P 3]
-> [P 1]
-> [P 1]
-> [P 2]
-> [P 3]
-> [P 1]
-> [P 0]
-> !! 完了です !!

最初の数行は次のように読みます。P 2を証明するためにeauto 5は最初にH2を適用しサブゴールP 3を作ります。これを解くために、eauto 4は再度H2を適用し、ゴールP 4を作ります。同様に探索はP 5、P 6、P 7と進みます。P 7に逹したときタクティックeauto 0が呼ばれますが、eauto 0は補題を適用することができないため、失敗します。このためゴールP 6に戻り、ここでは仮定H3を適用し、サブゴールP 5を生成します。ここでまたeauto 0はこのゴールを解くことに失敗します。

このプロセスは延々と続きます。P 3までバックトラックし、H2を3回連続して適用してP 2、P 1、P 0と進むまでは。この探索木は、eautoがなぜapply H2から始まる証明を発見できるかを説明しています。

ヒントを追加する

デフォルトでは、auto(およびeauto)は証明コンテキストに現れる仮定だけを適用しようとします。それより前に証明した補題を使うことをautoに教えてやる方法は2つあります。1つはautoを呼ぶ直前に補題を仮定として加えてやることです。もう1つは、補題をヒントとして追加することです。そうすると、autoを呼ぶときいつでもそれを使うことができるようになります。

1つ目の方法は、この特定の場所のためだけに補題をautoに使わせるのに便利です。補題を仮定として追加するためには、generalize mylemma; intros、あるいは単にlets: mylemmaと打ちます(後者にはLibTactics_J.vが必要です)。

2つ目の方法は何回も補題を使う必要がある場合に便利です。補題をヒントに追加する構文はHint Resolve mylemmaです。例えば、任意の数値は自分以下であるという補題forall x, x <= xはCoq標準ライブラリではLe.le_reflと呼ばれていますが、これをヒントとして追加するには次のようにします。

Hint Resolve Le.le_refl.

帰納的データ型のすべてのコンストラクタをヒントとして追加する便利な略記法がコマンドHint Constructors mydatatypeです。

ワーニング: いくつかの補題、推移律のようなものは、ヒントとして追加するべきではありません。証明探索のパフォーマンスに非常に悪い影響を与えるからです。この問題の記述と推移律の一般的な回避策の提示は後で出てきます。

タクティックへの自動証明の統合

ライブラリ “LibTactics” はタクティックを呼んだ後で自動証明を呼ぶ便利な機能を提供します。要するに、タクティック名に星印(*)をつければ良いのです。例えば、apply* Hはapply H; auto_starと等価です。ここでauto_starは必要なように定義できます。デフォルトでは、auto_starは最初にautoを使ってゴールを解こうとします。そしてそれに成功しなかった場合jautoを呼ぼうとします。jautoの強さがautoを越えているのに、autoを先に呼ぶのは意味があります。autoで成功した場合、かなりの時間を節約できるかもしれません。そしてautoが証明に失敗するときには、非常に速く失敗するのです。

星印の意味を定めるauto_starの定義は、いつでも必要なときに変更できます。単に次のように書きます:

Ltac auto_star ::= a_new_definition.

ここで、:=ではなく::=が使われていることを見てください。これは、このタクティックが新しい定義に再束縛されていることを示しています。そのデフォルトの定義は次の通りです。

Ltac auto_star ::= try solve [ auto | jauto ].

標準のCoqタクティックのほとんどすべてと、”LibTactics”のタクティックのすべては、星印を付けて呼ぶことができます。例えば、subst*、destruct* H、inverts* H、lets* I: H x、specializes* H x、等々が可能です。注記すべき例外が2つあります。タクティックauto*はauto_starの別名です。また、タクティックapply* Hはeapply H(または、もし必要ならばより強力なapplys H)を呼び、その後auto_starを呼びます。eapply* Hタクティックは存在しないので、代わりにapply* Hを呼ぶように注意してください。

大きな開発では、2つの段階の自動化を使うのが便利でしょう。典型的には、1つはautoのような速いタクティック、もう1つはjautoのように遅いけれどもより強力なタクティックです。2種類の自動化をスムーズに共存させるために、LibTactics_J.vはタクティックにチルダ(~)を付けるバージョンも定義しています。apply~ H、destruct~ H、subst~、auto~などです。チルダ記号の意味はauto_tildeタクティックによって記述されています。このデフォルトの実装はautoです。

Ltac auto_tilde ::= auto.

以降の例では、auto_starだけが必要です。

自動化の使用例

「ソフトウェアの基礎」(“Software Foundations”)コースの主要定理に証明探索を実際にどのように使うかを見てみましょう。決定性、保存、進行などの特定の結果を証明します...

決定性

Module DeterministicImp.
Require Import Imp_J.

Imp言語の決定性補題のオリジナルの証明を振り返ってみましょう。以下の通りです。

Theorem ceval_deterministic: forall c st st1 st2,
c / st || st1 ->
c / st || st2 ->
st1 = st2.
Proof.
intros c st st1 st2 E1 E2.
generalize dependent st2.
(ceval_cases (induction E1) Case); intros st2 E2; inversion E2; subst.
Case "E_Skip". reflexivity.
Case "E_Ass". reflexivity.
Case "E_Seq".
assert (st' = st'0) as EQ1.
SCase "Proof of assertion". apply IHE1_1; assumption.
subst st'0.
apply IHE1_2. assumption.
Case "E_IfTrue".
SCase "b1 evaluates to true".
apply IHE1. assumption.
SCase "b1 evaluates to false (contradiction)".
rewrite H in H5. inversion H5.
Case "E_IfFalse".
SCase "b1 evaluates to true (contradiction)".
rewrite H in H5. inversion H5.
SCase "b1 evaluates to false".
apply IHE1. assumption.
Case "E_WhileEnd".
SCase "b1 evaluates to true".
reflexivity.
SCase "b1 evaluates to false (contradiction)".
rewrite H in H2. inversion H2.
Case "E_WhileLoop".
SCase "b1 evaluates to true (contradiction)".
rewrite H in H4. inversion H4.
SCase "b1 evaluates to false".
assert (st' = st'0) as EQ1.
SSCase "Proof of assertion". apply IHE1_1; assumption.
subst st'0.
apply IHE1_2. assumption.
Qed.

練習問題: この証明を可能な限りautoを使って書き直しなさい。

Theorem ceval_deterministic': forall c st st1 st2,
c / st || st1 ->
c / st || st2 ->
st1 = st2.
Proof.
(* FILL IN HERE *) admit.
Qed.

実際、自動化の利用は、ただ1つや2つの別のタクティックの代わりにautoを使うというようなことではないのです。自動化の利用は、証明を記述しメンテナンスする作業を最小化するために、タクティック列の構成を再考することなのです。このプロセスはLibTactics_J.vのタクティックを使うことで楽になります。そこで、自動化の使用法の最適化に取り組む前に、まず決定性の証明を書き直してみましょう:

- intros x Hの代わりにintrov Hを使います

- generalize dependent xの代わりにgen xを使います

- generalize dependent xの代わりにgen xを使います

- inversion H; substの代わりにinverts Hを使います

- 矛盾を扱うためにtryfalseを使い、 コンテキストにbeval st b1 = trueとbeval st b1 = falseの両者が現れているのを除去します

- 場合にラベルを付けるためのceval_casesの使用を止めます。

Theorem ceval_deterministic’‘: forall c st st1 st2, c / st || st1 -> c / st || st2 -> st1 = st2. Proof. introv E1 E2. gen st2. induction E1; intros; inverts E2; tryfalse. auto. auto. assert (st’ = st‘0). auto. subst. auto. auto. auto. auto. assert (st’ = st‘0). auto. subst. auto. Qed.

きれいな証明記述を得るためには、assert (st' = st'0)の呼び出しを消去しなければなりません。このようなタクティックの呼び出しは、きれいではありません。なぜなら、自動命名された変数を参照しているからです。こういうタクティックはとても脆弱なものになりやすいのです。タクティックassert (st' = st'0)は帰納法の仮定から導出したい結論を主張するのに使われています。そこで、この結論を明示的に述べる代わりに、帰納法の仮定を具体化する際に自動処理によって計算される具体化法を使うようにCoqに伝えてみましょう。LibTactics_J.vに記述されたタクティックforwardsは、事実の具体化について的確に助けてくれます。それでは、この例についてどのようにはたらくか見てみましょう。

Theorem ceval_deterministic''': forall c st st1 st2,
c / st || st1 ->
c / st || st2 ->
st1 = st2.
Proof.

introv E1 E2. gen st2.
induction E1; intros; inverts E2; tryfalse.
auto. auto.

dup 4.

assert (st' = st'0). apply IHE1_1. apply H1.
skip.

forwards: IHE1_1. apply H1.
skip.

forwards: IHE1_1. eauto.
skip.

forwards*: IHE1_1.
skip.

Admitted.

証明記述を洗練するために、星印を使って呼び出しをautoに分解することが残っています。そうすると、決定性の証明はたった4行の10個を越えないタクティックに書き直されます。

Theorem ceval_deterministic'''': forall c st st1 st2,
c / st || st1  ->
c / st || st2 ->
st1 = st2.
Proof.
introv E1 E2. gen st2.
induction E1; intros; inverts* E2; tryfalse.
forwards*: IHE1_1. subst*.
forwards*: IHE1_1. subst*.
Qed.

End DeterministicImp.

STLC の保存

Module PreservationProgressStlc.
Require Import Stlc_J.
Import STLC.

STLC の保存の証明を振り返ってみましょう。次の通りです。この証明では既にドット3つ(...)のメカニズムを通じてeautoを使っています。

Theorem preservation : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.
Proof with eauto.
remember (@empty ty) as Gamma.
intros t t' T HT. generalize dependent t'.
(has_type_cases (induction HT) Case); intros t' HE; subst Gamma.
Case "T_Var".
inversion HE.
Case "T_Abs".
inversion HE.
Case "T_App".
inversion HE; subst...

SCase "ST_AppAbs".
apply substitution_preserves_typing with T11...
inversion HT1...
Case "T_True".
inversion HE.
Case "T_False".
inversion HE.
Case "T_If".
inversion HE; subst...
Qed.

練習問題: この証明をLibTacticsのタクティックを使って書き直しなさい。そして、...の代わりに星印を使って自動証明を呼びなさい。より詳しくは、invertsあるいはapplysの後でauto*を呼ぶためにinverts*とapplys*を使いなさい。解は3行の長さです。

Theorem preservation' : forall t t' T,
has_type empty t T  ->
t ==> t'  ->
has_type empty t' T.
Proof.
(* FILL IN HERE *) admit.
Qed.

STLC の前進

前進定理の証明を振り返りましょう。

Theorem progress : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.
Proof with eauto.
intros t T Ht.
remember (@empty ty) as Gamma.
(has_type_cases (induction Ht) Case); subst Gamma...
Case "T_Var".
inversion H.
Case "T_App".
right. destruct IHHt1...
SCase "t1 is a value".
destruct IHHt2...
SSCase "t2 is a value".
inversion H; subst; try solve by inversion.
exists (subst t2 x t)...
SSCase "t2 steps".
destruct H0 as [t2' Hstp]. exists (tm_app t1 t2')...
SCase "t1 steps".
destruct H as [t1' Hstp]. exists (tm_app t1' t2)...
Case "T_If".
right. destruct IHHt1...
destruct t1; try solve by inversion...
inversion H. exists (tm_if x t2 t3)...
Qed.

練習問題: 前進定理の証明を最適化しなさい。ヒント:destruct*とinverts*を使いなさい。解は10行の長さです(行は短いです)。

Theorem progress' : forall t T,
has_type empty t T ->
value t \/ exists t', t ==> t'.
Proof.
(* FILL IN HERE *) admit.
Qed.

End PreservationProgressStlc.

ビッグステップとスモールステップ

Module Semantics.
Require Import Smallstep_J.

スモールステップ簡約ジャッジメントとビッグステップ簡約ジャッジメントを関係づける証明を振り返りましょう。

Theorem stepmany__eval : forall t v,
normal_form_of t v -> t || v.
Proof.
intros t v Hnorm.
unfold normal_form_of in Hnorm.
inversion Hnorm as [Hs Hnf]; clear Hnorm.
apply nf_is_value in Hnf. inversion Hnf. clear Hnf.
(rsc_cases (induction Hs) Case); subst.
Case "rsc_refl".
apply E_Const.
Case "rsc_step".
eapply step__eval. eassumption. apply IHHs. reflexivity.
Qed.

練習問題: 上の証明を、introv、invert、applys*を使って最適化しなさい。解は4行の長さです。

Theorem stepmany__eval' : forall t v,
normal_form_of t v -> t || v.
Proof.
(* FILL IN HERE *) admit.
Qed.

End Semantics.

STLCRef の保存

Module PreservationProgressReferences.
Require Import References_J.
Import STLCRef.
Hint Resolve store_weakening extends_refl.

STLCRefの保存の証明はReferences_J.vにあります。(場合にラベル付けをする行を除いて)58行です。最適化された証明は2分の1以下の短かさになります。以下の資料は最適化された証明記述をどのように構築するかを説明します。最適化された結果の保存定理の証明記述は、後で出てきます。

Theorem preservation : forall ST t t' T st st',
has_type empty ST t T ->
store_well_typed ST st ->
t / st ==> t' / st' ->
exists ST',
(extends ST' ST /\
has_type empty ST' t' T /\
store_well_typed ST' st').
Proof.

remember (@empty ty) as Gamma. introv Ht. gen t'.
(has_type_cases (induction Ht) Case); introv HST Hstep;

subst Gamma; inverts Hstep; eauto.

Case "T_App".
SCase "ST_AppAbs".

exists ST. inverts Ht1. splits*. applys* substitution_preserves_typing.

SCase "ST_App1".

forwards: IHHt1. eauto. eauto. eauto.

jauto_set_hyps; intros.

jauto_set_goal; intros.

eauto. eauto. eauto.

SCase "ST_App2".

forwards*: IHHt2.

forwards*: IHHt.
forwards*: IHHt.
forwards*: IHHt1.
forwards*: IHHt2.
forwards*: IHHt1.

Case "T_Ref".
SCase "ST_RefValue".

exists (snoc ST T1). inverts keep HST. splits.

apply extends_snoc.

applys_eq T_Loc 1.

rewrite length_snoc. omega.

unfold store_ty_lookup. rewrite <- H. rewrite* nth_eq_snoc.

apply* store_well_typed_snoc.

forwards*: IHHt.

Case "T_Deref".
SCase "ST_DerefLoc".

exists ST. splits*.

lets [_ Hsty]: HST.

applys_eq* Hsty 1.

inverts* Ht.

forwards*: IHHt.

Case "T_Assign".
SCase "ST_Assign".

exists ST. splits*. applys* assign_pres_store_typing. inverts* Ht1.

forwards*: IHHt1.
forwards*: IHHt2.
Qed.

証明の最適化が難しい場合に戻りましょう。困難さの原因はnth_eq_snocです。これは、nth (length l) (snoc l x) d = xをとります。この補題は使うのが難しいのです。それは最初の引数length lがlに言及していて、それがsnoc l xに現れるlと完全に同じだからです。実際、通常は引数は自然数nで、これはlength lと等しいかもしれませんが、構文的にはlength lと違っています。nth_eq_snocを適用しやすくする簡単な修正方法があります。中間的な変数nを明示的に導入し、ゴールをnth n (snoc l x) d = xにします。そして、その際に仮定n = length lを加えます。

Lemma nth_eq_snoc' : forall (A : Type) (l : list A) (x d : A) (n : nat),
n = length l -> nth n (snoc l x) d = x.
Proof. intros. subst. apply nth_eq_snoc. Qed.

保存定理の証明のrefの場合は、はるかに簡単に証明できるようになります。rewrite nth_eq_snoc'が成功するからです。

Lemma preservation_ref : forall (st:store) (ST : store_ty) T1,
length ST = length st ->
ty_Ref T1 = ty_Ref (store_ty_lookup (length st) (snoc ST T1)).
Proof.
intros. dup.

unfold store_ty_lookup. rewrite* nth_eq_snoc'.

fequal. symmetry. apply* nth_eq_snoc'.
Qed.

保存の最適化された証明は次のようにまとめられます。

Theorem preservation' : forall ST t t' T st st',
has_type empty ST t T ->
store_well_typed ST st ->
t / st ==> t' / st' ->
exists ST',
(extends ST' ST /\
has_type empty ST' t' T /\
store_well_typed ST' st').
Proof.
remember (@empty ty) as Gamma. introv Ht. gen t'.
induction Ht; introv HST Hstep; subst Gamma; inverts Hstep; eauto.
exists ST. inverts Ht1. splits*. applys* substitution_preserves_typing.
forwards*: IHHt1.
forwards*: IHHt2.
forwards*: IHHt.
forwards*: IHHt.
forwards*: IHHt1.
forwards*: IHHt2.
forwards*: IHHt1.
exists (snoc ST T1). inverts keep HST. splits.
apply extends_snoc.
applys_eq T_Loc 1.
rewrite length_snoc. omega.
unfold store_ty_lookup. rewrite* nth_eq_snoc'.
apply* store_well_typed_snoc.
forwards*: IHHt.
exists ST. splits*. lets [_ Hsty]: HST.
applys_eq* Hsty 1. inverts* Ht.
forwards*: IHHt.
exists ST. splits*. applys* assign_pres_store_typing. inverts* Ht1.
forwards*: IHHt1.
forwards*: IHHt2.
Qed.

STLCRef の前進

STLCRefの前進の証明はファイルReferences_J.vにあります。その証明は53行で、最適化された証明記述は、また、2分の1になります。

Theorem progress : forall ST t T st,
has_type empty ST t T ->
store_well_typed ST st ->
(value t \/ exists t', exists st', t / st ==> t' / st').
Proof.
introv Ht HST. remember (@empty ty) as Gamma.
induction Ht; subst Gamma; tryfalse; try solve [left*].
right. destruct* IHHt1 as [K|].
inverts K; inverts Ht1.
destruct* IHHt2.
right. destruct* IHHt as [K|].
inverts K; try solve [inverts Ht]. eauto.
right. destruct* IHHt as [K|].
inverts K; try solve [inverts Ht]. eauto.
right. destruct* IHHt1 as [K|].
inverts K; try solve [inverts Ht1].
destruct* IHHt2 as [M|].
inverts M; try solve [inverts Ht2]. eauto.
right. destruct* IHHt1 as [K|].
inverts K; try solve [inverts Ht1]. destruct* n.
right. destruct* IHHt.
right. destruct* IHHt as [K|].
inverts K; inverts Ht as M.
inverts HST as N. rewrite* N in M.
right. destruct* IHHt1 as [K|].
destruct* IHHt2.
inverts K; inverts Ht1 as M.
inverts HST as N. rewrite* N in M.
Qed.

End PreservationProgressReferences.

サブタイプ

Module SubtypingInversion.
Require Import Subtyping_J.

サブタイプを持つ型システムの抽象化の型ジャッジメントに関する反転補題を振り返ってみましょう。

Lemma abs_arrow : forall x S1 s2 T1 T2,
has_type empty (tm_abs x S1 s2) (ty_arrow T1 T2) ->
subtype T1 S1
/\ has_type (extend empty x S1) s2 T2.
Proof with eauto.
intros x S1 s2 T1 T2 Hty.
apply typing_inversion_abs in Hty.
destruct Hty as [S2 [Hsub Hty]].
apply sub_inversion_arrow in Hsub.
destruct Hsub as [U1 [U2 [Heq [Hsub1 Hsub2]]]].
inversion Heq; subst...
Qed.

練習問題:introv、lets、inverts*を使って証明記述を最適化しなさい。特にapply K in H. destruct H as Iをlets I: K Hに置き換えることは有効です。解は4行です。

Lemma abs_arrow' : forall x S1 s2 T1 T2,
has_type empty (tm_abs x S1 s2) (ty_arrow T1 T2) ->
subtype T1 S1
/\ has_type (extend empty x S1) s2 T2.
Proof.
(* FILL IN HERE *) admit.
Qed.

補題substitution_preserves_typingはファイルUseTactics_J.vでletsとapplysのはたらきを示すために既に使われています。この証明のさらなる最適化を、(星印付きの)自動処理とタクティックcases_if'を使って行いなさい。解は33行で、Case命令を含みます。

Lemma substitution_preserves_typing : forall Gamma x U v t S,
has_type (extend Gamma x U) t S ->
has_type empty v U ->
has_type Gamma (subst v x t) S.
Proof.
(* FILL IN HERE *) admit.
Qed.

End SubtypingInversion.

証明探索の進んだ話題

補題を正しい方法で記述する

深さ優先探索のため、eautoは探索の深さが増えるにつれ指数的に遅くなります。短かい証明が存在する場合でもそうです。一般に、証明探索を合理的な速さにするため、証明の深さを5から6を越える深さの探索は避けるべきです。さらに、適用可能な補題の数を最小化し、通常は証明の中で存在変数を具体化する仮定を最初に置くべきです。

実際、eautoが特定のゴールを解く能力は、仮定がどの順番で記述されるかに依存します。このことが以下の例で示されます。この例では、Pは自然数についての述語です。この述語は、P mが0以外のいずれかのmについて成立するとき、任意のnについてP nが成立するというものです。ゴールは、P 2ならばP 1を証明することです。Pについての仮定がforall n m, P m -> m <> 0 -> P nの形で主張されるとき、eautoははたらきます。しかしながら、forall n m, m <> 0 -> P m -> P nのときはタクティックeautoは失敗します。

Lemma order_matters_1 : forall (P : nat->Prop),
(forall n m, P m -> m <> 0 -> P n) -> P 2 -> P 1.
Proof.
eauto.

Qed.

Lemma order_matters_2 : forall (P : nat->Prop),
(forall n m, m <> 0 -> P m -> P n) -> P 5 -> P 1.
Proof.
eauto.

intros P H K.
eapply H.

eauto.

Admitted.

理解の上で重要な点は、仮定forall n m, P m -> m <> 0 -> P nはeautoに優しく、一方forall n m, m <> 0 -> P m -> P nは実際はそうではない、ということです。P mが成立するmの値を推測し、それからm <> 0が成立することをチェックするのがうまくいくのは、P mが成立するmがほとんどないからです。これから、eautoが正しいmを見つける可能性は高いのです。一方、m <> 0となるmの値を推測し、それからP mが成立するかをチェックすることはうまくいきません。なぜなら、m <> 0でありながらP mではないmはたくさんあるからです。

証明検索中で定義を展開する

中間的定義を使うことは通常、主張をより簡潔に、より読みやすくすることから、形式的開発では一般に奨励されます。しかし定義は、証明を自動化することを少し難しくします。問題は、証明探索メカニズムにとって、定義を展開しなければならないのがいつかが明らかではないことです。ここで、証明探索を呼ぶ前にすべての定義を展開しておくという素朴な戦略は、大きな証明ではスケールしない(拡大適用できない)ため、それは避ける、ということに注意します。この節では、証明探索前に手動で定義を展開することを避けるためのいくつかのテクニックを紹介します。

定義の扱い方を示すために、Pを自然数についての抽象述語で、myFactを、命題3以下の任意のxについて命題P xが成立することの定義であるとします。

Axiom P : nat -> Prop.

Definition myFact := forall x, x <= 3 -> P x.

任意のxについてP xが成立するという仮定のもとでmyFactを証明することは、雑作もないことのはずです。しかし、myFactの定義を明示的に展開しない限り、autoは証明に失敗します。

Lemma demo_hint_unfold_goal_1 :
(forall x, P x) -> myFact.
Proof.
auto.
unfold myFact. auto.
Qed.

証明課題に現れる定義の展開を自動化するために、コマンドHint Unfold myFactを使うことができます。こうすると、myFactがゴールに現れたときに常にmyFactを展開してみるべきであるということを、Coqに伝えることができます。

Hint Unfold myFact.

これでやっと、自動証明は、myFactの定義の中を見ることができるようになります。

Lemma demo_hint_unfold_goal_2 :
(forall x, P x) -> myFact.
Proof. auto. Qed.

しかしながら、Hint Unfoldメカニズムがはたらくのは、ゴールに現れる定義の展開だけです。一般に証明探索は、コンテキストの定義を展開しません。例えば、True -> myFactの仮定のもとで、P 3が成立することを証明したいとします。

Lemma demo_hint_unfold_context_1 :
(True -> myFact) -> P 3.
Proof.
intros.
auto.
unfold myFact in *. auto.
Qed.

注意: 前の規則に1つ例外があります:コンテキストの定数はゴールに直接適用されるときに自動的に展開されます。例えば仮定がTrue -> myFactではなくmyFactであるとき、autoは証明に成功します。

不合理なゴールの証明の自動化

この節では、否定を結論部とする補題は一般にはヒントには適さないこと、そしてFalseを結論部とする補題は有用なヒントになりますが、それが多過ぎると証明探索が非効率になるということを示します。また、効率問題の現実的な回避策も見ます。

次の補題を考えましょう。この補題は、3以下の数は3を越えていないと主張しています。

Parameter le_not_gt : forall x,
(x <= 3) -> ~ (x > 3).

等価的に、3を越える数は3以下ではないと主張することもできるでしょう。

Parameter gt_not_le : forall x,
(x > 3) -> ~ (x <= 3).

実際、両主張は3つ目の主張：x <= 3かつx > 3は矛盾する、と、Falseを含意するという意味で同値です。

Parameter le_gt_false : forall x,
(x <= 3) -> (x > 3) -> False.

以下でやることの狙いは、証明自動化に関しては3つの主張のうちどれが便利かを調べることです。以下の素材はSection内に入れられています。これは、追加するヒントのスコープを限定するためです。言い換えると、セクションが終わった後では、セクション内で追加されたヒントはアクティブではなくなります。

Section DemoAbsurd1.

最初の補題le_not_gtをヒントとして追加して、命題exists x, x <= 3 /\ x > 3が不合理であることを証明できるか試してみましょう。

Hint Resolve le_not_gt.

Lemma demo_auto_absurd_1 :
(exists x, x <= 3 /\ x > 3) -> False.
Proof.
intros. jauto_set.
eauto.
eapply le_not_gt. eauto. eauto.
Qed.

補題gt_not_leはle_not_gtと対称性があるため、同じことです。3つ目の補題le_gt_falseはより有効なヒントです。なぜなら、Falseが結論部になっているため、現在のゴールがFalseであるときに、証明探索が適用してみようとするからです。

Hint Resolve le_gt_false.

Lemma demo_auto_absurd_2 :
(exists x, x <= 3 /\ x > 3) -> False.
Proof.
dup.

intros. jauto_set.  eauto.

jauto.
Qed.

まとめると、H1 -> H2 -> Falseという形の補題はH1 -> ~ H2よりはるかに有効なヒントです。両者は否定記号~の定義のもとで同値であるにもかかわらずそうなのです。

しかし、Falseを結論部とする補題をヒントに追加するのは慎重に行うべきです。理由は、ゴールFalseに到達するときはいつでも、証明探索メカニズムは、適切なヒントを適用する前に、結論部がFalseであるヒントをすべて適用してみる可能性があるからです。

End DemoAbsurd1.

結論部がFalseである補題をヒントに追加することは、ローカルにはとても効率的な解です。しかし、このアプローチはグローバルなヒントにはスケールアップ(拡大適用)できません。一番現実的な適用のためには、矛盾を導くのに使う補題に名前を付けるのが合理的です。タクティックfalse Hはこの目的に有用です。このタクティックは、ゴールをFalseに置換し、eapply Hを呼びます。その振る舞いは以下で記述します。3つの主張le_not_gt、gt_not_le、le_gt_falseのいずれでも使えることを見てください。

Lemma demo_false : forall x,
(x <= 3) -> (x > 3) -> 4 = 5.
Proof.
intros. dup 4.

false. eapply le_gt_false.
auto.

skip.

false. eapply le_gt_false.
eauto.
eauto.

false le_gt_false. eauto. eauto.

false le_not_gt. eauto. eauto.
Qed.

上の例で、false le_gt_false; eautoはゴールを証明します。しかしfalse le_gt_false; autoはゴールを証明できません。なぜならautoは存在変数を正しく具体化しないからです。false* le_gt_falseも動作しないことに注意します。なぜなら*記号はautoを最初に呼ぶからです。ここでは、証明を完結するのに2つの可能性があります。false le_gt_false; eautoを呼ぶかfalse* (le_gt_false 3)を呼ぶかです。

推移性補題についての自動化

いくつかの補題はヒントに追加するべきではありません。それは、証明探索を非常に遅くするからです。典型的な例は推移的な結果についてのものです。この節では、その問題を説明し、一般的な回避策を示します。型typの2つのオブジェクトSとTの間のサブタイプ関係subtype S Tを考えましょう。この関係は反射的かつ推移的であることが証明されていると仮定します。対応する補題をsubtype_reflとsubtype_transとします。

Parameter typ : Type.

Parameter subtype : typ -> typ -> Prop.

Parameter subtype_refl : forall T,
subtype T T.

Parameter subtype_trans : forall S T U,
subtype S T -> subtype T U -> subtype S U.

反射性をヒントに加えるのは一般に良い考えです。サブタイプ関係の反射性をヒントに加えましょう。

Hint Resolve subtype_refl.

推移性をヒントに加えることは一般には良い考えではありません。それが何故かを理解するために、ヒントに加えてみて何が起こるか見てみましょう。一度ヒントに追加するとそれを除去することはできないので、セクション(“Section”)を設けて、推移性ヒントのスコープをそのセクションに限定するようにします。

Section HintsTransitivity.

Hint Resolve subtype_trans.

このとき、ゴールforall S T, subtype S Tを考えます。これは明らかに解ける見込みがありません。このゴールにeautoを呼んでみましょう。

Lemma transitivity_bad_hint_1 : forall S T,
subtype S T.
Proof.
intros.  eauto.
Admitted.

セクションを閉じた後では、ヒントsubtype_transはもうアクティブではなくなることに注意します。

End HintsTransitivity.

上の例では、証明探索は多くの時間を費して、推移性と反射性を可能なすべての方法で適用しようと試みています。この過程は以下のようにまとめられます。最初のゴールはsubtype S Tです。これに反射性は適用できないことから、eautoは推移性を呼びます。この結果2つのサブゴールsubtype S ?Xとsubtype ?X Tができます。最初のサブゴールsubtype S ?Xはすぐに解くことができます。反射性を適用すれば十分です。この結果?XはSと単一化されます。これから、第二のサブゴールsubtype ?X Tはsubtype S Tとなります。これは最初のゴールとまったく同一です...

推移性補題の問題は、この補題がサブタイプ関係を結論部とするどのようなゴールにも適用可能だということです。このことから、eautoは、ほとんどの場合ゴールを解決する助けにならないにもかかわらず、この補題を適用しようとし続けます。これから、証明探索のヒントに推移性を加えることはやめるべきです。

効率を無視せずに推移性補題を自動証明で使うための一般的回避策があります。この回避策は “external hint” という強力なメカニズムを使います。このメカニズムを使うと、特定の補題を証明探索中でどういう条件の場合に試してみるべきかを手で書くことができます。

サブタイプの推移性の場合、推移性補題をsubtype S Uという形のゴールに適用してみるのは、既に証明コンテキスト内に仮定としてsubtype S Tまたはsubtype T Uがあるときに限る、とCoqに伝えます。言い換えると、推移性補題を適用するのは、その適用が証明の助けになるという何らかの根拠があるときだけ、ということです。この “external hint” を設定するために、次のように記述します。

Hint Extern 1 (subtype ?S ?U) =>
match goal with
| H: subtype S ?T |- _ => apply (@subtype_trans S T U)
| H: subtype ?T U |- _ => apply (@subtype_trans S T U)
end.

このヒント宣言は次のように理解できます。

- “Hint Extern” はヒントを導入します。

- 数 “1” は証明探索の優先度に対応します。 実際にどの優先度が使われるかはそれほど問題ではありません。

- パターンsubtype ?S ?Uはパターンが適用されるべきゴールの種類を記述します。 クエスチョンマークは、ヒント記述の残りの部分で変数?Sと?Uが何らかの値に束縛されることを示します。

- 構文match goal with ... endによって、 ゴールまたは証明コンテキストまたはその両方におけるパターンを認識しようとします。

- 最初のパターンはH: subtype S ?T |- _です。 これは、コンテキストが型subtype S ?Tである仮定Hを持たなければならないことを示します。ただしSはゴールのものと同一でなければならず、?Tは任意の値で構いません。

- H: subtype S ?T |- _の最後の記号|- _は、 証明課題がどのような形でなければならないかについて、これ以上の条件をつけないことを示します。

- それに続く枝=> apply (@subtype_trans S T U)は、 ゴールがsubtype S Uという形で、subtype S Tという形の仮定があるとき、推移性補題を引数S、T、Uを具体化して適用してみるべきであることを示します。(なお、subtype_transの前の記号@が実際に必要なのは、暗黙の引数(“Implicit Arguments”)機能がアクティブであるときだけです。)

- 別の枝は、H: subtype ?T Uという形の仮定に対応しますが、上記と対称です。

注意: 任意の別の推移的関係について同じ external hint を再利用することができます。その場合、subtypeをその関係の名前に置き換えるだけです。

このヒントがどのようにはたらくか例を見てみましょう。

Lemma transitivity_workaround_1 : forall T1 T2 T3 T4,
subtype T1 T2 -> subtype T2 T3 -> subtype T3 T4 -> subtype T1 T4.
Proof.
intros.  eauto.
Qed.

新しい external hint が複雑さの爆発を起こさないことをチェックすることもできるでしょう。

Lemma transitivity_workaround_2 : forall S T,
subtype S T.
Proof.
intros.  eauto.
Admitted.

決定手続き

決定手続きは主張が特定の形である証明課題を解くことができます。この節では、3つの有用な決定手続きについて説明します。タクティックomegaは算術と不等式を含むゴールを扱うことができますが、一般の積算は扱えません。タクティックringは積算を含む算術が扱えますが、不等式は対象としません。タクティックcongruenceは証明コンテキストから得られる等式を使って、等式および不等式を証明することができます。

Omega

タクティックomegaは自然数(型nat)と整数(型Z、これはZArithモジュールをincludeすることで利用可)を対象とします。加算、減算、等式、不等式を対象とします。omegaを使う前にモジュールOmegaを import する必要があります。次の通りです。

Require Import Omega.

例を示します:xとyを2つの自然数(負にはならない)とする。yは4以下と仮定し、x+x+1はy以下と仮定し、そしてxはゼロではないと仮定する。すると、xは1でなければならない。

Lemma omega_demo_1 : forall (x y : nat),
(y <= 4) -> (x + x + 1 <= y) -> (x <> 0) -> (x = 1).
Proof. intros. omega. Qed.

別の例: もしzがxとyの間で、xとyの差が高々4である場合、xとzの間は高々2である。

Lemma omega_demo_2 : forall (x y z : nat),
(x + y = z + z) -> (x - y <= 4) -> (x - z <= 2).
Proof. intros. omega. Qed.

コンテキストの数学的事実が矛盾している場合、omegaを使ってFalseを証明することができます。次の例では、xとyの制約をすべて同時に満たすことはできません。

Lemma omega_demo_3 : forall (x y : nat),
(x + 5 <= y) -> (y - x < 3) -> False.
Proof. intros. omega. Qed.

注意:omegaが矛盾によってゴールを証明できるのは、ゴールの結論部がFalseに簡約されるときだけです。Falseから(ex_falso_quodlibetによって)任意の命題Pが導出されますが、タクティックomegaは、ゴールの結論部が任意の命題Pであるときは常に失敗します。

Lemma omega_demo_4 : forall (x y : nat) (P : Prop),
(x + 5 <= y) -> (y - x < 3) -> P.
Proof.
intros.

false. omega.
Qed.

Ring(環)

omegaと比較して、タクティックringは積算を対象としていますが、不等式についての推論は放棄しています。さらに、対象とするのは整数(型Z)だけで、自然数(型nat)は対象外です。以下はringの使い方の例です。

Module RingDemo.
Require Import ZArith.
Open Scope Z_scope.

Lemma ring_demo : forall (x y z : Z),
x * (y + z) - z * 3 * x
= x * y - 2 * x * z.
Proof. intros. ring. Qed.

End RingDemo.

Congruence(合同)

タクティックcongruenceは、証明コンテキストの等式を使って、ゴールに至るための書き換えを自動実行することができます。タクティックsubstが扱える等式は変数xと式eについてx = eという形のものだけですが、congruenceはsubstより若干強力です。

Lemma congruence_demo_1 :
forall (f : nat->nat->nat) (g h : nat->nat) (x y z : nat),
f (g x) (g y) = z ->
2 = g x ->
g y = h z ->
f 2 (h z) = z.
Proof. intros. congruence. Qed.

さらにcongruenceは、例えばforall a, g a = h aのように全称限量された等式を扱えます。

Lemma congruence_demo_2 :
forall (f : nat->nat->nat) (g h : nat->nat) (x y z : nat),
(forall a, g a = h a) ->
f (g x) (g y) = z ->
g x = 2 ->
f 2 (h y) = z.
Proof. congruence. Qed.

次はcongruenceがとても有効な例です。

Lemma congruence_demo_4 : forall (f g : nat->nat),
(forall a, f a = g a) ->
f (g (g 2)) = g (f (f 2)).
Proof. congruence. Qed.

タクティックcongruenceは、証明コンテキストで等しくない関係にある両辺についての等式をゴールが前提とするとき、矛盾を証明できます。

Lemma congruence_demo_3 :
forall (f g h : nat->nat) (x : nat),
(forall a, f a = h a) ->
g x = f x ->
g x <> h x ->
False.
Proof. congruence. Qed.

congruenceの強みの1つはとても速いタクティックだということです。このため、役立つかもしれないときはいつでも、試すことをためらう必要はありません。

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

LibTactics_J: 使いやすい汎用タクティックのコレクション

このファイルは、Coqの標準ディストリビューションで提供されるビルトインタクティックを拡張するタクティックのセットを含んでいます。タクティックの標準セットのいくつもの限界を克服し、それによってユーザがより短かくより頑強な証明を書けるようにすることを意図したものです。

おそらく、Coqのタクティックは時が経つにつれて改良されて行き、このファイルは究極的には不要になるでしょう。それまでの間は、本格的なCoqユーザはおそらくとても便利だと感じるでしょう。

このファイルはそれらのタクティックの実装と詳細なドキュメンテーションを含んでいます。SFの読者はこのファイルを読む必要はありません。その代わり、UseTactics_J.vという名前の章を読むと良いでしょう。その章はLibTacticライブラリの最も便利なタクティックの紹介となっています。

提供するメインの機能は:

- 仮定の名前付けのためのより便利な構文と、それに関する導入(introduction) と反転(inversion)のタクティック。それらのタクティックは、すべての変数の名前は必要とせず、型Propの仮定の名前だけを入力とします。

- N-引数の連言、選言、存在限量の扱いをサポートするタクティック。 背後にある実装が二項述語をベースにしていることを隠蔽します。

- 自動化の便利なサポート。タクティックの後に”~”または”*”を付けると、 生成されたサブゴールについて自動処理を行います。記号”~”はautoを、”*“はintuition eautoを行います。これらはカスタマイズできます。

- 補題を、変数、仮定、あるいはその両方を使って具体化するための、 前方連鎖のタクティックが提供されます。

- applyのより強力な実装が提供されます(refineをベースにしているので、 変換(conversion)に関してより良い振る舞いをします)。

- 従来の反転(inversion)のメカニズムで生成される変数の等式を置換する、 改良版の反転タクティック。さらに、依存型の等式の除去もサポートします(これは Proof Irrelevance の弱い形である公理Kを必要とします)。

- 証明記述の時間を節約するためのタクティック。 それには、仮定やサブゴールを主張するタクティックや、仮定を除去したり、仮定の名前や順番を変えたりするタクティックの改良版があります。

追加のクレジット:

- タクティックforwardのアイデアの提供に関して、Xavier Leroy に感謝します

- rapplyの実装のトリックに関して、Georges Gonthier に感謝します

Set Implicit Arguments.

Coqのための追加の記法

N変数の存在限量

exists T1 ... TN, Pはexists T1, ..., exists TN, Pの略記法です。なお、Coq.Program.Syntaxは既に4つまでの変数の存在限量を定義しています。

Notation "'exists' x1 ',' P" :=
(exists x1, P)
(at level 200, x1 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 ',' P" :=
(exists x1, exists x2, P)
(at level 200, x1 ident, x2 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 ',' P" :=
(exists x1, exists x2, exists x3, P)
(at level 200, x1 ident, x2 ident, x3 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 x5 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, exists x5, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 x5 x6 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, exists x5, exists x6, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident,
x6 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 x5 x6 x7 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, exists x5, exists x6,
exists x7, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident,
x6 ident, x7 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 x5 x6 x7 x8 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, exists x5, exists x6,
exists x7, exists x8, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident,
x6 ident, x7 ident, x8 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 x5 x6 x7 x8 x9 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, exists x5, exists x6,
exists x7, exists x8, exists x9, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident,
x6 ident, x7 ident, x8 ident, x9 ident,
right associativity) : type_scope.
Notation "'exists' x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ',' P" :=
(exists x1, exists x2, exists x3, exists x4, exists x5, exists x6,
exists x7, exists x8, exists x9, exists x10, P)
(at level 200, x1 ident, x2 ident, x3 ident, x4 ident, x5 ident,
x6 ident, x7 ident, x8 ident, x9 ident, x10 ident,
right associativity) : type_scope.

Ltacによるプログラミングのための道具類

等価継続

Ltac idcont tt :=
idtac.

タクティックの型付けされない引数

任意のCoqの値は型Boxerに収めることができます。これは、タクティックを実装するためのCoqの計算に便利です。

Inductive Boxer : Type :=
| boxer : forall (A:Type), A -> Boxer.

タクティックのオプショナルな引数

ltac_no_argは、タクティックの定義の中で、オプショナルな引数をシミュレートするのに使うことができる定数です。タクティックの呼び出しにはmytactic ltac_no_argとします。また、引数が与えられたかどうかをテストするためにはmatch arg with ltac_no_arg => ..またはmatch type of arg with ltac_No_arg  => ..とします。

Inductive ltac_No_arg : Set :=
| ltac_no_arg : ltac_No_arg.

タクティックのワイルドカード引数

ltac_wildは、タクティックの定義の中で、ワイルドカード引数をシミュレートするのに使うことができる定数です。記法は__です。

Inductive ltac_Wild : Set :=
| ltac_wild : ltac_Wild.

Notation "'__'" := ltac_wild : ltac_scope.

ltac_wildsは、典型的にはN個のワイルドカードの列をシミュレートするのに使う定数です。ここでNはコンテキストに依存して適切に選ばれます。記法は___です。

Inductive ltac_Wilds : Set :=
| ltac_wilds : ltac_Wilds.

Notation "'___'" := ltac_wilds : ltac_scope.

Open Scope ltac_scope.

ポジションマーカ

ltac_Markとltac_markは、コンテキストまたはゴールにおいて、特定のポジションにマークをつけるために、タクティックが使う標識のダミーの定義です。

Inductive ltac_Mark : Type :=
| ltac_mark : ltac_Mark.

gen_until_markはコンテキストの一番下の仮定から型Markの仮定に逹するまでgeneralizeを繰り返します。コンテキストにMarkが現れないときは失敗します。

Ltac gen_until_mark :=
match goal with H: ?T |- _ =>
match T with
| ltac_Mark => clear H
| _ => generalize H; clear H; gen_until_mark
end end.

intro_until_markは型Markの仮定に逹するまでintroを繰り返します。そしてその仮定Markを廃棄します。ゴールの仮定にMarkが現れないときには失敗します。

Ltac intro_until_mark :=
match goal with
| |- (ltac_Mark -> _) => intros _
| _ => intro; intro_until_mark
end.

タクティックの引数のリスト

型list Boxerの datatype は ltac でCoqの値のリストを扱うために使われます。記法は>> v1 v2 ... vNで値v1からvNまでを含むリストを作ります。

Require Import List.

Notation "'>>'" :=
(@nil Boxer)
(at level 0)
: ltac_scope.
Notation "'>>' v1" :=
((boxer v1)::nil)
(at level 0, v1 at level 0)
: ltac_scope.
Notation "'>>' v1 v2" :=
((boxer v1)::(boxer v2)::nil)
(at level 0, v1 at level 0, v2 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3" :=
((boxer v1)::(boxer v2)::(boxer v3)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)
::(boxer v11)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)
::(boxer v11)::(boxer v12)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0,
v12 at level 0)
: ltac_scope.
Notation "'>>' v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13" :=
((boxer v1)::(boxer v2)::(boxer v3)::(boxer v4)::(boxer v5)
::(boxer v6)::(boxer v7)::(boxer v8)::(boxer v9)::(boxer v10)
::(boxer v11)::(boxer v12)::(boxer v13)::nil)
(at level 0, v1 at level 0, v2 at level 0, v3 at level 0,
v4 at level 0, v5 at level 0, v6 at level 0, v7 at level 0,
v8 at level 0, v9 at level 0, v10 at level 0, v11 at level 0,
v12 at level 0, v13 at level 0)
: ltac_scope.

タクティックlist_boxer_ofは項Eを入力し、次の規則に従って型 “list boxer”の項を返します:

- もしEが既に型”list Boxer”ならばEを返す;

- そうでなければリスト(boxer E)::nilを返す。

Ltac list_boxer_of E := match type of E with | List.list Boxer => constr:(E) | _ => constr:((boxer E)::nil) end.

補題のデータベース

項を項へマップするデータベースを実装するために、ヒント機構を使います。新しいデータベースを宣言するには定義Definition mydatabase := True.を使います。

そして、mykeyをmyvalueにマップするには、次のヒントを記述します:Hint Extern 1 (Register mydatabase mykey) => Provide myvalue.

最後に、キーに関連付けられた値を問合わせるには、タクティックltac_database_get mydatabase mykeyを走らせます。そうするとゴールの先頭に項myvalueが置かれます。するとintroによって指名し利用できます。

Definition ltac_database (D:Boxer) (T:Boxer) (A:Boxer) := True.

Notation "'Register' D T" := (ltac_database (boxer D) (boxer T) _)
(at level 69, D at level 0, T at level 0).

Lemma ltac_database_provide : forall (A:Boxer) (D:Boxer) (T:Boxer),
ltac_database D T A.
Proof. split. Qed.

Ltac Provide T := apply (@ltac_database_provide (boxer T)).

Ltac ltac_database_get D T :=
let A := fresh "TEMP" in evar (A:Boxer);
let H := fresh "TEMP" in
assert (H : ltac_database (boxer D) (boxer T) A);
[ subst A; auto
| subst A; match type of H with ltac_database _ _ (boxer ?L) =>
generalize L end; clear H ].

その場での仮定の除去

lets、applys、forwards、specializesなどのタクティックに渡される引数のリスト>> H1 H2 .. HNにおいて、恒等関数である項rmを消去すべき仮定の名前の前に置くことができます。

Definition rm (A:Type) (X:A) := X.

rm_term EはEと同じ型と認められる仮定を除去します。

Ltac rm_term E :=
let T := type of E in
match goal with H: T |- _ => try clear H end.

rm_inside Eはrm Eiという形のEの任意の部分項に対してrm_term Eiを呼びます。

Ltac rm_inside E :=
let go E := rm_inside E in
match E with
| rm ?X => rm_term X
| ?X1 ?X2 =>
go X1; go X2
| ?X1 ?X2 ?X3 =>
go X1; go X2; go X3
| ?X1 ?X2 ?X3 ?X4 =>
go X1; go X2; go X3; go X4
| ?X1 ?X2 ?X3 ?X4 ?X5 =>
go X1; go X2; go X3; go X4; go X5
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 =>
go X1; go X2; go X3; go X4; go X5; go X6
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8; go X9
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 ?X10 =>
go X1; go X2; go X3; go X4; go X5; go X6; go X7; go X8; go X9; go X10
| _ => idtac
end.

パフォーマンスを上げるためにrm_insideを非アクティブ化するには、次の定義の本体をidtacに置換してください。

Ltac fast_rm_inside E :=
rm_inside E.

引数としての数値

タクティックが自然数を引数としてとるとき、自然数として構文解析される可能性と相対値として構文解析される可能性があります。タクティックが引数を自然数に変換するために、変換タクティックを提供します。

Require Coq.NArith.BinPos Coq.ZArith.BinInt.

Definition ltac_nat_from_int (x:BinInt.Z) : nat :=
match x with
| BinInt.Z0 => 0%nat
| BinInt.Zpos p => BinPos.nat_of_P p
| BinInt.Zneg p => 0%nat
end.

Ltac nat_from_number N :=
match type of N with
| nat => constr:(N)
| BinInt.Z => let N' := constr:(ltac_nat_from_int N) in eval compute in N'
end.

ltac_pattern E at Kはpattern E at Kと同様ですが、Kが Ltac の整数ではなく Coq の自然数である点が違います。構文ltac_pattern E as K in Hも可能です。

Tactic Notation "ltac_pattern" constr(E) "at" constr(K) :=
match nat_from_number K with
| 1 => pattern E at 1
| 2 => pattern E at 2
| 3 => pattern E at 3
| 4 => pattern E at 4
| 5 => pattern E at 5
| 6 => pattern E at 6
| 7 => pattern E at 7
| 8 => pattern E at 8
end.

Tactic Notation "ltac_pattern" constr(E) "at" constr(K) "in" hyp(H) :=
match nat_from_number K with
| 1 => pattern E at 1 in H
| 2 => pattern E at 2 in H
| 3 => pattern E at 3 in H
| 4 => pattern E at 4 in H
| 5 => pattern E at 5 in H
| 6 => pattern E at 6 in H
| 7 => pattern E at 7 in H
| 8 => pattern E at 8 in H
end.

タクティックをテストする

show tacはタクティックtacを実行し、その結果を表示します。

Tactic Notation "show" tactic(tac) :=
let R := tac in pose R.

dup Nは現在のゴールのN個のコピーを作ります。これは、タクティックのふるまいを示す例を作るのに便利です。dupはdup 2の略記法です。

Lemma dup_lemma : forall P, P -> P -> P.
Proof. auto. Qed.

Ltac dup_tactic N :=
match nat_from_number N with
| 0 => idtac
| S 0 => idtac
| S ?N' => apply dup_lemma; [ | dup_tactic N' ]
end.

Tactic Notation "dup" constr(N) :=
dup_tactic N.
Tactic Notation "dup" :=
dup 2.

ゴールにやり残しがないことのチェック

Ltac check_noevar M :=
match M with M => idtac end.

Ltac check_noevar_hyp H :=
let T := type of H in
match type of H with T => idtac end.

Ltac check_noevar_goal :=
match goal with |- ?G => match G with G => idtac end end.

仮定のタグ付け

get_last_hyp ttはコンテキストの一番下の最後の仮定を返す関数です。仮定に付けられたデフォルトの名前を得るのに便利です。例えば:intro; let H := get_last_hyp tt in let H' := fresh "P" H in ...

Ltac get_last_hyp tt :=
match goal with H: _ |- _ => constr:(H) end.

仮定のタグ付け

ltac_tag_substは置換対象の等式である仮定にタグ付けするのに使われる特別なマーカです。

Definition ltac_tag_subst (A:Type) (x:A) := x.

ltac_to_generalizeは一般化する仮定のための特別なマーカです。

Definition ltac_to_generalize (A:Type) (x:A) := x.

Ltac gen_to_generalize :=
repeat match goal with
H: ltac_to_generalize _ |- _ => generalize H; clear H end.

Ltac mark_to_generalize H :=
let T := type of H in
change T with (ltac_to_generalize T) in H.

項を解体する

get_head Eは項Eの冒頭の定数を返すタクティックです。つまり、P x1 ... xNという形の項に適用されるとPを返します。Eが適用の形ではないときには、Eを返します。注意: このタクティックは、ゴールが積で、この関数の結果を使う処理がある場合にループすることがあります。(訳注: このファイル中での積(product)は、他のファイルとは異なり(？)Coq のマニュアルの product のことです。含意または全称限量のことを指します。Logic_J.vの冒頭で、->とforallが同じだと言っていますが、これらのことです。)

Ltac get_head E :=
match E with
| ?P _ _ _ _ _ _ _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ _ => constr:(P)
| ?P _ _ _ _ => constr:(P)
| ?P _ _ _ => constr:(P)
| ?P _ _ => constr:(P)
| ?P _ => constr:(P)
| ?P => constr:(P)
end.

get_fun_arg Eは適用項Eの分解をするタクティックです。つまり、X1 ... XNという形の項に適用されるとX1 .. X(N-1)とXNの対を返します。

Ltac get_fun_arg E :=
match E with
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X => constr:((X1 X2 X3 X4 X5 X6,X))
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X => constr:((X1 X2 X3 X4 X5,X))
| ?X1 ?X2 ?X3 ?X4 ?X5 ?X => constr:((X1 X2 X3 X4,X))
| ?X1 ?X2 ?X3 ?X4 ?X => constr:((X1 X2 X3,X))
| ?X1 ?X2 ?X3 ?X => constr:((X1 X2,X))
| ?X1 ?X2 ?X => constr:((X1,X))
| ?X1 ?X => constr:((X1,X))
end.

出現場所でのアクションと出現場所以外でのアクション

ltac_action_at K of E do TacはゴールにおけるEのK番目の出現を区別し、それを指定されたパターンPによってP Eの形にセットしてタクティックTacを呼び、最後にPを unfold します。構文ltac_action_at K of E in H do Tacも可能です。

Tactic Notation "ltac_action_at" constr(K) "of" constr(E) "do" tactic(Tac) :=
let p := fresh in ltac_pattern E at K;
match goal with |- ?P _ => set (p:=P) end;
Tac; unfold p; clear p.

Tactic Notation "ltac_action_at" constr(K) "of" constr(E) "in" hyp(H) "do" tactic(Tac) :=
let p := fresh in ltac_pattern E at K in H;
match type of H with ?P _ => set (p:=P) in H end;
Tac; unfold p in H; clear p.

protects E do Tacは式Eに一時的に名前を与えることで、タクティックTacの実行がEを変更しないようにします。これは例えばsimplのアクションを制限するのに便利です。

Tactic Notation "protects" constr(E) "do" tactic(Tac) :=

let x := fresh "TEMP" in let H := fresh "TEMP" in
set (X := E) in *; assert (H : X = E) by reflexivity;
clearbody X; Tac; subst x.

Tactic Notation "protects" constr(E) "do" tactic(Tac) "/" :=
protects E do Tac.

eqの別名

eq'は帰納的定義の等式で使うためのeqの別名で、これにより、inversionによって生成される等式と混ざるのを防ぐことができます。

Definition eq' := @eq.

Hint Unfold eq'.

Notation "x '='' y" := (@eq' _ x y)
(at level 70, arguments at next level).

後方/前方連鎖

適用(Application)

rapplyはeapplyと同様のタクティックですが、refineタクティックに基づいている点が違います。そしてこのために、(少なくとも理論的には ：)より強力です。簡単に言うと、引数がマッチするために必要となる変換をその場で行うことができます。また必要なときに存在変数を具体化できます。

Tactic Notation "rapply" constr(t) :=
first
[ eexact (@t)
| refine (@t)
| refine (@t _)
| refine (@t _ _)
| refine (@t _ _ _)
| refine (@t _ _ _ _)
| refine (@t _ _ _ _ _)
| refine (@t _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _ _ _ _ _ _)
| refine (@t _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
].

自然数Nについて、タクティックapplys_N Tはapplys Tをより効果的に使う方法を提供します。関数Tの引数の数(アリティ、arity)を明示的に指定することで、すべての可能なアリティを試してみることを避けます。

Tactic Notation "rapply_0" constr(t) :=
refine (@t).
Tactic Notation "rapply_1" constr(t) :=
refine (@t _).
Tactic Notation "rapply_2" constr(t) :=
refine (@t _ _).
Tactic Notation "rapply_3" constr(t) :=
refine (@t _ _ _).
Tactic Notation "rapply_4" constr(t) :=
refine (@t _ _ _ _).
Tactic Notation "rapply_5" constr(t) :=
refine (@t _ _ _ _ _).
Tactic Notation "rapply_6" constr(t) :=
refine (@t _ _ _ _ _ _).
Tactic Notation "rapply_7" constr(t) :=
refine (@t _ _ _ _ _ _ _).
Tactic Notation "rapply_8" constr(t) :=
refine (@t _ _ _ _ _ _ _ _).
Tactic Notation "rapply_9" constr(t) :=
refine (@t _ _ _ _ _ _ _ _ _).
Tactic Notation "rapply_10" constr(t) :=
refine (@t _ _ _ _ _ _ _ _ _ _).

lets_base H Eは仮定H : Tをコンテキストに追加します。ここでTは項Eの型です。もしHが導入パターンなら、パターンに従ってHを分解します。

Ltac lets_base I E := generalize E; intros I.

applys_to H Eは、仮定Hを、項EをHに適用した結果で置換することで、仮定の型を変換します。直観的には、lets H: (E H)と同値です。

Tactic Notation "applys_to" hyp(H) constr(E) :=
let H' := fresh in rename H into H';
(first [ lets_base H (E H')
| lets_base H (E _ H')
| lets_base H (E _ _ H')
| lets_base H (E _ _ _ H')
| lets_base H (E _ _ _ _ H')
| lets_base H (E _ _ _ _ _ H')
| lets_base H (E _ _ _ _ _ _ H')
| lets_base H (E _ _ _ _ _ _ _ H')
| lets_base H (E _ _ _ _ _ _ _ _ H')
| lets_base H (E _ _ _ _ _ _ _ _ _ H') ]
); clear H'.

constructorsはconstructorまたはeconstructorを呼びます。

Tactic Notation "constructors" :=
first [ constructor | econstructor ]; unfold eq'.

表明(Assertions)

false_goalは任意のゴールをFalseで置換します。タクティックfalse(後述)と対照的に、特に何もしようとしません。

Tactic Notation "false_goal" :=
elimtype False.

false_postはFalseの形のゴールを証明するときに背後で使われるタクティックです。デフォルトの実装ではコンテキストがFalseか、またはC x1 .. xN  =  D y1 .. yMという形の仮定を含む場合、あるいはcongruenceタクティックがあるxについてx <> xの証明を見つけた場合にゴールを証明します。

Ltac false_post :=
solve [ assumption | discriminate | congruence ].

falseは任意のゴールをFalseに置換し、false_postを呼びます。

Tactic Notation "false" :=
false_goal; try false_post.

tryfalseは矛盾によってゴールを解こうとします。そして解けなかった場合にはゴールを変更しないまま残します。これはtry solve \[ false \] と同値です。

Tactic Notation "tryfalse" :=
try solve [ false ].

tryfalse by tac /はtryfalseと同様ですが、assumptionとdiscriminateが適用できないとき、タクティックtacを使ってゴールを解こうとする点が違います。これはtry solve \[ false; tac \] と同値です。例:tryfalse by congruence/

Tactic Notation "tryfalse" "by" tactic(tac) "/" :=
try solve [ false; instantiate; tac ].

false Tはfalse; apply Tを試みます。それが失敗した場合、Tを仮定に加えfalseを呼びます。

Tactic Notation "false" constr(T) "by" tactic(tac) "/" :=
false_goal; first
[ first [ apply T | eapply T | rapply T]; instantiate; tac
| let H := fresh in lets_base H T;
first [ discriminate H
| false; instantiate; tac ] ].

Tactic Notation "false" constr(T) :=
false T by idtac/.

false_invertは、コンテキストに少なくとも1つの仮定Hがあって、inversion HによってHが不合理(absurd)であることが証明されるとき、任意のゴールを証明します。

Ltac false_invert_tactic :=
match goal with H:_ |- _ =>
solve [ inversion H
| clear H; false_invert_tactic
| fail 2 ] end.

Tactic Notation "false_invert" :=
false_invert_tactic.

tryfalse_invertはfalseとfalse_invertを使ってゴールを解こうとします。そして失敗するときは、ゴールを変えずに残します。

Tactic Notation "tryfalse_invert" :=
try solve [ false | false_invert ].

asserts H: Tはassert (H : T)の別構文です。これは同様に導出パターンについてはたらきます。例えば、次のように書くことができます:asserts \[x P\(exists n, n = 3)]、あるいはasserts \[H|H\(n = 0 / n = 1)]。

Tactic Notation "asserts" simple_intropattern(I) ":" constr(T) :=
let H := fresh in assert (H : T);
[ | generalize H; clear H; intros I ].

asserts H1 .. HN: Tはasserts \[H1 \[H2 \[.. HN\]]: T] の略記法です。

Tactic Notation "asserts" simple_intropattern(I1)
simple_intropattern(I2) ":" constr(T) :=
asserts [I1 I2]: T.
Tactic Notation "asserts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) :=
asserts [I1 [I2 I3]]: T.
Tactic Notation "asserts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) ":" constr(T) :=
asserts [I1 [I2 [I3 I4]]]: T.
Tactic Notation "asserts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) :=
asserts [I1 [I2 [I3 [I4 I5]]]]: T.
Tactic Notation "asserts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) simple_intropattern(I5)
simple_intropattern(I6) ":" constr(T) :=
asserts [I1 [I2 [I3 [I4 [I5 I6]]]]]: T.

asserts: Tは自動的に選択されたHについてasserts H: Tをします。

Tactic Notation "asserts" ":" constr(T) :=
let H := fresh in asserts H : T.

cuts H: Tはasserts H: Tと同様ですが、生成される2つのサブゴールの順番が逆になる点が違います。サブゴールTが二番目に来ます。なお、cutと対照的に仮定を導入します。

Tactic Notation "cuts" simple_intropattern(I) ":" constr(T) :=
cut (T); [ intros I | idtac ].

cuts: Tは自動的に選択されたHについてcuts H: Tをします。

Tactic Notation "cuts" ":" constr(T) :=
let H := fresh in cuts H: T.

cuts H1 .. HN: Tはcuts \[H1 \[H2 \[.. HN\]]: T] の略記法です。

Tactic Notation "cuts" simple_intropattern(I1)
simple_intropattern(I2) ":" constr(T) :=
cuts [I1 I2]: T.
Tactic Notation "cuts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) :=
cuts [I1 [I2 I3]]: T.
Tactic Notation "cuts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) ":" constr(T) :=
cuts [I1 [I2 [I3 I4]]]: T.
Tactic Notation "cuts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) :=
cuts [I1 [I2 [I3 [I4 I5]]]]: T.
Tactic Notation "cuts" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) simple_intropattern(I5)
simple_intropattern(I6) ":" constr(T) :=
cuts [I1 [I2 [I3 [I4 [I5 I6]]]]]: T.

具体化と前方連鎖

具体化タクティックは補題E(その型は積)をある引数について具体化するために使います。Eの型は含意と全称限量から成ります。例えばforall x, P x -> forall y z, Q x y z -> R zです。

最初の可能性は引数を順番に与えることです。最初にx、次にP xの証明、次にy...このやり方をとることは”Args”モードと呼ばれますが、すべての引数を与えることが必要です。もしワイルドカード(__と書かれる)が与えられると、引数の場所に存在変数が導入されます。

しばしば、依存する変数(この場合x,y,z)だけを与え、生成される仮定をサブゴールとすることで、多くの時間を節約できます。この”Vars”モードでは、変数だけが与えなければならないものです。例えば、補題Eが3と4に適用されたとき、結果は型forall z, Q 3 4 z -> R zの項となり、P 3が新しいサブゴールになります。ワイルドカードを使って存在変数を導入することもできます。

しかしながら、仮定のいくつかが既に存在していることがあり、そのときには、その仮定を使って補題Eを具体化することで時間を節約することができます。例えば、Fが型P 2の項とします。この”Hyps”モードでEをFに適用すると結果は型forall y z, Q 2 y z -> R zの項になります。ワイルドカードの使用はこのモードでは表明を生成します。例えばGが型Q 2 3 4を持つならば、mode-h でEをワイルドカードへ適用し、それをGへ適用した結果は型R 4の項となり、P 2は新しいサブゴールとなります。

補題の具体化するべき引数を与え、アンダースコアが入るべき場所をタクティックに自動的に発見させることはとても便利です。アンダースコア引数__は次のように解釈されます:アンダースコアは引数をスキップしたいことを意味します。ただしその引数の型は次に与えられる実際の引数(ここで「実際の」とはアンダースコアでないこと)と同じになります。アンダースコアの後で実際の引数が与えられない場合、アンダースコアは最初の可能な引数に使われます。

一般構文はtactic (>> E1 .. EN)です。ここでtacticはタクティック(いくつかの引数を伴うこともある)の名前で、Eiは引数です。さらに、いくつかのタクティックは、5以下のNについてtactic (>>Hnts E1 .. EN)の略記法として構文tactic E1 .. ENを使うことができます。

最後に、与えられた引数ENが三連アンダースコア___のときは、適切な数のワイルドカードのリストを与えるのと同値です。これは、補題の残りのすべての引数が具体化されることを意味します。

Ltac app_assert t P cont :=
let H := fresh "TEMP" in
assert (H : P); [ | cont(t H); clear H ].

Ltac app_evar t A cont :=
let x := fresh "TEMP" in
evar (x:A);
let t' := constr:(t x) in
let t'' := (eval unfold x in t') in
subst x; cont t''.

Ltac app_arg t P v cont :=
let H := fresh "TEMP" in
assert (H : P); [ apply v | cont(t H); try clear H ].

Ltac build_app_alls t final :=
let rec go t :=
match type of t with
| ?P -> ?Q => app_assert t P go
| forall _:?A, _ => app_evar t A go
| _ => final t
end in
go t.

Ltac boxerlist_next_type vs :=
match vs with
| nil => constr:(ltac_wild)
| (boxer ltac_wild)::?vs' => boxerlist_next_type vs'
| (boxer ltac_wilds)::_ => constr:(ltac_wild)
| (@boxer ?T _)::_ => constr:(T)
end.

Ltac build_app_hnts t vs final :=
let rec go t vs :=
match vs with
| nil => first [ final t | fail 1 ]
| (boxer ltac_wilds)::_ => first [ build_app_alls t final | fail 1 ]
| (boxer ?v)::?vs' =>
let cont t' := go t' vs in
let cont' t' := go t' vs' in
let T := type of t in
let T := eval hnf in T in
match v with
| ltac_wild =>
first [ let U := boxerlist_next_type vs' in
match U with
| ltac_wild =>
match T with
| ?P -> ?Q => first [ app_assert t P cont' | fail 3 ]
| forall _:?A, _ => first [ app_evar t A cont' | fail 3 ]
end
| _ =>
match T with
| U -> ?Q => first [ app_assert t U cont' | fail 3 ]
| forall _:U, _ => first [ app_evar t U cont' | fail 3 ]
| ?P -> ?Q => first [ app_assert t P cont | fail 3 ]
| forall _:?A, _ => first [ app_evar t A cont | fail 3 ]
end
end
| fail 2 ]
| _ =>
match T with
| ?P -> ?Q => first [ app_arg t P v cont'
| app_assert t P cont
| fail 3 ]
| forall _:?A, _ => first [ cont' (t v)
| app_evar t A cont
| fail 3 ]
end
end
end in
go t vs.

Ltac build_app args final :=
first [
match args with (@boxer ?T ?t)::?vs =>
let t := constr:(t:T) in
build_app_hnts t vs final
end
| fail 1 "Instantiation fails for:" args].

Ltac unfold_head_until_product T :=
eval hnf in T.

Ltac args_unfold_head_if_not_product args :=
match args with (@boxer ?T ?t)::?vs =>
let T' := unfold_head_until_product T in
constr:((@boxer T' t)::vs)
end.

Ltac args_unfold_head_if_not_product_but_params args :=
match args with
| (boxer ?t)::(boxer ?v)::?vs =>
args_unfold_head_if_not_product args
| _ => constr:(args)
end.

lets H: (>> E0 E1 .. EN)は補題E0を各引数Ei(これはワイルドカード__のこともあります)について具体化し、結果の項に名前Hを付けます。Hは導出パターンか、導出パターンの列I1 I2 INか、空です。構文lets H: E0 E1 .. ENも可能です。もし最後の引数ENが___(三連アンダースコア)ならば、Hのすべての引数が具体化されます。

Ltac lets_build I Ei :=
let args := list_boxer_of Ei in
let args := args_unfold_head_if_not_product_but_params args in

build_app args ltac:(fun R => lets_base I R).

Tactic Notation "lets" simple_intropattern(I) ":" constr(E) :=
lets_build I E; fast_rm_inside E.
Tactic Notation "lets" ":" constr(E) :=
let H := fresh in lets H: E.
Tactic Notation "lets" ":" constr(E0)
constr(A1) :=
lets: (>> E0 A1).
Tactic Notation "lets" ":" constr(E0)
constr(A1) constr(A2) :=
lets: (>> E0 A1 A2).
Tactic Notation "lets" ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets: (>> E0 A1 A2 A3).
Tactic Notation "lets" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets: (>> E0 A1 A2 A3 A4).
Tactic Notation "lets" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets: (>> E0 A1 A2 A3 A4 A5).

Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2)
":" constr(E) :=
lets [I1 I2]: E.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) ":" constr(E) :=
lets [I1 [I2 I3]]: E.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) simple_intropattern(I4) ":" constr(E) :=
lets [I1 [I2 [I3 I4]]]: E.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5)
":" constr(E) :=
lets [I1 [I2 [I3 [I4 I5]]]]: E.

Tactic Notation "lets" simple_intropattern(I) ":" constr(E0)
constr(A1) :=
lets I: (>> E0 A1).
Tactic Notation "lets" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) :=
lets I: (>> E0 A1 A2).
Tactic Notation "lets" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets I: (>> E0 A1 A2 A3).
Tactic Notation "lets" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets I: (>> E0 A1 A2 A3 A4).
Tactic Notation "lets" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets I: (>> E0 A1 A2 A3 A4 A5).

Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0)
constr(A1) :=
lets [I1 I2]: E0 A1.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0)
constr(A1) constr(A2) :=
lets [I1 I2]: E0 A1 A2.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets [I1 I2]: E0 A1 A2 A3.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets [I1 I2]: E0 A1 A2 A3 A4.
Tactic Notation "lets" simple_intropattern(I1) simple_intropattern(I2) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets [I1 I2]: E0 A1 A2 A3 A4 A5.

forwards H: (>> E0 E1 .. EN)はforwards H: (>> E0 E1 .. EN ___)の略記法です。各引数Ei(E0を除く)はワイルドカード__でも構いません。Hは導入パターンか、導入パターンの列か、空です。構文forwards H: E0 E1 .. ENも可能です。

Ltac forwards_build_app_arg Ei :=
let args := list_boxer_of Ei in
let args := (eval simpl in (args ++ ((boxer ___)::nil))) in
let args := args_unfold_head_if_not_product args in
args.

Ltac forwards_then Ei cont :=
let args := forwards_build_app_arg Ei in
let args := args_unfold_head_if_not_product_but_params args in
build_app args cont.

Tactic Notation "forwards" simple_intropattern(I) ":" constr(Ei) :=
let args := forwards_build_app_arg Ei in
lets I: args.

Tactic Notation "forwards" ":" constr(E) :=
let H := fresh in forwards H: E.
Tactic Notation "forwards" ":" constr(E0)
constr(A1) :=
forwards: (>> E0 A1).
Tactic Notation "forwards" ":" constr(E0)
constr(A1) constr(A2) :=
forwards: (>> E0 A1 A2).
Tactic Notation "forwards" ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
forwards: (>> E0 A1 A2 A3).
Tactic Notation "forwards" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
forwards: (>> E0 A1 A2 A3 A4).
Tactic Notation "forwards" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
forwards: (>> E0 A1 A2 A3 A4 A5).

Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2)
":" constr(E) :=
forwards [I1 I2]: E.
Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) ":" constr(E) :=
forwards [I1 [I2 I3]]: E.
Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) simple_intropattern(I4) ":" constr(E) :=
forwards [I1 [I2 [I3 I4]]]: E.
Tactic Notation "forwards" simple_intropattern(I1) simple_intropattern(I2)
simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5)
":" constr(E) :=
forwards [I1 [I2 [I3 [I4 I5]]]]: E.

Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0)
constr(A1) :=
forwards I: (>> E0 A1).
Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) :=
forwards I: (>> E0 A1 A2).
Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
forwards I: (>> E0 A1 A2 A3).
Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
forwards I: (>> E0 A1 A2 A3 A4).
Tactic Notation "forwards" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
forwards I: (>> E0 A1 A2 A3 A4 A5).

Tactic Notation "forwards_nounfold" simple_intropattern(I) ":" constr(Ei) :=
let args := list_boxer_of Ei in
let args := (eval simpl in (args ++ ((boxer ___)::nil))) in
build_app args ltac:(fun R => lets_base I R);
fast_rm_inside Ei.

Ltac forwards_nounfold_then Ei cont :=
let args := list_boxer_of Ei in
let args := (eval simpl in (args ++ ((boxer ___)::nil))) in
build_app args cont;
fast_rm_inside Ei.

applys (>> E0 E1 .. EN)は補題E0を各引数Ei(ワイルドカード__でも良い)について具体化し、その結果を、前述のapplysを使って現在のゴールに適用します。applys E0 E1 E2 .. ENも可能です。

Ltac applys_build Ei :=
let args := list_boxer_of Ei in
let args := args_unfold_head_if_not_product_but_params args in
build_app args ltac:(fun R =>
first [ apply R | eapply R | rapply R ]).

Ltac applys_base E :=
match type of E with
| list Boxer => applys_build E
| _ => first [ rapply E | applys_build E ]
end; fast_rm_inside E.

Tactic Notation "applys" constr(E) :=
applys_base E.
Tactic Notation "applys" constr(E0) constr(A1) :=
applys (>> E0 A1).
Tactic Notation "applys" constr(E0) constr(A1) constr(A2) :=
applys (>> E0 A1 A2).
Tactic Notation "applys" constr(E0) constr(A1) constr(A2) constr(A3) :=
applys (>> E0 A1 A2 A3).
Tactic Notation "applys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) :=
applys (>> E0 A1 A2 A3 A4).
Tactic Notation "applys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
applys (>> E0 A1 A2 A3 A4 A5).

fapplys (>> E0 E1 .. EN)は補題E0を各引数Eiについて具体化します。引数が___のときは、すべての存在変数が明示的に具体化されます。そして結果の項を現在のゴールに適用します。fapplys E0 E1 E2 .. ENも可能です。

Ltac fapplys_build Ei :=
let args := list_boxer_of Ei in
let args := (eval simpl in (args ++ ((boxer ___)::nil))) in
let args := args_unfold_head_if_not_product_but_params args in
build_app args ltac:(fun R => apply R).

Tactic Notation "fapplys" constr(E0) :=
match type of E0 with
| list Boxer => fapplys_build E0
| _ => fapplys_build (>> E0)
end.
Tactic Notation "fapplys" constr(E0) constr(A1) :=
fapplys (>> E0 A1).
Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) :=
fapplys (>> E0 A1 A2).
Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) constr(A3) :=
fapplys (>> E0 A1 A2 A3).
Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) :=
fapplys (>> E0 A1 A2 A3 A4).
Tactic Notation "fapplys" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
fapplys (>> E0 A1 A2 A3 A4 A5).

specializes H (>> E1 E2 .. EN)は仮定Hを各引数Ei(ワイルドカード__も可)について具体化します。もし最後の引数ENが___(三連アンダースコア)ならば、Hのすべての引数が具体化されます。

Ltac specializes_build H Ei :=
let H' := fresh "TEMP" in rename H into H';
let args := list_boxer_of Ei in
let args := constr:((boxer H')::args) in
let args := args_unfold_head_if_not_product args in
build_app args ltac:(fun R => lets H: R);
clear H'.

Ltac specializes_base H Ei :=
specializes_build H Ei; fast_rm_inside Ei.

Tactic Notation "specializes" hyp(H) :=
specializes_base H (___).
Tactic Notation "specializes" hyp(H) constr(A) :=
specializes_base H A.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) :=
specializes H (>> A1 A2).
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) :=
specializes H (>> A1 A2 A3).
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) :=
specializes H (>> A1 A2 A3 A4).
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
specializes H (>> A1 A2 A3 A4 A5).

適用(application)の実験的タクティック

fapplyはapplyのforwardsにもとづくバージョンです。

Tactic Notation "fapply" constr(E) :=
let H := fresh in forwards H: E;
first [ apply H | eapply H | rapply H | hnf; apply H
| hnf; eapply H | applys H ].

sapplyは”super apply”の意味です。apply、eapply、applys、fapplyを試し、さらに最初にゴールの頭正規化(head-nomalize)をしようとします。

Tactic Notation "sapply" constr(H) :=
first [ apply H | eapply H | rapply H | applys H
| hnf; apply H | hnf; eapply H | hnf; applys H
| fapply H ].

仮定を追加する

lets_simpl H: Eはlets H: Eと同様ですが、仮定 H についてsimplを呼ぶ点が違います。

Tactic Notation "lets_simpl" ident(H) ":" constr(E) :=
lets H: E; simpl in H.

lets_hnf H: Eはlets H: Eと同様ですが、hnfを呼んで定義を頭正規形(head normal form)にする点が違います。

Tactic Notation "lets_hnf" ident(H) ":" constr(E) :=
lets H: E; hnf in H.

lets_simpl: Eはlets_simpl H: Eと同様ですが、名前Hは自動的に選ばれます。

Tactic Notation "lets_simpl" ":" constr(T) :=
let H := fresh in lets_simpl H: T.

lets_hnf: Eはlets_hnf H: Eと同様ですが、名前Hは自動的に選ばれます。

Tactic Notation "lets_hnf" ":" constr(T) :=
let H := fresh in lets_hnf H: T.

put X: Eはpose (X := E)と同義です。別にput: Eという構文もあります。

Tactic Notation "put" ident(X) ":" constr(E) :=
pose (X := E).
Tactic Notation "put" ":" constr(E) :=
let X := fresh "X" in pose (X := E).

トートロジーの適用

Eが事実とするとき、logic Eはassert H:E; [tauto | eapply H; clear H]と同値です。例えば連言(AND式)A /\ Bを証明するとき、最初にAを示し、次にA -> Bを示すのに、コマンドlogic (foral A B, A -> (A -> B) -> A /\ B)を使うのが便利です。

Ltac logic_base E cont :=
assert (H:E); [ cont tt | eapply H; clear H ].

Tactic Notation "logic" constr(E) :=
logic_base E ltac:(fun _ => tauto).

等式を法とした適用

タクティックequatesはP x y zの形のゴールをP x ?a zに置き換え、サブゴール?a = yを作ります。存在変数?aが導入されることで、もとのゴールに適用できなかった補題が適用できるようになることがあります。例えば、forall n m, P n n mという形の補題です。なぜなら、xとyは等しかったかもしれませんが、変換可能ではないからです。

使用法はequates i1 ... ikです。ここで各インデックスijは存在変数に置き換える引数の場所を、左端から数えたものです。もし0が引数に与えられたら、ゴール全体が存在変数に置き換えられます。

Section equatesLemma.
Variables
(A0 A1 : Type)
(A2 : forall (x1 : A1), Type)
(A3 : forall (x1 : A1) (x2 : A2 x1), Type)
(A4 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2), Type)
(A5 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3), Type)
(A6 : forall (x1 : A1) (x2 : A2 x1) (x3 : A3 x2) (x4 : A4 x3) (x5 : A5 x4), Type).

Lemma equates_0 : forall (P Q:Prop),
P -> P = Q -> Q.
Proof. intros. subst. auto. Qed.

Lemma equates_1 :
forall (P:A0->Prop) x1 y1,
P y1 -> x1 = y1 -> P x1.
Proof. intros. subst. auto. Qed.

Lemma equates_2 :
forall y1 (P:A0->forall(x1:A1),Prop) x1 x2,
P y1 x2 -> x1 = y1 -> P x1 x2.
Proof. intros. subst. auto. Qed.

Lemma equates_3 :
forall y1 (P:A0->forall(x1:A1)(x2:A2 x1),Prop) x1 x2 x3,
P y1 x2 x3 -> x1 = y1 -> P x1 x2 x3.
Proof. intros. subst. auto. Qed.

Lemma equates_4 :
forall y1 (P:A0->forall(x1:A1)(x2:A2 x1)(x3:A3 x2),Prop) x1 x2 x3 x4,
P y1 x2 x3 x4 -> x1 = y1 -> P x1 x2 x3 x4.
Proof. intros. subst. auto. Qed.

Lemma equates_5 :
forall y1 (P:A0->forall(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3),Prop) x1 x2 x3 x4 x5,
P y1 x2 x3 x4 x5 -> x1 = y1 -> P x1 x2 x3 x4 x5.
Proof. intros. subst. auto. Qed.

Lemma equates_6 :
forall y1 (P:A0->forall(x1:A1)(x2:A2 x1)(x3:A3 x2)(x4:A4 x3)(x5:A5 x4),Prop)
x1 x2 x3 x4 x5 x6,
P y1 x2 x3 x4 x5 x6 -> x1 = y1 -> P x1 x2 x3 x4 x5 x6.
Proof. intros. subst. auto. Qed.

End equatesLemma.

Ltac equates_lemma n :=
match nat_from_number n with
| 0 => constr:(equates_0)
| 1 => constr:(equates_1)
| 2 => constr:(equates_2)
| 3 => constr:(equates_3)
| 4 => constr:(equates_4)
| 5 => constr:(equates_5)
| 6 => constr:(equates_6)
end.

Ltac equates_one n :=
let L := equates_lemma n in
eapply L.

Ltac equates_several E cont :=
let all_pos := match type of E with
| List.list Boxer => constr:(E)
| _ => constr:((boxer E)::nil)
end in
let rec go pos :=
match pos with
| nil => cont tt
| (boxer ?n)::?pos' => equates_one n; [ instantiate; go pos' | ]
end in
go all_pos.

Tactic Notation "equates" constr(E) :=
equates_several E ltac:(fun _ => idtac).
Tactic Notation "equates" constr(n1) constr(n2) :=
equates (>> n1 n2).
Tactic Notation "equates" constr(n1) constr(n2) constr(n3) :=
equates (>> n1 n2 n3).
Tactic Notation "equates" constr(n1) constr(n2) constr(n3) constr(n4) :=
equates (>> n1 n2 n3 n4).

applys_eq H i1 .. iKはequates i1 .. iKの後最初のサブゴールに対してapply Hを行ったのと同じです。

Tactic Notation "applys_eq" constr(H) constr(E) :=
equates_several E ltac:(fun _ => sapply H).
Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) :=
applys_eq H (>> n1 n2).
Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) constr(n3) :=
applys_eq H (>> n1 n2 n3).
Tactic Notation "applys_eq" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) :=
applys_eq H (>> n1 n2 n3 n4).

導入と一般化

導入(Introduction)

introvは依存性のない(non-dependent)仮定のみを指名するのに使います。

- introvがforall x, Hという形のゴールに対して呼ばれると、 ゴールの頭部のforallに限量されたすべての変数が導入されます。しかし、P -> Qのような矢印コンストラクタの前の仮定は導入されません。

- introvがforall x, HでもP -> Qでもない形のゴールに対して呼ばれると、forall x, HまたはP -> Q.の形になるまで、定義を展開(unfold)します。展開してもゴールが上記の形にならなかったとき、タクティックintrovは何もしません。

Ltac introv_rec := match goal with | |- ?P -> ?Q => idtac | |- forall _, _ => intro; introv_rec | |- _ => idtac end.

Ltac introv_noarg := match goal with | |- ?P -> ?Q => idtac | |- forall _, _ => introv_rec | |- ?G => hnf; match goal with | |- ?P -> ?Q => idtac | |- forall _, _ => introv_rec end | |- _ => idtac end.

Ltac introv_noarg_not_optimized := intro; match goal with H:|- => revert H end; introv_rec.

Ltac introv_arg H := hnf; match goal with | |- ?P -> ?Q => intros H | |- forall _, _ => intro; introv_arg H end.

Tactic Notation “introv” := introv_noarg. Tactic Notation “introv” simple_intropattern(I1) := introv_arg I1. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) := introv I1; introv I2. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) := introv I1; introv I2 I3. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) := introv I1; introv I2 I3 I4. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) := introv I1; introv I2 I3 I4 I5. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) := introv I1; introv I2 I3 I4 I5 I6. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) := introv I1; introv I2 I3 I4 I5 I6 I7. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) := introv I1; introv I2 I3 I4 I5 I6 I7 I8. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) := introv I1; introv I2 I3 I4 I5 I6 I7 I8 I9. Tactic Notation “introv” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) simple_intropattern(I9) simple_intropattern(I10) := introv I1; introv I2 I3 I4 I5 I6 I7 I8 I9 I10.

intros_allはintroを可能な限り繰り返します。introsと対照的に、定義を途中で unfold します。否定の定義も unfold するので、intros_allをforall x, P x -> ~Qの形のゴールに適用すると、x、P x、Qを導入し、ゴールにFalseを残すことに注意します。

Tactic Notation "intros_all" :=
repeat intro.

intros_hnfは仮定を導入し、頭正規形にします。

Tactic Notation "intro_hnf" :=
intro; match goal with H: _ |- _ => hnf in H end.

一般化(Generalization)

gen X1 .. XNは、変数XN...X1に対してgeneralize dependentを呼ぶことの略記法です。なお、generalizeタクティックの慣習にならって、変数は逆順で一般化(generalize)されます。つまり、X1が結果のゴールの最初の束縛変数になるということです。

Tactic Notation "gen" ident(X1) :=
generalize dependent X1.
Tactic Notation "gen" ident(X1) ident(X2) :=
gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) :=
gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4)  :=
gen X4; gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5) :=
gen X5; gen X4; gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5)
ident(X6) :=
gen X6; gen X5; gen X4; gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5)
ident(X6) ident(X7) :=
gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5)
ident(X6) ident(X7) ident(X8) :=
gen X8; gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5)
ident(X6) ident(X7) ident(X8) ident(X9) :=
gen X9; gen X8; gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1.
Tactic Notation "gen" ident(X1) ident(X2) ident(X3) ident(X4) ident(X5)
ident(X6) ident(X7) ident(X8) ident(X9) ident(X10) :=
gen X10; gen X9; gen X8; gen X7; gen X6; gen X5; gen X4; gen X3; gen X2; gen X1.

generalizes Xはgeneralize X; clear Xの略記法です。これは依存性をサポートしないため、タクティックgen Xより弱いです。主にタクティック記述に利用することを意図したものです。

Tactic Notation "generalizes" hyp(X) :=
generalize X; clear X.
Tactic Notation "generalizes" hyp(X1) hyp(X2) :=
generalizes X1; generalizes X2.
Tactic Notation "generalizes" hyp(X1) hyp(X2) hyp(X3) :=
generalizes X1 X2; generalizes X3.
Tactic Notation "generalizes" hyp(X1) hyp(X2) hyp(X3) hyp(X4) :=
generalizes X1 X2 X3; generalizes X4.

名前付け(Naming)

sets X: Eはset (X := E) in *と同じです。つまり、Eのすべての出現を新しいメタ変数Xに置換します。Xの定義はEになります。

Tactic Notation "sets" ident(X) ":" constr(E) :=
set (X := E) in *.

def_to_eq E X Hは、X := Eがローカルな定義のとき適用できます。適用されると仮定H: X = Eが追加され、Xの定義がクリアされます。def_to_eq_symも同様ですが、違いは、この場合、等式H: E = Xが生成されることです。

Ltac def_to_eq X HX E :=
assert (HX : X = E) by reflexivity; clearbody X.
Ltac def_to_eq_sym X HX E :=
assert (HX : E = X) by reflexivity; clearbody X.

set_eq X H: Eは新しい名前Xについての等式H: X = Eを生成し、現在のゴールのEをXで置換します。構文set_eq X: Eおよびset_eq: Eも可能です。同様に、set_eq <- X H: Eは等式H: E = Xを生成します。

sets_eq X HX: Eも同様ですが、ゴールのすべてのEをXで置換します。sets_eq X HX: E in HはH内を置換します。set_eq X HX: E in |-は何も置換しません。

Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) :=
set (X := E); def_to_eq X HX E.
Tactic Notation "set_eq" ident(X) ":" constr(E) :=
let HX := fresh "EQ" X in set_eq X HX: E.
Tactic Notation "set_eq" ":" constr(E) :=
let X := fresh "X" in set_eq X: E.

Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) :=
set (X := E); def_to_eq_sym X HX E.
Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) :=
let HX := fresh "EQ" X in set_eq <- X HX: E.
Tactic Notation "set_eq" "<-" ":" constr(E) :=
let X := fresh "X" in set_eq <- X: E.

Tactic Notation "sets_eq" ident(X) ident(HX) ":" constr(E) :=
set (X := E) in *; def_to_eq X HX E.
Tactic Notation "sets_eq" ident(X) ":" constr(E) :=
let HX := fresh "EQ" X in sets_eq X HX: E.
Tactic Notation "sets_eq" ":" constr(E) :=
let X := fresh "X" in sets_eq X: E.

Tactic Notation "sets_eq" "<-" ident(X) ident(HX) ":" constr(E) :=
set (X := E) in *; def_to_eq_sym X HX E.
Tactic Notation "sets_eq" "<-" ident(X) ":" constr(E) :=
let HX := fresh "EQ" X in sets_eq <- X HX: E.
Tactic Notation "sets_eq" "<-" ":" constr(E) :=
let X := fresh "X" in sets_eq <- X: E.

Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) "in" hyp(H) :=
set (X := E) in H; def_to_eq X HX E.
Tactic Notation "set_eq" ident(X) ":" constr(E) "in" hyp(H) :=
let HX := fresh "EQ" X in set_eq X HX: E in H.
Tactic Notation "set_eq" ":" constr(E) "in" hyp(H) :=
let X := fresh "X" in set_eq X: E in H.

Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) "in" hyp(H) :=
set (X := E) in H; def_to_eq_sym X HX E.
Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) "in" hyp(H) :=
let HX := fresh "EQ" X in set_eq <- X HX: E in H.
Tactic Notation "set_eq" "<-" ":" constr(E) "in" hyp(H) :=
let X := fresh "X" in set_eq <- X: E in H.

Tactic Notation "set_eq" ident(X) ident(HX) ":" constr(E) "in" "|-" :=
set (X := E) in |-; def_to_eq X HX E.
Tactic Notation "set_eq" ident(X) ":" constr(E) "in" "|-" :=
let HX := fresh "EQ" X in set_eq X HX: E in |-.
Tactic Notation "set_eq" ":" constr(E) "in" "|-" :=
let X := fresh "X" in set_eq X: E in |-.

Tactic Notation "set_eq" "<-" ident(X) ident(HX) ":" constr(E) "in" "|-" :=
set (X := E) in |-; def_to_eq_sym X HX E.
Tactic Notation "set_eq" "<-" ident(X) ":" constr(E) "in" "|-" :=
let HX := fresh "EQ" X in set_eq <- X HX: E in |-.
Tactic Notation "set_eq" "<-" ":" constr(E) "in" "|-" :=
let X := fresh "X" in set_eq <- X: E in |-.

inductionタクティックは通常、情報を失いますが、gen_eq X: Eは、inductionのこの限界を避けて等式を導入することを目的としたタクティックです。gen_eq E as X項Eのすべての出現を新しい変数Xで置換し、等式X = Eを現在の結論の追加の仮定とします。言い換えると、結論Cは(X = E) -> Cになります。gen_eq: Eおよびgen_eq: E as Xも可能です。

Tactic Notation "gen_eq" ident(X) ":" constr(E) :=
let EQ := fresh in sets_eq X EQ: E; revert EQ.
Tactic Notation "gen_eq" ":" constr(E) :=
let X := fresh "X" in gen_eq X: E.
Tactic Notation "gen_eq" ":" constr(E) "as" ident(X) :=
gen_eq X: E.
Tactic Notation "gen_eq" ident(X1) ":" constr(E1) ","
ident(X2) ":" constr(E2) :=
gen_eq X2: E2; gen_eq X1: E1.
Tactic Notation "gen_eq" ident(X1) ":" constr(E1) ","
ident(X2) ":" constr(E2) "," ident(X3) ":" constr(E3) :=
gen_eq X3: E3; gen_eq X2: E2; gen_eq X1: E1.

sets_let Xはゴールの最初の let-式を見つけ出し、その本体をXと名付けます。sets_eq_let Xも同様ですが、明示的に等式を作ることが違います。タクティックsets_let X in Hとsets_eq_let X in Hにより特定の仮定を指定することができます(デフォルトでは、letを含む最初のものが対象となります)。

既知の限界: ltac で項内の複数の let-inコンストラクタに対する名前付けのサポートをすることは不可能なようです。

Ltac sets_let_base tac :=
match goal with
| |- context[let _ := ?E in _] => tac E; cbv zeta
| H: context[let _ := ?E in _] |- _ => tac E; cbv zeta in H
end.

Ltac sets_let_in_base H tac :=
match type of H with context[let _ := ?E in _] =>
tac E; cbv zeta in H end.

Tactic Notation "sets_let" ident(X) :=
sets_let_base ltac:(fun E => sets X: E).
Tactic Notation "sets_let" ident(X) "in" hyp(H) :=
sets_let_in_base H ltac:(fun E => sets X: E).
Tactic Notation "sets_eq_let" ident(X) :=
sets_let_base ltac:(fun E => sets_eq X: E).
Tactic Notation "sets_eq_let" ident(X) "in" hyp(H) :=
sets_let_in_base H ltac:(fun E => sets_eq X: E).

書き換え

書き換え(Rewriting)

rewrite_all Eはrewrite Eを可能な限り繰り返します。注意: このタクティックは簡単に無限ループに陥ります。右から左への書き換えや仮定への適用の構文はrewriteと同様です。

Tactic Notation "rewrite_all" constr(E) :=
repeat rewrite E.
Tactic Notation "rewrite_all" "<-" constr(E) :=
repeat rewrite <- E.
Tactic Notation "rewrite_all" constr(E) "in" ident(H) :=
repeat rewrite E in H.
Tactic Notation "rewrite_all" "<-" constr(E) "in" ident(H) :=
repeat rewrite <- E in H.
Tactic Notation "rewrite_all" constr(E) "in" "*" :=
repeat rewrite E in *.
Tactic Notation "rewrite_all" "<-" constr(E) "in" "*" :=
repeat rewrite <- E in *.

asserts_rewrite Eは等式Eの成立を主張し(対応するサブゴールを生成します)、現在のゴールの対応する部分をすぐに書き換えます。これによって、等式に名前を付けて後でそれを消すことを避けることができます。右から左への書き換えや仮定への適用の構文はrewriteと同様です。なお、タクティックreplacesも同様のはたらきをします。

Ltac asserts_rewrite_tactic E action :=
let EQ := fresh in (assert (EQ : E);
[ idtac | action EQ; clear EQ ]).

Tactic Notation "asserts_rewrite" constr(E) :=
asserts_rewrite_tactic E ltac:(fun EQ => rewrite EQ).
Tactic Notation "asserts_rewrite" "<-" constr(E) :=
asserts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ).
Tactic Notation "asserts_rewrite" constr(E) "in" hyp(H) :=
asserts_rewrite_tactic E ltac:(fun EQ => rewrite EQ in H).
Tactic Notation "asserts_rewrite" "<-" constr(E) "in" hyp(H) :=
asserts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ in H).

cuts_rewrite Eはasserts_rewrite Eと同様ですが、サブゴールの順番が変わります。

Ltac cuts_rewrite_tactic E action :=
let EQ := fresh in (cuts EQ: E;
[ action EQ; clear EQ | idtac ]).

Tactic Notation "cuts_rewrite" constr(E) :=
cuts_rewrite_tactic E ltac:(fun EQ => rewrite EQ).
Tactic Notation "cuts_rewrite" "<-" constr(E) :=
cuts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ).
Tactic Notation "cuts_rewrite" constr(E) "in" hyp(H) :=
cuts_rewrite_tactic E ltac:(fun EQ => rewrite EQ in H).
Tactic Notation "cuts_rewrite" "<-" constr(E) "in" hyp(H) :=
cuts_rewrite_tactic E ltac:(fun EQ => rewrite <- EQ in H).

rewrite_except H EQは、仮定H以外のすべての部分で等式EQを書き換えます。

Ltac rewrite_except H EQ :=
let K := fresh in let T := type of H in
set (K := T) in H;
rewrite EQ in *; unfold K in H; clear K.

rewrites E at KはEがT1 = T2の形のときに適用できます。このタクティックにより、現在のゴールにおけるT1のK番目の出現がT2に書き換えられます。構文rewrites <- E at Kとrewrites E at K in Hも可能です。

Tactic Notation "rewrites" constr(E) "at" constr(K) :=
match type of E with ?T1 = ?T2 =>
ltac_action_at K of T1 do (rewrite E) end.
Tactic Notation "rewrites" "<-" constr(E) "at" constr(K) :=
match type of E with ?T1 = ?T2 =>
ltac_action_at K of T2 do (rewrite <- E) end.
Tactic Notation "rewrites" constr(E) "at" constr(K) "in" hyp(H) :=
match type of E with ?T1 = ?T2 =>
ltac_action_at K of T1 in H do (rewrite E in H) end.
Tactic Notation "rewrites" "<-" constr(E) "at" constr(K) "in" hyp(H) :=
match type of E with ?T1 = ?T2 =>
ltac_action_at K of T2 in H do (rewrite <- E in H) end.

置き換え(Replace)

replaces E with Fはreplace E with Fと同様ですが、等式E = Fが最初のサブゴールとして生成される点が違います。構文replaces E with F in Hも可能です。replaceと対照的に、replacesはassumptionによって等式を解こうとはしません。なお、replaces E with Fはasserts_rewrite (E = F)と同様です。

Tactic Notation "replaces" constr(E) "with" constr(F) :=
let T := fresh in assert (T: E = F); [ | replace E with F; clear T ].

Tactic Notation "replaces" constr(E) "with" constr(F) "in" hyp(H) :=
let T := fresh in assert (T: E = F); [ | replace E with F in H; clear T ].

replaces E at K with Fは現在のゴールのEのK番目の出現をFに置き換えます。構文replaces E at K with F in Hも可能です。

Tactic Notation "replaces" constr(E) "at" constr(K) "with" constr(F) :=
let T := fresh in assert (T: E = F); [ | rewrites T at K; clear T ].

Tactic Notation "replaces" constr(E) "at" constr(K) "with" constr(F) "in" hyp(H) :=
let T := fresh in assert (T: E = F); [ | rewrites T at K in H; clear T ].

名前変え(リネーム、Renaming)

renames X1 to Y1, ..., XN to YNはリネーム操作rename Xi into Yiの列の略記法です。

Tactic Notation "renames" ident(X1) "to" ident(Y1) :=
rename X1 into Y1.
Tactic Notation "renames" ident(X1) "to" ident(Y1) ","
ident(X2) "to" ident(Y2) :=
renames X1 to Y1; renames X2 to Y2.
Tactic Notation "renames" ident(X1) "to" ident(Y1) ","
ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) :=
renames X1 to Y1; renames X2 to Y2, X3 to Y3.
Tactic Notation "renames" ident(X1) "to" ident(Y1) ","
ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) ","
ident(X4) "to" ident(Y4) :=
renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4.
Tactic Notation "renames" ident(X1) "to" ident(Y1) ","
ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) ","
ident(X4) "to" ident(Y4) "," ident(X5) "to" ident(Y5) :=
renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4, X5 to Y5.
Tactic Notation "renames" ident(X1) "to" ident(Y1) ","
ident(X2) "to" ident(Y2) "," ident(X3) "to" ident(Y3) ","
ident(X4) "to" ident(Y4) "," ident(X5) "to" ident(Y5) ","
ident(X6) "to" ident(Y6) :=
renames X1 to Y1; renames X2 to Y2, X3 to Y3, X4 to Y4, X5 to Y5, X6 to Y6.

定義の展開(Unfolding)

unfoldsはゴールの先頭の定義を展開します。つまり、ゴールがP x1 ... xNの形のとき、unfold Pを呼びます。ゴールが等式のとき、左辺の先頭の定数を展開しようとします。それができないとき、右辺について試みます。ゴールが積のとき、最初にintrosを呼びます。

Ltac apply_to_head_of E cont :=
let go E :=
let P := get_head E in cont P in
match E with
| forall _,_ => intros; apply_to_head_of E cont
| ?A = ?B => first [ go A | go B ]
| ?A => go A
end.

Ltac unfolds_base :=
match goal with |- ?G =>
apply_to_head_of G ltac:(fun P => unfold P) end.

Tactic Notation "unfolds" :=
unfolds_base.

unfolds in Hは仮定Hの冒頭の定義を展開します。つまりHが型P x1 ... xNならば、unfold P in Hを呼びます。

Ltac unfolds_in_base H :=
match type of H with ?G =>
apply_to_head_of G ltac:(fun P => unfold P in H) end.

Tactic Notation "unfolds" "in" hyp(H) :=
unfolds_in_base H.

unfolds P1,..,PNはunfold P1,..,PN in *の略記法です。

Tactic Notation "unfolds" reference(F1) :=
unfold F1 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2) :=
unfold F1,F2 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2)
"," reference(F3) :=
unfold F1,F2,F3 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2)
"," reference(F3) "," reference(F4) :=
unfold F1,F2,F3,F4 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2)
"," reference(F3) "," reference(F4) "," reference(F5) :=
unfold F1,F2,F3,F4,F5 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2)
"," reference(F3) "," reference(F4) "," reference(F5) "," reference(F6) :=
unfold F1,F2,F3,F4,F5,F6 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2)
"," reference(F3) "," reference(F4) "," reference(F5)
"," reference(F6) "," reference(F7) :=
unfold F1,F2,F3,F4,F5,F6,F7 in *.
Tactic Notation "unfolds" reference(F1) "," reference(F2)
"," reference(F3) "," reference(F4) "," reference(F5)
"," reference(F6) "," reference(F7) "," reference(F8) :=
unfold F1,F2,F3,F4,F5,F6,F7,F8 in *.

folds P1,..,PNはfold P1 in *; ..; fold PN in *の略記法です。

Tactic Notation "folds" constr(H) :=
fold H in *.
Tactic Notation "folds" constr(H1) "," constr(H2) :=
folds H1; folds H2.
Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3) :=
folds H1; folds H2; folds H3.
Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3)
"," constr(H4) :=
folds H1; folds H2; folds H3; folds H4.
Tactic Notation "folds" constr(H1) "," constr(H2) "," constr(H3)
"," constr(H4) "," constr(H5) :=
folds H1; folds H2; folds H3; folds H4; folds H5.

単純化(Simplification)

simplsはsimpl in *の略記法です。

Tactic Notation "simpls" :=
simpl in *.

simpls P1,..,PNはsimpl P1 in *; ..; simpl PN in *の略記法です。

Tactic Notation "simpls" reference(F1) :=
simpl F1 in *.
Tactic Notation "simpls" reference(F1) "," reference(F2) :=
simpls F1; simpls F2.
Tactic Notation "simpls" reference(F1) "," reference(F2)
"," reference(F3) :=
simpls F1; simpls F2; simpls F3.
Tactic Notation "simpls" reference(F1) "," reference(F2)
"," reference(F3) "," reference(F4) :=
simpls F1; simpls F2; simpls F3; simpls F4.

unsimpl EはXのすべての出現をEに置き換えます。ここでXはEにsimplを適用すると得られるであろう結果です。simplが単純化し過ぎたときに undo をするのに便利です。

Tactic Notation "unsimpl" constr(E) :=
let F := (eval simpl in E) in change F with E.

unsimpl E in Hはunsimpl Eと同様ですが、特定の仮定Hの中だけに適用されます。

Tactic Notation "unsimpl" constr(E) "in" hyp(H) :=
let F := (eval simpl in E) in change F with E in H.

unsimpl E in *はunsimpl Eを可能なすべての場所に適用します。unsimpls Eはその別名です。

Tactic Notation "unsimpl" constr(E) "in" "*" :=
let F := (eval simpl in E) in change F with E in *.
Tactic Notation "unsimpls" constr(E) :=
unsimpl E in *.

nosimpl tはCoqの項tについて、ある形の単純化が適用されないようにします。このからくりの詳細は Gonthier の仕事を見てください。

Notation "'nosimpl' t" := (match tt with tt => t end)
(at level 10).

評価(Evaluation)

Tactic Notation "hnfs" := hnf in *.

置換(Substitution)

substsはsubstは同様にはたらきますが、違いは、substsはコンテキストに循環する等式があっても失敗しないことです。

Tactic Notation "substs" :=
repeat (match goal with H: ?x = ?y |- _ =>
first [ subst x | subst y ] end).

次はsubsts belowの実装です。これは、証明コンテキストの指定されたポジションより下のすべての仮定にsubstを呼ぶことを可能にするものです。

Ltac substs_below limit :=
match goal with H: ?T |- _ =>
match T with
| limit => idtac
| ?x = ?y =>
first [ subst x; substs_below limit
| subst y; substs_below limit
| generalizes H; substs_below limit; intro ]
end end.

substs below body Eは、コンテキストの中で本体がEである最初の仮定より下に現れるすべての等式にsubstを適用します。もしコンテキストにそのような仮定がないときには、substと同値です。例えば、Hが仮定のとき、substs below Hは仮定Hより下のすべての等式を置換します。

Tactic Notation "substs" "below" "body" constr(M) :=
substs_below M.

substs below HはコンテキストでHで指定された仮定より下に現れるすべての等式にsubstを適用します。なお、現在の実装は技術的に間違いがあります。それは、同じ本体を持つ違う仮定を区別できないからです。

Tactic Notation "substs" "below" hyp(H) :=
match type of H with ?M => substs below body M end.

subst_hyp HはHに含まれる等式を置換します。このふるまいは LibDataで拡張されます。 –(今後の課題)

Ltac subst_hyp_base H :=
match type of H with
| ?x = ?y => first [ subst x | subst y ]
end.

Tactic Notation "subst_hyp" hyp(H) := subst_hyp_base H.

intro_substはintro H; subst_hyp Hの略記法です。現在のゴールの先頭の等式を導入し置換します。

Tactic Notation "intro_subst" :=
let H := fresh "TEMP" in intros H; subst_hyp H.

subst_localはコンテキストのすべてのローカル定義を置換します。

Ltac subst_local :=
repeat match goal with H:=_ |- _ => subst H end.

subst_eq Eは等式x = tをとり、ゴールのすべての場所でxをtに置き換えます。

Ltac subst_eq_base E :=
let H := fresh "TEMP" in lets H: E; subst_hyp H.

Tactic Notation "subst_eq" constr(E) :=
subst_eq_base E.

proof irrelevance を扱うタクティック

Require Import ProofIrrelevance.

pi_rewrite Eは型PropのEを新しい単一化変数に置き換えます。これから、proof irrelevance を利用する現実的な方法になります。明示的にrewrite (proof_irrelevance E E')と書く必要はありません。E'が大きな式であるとき特に有効です。(訳注: Proof Irrelevance は、言ってみれば、同じ命題の証明オブジェクトをすべて同一視してしまうもの。)

Ltac pi_rewrite_base E rewrite_tac :=
let E' := fresh in let T := type of E in evar (E':T);
rewrite_tac (@proof_irrelevance _ E E'); subst E'.

Tactic Notation "pi_rewrite" constr(E) :=
pi_rewrite_base E ltac:(fun X => rewrite X).
Tactic Notation "pi_rewrite" constr(E) "in" hyp(H) :=
pi_rewrite_base E ltac:(fun X => rewrite X in H).

等式を証明する

fequalはf_equalの変種で、n個組の間の等式をよりうまく扱います。

Ltac fequal_base :=
let go := f_equal; [ fequal_base | ] in
match goal with
| |- (_,_,_) = (_,_,_) => go
| |- (_,_,_,_) = (_,_,_,_) => go
| |- (_,_,_,_,_) = (_,_,_,_,_) => go
| |- (_,_,_,_,_,_) = (_,_,_,_,_,_) => go
| |- _ => f_equal
end.

Tactic Notation "fequal" :=
fequal_base.

fequalsはfequalと同様ですが、違う点は、すべての簡単なサブゴールをreflexivityとcongruence(および proof-irrelevance 原理)を使って解こうとします。fequalsはf x1 .. xN = f y1 .. yNという形のゴールに適用することができ、xi = yiという形のサブゴールをいくつか生成します。

Ltac fequal_post :=
first [ reflexivity | congruence | apply proof_irrelevance | idtac ].

Tactic Notation "fequals" :=
fequal; fequal_post.

fequals_recはfequalsを再帰的に呼び出します。これはrepeat (progress fequals)と同値です。

Tactic Notation "fequals_rec" :=
repeat (progress fequals).

反転(Inversion)

基本反転(Basic inversion)

invert keep Hはinversion Hと同様ですが、得られた事実をすべてゴールに置く点が違います。キーワードkeepは仮定Hを除去しないでおくことを意味します。

Tactic Notation "invert" "keep" hyp(H) :=
pose ltac_mark; inversion H; gen_until_mark.

invert keep H as X1 .. XNはinversion H as ...と同様ですが、明示的に名前を付けなければならないのが変数ではない仮定だけである点が違います。これは、introvが仮定だけに名前を付けるのと同じ流儀です。

Tactic Notation "invert" "keep" hyp(H) "as" simple_intropattern(I1) :=
invert keep H; introv I1.
Tactic Notation "invert" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) :=
invert keep H; introv I1 I2.
Tactic Notation "invert" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) :=
invert keep H; introv I1 I2 I3.

invert Hはinversion Hと同様ですが、得られた事実をすべてゴールに置き、仮定Hをクリアする点が違います。言い換えると、これはinvert keep H; clear Hと同値です。

Tactic Notation "invert" hyp(H) :=
invert keep H; clear H.

invert H as X1 .. XNはinvert keep H as X1 .. XNと同様ですが、仮定Hもクリアする点が違います。

Tactic Notation "invert_tactic" hyp(H) tactic(tac) :=
let H' := fresh in rename H into H'; tac H'; clear H'.
Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1) :=
invert_tactic H (fun H => invert keep H as I1).
Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) :=
invert_tactic H (fun H => invert keep H as I1 I2).
Tactic Notation "invert" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) :=
invert_tactic H (fun H => invert keep H as I1 I2 I3).

置換(substitution)を伴う反転(inversion)

ここで定義する反転タクティックは、inversionによって生成される依存等式をproof irrelevance を使って除去できます。

Axiom inj_pair2 : forall (U : Type) (P : U -> Type) (p : U) (x y : P p),
existT P p x = existT P p y -> x = y.

Ltac inverts_tactic H i1 i2 i3 i4 i5 i6 :=
let rec go i1 i2 i3 i4 i5 i6 :=
match goal with
| |- (ltac_Mark -> _) => intros _
| |- (?x = ?y -> _) => let H := fresh in intro H;
first [ subst x | subst y ];
go i1 i2 i3 i4 i5 i6
| |- (existT ?P ?p ?x = existT ?P ?p ?y -> _) =>
let H := fresh in intro H;
generalize (@inj_pair2 _ P p x y H);
clear H; go i1 i2 i3 i4 i5 i6
| |- (?P -> ?Q) => i1; go i2 i3 i4 i5 i6 ltac:(intro)
| |- (forall _, _) => intro; go i1 i2 i3 i4 i5 i6
end in
generalize ltac_mark; invert keep H; go i1 i2 i3 i4 i5 i6;
unfold eq' in *.

inverts keep Hはinvert keep Hと同様ですが、inversion によって生成されたすべての等式にsubstを適用する点が違います。

Tactic Notation "inverts" "keep" hyp(H) :=
inverts_tactic H ltac:(intro) ltac:(intro) ltac:(intro)
ltac:(intro) ltac:(intro) ltac:(intro).

inverts keep H as X1 .. XNはinvert keep H as X1 .. XNと同様ですが、inversion によって生成されたすべての等式にsubstを適用する点が違います。

Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1) :=
inverts_tactic H ltac:(intros I1)
ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro).
Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) :=
inverts_tactic H ltac:(intros I1) ltac:(intros I2)
ltac:(intro) ltac:(intro) ltac:(intro) ltac:(intro).
Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) :=
inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3)
ltac:(intro) ltac:(intro) ltac:(intro).
Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) :=
inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3)
ltac:(intros I4) ltac:(intro) ltac:(intro).
Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4)
simple_intropattern(I5) :=
inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3)
ltac:(intros I4) ltac:(intros I5) ltac:(intro).
Tactic Notation "inverts" "keep" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4)
simple_intropattern(I5) simple_intropattern(I6) :=
inverts_tactic H ltac:(intros I1) ltac:(intros I2) ltac:(intros I3)
ltac:(intros I4) ltac:(intros I5) ltac:(intros I6).

inverts Hはinverts keep Hと同様ですが、仮定Hをクリアする点が違います。

Tactic Notation "inverts" hyp(H) :=
inverts keep H; clear H.

inverts H as X1 .. XNはinverts keep H as X1 .. XNと同様ですが、仮定Hもクリアする点が違います。

Tactic Notation "inverts_tactic" hyp(H) tactic(tac) :=
let H' := fresh in rename H into H'; tac H'; clear H'.
Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1) :=
invert_tactic H (fun H => inverts keep H as I1).
Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) :=
invert_tactic H (fun H => inverts keep H as I1 I2).
Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) :=
invert_tactic H (fun H => inverts keep H as I1 I2 I3).
Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) :=
invert_tactic H (fun H => inverts keep H as I1 I2 I3 I4).
Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4)
simple_intropattern(I5) :=
invert_tactic H (fun H => inverts keep H as I1 I2 I3 I4 I5).
Tactic Notation "inverts" hyp(H) "as" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4)
simple_intropattern(I5) simple_intropattern(I6) :=
invert_tactic H (fun H => inverts keep H as I1 I2 I3 I4 I5 I6).

inverts H asは仮定Hに対して inversion を行ない、生成された等式を置換し、そして、別の新しく生成された仮定を、ユーザが明示的に名前を付けられるようにゴールに置きます。inverts keep H asは同様ですが、Hをクリアしない点が違います。

- TODO: 上述のinvertsをこれを使って再実装すること

Ltac inverts_as_tactic H := let rec go tt := match goal with | |- (ltac_Mark -> _) => intros _ | |- (?x = ?y -> _) => let H := fresh “TEMP” in intro H; first [ subst x | subst y ]; go tt | |- (existT ?P ?p ?x = existT ?P ?p ?y -> _) => let H := fresh in intro H; generalize (@inj_pair2 _ P p x y H); clear H; go tt | |- (forall _, _) => intro; let H := get_last_hyp tt in mark_to_generalize H; go tt end in pose ltac_mark; inversion H; generalize ltac_mark; gen_until_mark; go tt; gen_to_generalize; unfolds ltac_to_generalize; unfold eq’ in *.

Tactic Notation “inverts” “keep” hyp(H) “as” := inverts_as_tactic H.

Tactic Notation “inverts” hyp(H) “as” := inverts_as_tactic H; clear H.

Tactic Notation “inverts” hyp(H) “as” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) := inverts H as; introv I1 I2 I3 I4 I5 I6 I7. Tactic Notation “inverts” hyp(H) “as” simple_intropattern(I1) simple_intropattern(I2) simple_intropattern(I3) simple_intropattern(I4) simple_intropattern(I5) simple_intropattern(I6) simple_intropattern(I7) simple_intropattern(I8) := inverts H as; introv I1 I2 I3 I4 I5 I6 I7 I8.

置換を伴う注入(Injection)

injectsの背後の実装

Ltac injects_tactic H :=
let rec go _ :=
match goal with
| |- (ltac_Mark -> _) => intros _
| |- (?x = ?y -> _) => let H := fresh in intro H;
first [ subst x | subst y | idtac ];
go tt
end in
generalize ltac_mark; injection H; go tt.

injects keep HはC a1 .. aN = C b1 .. bNの形の仮定Hをとって、生成されたすべての等式ai = biを置換します。

Tactic Notation "injects" "keep" hyp(H) :=
injects_tactic H.

injects Hはinjects keep Hと同様ですが、仮定Hをクリアする点が違います。

Tactic Notation "injects" hyp(H) :=
injects_tactic H; clear H.

inject H as X1 .. XNはinjectionに続けてintros X1 .. XNを行うのと同様です。

Tactic Notation "inject" hyp(H) :=
injection H.
Tactic Notation "inject" hyp(H) "as" ident(X1) :=
injection H; intros X1.
Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) :=
injection H; intros X1 X2.
Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3) :=
injection H; intros X1 X2 X3.
Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3)
ident(X4) :=
injection H; intros X1 X2 X3 X4.
Tactic Notation "inject" hyp(H) "as" ident(X1) ident(X2) ident(X3)
ident(X4) ident(X5) :=
injection H; intros X1 X2 X3 X4 X5.

置換を伴う反転と注入 – おおざっぱな実装

この節で提供するタクティックinversionsおよびinjectionsはそれぞれinvertsおよびinjectsと同様ですが、置換する等式は、新しく生成されたものに限らずすべてのコンテキストの等式である点が違います。対応する実装は、より簡単になっています。

inversions keep Hはinversions Hと同様ですが、仮定Hをクリアしません。

Tactic Notation "inversions" "keep" hyp(H) :=
inversion H; subst.

inversions Hはinversion Hに続いてsubstとclear Hを行うことの略記法です。これはinverts Hのおおざっぱな実装で、証明コンテキストが既に等式を含んでいるときには、問題のある振る舞いをします。これは、より良い実装(inverts H)が遅すぎる場合のために用意してあります。

Tactic Notation "inversions" hyp(H) :=
inversion H; subst; clear H.

injections keep Hはinjection Hに続いてintrosとsubstを行うことの略記法です。これはinjects keep Hのおおざっぱな実装で、証明コンテキストが既に等式を含んでいるとき、あるいはゴールがforallまたは含意で始まるときには、問題のある振る舞いをします。

Tactic Notation "injections" "keep" hyp(H) :=
injection H; intros; subst.

injections Hはinjection Hに続いてintros、clear H、substを順に行うのと同じです。これはinjects Hのおおざっぱな実装で、証明コンテキストが既に等式を含んでいるとき、あるいはゴールがforallまたは含意で始まるときには、問題のある振る舞いをします。

Tactic Notation "injections" "keep" hyp(H) :=
injection H; clear H; intros; subst.

場合分け

casesはcase_eq Eと同様ですが、等式をゴールではなくコンテキストに作る点と、作る等式の右辺と左辺が逆であることが違います。構文cases E as Hが可能で、仮定の名前Hを特定します。

Tactic Notation "cases" constr(E) "as" ident(H) :=
let X := fresh "TEMP" in
set (X := E) in *; def_to_eq_sym X H E;
destruct X.

Tactic Notation "cases" constr(E) :=
let x := fresh "Eq" in cases E as H.

case_if_postはゴールをかたづけるタクティックとして後で定義されるものです。

Ltac case_if_post := idtac.

case_ifはコンテキスト内のif ?B then ?E1 else ?E2という形のパターンを探し、Bについてdestruct Bを呼んで場合分けをします。最初にゴールを見て、そこになければ、if文を含む最初の仮定を見ます。case_if in Hは考慮対象の仮定を指定するのに使えます。構文case_if as Eqとcase_if in H as Eqは、場合分けによって生成される仮定に名前を付けるのに使えます。

Ltac case_if_on_tactic E Eq :=
match type of E with
| {_}+{_} => destruct E as [Eq | Eq]
| _ => let X := fresh in
sets_eq <- X Eq: E;
destruct X
end; case_if_post.

Tactic Notation "case_if_on" constr(E) "as" simple_intropattern(Eq) :=
case_if_on_tactic E Eq.

Tactic Notation "case_if" "as" simple_intropattern(Eq) :=
match goal with
| |- context [if ?B then _ else _] => case_if_on B as Eq
| K: context [if ?B then _ else _] |- _ => case_if_on B as Eq
end.

Tactic Notation "case_if" "in" hyp(H) "as" simple_intropattern(Eq) :=
match type of H with context [if ?B then _ else _] =>
case_if_on B as Eq end.

Tactic Notation "case_if" :=
let Eq := fresh in case_if as Eq.

Tactic Notation "case_if" "in" hyp(H) :=
let Eq := fresh in case_if in H as Eq.

cases_ifはcase_ifと同様ですが、主に2つの違いがあります:もしx = yまたはx == yという形の等式が生成されたなら、ゴールでこの等式にもとづく置換をします。

Ltac cases_if_on_tactic E Eq :=
match type of E with
| {_}+{_} => destruct E as [Eq|Eq]; try subst_hyp Eq
| _ => let X := fresh in
sets_eq <- X Eq: E;
destruct X
end; case_if_post.

Tactic Notation "cases_if_on" constr(E) "as" simple_intropattern(Eq) :=
cases_if_on_tactic E Eq.

Tactic Notation "cases_if" "as" simple_intropattern(Eq) :=
match goal with
| |- context [if ?B then _ else _] => case_if_on B as Eq
| K: context [if ?B then _ else _] |- _ => case_if_on B as Eq
end.

Tactic Notation "cases_if" "in" hyp(H) "as" simple_intropattern(Eq) :=
match type of H with context [if ?B then _ else _] =>
cases_if_on B as Eq end.

Tactic Notation "cases_if" :=
let Eq := fresh in cases_if as Eq.

Tactic Notation "cases_if" "in" hyp(H) :=
let Eq := fresh in cases_if in H as Eq.

destruct_ifはコンテキストからif ?B then ?E1 else ?E2という形のパターンを探し、Bについてdestruct Bを呼ぶことで場合分けをします。まずゴールを見て、そこになければif文を含む最初の仮定を見ます。

Ltac destruct_if_post := tryfalse.

Tactic Notation "destruct_if"
"as" simple_intropattern(Eq1) simple_intropattern(Eq2) :=
match goal with
| |- context [if ?B then _ else _] => destruct B as [Eq1|Eq2]
| K: context [if ?B then _ else _] |- _ => destruct B as [Eq1|Eq2]
end;
destruct_if_post.

Tactic Notation "destruct_if" "in" hyp(H)
"as" simple_intropattern(Eq1) simple_intropattern(Eq2) :=
match type of H with context [if ?B then _ else _] =>
destruct B as [Eq1|Eq2] end;
destruct_if_post.

Tactic Notation "destruct_if" "as" simple_intropattern(Eq) :=
destruct_if as Eq Eq.
Tactic Notation "destruct_if" "in" hyp(H) "as" simple_intropattern(Eq) :=
destruct_if in H as Eq Eq.

Tactic Notation "destruct_if" :=
let Eq := fresh "C" in destruct_if as Eq Eq.
Tactic Notation "destruct_if" "in" hyp(H) :=
let Eq := fresh "C" in destruct_if in H as Eq Eq.

destruct_head_matchは、ゴールがmatch ?E with ...またはmatch ?E with ... = _または_ = match ?E with ...という形のとき、先頭パターンマッチの引数で場合分けをします。Ltacの制約により、マッチするものがないときでもこのタクティックは失敗しません。その代わり、ゴールの不特定の部分項について、場合分けします。

- 注意: 実験的です。

Ltac find_head_match T := match T with context [?E] => match T with | E => fail 1 | _ => constr:(E) end end.

Ltac destruct_head_match_core cont := match goal with | |- ?T1 = ?T2 => first [ let E := find_head_match T1 in cont E | let E := find_head_match T2 in cont E ] | |- ?T1 => let E := find_head_match T1 in cont E end; destruct_if_post.

Tactic Notation “destruct_head_match” “as” simple_intropattern(I) := destruct_head_match_core ltac:(fun E => destruct E as I).

Tactic Notation “destruct_head_match” := destruct_head_match_core ltac:(fun E => destruct E).

- rememberとのコンパチビリティのために提供します

cases' Eはcase_eq Eと同様ですが、等式をゴールではなくコンテキストに作ります。構文cases E as Hも可能で、その仮定の名前Hを指定します。

Tactic Notation "cases'" constr(E) "as" ident(H) :=
let X := fresh "TEMP" in
set (X := E) in *; def_to_eq X H E;
destruct X.

Tactic Notation "cases'" constr(E) :=
let x := fresh "Eq" in cases' E as H.

cases_if'はcases_ifと同様ですが、生成される等式が鏡像になっている点が違います。

Ltac cases_if_on' E Eq :=
match type of E with
| {_}+{_} => destruct E as [Eq|Eq]; try subst_hyp Eq
| _ => let X := fresh in
sets_eq X Eq: E;
destruct X
end; case_if_post.

Tactic Notation "cases_if'" "as" simple_intropattern(Eq) :=
match goal with
| |- context [if ?B then _ else _] => cases_if_on' B Eq
| K: context [if ?B then _ else _] |- _ => cases_if_on' B Eq
end.

Tactic Notation "cases_if'" :=
let Eq := fresh in cases_if' as Eq.

帰納法(Induction)

inductions Eはdependent induction Eの略記法です。inductions E gen X1 .. XNはdependent induction E generalizing X1 .. XNの略記法です。

Require Import Coq.Program.Equality.

Ltac inductions_post :=
unfold eq' in *.

Tactic Notation "inductions" ident(E) :=
dependent induction E; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) :=
dependent induction E generalizing X1; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2) :=
dependent induction E generalizing X1 X2; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2)
ident(X3) :=
dependent induction E generalizing X1 X2 X3; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2)
ident(X3) ident(X4) :=
dependent induction E generalizing X1 X2 X3 X4; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2)
ident(X3) ident(X4) ident(X5) :=
dependent induction E generalizing X1 X2 X3 X4 X5; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2)
ident(X3) ident(X4) ident(X5) ident(X6) :=
dependent induction E generalizing X1 X2 X3 X4 X5 X6; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2)
ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) :=
dependent induction E generalizing X1 X2 X3 X4 X5 X6 X7; inductions_post.
Tactic Notation "inductions" ident(E) "gen" ident(X1) ident(X2)
ident(X3) ident(X4) ident(X5) ident(X6) ident(X7) ident(X8) :=
dependent induction E generalizing X1 X2 X3 X4 X5 X6 X7 X8; inductions_post.

induction_wf IH: E Xは、与えられた整礎関係(well-founded relation)についての整礎帰納法原理(well-founded induction principle)を適用するために使われます。これはゴールPXに対して適用されます。ここでPXはXの上の命題です。最初に、pattern Xを使って(fun a => P a) Xという形のゴールを用意します。そして次に、Eについて具体化された整礎帰納法原理を適用します。ここでEは型well_founded Rの項で、Rは二項関係です。構文はinduction_wf: E Xとinduction_wf E Xです。

Tactic Notation "induction_wf" ident(IH) ":" constr(E) ident(X) :=
pattern X; apply (well_founded_ind E); clear X; intros X IH.
Tactic Notation "induction_wf" ":" constr(E) ident(X) :=
let IH := fresh "IH" in induction_wf IH: E X.
Tactic Notation "induction_wf" ":" constr(E) ident(X) :=
induction_wf: E X.

決定可能な等式

decides_equalityはdecide equalityと同様ですが、現在のゴールの先頭の定義を展開できる点が違います。

Ltac decides_equality_tactic :=
first [ decide equality | progress(unfolds); decides_equality_tactic ].

Tactic Notation "decides_equality" :=
decides_equality_tactic.

同値(Equivalence)

iff Hは同値P <-> Qを証明し、それぞれの場合に得られる仮定に名前Hを付けることができます。構文iffとiff H1 H2も可能で、それぞれ0個、2個の名前を付けます。タクティックiff <- Hは2つのサブゴールを交換します。つまり、(Q -> P)が最初のゴールになります。

Lemma iff_intro_swap : forall (P Q : Prop),
(Q -> P) -> (P -> Q) -> (P <-> Q).
Proof. intuition. Qed.

Tactic Notation "iff" simple_intropattern(H1) simple_intropattern(H2) :=
split; [ intros H1 | intros H2 ].
Tactic Notation "iff" simple_intropattern(H) :=
iff H H.
Tactic Notation "iff" :=
let H := fresh "H" in iff H.

Tactic Notation "iff" "<-" simple_intropattern(H1) simple_intropattern(H2) :=
apply iff_intro_swap; [ intros H1 | intros H2 ].
Tactic Notation "iff" "<-" simple_intropattern(H) :=
iff <- H H.
Tactic Notation "iff" "<-" :=
let H := fresh "H" in iff <- H.

N個の連言と選言

ゴールに分割されるN-連言

splitsの背後の実装。

Ltac splits_tactic N :=
match N with
| O => fail
| S O => idtac
| S ?N' => split; [| splits_tactic N']
end.

Ltac unfold_goal_until_conjunction :=
match goal with
| |- _ /\ _ => idtac
| _ => progress(unfolds); unfold_goal_until_conjunction
end.

Ltac get_term_conjunction_arity T :=
match T with
| _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(8)
| _ /\ _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(7)
| _ /\ _ /\ _ /\ _ /\ _ /\ _ => constr:(6)
| _ /\ _ /\ _ /\ _ /\ _ => constr:(5)
| _ /\ _ /\ _ /\ _ => constr:(4)
| _ /\ _ /\ _ => constr:(3)
| _ /\ _ => constr:(2)
| _ -> ?T' => get_term_conjunction_arity T'
| _ => let P := get_head T in
let T' := eval unfold P in T in
match T' with
| T => fail 1
| _ => get_term_conjunction_arity T'
end

end.

Ltac get_goal_conjunction_arity :=
match goal with |- ?T => get_term_conjunction_arity T end.

splitsは(T1 /\ .. /\ TN)という形のゴールに適用され、N個のサブゴールT1..TNに分解します。ゴールが連言ではない場合、先頭の定義を展開します。

Tactic Notation "splits" :=
unfold_goal_until_conjunction;
let N := get_goal_conjunction_arity in
splits_tactic N.

splits Nはsplitsと同様ですが、N-連言を得るのに必要なだけ定義を展開する点が違います。

Tactic Notation "splits" constr(N) :=
let N := nat_from_number N in
splits_tactic N.

splits_allは必要なときに定義を展開しながら、任意の連言を再帰的に分解します。注意: このタクティックはwell_founded Rという形のゴールに対してループします。Todo: この問題を解決すること

Ltac splits_all_base := repeat split.

Tactic Notation "splits_all" :=
splits_all_base.

N-連言の分解

destructsの背後の実装。

Ltac destructs_conjunction_tactic N T :=
match N with
| 2 => destruct T as [? ?]
| 3 => destruct T as [? [? ?]]
| 4 => destruct T as [? [? [? ?]]]
| 5 => destruct T as [? [? [? [? ?]]]]
| 6 => destruct T as [? [? [? [? [? ?]]]]]
| 7 => destruct T as [? [? [? [? [? [? ?]]]]]]
end.

destructs Tは N-連言の項Tを分解します。destruct T as (H1 .. HN)と同様ですが、N個の異なる名前を手動で指定しなくて良い点が違います。

Tactic Notation "destructs" constr(T) :=
let TT := type of T in
let N := get_term_conjunction_arity TT in
destructs_conjunction_tactic N T.

destructs N Tはdestruct T as (H1 .. HN)と同様ですが、N個の異なる名前を手動で指定しなくて良い点が違います。N-引数の連言に限らないことに注意します。

Tactic Notation "destructs" constr(N) constr(T) :=
let N := nat_from_number N in
destructs_conjunction_tactic N T.

N-選言であるゴールを証明する

branchの背後の実装。

Ltac branch_tactic K N :=
match constr:(K,N) with
| (_,0) => fail 1
| (0,_) => fail 1
| (1,1) => idtac
| (1,_) => left
| (S ?K', S ?N') => right; branch_tactic K' N'
end.

Ltac unfold_goal_until_disjunction :=
match goal with
| |- _ \/ _ => idtac
| _ => progress(unfolds); unfold_goal_until_disjunction
end.

Ltac get_term_disjunction_arity T :=
match T with
| _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(8)
| _ \/ _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(7)
| _ \/ _ \/ _ \/ _ \/ _ \/ _ => constr:(6)
| _ \/ _ \/ _ \/ _ \/ _ => constr:(5)
| _ \/ _ \/ _ \/ _ => constr:(4)
| _ \/ _ \/ _ => constr:(3)
| _ \/ _ => constr:(2)
| _ -> ?T' => get_term_disjunction_arity T'
| _ => let P := get_head T in
let T' := eval unfold P in T in
match T' with
| T => fail 1
| _ => get_term_disjunction_arity T'
end
end.

Ltac get_goal_disjunction_arity :=
match goal with |- ?T => get_term_disjunction_arity T end.

branch NはP1 \/ ... \/ PK \/ ... \/ PNという形のゴールに適用され、ゴールPKを残します。これは先頭の定義(もし存在すれば)だけを展開することができます。より複雑な展開のためには、タクティックbranch K of Nを使うべきです。

Tactic Notation "branch" constr(K) :=
let K := nat_from_number K in
unfold_goal_until_disjunction;
let N := get_goal_disjunction_arity in
branch_tactic K N.

branch K of Nはbranch Kと同様ですが、選言の数Nが手動で与えられ、このため定義を展開できます。言い換えると、P1 \/ ... \/ PK \/ ... \/ PNという形のゴールに適用され、ゴールPKを残します。

Tactic Notation "branch" constr(K) "of" constr(N) :=
let N := nat_from_number N in
let K := nat_from_number K in
branch_tactic K N.

N-選言の分解

branchesの背後の実装。

Ltac destructs_disjunction_tactic N T :=
match N with
| 2 => destruct T as [? | ?]
| 3 => destruct T as [? | [? | ?]]
| 4 => destruct T as [? | [? | [? | ?]]]
| 5 => destruct T as [? | [? | [? | [? | ?]]]]
end.

branches TはN-選言である項Tを分解します。これはdestruct T as [ H1 | .. | HN] と同値で、N個の可能な場合に対応するN個のサブゴールを生成します。

Tactic Notation "branches" constr(T) :=
let TT := type of T in
let N := get_term_disjunction_arity TT in
destructs_disjunction_tactic N T.

branches N Tはbranches Tと同様ですが、選言の個数がNに強制される点が違います。この形は定義をその場で展開したいときに便利です。

Tactic Notation "branches" constr(N) constr(T) :=
let N := nat_from_number N in
destructs_disjunction_tactic N T.

N-変数存在限量

Ltac get_term_existential_arity T :=
match T with
| exists x1 x2 x3 x4 x5 x6 x7 x8, _ => constr:(8)
| exists x1 x2 x3 x4 x5 x6 x7, _ => constr:(7)
| exists x1 x2 x3 x4 x5 x6, _ => constr:(6)
| exists x1 x2 x3 x4 x5, _ => constr:(5)
| exists x1 x2 x3 x4, _ => constr:(4)
| exists x1 x2 x3, _ => constr:(3)
| exists x1 x2, _ => constr:(2)
| exists x1, _ => constr:(1)
| _ -> ?T' => get_term_existential_arity T'
| _ => let P := get_head T in
let T' := eval unfold P in T in
match T' with
| T => fail 1
| _ => get_term_existential_arity T'
end
end.

Ltac get_goal_existential_arity :=
match goal with |- ?T => get_term_existential_arity T end.

exists T1 ... TNはexists T1; ...; exists TNの略記法です。これはexist X1 .. XN, Pという形のゴールを証明することを意図したものです。もし与えられた引数が__(二連アンダースコア)ならば、存在変数が導入されます。exists T1 .. TN ___は、任意個の__についてのexists T1 .. TN __ __ __と同値です。

Tactic Notation "exists_original" constr(T1) :=
exists T1.
Tactic Notation "exists" constr(T1) :=
match T1 with
| ltac_wild => esplit
| ltac_wilds => repeat esplit
| _ => exists T1
end.
Tactic Notation "exists" constr(T1) constr(T2) :=
exists T1; exists T2.
Tactic Notation "exists" constr(T1) constr(T2) constr(T3) :=
exists T1; exists T2; exists T3.
Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4) :=
exists T1; exists T2; exists T3; exists T4.
Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4)
constr(T5) :=
exists T1; exists T2; exists T3; exists T4; exists T5.
Tactic Notation "exists" constr(T1) constr(T2) constr(T3) constr(T4)
constr(T5) constr(T6) :=
exists T1; exists T2; exists T3; exists T4; exists T5; exists T6.

タクティックexists___ NはN個の二連アンダースコアのexists __ ... __の略記法です。タクティックexists_は、ゴールの先頭の構文的な存在限量の数Nについてexists___ Nを呼ぶのと同値です。exists___の振る舞いがexists ___と違うのは、ゴールの定義を展開してはじめて存在限量になる場合です。

Tactic Notation "exists___" constr(N) :=
let rec aux N :=
match N with
| 0 => idtac
| S ?N' => esplit; aux N'
end in
let N := nat_from_number N in aux N.

Tactic Notation "exists___" :=
let N := get_goal_existential_arity in
exists___ N.

仮定内の存在限量と連言

todo: ドキュメンテーション

Ltac intuit_core :=
repeat match goal with
| H: _ /\ _ |- _ => destruct H
| H: exists a, _ |- _ => destruct H
end.

Ltac intuit_from H :=
first [ progress (intuit_core)
| destruct H; intuit_core ].

Tactic Notation "intuit" :=
intuit_core.
Tactic Notation "intuit" constr(H) :=
intuit_from H.

タイプクラスのインスタンスを証明するためのタクティック

typeclassはタイプクラスのインスタンスを発見することに特化された自動化タクティックです。

Tactic Notation "typeclass" :=
let go _ := eauto with typeclass_instances in
solve [ go tt | constructor; go tt ].

solve_typeclassはtypeclassの簡易版です。インスタンスを再度解くヒントタクティックで使われます。

Tactic Notation "solve_typeclass" :=
solve [ eauto with typeclass_instances ].

自動化起動のタクティック

jauto, 新しい自動化タクティック

jautoはintuition eautoと比べて、コンテキストから存在限量を展開できる点が優れています。同時に、jautoはコンテキストから選言を分解しないため、intuition eautoより速い場合があります。jautoの戦略は以下のようにまとめられます:

- コンテキストからすべての存在限量と連言を開きます

- ゴールの存在限量と連言に対して esplit と split を呼びます

- eauto を呼びます。

Ltac jauto_set_hyps := repeat match goal with H: ?T |- _ => match T with | _ / _ => destruct H | exists a, _ => destruct H | _ => generalizes H end end.

Ltac jauto_set_goal := repeat match goal with | |- exists a, _ => esplit | |- _ / _ => split end.

Ltac jauto_set := intros; jauto_set_hyps; intros; jauto_set_goal; unfold not in *.

Tactic Notation “jauto” := try solve [ jauto_set; eauto ].

Tactic Notation “jauto_fast” := try solve [ auto | eauto | jauto ].

iautoはintuition eautoの略記法です

Tactic Notation "iauto" := try solve [intuition eauto].

自動化タクティックの定義

以下の2つのタクティックは、「軽い自動化」(“light automation”)と「強力な自動化」(“strong automation”)のデフォルトの振る舞いを定義します。これらのタクティックは、構文Ltac .. ::= ..を使うことでいつでも再定義できます。

auto_tildeは、タクティックの後に記号~が使われたときにいつでも呼ばれるタクティックです。

Ltac auto_tilde_default := auto.
Ltac auto_tilde := auto_tilde_default.

auto_starは、タクティックの後に記号*が使われたときにいつでも呼ばれるタクティックです。

Ltac auto_star_default := try solve [ auto | eauto | intuition eauto ].

Ltac auto_star := auto_star_default.

auto~はタクティックauto_tildeの記法です。この後に、ゴールを解くために auto が使う補題(または証明項)を付記することができます。

Tactic Notation "auto" "~" :=
auto_tilde.
Tactic Notation "auto" "~" constr(E1) :=
lets: E1; auto_tilde.
Tactic Notation "auto" "~" constr(E1) constr(E2) :=
lets: E1; lets: E2; auto_tilde.
Tactic Notation "auto" "~" constr(E1) constr(E2) constr(E3) :=
lets: E1; lets: E2; lets: E3; auto_tilde.

auto*はタクティックauto_starの記法です。この後に、ゴールを解くために auto が使う補題(または証明項)を付記することができます。

Tactic Notation "auto" "*" :=
auto_star.
Tactic Notation "auto" "*" constr(E1) :=
lets: E1; auto_star.
Tactic Notation "auto" "*" constr(E1) constr(E2) :=
lets: E1; lets: E2; auto_star.
Tactic Notation "auto" "*" constr(E1) constr(E2) constr(E3) :=
lets: E1; lets: E2; lets: E3; auto_star.

auto_falseは、ある種の矛盾を発見できるautoの一種です。auto_false~およびauto_false*も可能です。

Ltac auto_false_base cont :=
try solve [ cont tt | tryfalse by congruence/
| try split; intros_all; tryfalse by congruence/ ].

Tactic Notation "auto_false" :=
auto_false_base ltac:(fun tt => auto).
Tactic Notation "auto_false" "~" :=
auto_false_base ltac:(fun tt => auto~).
Tactic Notation "auto_false" "*" :=
auto_false_base ltac:(fun tt => auto*).

コンパチビリティを構文解析するための定義

Tactic Notation "f_equal" :=
f_equal.
Tactic Notation "constructor" :=
constructor.
Tactic Notation "simple" :=
simpl.

軽い自動化の構文解析

任意のタクティックに記号~を付けると、すべてのサブゴールに対してauto_tildeが呼ばれます。例外が3つあります:

- cutsとassertsは最初のサブゴールにautoだけを呼びます

- apply~はapplyではなくsapplyを使います

- tryfalse~はtryfalse by auto_tildeと定義されています。

いくつかのビルトイン・タクティックはタクティック記法を使って定義されていないため、拡張できません。例えばsimplとunfoldです。これらに対して、simpl~のような記法は使えません。

Tactic Notation "equates" "~" constr(E) :=
equates E; auto~.
Tactic Notation "equates" "~" constr(n1) constr(n2) :=
equates n1 n2; auto~.
Tactic Notation "equates" "~" constr(n1) constr(n2) constr(n3) :=
equates n1 n2 n3; auto~.
Tactic Notation "equates" "~" constr(n1) constr(n2) constr(n3) constr(n4) :=
equates n1 n2 n3 n4; auto~.

Tactic Notation "applys_eq" "~" constr(H) constr(E) :=
applys_eq H E; auto_tilde.
Tactic Notation "applys_eq" "~" constr(H) constr(n1) constr(n2) :=
applys_eq H n1 n2; auto_tilde.
Tactic Notation "applys_eq" "~" constr(H) constr(n1) constr(n2) constr(n3) :=
applys_eq H n1 n2 n3; auto_tilde.
Tactic Notation "applys_eq" "~" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) :=
applys_eq H n1 n2 n3 n4; auto_tilde.

Tactic Notation "apply" "~" constr(H) :=
sapply H; auto_tilde.

Tactic Notation "destruct" "~" constr(H) :=
destruct H; auto_tilde.
Tactic Notation "destruct" "~" constr(H) "as" simple_intropattern(I) :=
destruct H as I; auto_tilde.
Tactic Notation "f_equal" "~" :=
f_equal; auto_tilde.
Tactic Notation "induction" "~" constr(H) :=
induction H; auto_tilde.
Tactic Notation "inversion" "~" constr(H) :=
inversion H; auto_tilde.
Tactic Notation "split" "~" :=
split; auto_tilde.
Tactic Notation "subst" "~" :=
subst; auto_tilde.
Tactic Notation "right" "~" :=
right; auto_tilde.
Tactic Notation "left" "~" :=
left; auto_tilde.
Tactic Notation "constructor" "~" :=
constructor; auto_tilde.
Tactic Notation "constructors" "~" :=
constructors; auto_tilde.

Tactic Notation "false" "~" :=
false; auto_tilde.
Tactic Notation "false" "~" constr(T) :=
false T by auto_tilde/.
Tactic Notation "tryfalse" "~" :=
tryfalse by auto_tilde/.
Tactic Notation "tryfalse_invert" "~" :=
first [ tryfalse~ | false_invert ].

Tactic Notation "asserts" "~" simple_intropattern(H) ":" constr(E) :=
asserts H: E; [ auto_tilde | idtac ].
Tactic Notation "cuts" "~" simple_intropattern(H) ":" constr(E) :=
cuts H: E; [ auto_tilde | idtac ].
Tactic Notation "cuts" "~" ":" constr(E) :=
cuts: E; [ auto_tilde | idtac ].

Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E) :=
lets I: E; auto_tilde.
Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) :=
lets I: E0 A1; auto_tilde.
Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) :=
lets I: E0 A1 A2; auto_tilde.
Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets I: E0 A1 A2 A3; auto_tilde.
Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets I: E0 A1 A2 A3 A4; auto_tilde.
Tactic Notation "lets" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets I: E0 A1 A2 A3 A4 A5; auto_tilde.

Tactic Notation "lets" "~" ":" constr(E) :=
lets: E; auto_tilde.
Tactic Notation "lets" "~" ":" constr(E0)
constr(A1) :=
lets: E0 A1; auto_tilde.
Tactic Notation "lets" "~" ":" constr(E0)
constr(A1) constr(A2) :=
lets: E0 A1 A2; auto_tilde.
Tactic Notation "lets" "~" ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets: E0 A1 A2 A3; auto_tilde.
Tactic Notation "lets" "~" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets: E0 A1 A2 A3 A4; auto_tilde.
Tactic Notation "lets" "~" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets: E0 A1 A2 A3 A4 A5; auto_tilde.

Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E) :=
forwards I: E; auto_tilde.
Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) :=
forwards I: E0 A1; auto_tilde.
Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) :=
forwards I: E0 A1 A2; auto_tilde.
Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
forwards I: E0 A1 A2 A3; auto_tilde.
Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
forwards I: E0 A1 A2 A3 A4; auto_tilde.
Tactic Notation "forwards" "~" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
forwards I: E0 A1 A2 A3 A4 A5; auto_tilde.

Tactic Notation "forwards" "~" ":" constr(E) :=
forwards: E; auto_tilde.
Tactic Notation "forwards" "~" ":" constr(E0)
constr(A1) :=
forwards: E0 A1; auto_tilde.
Tactic Notation "forwards" "~" ":" constr(E0)
constr(A1) constr(A2) :=
forwards: E0 A1 A2; auto_tilde.
Tactic Notation "forwards" "~" ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
forwards: E0 A1 A2 A3; auto_tilde.
Tactic Notation "forwards" "~" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
forwards: E0 A1 A2 A3 A4; auto_tilde.
Tactic Notation "forwards" "~" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
forwards: E0 A1 A2 A3 A4 A5; auto_tilde.

Tactic Notation "applys" "~" constr(H) :=
sapply H; auto_tilde.
Tactic Notation "applys" "~" constr(E0) constr(A1) :=
applys E0 A1; auto_tilde.
Tactic Notation "applys" "~" constr(E0) constr(A1) :=
applys E0 A1; auto_tilde.
Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) :=
applys E0 A1 A2; auto_tilde.
Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) constr(A3) :=
applys E0 A1 A2 A3; auto_tilde.
Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) :=
applys E0 A1 A2 A3 A4; auto_tilde.
Tactic Notation "applys" "~" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
applys E0 A1 A2 A3 A4 A5; auto_tilde.

Tactic Notation "specializes" "~" hyp(H) :=
specializes H; auto_tilde.
Tactic Notation "specializes" "~" hyp(H) constr(A1) :=
specializes H A1; auto_tilde.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) :=
specializes H A1 A2; auto_tilde.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) :=
specializes H A1 A2 A3; auto_tilde.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) :=
specializes H A1 A2 A3 A4; auto_tilde.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
specializes H A1 A2 A3 A4 A5; auto_tilde.

Tactic Notation "fapply" "~" constr(E) :=
fapply E; auto_tilde.
Tactic Notation "sapply" "~" constr(E) :=
sapply E; auto_tilde.

Tactic Notation "logic" "~" constr(E) :=
logic_base E ltac:(fun _ => auto_tilde).

Tactic Notation "intros_all" "~" :=
intros_all; auto_tilde.

Tactic Notation "unfolds" "~" :=
unfolds; auto_tilde.
Tactic Notation "unfolds" "~" reference(F1) :=
unfolds F1; auto_tilde.
Tactic Notation "unfolds" "~" reference(F1) "," reference(F2) :=
unfolds F1, F2; auto_tilde.
Tactic Notation "unfolds" "~" reference(F1) "," reference(F2) "," reference(F3) :=
unfolds F1, F2, F3; auto_tilde.
Tactic Notation "unfolds" "~" reference(F1) "," reference(F2) "," reference(F3) ","
reference(F4) :=
unfolds F1, F2, F3, F4; auto_tilde.

Tactic Notation "simple" "~" :=
simpl; auto_tilde.
Tactic Notation "simple" "~" "in" hyp(H) :=
simpl in H; auto_tilde.
Tactic Notation "simpls" "~" :=
simpls; auto_tilde.
Tactic Notation "hnfs" "~" :=
hnfs; auto_tilde.
Tactic Notation "substs" "~" :=
substs; auto_tilde.
Tactic Notation "intro_hyp" "~" hyp(H) :=
subst_hyp H; auto_tilde.
Tactic Notation "intro_subst" "~" :=
intro_subst; auto_tilde.
Tactic Notation "subst_eq" "~" constr(E) :=
subst_eq E; auto_tilde.

Tactic Notation "rewrite" "~" constr(E) :=
rewrite E; auto_tilde.
Tactic Notation "rewrite" "~" "<-" constr(E) :=
rewrite <- E; auto_tilde.
Tactic Notation "rewrite" "~" constr(E) "in" hyp(H) :=
rewrite E in H; auto_tilde.
Tactic Notation "rewrite" "~" "<-" constr(E) "in" hyp(H) :=
rewrite <- E in H; auto_tilde.

Tactic Notation "rewrite_all" "~" constr(E) :=
rewrite_all E; auto_tilde.
Tactic Notation "rewrite_all" "~" "<-" constr(E) :=
rewrite_all <- E; auto_tilde.
Tactic Notation "rewrite_all" "~" constr(E) "in" ident(H) :=
rewrite_all E in H; auto_tilde.
Tactic Notation "rewrite_all" "~" "<-" constr(E) "in" ident(H) :=
rewrite_all <- E in H; auto_tilde.
Tactic Notation "rewrite_all" "~" constr(E) "in" "*" :=
rewrite_all E in *; auto_tilde.
Tactic Notation "rewrite_all" "~" "<-" constr(E) "in" "*" :=
rewrite_all <- E in *; auto_tilde.

Tactic Notation "asserts_rewrite" "~" constr(E) :=
asserts_rewrite E; auto_tilde.
Tactic Notation "asserts_rewrite" "~" "<-" constr(E) :=
asserts_rewrite <- E; auto_tilde.
Tactic Notation "asserts_rewrite" "~" constr(E) "in" hyp(H) :=
asserts_rewrite E in H; auto_tilde.
Tactic Notation "asserts_rewrite" "~" "<-" constr(E) "in" hyp(H) :=
asserts_rewrite <- E in H; auto_tilde.

Tactic Notation "cuts_rewrite" "~" constr(E) :=
cuts_rewrite E; auto_tilde.
Tactic Notation "cuts_rewrite" "~" "<-" constr(E) :=
cuts_rewrite <- E; auto_tilde.
Tactic Notation "cuts_rewrite" "~" constr(E) "in" hyp(H) :=
cuts_rewrite E in H; auto_tilde.
Tactic Notation "cuts_rewrite" "~" "<-" constr(E) "in" hyp(H) :=
cuts_rewrite <- E in H; auto_tilde.

Tactic Notation "fequal" "~" :=
fequal; auto_tilde.
Tactic Notation "fequals" "~" :=
fequals; auto_tilde.
Tactic Notation "pi_rewrite" "~" constr(E) :=
pi_rewrite E; auto_tilde.
Tactic Notation "pi_rewrite" "~" constr(E) "in" hyp(H) :=
pi_rewrite E in H; auto_tilde.

Tactic Notation "invert" "~" hyp(H) :=
invert H; auto_tilde.
Tactic Notation "inverts" "~" hyp(H) :=
inverts H; auto_tilde.
Tactic Notation "injects" "~" hyp(H) :=
injects H; auto_tilde.
Tactic Notation "inversions" "~" hyp(H) :=
inversions H; auto_tilde.

Tactic Notation "cases" "~" constr(E) "as" ident(H) :=
cases E as H; auto_tilde.
Tactic Notation "cases" "~" constr(E) :=
cases E; auto_tilde.
Tactic Notation "case_if" "~" :=
case_if; auto_tilde.
Tactic Notation "case_if" "~" "in" hyp(H) :=
case_if in H; auto_tilde.
Tactic Notation "cases_if" "~" :=
cases_if; auto_tilde.
Tactic Notation "cases_if" "~" "in" hyp(H) :=
cases_if in H; auto_tilde.
Tactic Notation "destruct_if" "~" :=
destruct_if; auto_tilde.
Tactic Notation "destruct_if" "~" "in" hyp(H) :=
destruct_if in H; auto_tilde.
Tactic Notation "destruct_head_match" "~" :=
destruct_head_match; auto_tilde.

Tactic Notation "cases'" "~" constr(E) "as" ident(H) :=
cases' E as H; auto_tilde.
Tactic Notation "cases'" "~" constr(E) :=
cases' E; auto_tilde.
Tactic Notation "cases_if'" "~" "as" ident(H) :=
cases_if' as H; auto_tilde.
Tactic Notation "cases_if'" "~" :=
cases_if'; auto_tilde.

Tactic Notation "decides_equality" "~" :=
decides_equality; auto_tilde.

Tactic Notation "iff" "~" :=
iff; auto_tilde.
Tactic Notation "splits" "~" :=
splits; auto_tilde.
Tactic Notation "splits" "~" constr(N) :=
splits N; auto_tilde.
Tactic Notation "splits_all" "~" :=
splits_all; auto_tilde.

Tactic Notation "destructs" "~" constr(T) :=
destructs T; auto_tilde.
Tactic Notation "destructs" "~" constr(N) constr(T) :=
destructs N T; auto_tilde.

Tactic Notation "branch" "~" constr(N) :=
branch N; auto_tilde.
Tactic Notation "branch" "~" constr(K) "of" constr(N) :=
branch K of N; auto_tilde.

Tactic Notation "branches" "~" constr(T) :=
branches T; auto_tilde.
Tactic Notation "branches" "~" constr(N) constr(T) :=
branches N T; auto_tilde.

Tactic Notation "exists___" "~" :=
exists___; auto_tilde.
Tactic Notation "exists" "~" constr(T1) :=
exists T1; auto_tilde.
Tactic Notation "exists" "~" constr(T1) constr(T2) :=
exists T1 T2; auto_tilde.
Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) :=
exists T1 T2 T3; auto_tilde.
Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4) :=
exists T1 T2 T3 T4; auto_tilde.
Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4)
constr(T5) :=
exists T1 T2 T3 T4 T5; auto_tilde.
Tactic Notation "exists" "~" constr(T1) constr(T2) constr(T3) constr(T4)
constr(T5) constr(T6) :=
exists T1 T2 T3 T4 T5 T6; auto_tilde.

強力な自動化の構文解析

任意のタクティックに記号*を付けると、すべてのサブゴールに対してauto*が呼ばれます。例外は、軽い自動化と同じです。

例外: ライブラリCoq.Classes.Equivalenceを import したいときは、subst*ではなくsubs*を使ってください。

Tactic Notation "equates" "*" constr(E) :=
equates E; auto_star.
Tactic Notation "equates" "*" constr(n1) constr(n2) :=
equates n1 n2; auto_star.
Tactic Notation "equates" "*" constr(n1) constr(n2) constr(n3) :=
equates n1 n2 n3; auto_star.
Tactic Notation "equates" "*" constr(n1) constr(n2) constr(n3) constr(n4) :=
equates n1 n2 n3 n4; auto_star.

Tactic Notation "applys_eq" "*" constr(H) constr(E) :=
applys_eq H E; auto_star.
Tactic Notation "applys_eq" "*" constr(H) constr(n1) constr(n2) :=
applys_eq H n1 n2; auto_star.
Tactic Notation "applys_eq" "*" constr(H) constr(n1) constr(n2) constr(n3) :=
applys_eq H n1 n2 n3; auto_star.
Tactic Notation "applys_eq" "*" constr(H) constr(n1) constr(n2) constr(n3) constr(n4) :=
applys_eq H n1 n2 n3 n4; auto_star.

Tactic Notation "apply" "*" constr(H) :=
sapply H; auto_star.

Tactic Notation "destruct" "*" constr(H) :=
destruct H; auto_star.
Tactic Notation "destruct" "*" constr(H) "as" simple_intropattern(I) :=
destruct H as I; auto_star.
Tactic Notation "f_equal" "*" :=
f_equal; auto_star.
Tactic Notation "induction" "*" constr(H) :=
induction H; auto_star.
Tactic Notation "inversion" "*" constr(H) :=
inversion H; auto_star.
Tactic Notation "split" "*" :=
split; auto_star.
Tactic Notation "subs" "*" :=
subst; auto_star.
Tactic Notation "subst" "*" :=
subst; auto_star.
Tactic Notation "right" "*" :=
right; auto_star.
Tactic Notation "left" "*" :=
left; auto_star.
Tactic Notation "constructor" "*" :=
constructor; auto_star.
Tactic Notation "constructors" "*" :=
constructors; auto_star.

Tactic Notation "false" "*" :=
false; auto_star.
Tactic Notation "false" "*" constr(T) :=
false T by auto_star/.
Tactic Notation "tryfalse" "*" :=
tryfalse by auto_star/.
Tactic Notation "tryfalse_invert" "*" :=
first [ tryfalse* | false_invert ].

Tactic Notation "asserts" "*" simple_intropattern(H) ":" constr(E) :=
asserts H: E; [ auto_star | idtac ].
Tactic Notation "cuts" "*" simple_intropattern(H) ":" constr(E) :=
cuts H: E; [ auto_star | idtac ].
Tactic Notation "cuts" "*" ":" constr(E) :=
cuts: E; [ auto_star | idtac ].

Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E) :=
lets I: E; auto_star.
Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) :=
lets I: E0 A1; auto_star.
Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) :=
lets I: E0 A1 A2; auto_star.
Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets I: E0 A1 A2 A3; auto_star.
Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets I: E0 A1 A2 A3 A4; auto_star.
Tactic Notation "lets" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets I: E0 A1 A2 A3 A4 A5; auto_star.

Tactic Notation "lets" "*" ":" constr(E) :=
lets: E; auto_star.
Tactic Notation "lets" "*" ":" constr(E0)
constr(A1) :=
lets: E0 A1; auto_star.
Tactic Notation "lets" "*" ":" constr(E0)
constr(A1) constr(A2) :=
lets: E0 A1 A2; auto_star.
Tactic Notation "lets" "*" ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
lets: E0 A1 A2 A3; auto_star.
Tactic Notation "lets" "*" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
lets: E0 A1 A2 A3 A4; auto_star.
Tactic Notation "lets" "*" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
lets: E0 A1 A2 A3 A4 A5; auto_star.

Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E) :=
forwards I: E; auto_star.
Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) :=
forwards I: E0 A1; auto_star.
Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) :=
forwards I: E0 A1 A2; auto_star.
Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
forwards I: E0 A1 A2 A3; auto_star.
Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
forwards I: E0 A1 A2 A3 A4; auto_star.
Tactic Notation "forwards" "*" simple_intropattern(I) ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
forwards I: E0 A1 A2 A3 A4 A5; auto_star.

Tactic Notation "forwards" "*" ":" constr(E) :=
forwards: E; auto_star.
Tactic Notation "forwards" "*" ":" constr(E0)
constr(A1) :=
forwards: E0 A1; auto_star.
Tactic Notation "forwards" "*" ":" constr(E0)
constr(A1) constr(A2) :=
forwards: E0 A1 A2; auto_star.
Tactic Notation "forwards" "*" ":" constr(E0)
constr(A1) constr(A2) constr(A3) :=
forwards: E0 A1 A2 A3; auto_star.
Tactic Notation "forwards" "*" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) :=
forwards: E0 A1 A2 A3 A4; auto_star.
Tactic Notation "forwards" "*" ":" constr(E0)
constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
forwards: E0 A1 A2 A3 A4 A5; auto_star.

Tactic Notation "applys" "*" constr(H) :=
sapply H; auto_star.
Tactic Notation "applys" "*" constr(E0) constr(A1) :=
applys E0 A1; auto_star.
Tactic Notation "applys" "*" constr(E0) constr(A1) :=
applys E0 A1; auto_star.
Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) :=
applys E0 A1 A2; auto_star.
Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) constr(A3) :=
applys E0 A1 A2 A3; auto_star.
Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) :=
applys E0 A1 A2 A3 A4; auto_star.
Tactic Notation "applys" "*" constr(E0) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
applys E0 A1 A2 A3 A4 A5; auto_star.

Tactic Notation "specializes" "*" hyp(H) :=
specializes H; auto_star.
Tactic Notation "specializes" "~" hyp(H) constr(A1) :=
specializes H A1; auto_star.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) :=
specializes H A1 A2; auto_star.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) :=
specializes H A1 A2 A3; auto_star.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) :=
specializes H A1 A2 A3 A4; auto_star.
Tactic Notation "specializes" hyp(H) constr(A1) constr(A2) constr(A3) constr(A4) constr(A5) :=
specializes H A1 A2 A3 A4 A5; auto_star.

Tactic Notation "fapply" "*" constr(E) :=
fapply E; auto_star.
Tactic Notation "sapply" "*" constr(E) :=
sapply E; auto_star.

Tactic Notation "logic" constr(E) :=
logic_base E ltac:(fun _ => auto_star).

Tactic Notation "intros_all" "*" :=
intros_all; auto_star.

Tactic Notation "unfolds" "*" :=
unfolds; auto_star.
Tactic Notation "unfolds" "*" reference(F1) :=
unfolds F1; auto_star.
Tactic Notation "unfolds" "*" reference(F1) "," reference(F2) :=
unfolds F1, F2; auto_star.
Tactic Notation "unfolds" "*" reference(F1) "," reference(F2) "," reference(F3) :=
unfolds F1, F2, F3; auto_star.
Tactic Notation "unfolds" "*" reference(F1) "," reference(F2) "," reference(F3) ","
reference(F4) :=
unfolds F1, F2, F3, F4; auto_star.

Tactic Notation "simple" "*" :=
simpl; auto_star.
Tactic Notation "simple" "*" "in" hyp(H) :=
simpl in H; auto_star.
Tactic Notation "simpls" "*" :=
simpls; auto_star.
Tactic Notation "hnfs" "*" :=
hnfs; auto_star.
Tactic Notation "substs" "*" :=
substs; auto_star.
Tactic Notation "intro_hyp" "*" hyp(H) :=
subst_hyp H; auto_star.
Tactic Notation "intro_subst" "*" :=
intro_subst; auto_star.
Tactic Notation "subst_eq" "*" constr(E) :=
subst_eq E; auto_star.

Tactic Notation "rewrite" "*" constr(E) :=
rewrite E; auto_star.
Tactic Notation "rewrite" "*" "<-" constr(E) :=
rewrite <- E; auto_star.
Tactic Notation "rewrite" "*" constr(E) "in" hyp(H) :=
rewrite E in H; auto_star.
Tactic Notation "rewrite" "*" "<-" constr(E) "in" hyp(H) :=
rewrite <- E in H; auto_star.

Tactic Notation "rewrite_all" "*" constr(E) :=
rewrite_all E; auto_star.
Tactic Notation "rewrite_all" "*" "<-" constr(E) :=
rewrite_all <- E; auto_star.
Tactic Notation "rewrite_all" "*" constr(E) "in" ident(H) :=
rewrite_all E in H; auto_star.
Tactic Notation "rewrite_all" "*" "<-" constr(E) "in" ident(H) :=
rewrite_all <- E in H; auto_star.
Tactic Notation "rewrite_all" "*" constr(E) "in" "*" :=
rewrite_all E in *; auto_star.
Tactic Notation "rewrite_all" "*" "<-" constr(E) "in" "*" :=
rewrite_all <- E in *; auto_star.

Tactic Notation "asserts_rewrite" "*" constr(E) :=
asserts_rewrite E; auto_star.
Tactic Notation "asserts_rewrite" "*" "<-" constr(E) :=
asserts_rewrite <- E; auto_star.
Tactic Notation "asserts_rewrite" "*" constr(E) "in" hyp(H) :=
asserts_rewrite E; auto_star.
Tactic Notation "asserts_rewrite" "*" "<-" constr(E) "in" hyp(H) :=
asserts_rewrite <- E; auto_star.

Tactic Notation "cuts_rewrite" "*" constr(E) :=
cuts_rewrite E; auto_star.
Tactic Notation "cuts_rewrite" "*" "<-" constr(E) :=
cuts_rewrite <- E; auto_star.
Tactic Notation "cuts_rewrite" "*" constr(E) "in" hyp(H) :=
cuts_rewrite E in H; auto_star.
Tactic Notation "cuts_rewrite" "*" "<-" constr(E) "in" hyp(H) :=
cuts_rewrite <- E in H; auto_star.

Tactic Notation "fequal" "*" :=
fequal; auto_star.
Tactic Notation "fequals" "*" :=
fequals; auto_star.
Tactic Notation "pi_rewrite" "*" constr(E) :=
pi_rewrite E; auto_star.
Tactic Notation "pi_rewrite" "*" constr(E) "in" hyp(H) :=
pi_rewrite E in H; auto_star.

Tactic Notation "invert" "*" hyp(H) :=
invert H; auto_star.
Tactic Notation "inverts" "*" hyp(H) :=
inverts H; auto_star.
Tactic Notation "injects" "*" hyp(H) :=
injects H; auto_star.
Tactic Notation "inversions" "*" hyp(H) :=
inversions H; auto_star.

Tactic Notation "cases" "*" constr(E) "as" ident(H) :=
cases E as H; auto_star.
Tactic Notation "cases" "*" constr(E) :=
cases E; auto_star.
Tactic Notation "case_if" "*" :=
case_if; auto_star.
Tactic Notation "case_if" "*" "in" hyp(H) :=
case_if in H; auto_star.
Tactic Notation "cases_if" "*" :=
cases_if; auto_star.
Tactic Notation "cases_if" "*" "in" hyp(H) :=
cases_if in H; auto_star.
Tactic Notation "destruct_if" "*" :=
destruct_if; auto_star.
Tactic Notation "destruct_if" "*" "in" hyp(H) :=
destruct_if in H; auto_star.
Tactic Notation "destruct_head_match" "*" :=
destruct_head_match; auto_star.

Tactic Notation "cases'" "*" constr(E) "as" ident(H) :=
cases' E as H; auto_star.
Tactic Notation "cases'" "*" constr(E) :=
cases' E; auto_star.
Tactic Notation "cases_if'" "*" "as" ident(H) :=
cases_if' as H; auto_star.
Tactic Notation "cases_if'" "*" :=
cases_if'; auto_star.

Tactic Notation "decides_equality" "*" :=
decides_equality; auto_star.

Tactic Notation "iff" "*" :=
iff; auto_star.
Tactic Notation "splits" "*" :=
splits; auto_star.
Tactic Notation "splits" "*" constr(N) :=
splits N; auto_star.
Tactic Notation "splits_all" "*" :=
splits_all; auto_star.

Tactic Notation "destructs" "*" constr(T) :=
destructs T; auto_star.
Tactic Notation "destructs" "*" constr(N) constr(T) :=
destructs N T; auto_star.

Tactic Notation "branch" "*" constr(N) :=
branch N; auto_star.
Tactic Notation "branch" "*" constr(K) "of" constr(N) :=
branch K of N; auto_star.

Tactic Notation "branches" "*" constr(T) :=
branches T; auto_star.
Tactic Notation "branches" "*" constr(N) constr(T) :=
branches N T; auto_star.

Tactic Notation "exists___" "*" :=
exists___; auto_star.
Tactic Notation "exists" "*" constr(T1) :=
exists T1; auto_star.
Tactic Notation "exists" "*" constr(T1) constr(T2) :=
exists T1 T2; auto_star.
Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) :=
exists T1 T2 T3; auto_star.
Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4) :=
exists T1 T2 T3 T4; auto_star.
Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4)
constr(T5) :=
exists T1 T2 T3 T4 T5; auto_star.
Tactic Notation "exists" "*" constr(T1) constr(T2) constr(T3) constr(T4)
constr(T5) constr(T6) :=
exists T1 T2 T3 T4 T5 T6; auto_star.

証明コンテキストを整理するためのタクティック

仮定の隠蔽

Definition ltac_something (P:Type) (e:P) := e.

Notation "'Something'" :=
(@ltac_something _ _).

Lemma ltac_something_eq : forall (e:Type),
e = (@ltac_something _ e).
Proof. auto. Qed.

Lemma ltac_something_hide : forall (e:Type),
e -> (@ltac_something _ e).
Proof. auto. Qed.

Lemma ltac_something_show : forall (e:Type),
(@ltac_something _ e) -> e.
Proof. auto. Qed.

hide_def xとshow_def xによって、定義xの本体を隠蔽/明示化できます。

Tactic Notation "hide_def" hyp(x) :=
let x' := constr:(x) in
let T := eval unfold x in x' in
change T with (@ltac_something _ T) in x.

Tactic Notation "show_def" hyp(x) :=
let x' := constr:(x) in
let U := eval unfold x in x' in
match U with @ltac_something _ ?T =>
change U with T in x end.

show_defはゴールのSomethingを展開します

Tactic Notation "show_def" :=
unfold ltac_something.

Tactic Notation "show_def" "in" "*" :=
unfold ltac_something in *.

hide_defsとshow_defsはすべての定義に適用されます

Tactic Notation "hide_defs" :=
repeat match goal with H := ?T |- _ =>
match T with
| @ltac_something _ _ => fail 1
| _ => change T with (@ltac_something _ T) in H
end
end.

Tactic Notation "show_defs" :=
repeat match goal with H := (@ltac_something _ ?T) |- _ =>
change (@ltac_something _ T) with T in H end.

hide_hyp HはHの型の表記をSomethingに変え、show_hyp Hは仮定の型を明示します。なお、Hの隠された型でもHの実際の型と同様にはたらきます。

Tactic Notation "show_hyp" hyp(H) :=
apply ltac_something_show in H.

Tactic Notation "hide_hyp" hyp(H) :=
apply ltac_something_hide in H.

hide_hypsとshow_hypsは、型Propのすべての仮定を隠蔽/明示化します。

Tactic Notation "show_hyps" :=
repeat match goal with
H: @ltac_something _ _ |- _ => show_hyp H end.

Tactic Notation "hide_hyps" :=
repeat match goal with H: ?T |- _ =>
match type of T with
| Prop =>
match T with
| @ltac_something _ _ => fail 2
| _ => hide_hyp H
end
| _ => fail 1
end
end.

hide Hとshow Hはそれぞれ、hide_hypまたはhide_defを、あるいは、show_hypまたはshow_defを自動的に選択します。同様に、hide_allとshow_allはすべてに適用されます。

Tactic Notation "hide" hyp(H) :=
first [hide_def H | hide_hyp H].

Tactic Notation "show" hyp(H) :=
first [show_def H | show_hyp H].

Tactic Notation "hide_all" :=
hide_hyps; hide_defs.

Tactic Notation "show_all" :=
unfold ltac_something in *.

hide_term Eはゴールから項を隠すのに使います。show_termまたはshow_term Eは隠された項を明示化するために使います。hide_term E in Hは仮定を指定するときに使います。

Tactic Notation "hide_term" constr(E) :=
change E with (@ltac_something _ E).
Tactic Notation "show_term" constr(E) :=
change (@ltac_something _ E) with E.
Tactic Notation "show_term" :=
unfold ltac_something.

Tactic Notation "hide_term" constr(E) "in" hyp(H) :=
change E with (@ltac_something _ E) in H.
Tactic Notation "show_term" constr(E) "in" hyp(H) :=
change (@ltac_something _ E) with E in H.
Tactic Notation "show_term" "in" hyp(H) :=
unfold ltac_something in H.

仮定のソーティング

sortはコンテキストの仮定を並び変えて、すべての命題(型 Prop の仮定)がコンテキストの下部に来るようにします。

Ltac sort_tactic :=
try match goal with H: ?T |- _ =>
match type of T with Prop =>
generalizes H; (try sort_tactic); intro
end end.

Tactic Notation "sort" :=
sort_tactic.

仮定のクリア

clears X1 ... XNはclearの変種で、変数X1..XNとそれらに依存するすべての仮定をクリアします。clearと対照的に、失敗することはありません。

Tactic Notation "clears" ident(X1) :=
let rec doit _ :=
match goal with
| H:context[X1] |- _ => clear H; try (doit tt)
| _ => clear X1
end in doit tt.
Tactic Notation "clears" ident(X1) ident(X2) :=
clears X1; clears X2.
Tactic Notation "clears" ident(X1) ident(X2) ident(X3) :=
clears X1; clears X2; clear X3.
Tactic Notation "clears" ident(X1) ident(X2) ident(X3) ident(X4) :=
clears X1; clears X2; clear X3; clear X4.
Tactic Notation "clears" ident(X1) ident(X2) ident(X3) ident(X4)
ident(X5) :=
clears X1; clears X2; clear X3; clear X4; clear X5.
Tactic Notation "clears" ident(X1) ident(X2) ident(X3) ident(X4)
ident(X5) ident(X6) :=
clears X1; clears X2; clear X3; clear X4; clear X5; clear X6.

clears(引数なし)は使われていないすべての変数をコンテキストからクリアします。言い換えると、命題(型 Prop を持つもの)でもなく、別の仮定にもゴールにも現れないすべての変数を除去します。

Ltac clears_tactic :=
match goal with H: ?T |- _ =>
match type of T with
| Prop => generalizes H; (try clears_tactic); intro
| ?TT => clear H; (try clears_tactic)
| ?TT => generalizes H; (try clears_tactic); intro
end end.

Tactic Notation "clears" :=
clears_tactic.

clears_allは消すことができるすべての仮定をゴールからクリアします。残るのは、ゴールで言及されている仮定だけです。

Tactic Notation "clears_all" :=
repeat match goal with H: _ |- _ => clear H end.

clears_lastはコンテキストから最後の仮定をクリアします。clears_last Nは最後のN個の仮定をコンテキストからクリアします。

Tactic Notation "clears_last" :=
match goal with H: ?T |- _ => clear H end.

Ltac clears_last_base N :=
match nat_from_number N with
| 0 => idtac
| S ?p => clears_last; clears_last_base p
end.

Tactic Notation "clears_last" constr(N) :=
clears_last_base N.

開発目的のタクティック

サブゴールのスキップ

skipタクティックは現在のゴールをいつでも admit するために使います。skipを使うことは、トップレベルのコマンドFocusを使うより、特定のサブゴールに到達するのには、はるかに効率的です。

skipには2つの可能な実装があります。1つは存在変数を利用するもの、もう1つは型Falseについての公理に依存するものです。なお、現在のゴールが具体化されない変数を含んでいるときにはビルトイン・タクティックadmitは適用できないことに注意します。

1つ目の方法の優れた点は、skipを使った証明はAdmittedで終わらなければならなくなることです。なぜなら、Qedを使っても”uninstantiated existential variables“(具体化されていない存在変数)というメッセージが出て受理されないからです。このことで証明が未完であることが明確になります。

2つ目の方法の優れた点は、ちょうど逆になります。証明をQedで締めることができ、これから、QedをAdmittedに直したり、その逆をしたりをやり続ける苦労をしなくて済みます。なお、それでも、Qedが受理されるためには、他のタクティックによって導入された存在変数は、すべて具体化しなければなりません。

2つの実装を提供しますので、自分に合う方を選んでください。デフォルトでは、skip'は1つ目の実装を使い、skipは2つ目の実装を使います。

Ltac skip_with_existential :=
match goal with |- ?G =>
let H := fresh in evar(H:G); eexact H end.

Variable skip_axiom : False.

Ltac skip_with_axiom :=
elimtype False; apply skip_axiom.

Tactic Notation "skip" :=
skip_with_axiom.
Tactic Notation "skip'" :=
skip_with_existential.

skip H: Tは現在のコンテキストに型Tの仮定Hを追加します。このときにHは無批判に真と仮定されます。skip: Tとskip H_asserts: Tとskip_asserts: Tも構文として可能です。なお、H は intro パターンでも構いません。TがN個の連言のとき、構文skip H1 .. HN: Tも可能です。

Tactic Notation "skip" simple_intropattern(I) ":" constr(T) :=
asserts I: T; [ skip | ].
Tactic Notation "skip" ":" constr(T) :=
let H := fresh in skip H: T.

Tactic Notation "skip" simple_intropattern(I1)
simple_intropattern(I2) ":" constr(T) :=
skip [I1 I2]: T.
Tactic Notation "skip" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3) ":" constr(T) :=
skip [I1 [I2 I3]]: T.
Tactic Notation "skip" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) ":" constr(T) :=
skip [I1 [I2 [I3 I4]]]: T.
Tactic Notation "skip" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) simple_intropattern(I5) ":" constr(T) :=
skip [I1 [I2 [I3 [I4 I5]]]]: T.
Tactic Notation "skip" simple_intropattern(I1)
simple_intropattern(I2) simple_intropattern(I3)
simple_intropattern(I4) simple_intropattern(I5)
simple_intropattern(I6) ":" constr(T) :=
skip [I1 [I2 [I3 [I4 [I5 I6]]]]]: T.

Tactic Notation "skip_asserts" simple_intropattern(I) ":" constr(T) :=
skip I: T.
Tactic Notation "skip_asserts" ":" constr(T) :=
skip: T.

skip_cuts Tは単に現在のゴールをTに置きかえます。

Tactic Notation "skip_cuts" constr(T) :=
cuts: T; [ skip | ].

skip_goal Hは任意のゴールに適用できます。単に現在のゴールを真と仮定します。その仮定に “H” という名前を付けます。帰納法(induction)や余帰納法(coinduction)による証明の準備のときに便利です。構文skip_goalも可能です。

Tactic Notation "skip_goal" ident(H) :=
match goal with |- ?G => skip H: G end.

Tactic Notation "skip_goal" :=
let IH := fresh "IH" in skip_goal IH.

skip_rewrite TはTが等式のときに適用できます。この等式を無批判に成立するものとし、ゴールをこの等式について書き換えします。

Tactic Notation "skip_rewrite" constr(T) :=
let M := fresh in skip_asserts M: T; rewrite M; clear M.

skip_rewrite T in Hはrewrite_skipと同様ですが、仮定Hを書き換える点が違います。

Tactic Notation "skip_rewrite" constr(T) "in" hyp(H) :=
let M := fresh in skip_asserts M: T; rewrite M in H; clear M.

skip_rewrites_all Tはrewrite_skipと同様ですが、すべての場所(ゴールとすべての仮定)を書き換える点が違います。

Tactic Notation "skip_rewrite_all" constr(T) :=
let M := fresh in skip_asserts M: T; rewrite_all M; clear M.

skip_induction Eは任意のゴールに適用できます。現在のゴールを無批判に成立するものと仮定し(この仮定はデフォルトでは”IH”と名付けられます)、induction Eではなくdestruct Eを呼びます。これは、最初に帰納法による証明の準備を整え、証明の第2パスで帰納法の仮定の適用を調整していくときに便利です。

Tactic Notation "skip_induction" constr(E) :=
let IH := fresh "IH" in skip_goal IH; destruct E.

Tactic Notation "skip_induction" constr(E) "as" simple_intropattern(I) :=
let IH := fresh "IH" in skip_goal IH; destruct E as I.

標準ライブラリとのコンパチビリティ

モジュールProgramは現在のモジュールと衝突する定義を含んでいます。Programを直接または間接的に import するときには(Programを間接的に import するのは、例えばSetoidやZArithを利用するときです)、トップレベルのコマンドRequire Import LibTacticsCompatibilityを行って、コンパチビリティの定義を import する必要があります。

Module LibTacticsCompatibility.
Tactic Notation "apply" "*" constr(H) :=
sapply H; auto_star.
Tactic Notation "subst" "*" :=
subst; auto_star.
End LibTacticsCompatibility.

Open Scope nat_scope.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 次へ |

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

PE_J: 部分評価

Equiv_J.v ではプログラム変換の例として定数畳み込みを紹介し、そして、それがプログラムの意味を保存することを証明しました。定数畳み込みはANum式のようなマニフェスト定数(リテラル)を処理します。例えば、コマンドY ::= APlus (ANum 3) (ANum 1)をコマンドY ::= ANum 4に単純化します。しかしながら、この操作は、定数とわかったことをデータフローに沿って伝播することは行いません。例えば、次の列

X ::= ANum 3; Y ::= APlus (AId X) (ANum 1)

を

X ::= ANum 3; Y ::= ANum 4

に単純化することはありません。なぜなら、Xが3であったことは、Yに渡された時には忘れられてしまうからです。

定数畳み込みを強化して、定数と分かったことを伝播し、それを使ってプログラムを単純化するようにしたいと思うのは自然なことです。そうすることは、部分評価(partial evaluation)の初歩的な形となります。これから見るように、これを部分評価と呼ぶのは、プログラムを走らせることと似ているからです。ただ違うのは、プログラムの一部だけが評価されることです。その理由はプログラムの入力の一部だけがわかっているからです。例えば、Yの初期値がわからないとき、プログラム

X ::= ANum 3; Y ::= AMinus (APlus (AId X) (ANum 1)) (AId Y)

を単純化できるのは

X ::= ANum 3; Y ::= AMinus (ANum 4) (AId Y)

までです。

Require Export Imp_J.
Require Import FunctionalExtensionality.

定数畳み込みを一般化する

部分評価について最初にやることは、状態についての部分知識を表現することです。例えば上述の2つの代入において、部分評価器はXが3であることだけを知っており、他の変数については何も知らないでしょう。

部分状態

概念的には、(完全な具体的状態の型がid -> natであるのに対して)部分状態は型id -> option natと考えることができます。しかしながら、部分状態の個別の変数の状態を参照/更新するだけでなく、条件分岐の制御フローを扱うために、2つの部分状態を比較して、同じかどうか、あるいは違いはどこかを知りたいことがあるでしょう。2つの任意の関数をこのように比較することはできません。このため、部分状態をより具体的な形、つまりid * nat対のリストとして表現します。

Definition pe_state := list (id * nat).

これは、変数idがこのリストに現れることが、その変数の現在のnat値を知っていることとするというアイデアです。そしてpe_lookup関数はこの具体的表現を解釈します。(もし同じ変数idがこのリストに複数回現れるならば、最初の出現が有効です。ただ、部分評価器はそのようなpe_stateを構成することがないように定義します。)

Fixpoint pe_lookup (pe_st : pe_state) (V:id) : option nat :=
match pe_st with
| [] => None
| (V',n')::pe_st => if beq_id V V' then Some n'
else pe_lookup pe_st V
end.

例えば、empty_pe_stateはすべての変数を完全に無視することを表します。すべてのidをNoneに写像する関数です。

Definition empty_pe_state : pe_state := [].

より一般に、もしpe_stateを表現するlistが、あるidを含まないならば、pe_stateはidをNoneに写像しなければなりません。この事実を証明する前に、まずidの等号関係の推論に関する便利なタクティックを定義します。タクティック

compare V V' SCase

はbeq_id V V'がtrueかfalseかで場合分けする推論をすることを意味します。beq_id V V' = trueの場合、このタクティックは一貫してVをV'に置換します。

Tactic Notation "compare" ident(i) ident(j) ident(c) :=
let H := fresh "Heq" i j in
destruct (beq_id i j) as [|]_eqn:H;
[ Case_aux c "equal"; symmetry in H; apply beq_id_eq in H; subst j
| Case_aux c "not equal" ].

Theorem pe_domain: forall pe_st V n,
pe_lookup pe_st V = Some n ->
true = existsb (beq_id V) (map (@fst _ _) pe_st).
Proof. intros pe_st V n H. induction pe_st as [| [V' n'] pe_st].
Case "[]". inversion H.
Case "::". simpl in H. simpl. compare V V' SCase; auto. Qed.

算術式

aexpの部分評価は簡単です。基本的には定数畳み込みfold_constants_aexpと同じです。違うのは、部分状態が変数の現在の値を教えてくれる場合があるので、その時に変数を定数式に置換できるということです。

Fixpoint pe_aexp (pe_st : pe_state) (a : aexp) : aexp :=
match a with
| ANum n => ANum n
| AId i => match pe_lookup pe_st i with
| Some n => ANum n
| None => AId i
end
| APlus a1 a2 =>
match (pe_aexp pe_st a1, pe_aexp pe_st a2) with
| (ANum n1, ANum n2) => ANum (n1 + n2)
| (a1', a2') => APlus a1' a2'
end
| AMinus a1 a2 =>
match (pe_aexp pe_st a1, pe_aexp pe_st a2) with
| (ANum n1, ANum n2) => ANum (n1 - n2)
| (a1', a2') => AMinus a1' a2'
end
| AMult a1 a2 =>
match (pe_aexp pe_st a1, pe_aexp pe_st a2) with
| (ANum n1, ANum n2) => ANum (n1 * n2)
| (a1', a2') => AMult a1' a2'
end
end.

この部分評価器は定数を畳み込みしますが、可算の結合性の処理はしません。

Example test_pe_aexp1:
pe_aexp [(X,3)] (APlus (APlus (AId X) (ANum 1)) (AId Y))
= APlus (ANum 4) (AId Y).
Proof. reflexivity. Qed.

Example text_pe_aexp2:
pe_aexp [(Y,3)] (APlus (APlus (AId X) (ANum 1)) (AId Y))
= APlus (APlus (AId X) (ANum 1)) (ANum 3).
Proof. reflexivity. Qed.

さて、pe_aexpはどういう意味で正しいのでしょうか？pe_aexpの正しさを次のように定義するのが合理的です。完全状態st:stateが部分状態pe_st:pe_stateと整合的(consistent)であるならば(言い換えると、pe_stで値が与えられていないすべての変数にstと同じ値を代入した場合)常に、stのもとでのaの評価とpe_aexp pe_st aの評価が同じ結果になる、ということです。この主張は実際に真です。

Definition pe_consistent (st:state) (pe_st:pe_state) :=
forall V n, Some n = pe_lookup pe_st V -> st V = n.

Theorem pe_aexp_correct_weak: forall st pe_st, pe_consistent st pe_st ->
forall a, aeval st a = aeval st (pe_aexp pe_st a).
Proof. unfold pe_consistent. intros st pe_st H a.
aexp_cases (induction a) Case; simpl;
try reflexivity;
try (destruct (pe_aexp pe_st a1);
destruct (pe_aexp pe_st a2);
rewrite IHa1; rewrite IHa2; reflexivity).

Case "AId".
remember (pe_lookup pe_st i) as l. destruct l.
SCase "Some". rewrite H with (n:=n) by apply Heql. reflexivity.
SCase "None". reflexivity.
Qed.

しかしながらすぐに、部分評価器で代入を削除することも行ないたくなるでしょう。例えば、

X ::= ANum 3; Y ::= AMinus (AId X) (AId Y); X ::= ANum 4

を簡単化するには、Xの代入を最後に遅らせることで、単に

Y ::= AMinus (ANum 3) (AId Y); X ::= ANum 4

となります。この単純化を達成するためには、

pe_aexp [(X,3)] (AMinus (AId X) (AId Y))

を部分評価した結果はAMinus (ANum 3) (AId Y)であるべきで、オリジナルの式AMinus (AId X) (AId Y)ではありません。何といっても、

X ::= ANum 3; Y ::= AMinus (AId X) (AId Y); X ::= ANum 4

を

Y ::= AMinus (AId X) (AId Y); X ::= ANum 4

に変換することは、非効率であるだけではなく、間違っています。出力式AMinus (ANum 3) (AId Y)とAMinus (AId X) (AId Y)は両方とも正しさの基準を満たすにもかかわらずです。実のところ、単にpe_aexp pe_st a = aと定義したとしても、定理pe_aexp_correct'は成立してしまいます。

その代わりに、pe_aexpがより強い意味で正しいことを証明します。つまり、部分評価によって生成された式を評価したもの(aeval st (pe_aexp pe_st a))は、完全状態stの、部分状態pe_stによって特定された部分に依存しない、という意味でです。より正確にするために、関数pe_overrideを、stをpe_stの内容に更新するものとして定義します。言い換えると、pe_overrideはstより優先してpe_stにリストアップされた代入を行うということです。

Fixpoint pe_override (st:state) (pe_st:pe_state) : state :=
match pe_st with
| [] => st
| (V,n)::pe_st => update (pe_override st pe_st) V n
end.

Example test_pe_override:
pe_override (update empty_state Y 1) [(X,3),(Z,2)]
= update (update (update empty_state Y 1) Z 2) X 3.
Proof. reflexivity. Qed.

pe_overrideがpe_stateを表現する具体的listを操作するにもかかわらず、そのふるまいはpe_stateのpe_lookup解釈によって完全に定義されます。

Theorem pe_override_correct: forall st pe_st V0,
pe_override st pe_st V0 =
match pe_lookup pe_st V0 with
| Some n => n
| None => st V0
end.
Proof. intros. induction pe_st as [| [V n] pe_st]. reflexivity.
simpl in *. unfold update. rewrite beq_id_sym.
compare V0 V Case; auto. Qed.

pe_consistentとpe_overrideとは2つの方法で関係付けることができます。1つ目は、状態を部分状態でオーバーライド(上書き)したものは、常にその部分状態と整合的な状態となるということです。2つ目は、状態がもし部分状態と整合的ならば、その状態をその部分状態でオーバーライドしたものは、もとの状態と同じということです。

Theorem pe_override_consistent: forall st pe_st,
pe_consistent (pe_override st pe_st) pe_st.
Proof. intros st pe_st V n H. rewrite pe_override_correct.
destruct (pe_lookup pe_st V); inversion H. reflexivity. Qed.

Theorem pe_consistent_override: forall st pe_st,
pe_consistent st pe_st -> forall V, st V = pe_override st pe_st V.
Proof. intros st pe_st H V. rewrite pe_override_correct.
remember (pe_lookup pe_st V) as l. destruct l; auto. Qed.

いよいよ、pe_aexpがより強い意味で正しいことを主張し証明します。このことはこれから部分評価器の残りを定義する助けになります。

直観的には、部分評価を使ったプログラムの実行は2つのステージから成る過程です。第一の「静的」ステージでは、与えられたプログラムをある部分状態のもとで部分評価し、「残留」プログラムを得ます。第二の「動的」ステージは、残留プログラムを残りの状態で評価します。この動的ステージでは、静的(部分)状態ではわからなかった変数の値が与えられます。したがって残留プログラムは、部分状態にリストアップされた代入をもとのプログラムの前に追加したものと同値になります。

Theorem pe_aexp_correct: forall (pe_st:pe_state) (a:aexp) (st:state),
aeval (pe_override st pe_st) a = aeval st (pe_aexp pe_st a).
Proof.
intros pe_st a st.
aexp_cases (induction a) Case; simpl;
try reflexivity;
try (destruct (pe_aexp pe_st a1);
destruct (pe_aexp pe_st a2);
rewrite IHa1; rewrite IHa2; reflexivity).

rewrite pe_override_correct. destruct (pe_lookup pe_st i); reflexivity.
Qed.

ブール式

ブール式の部分評価は同様です。実のところ、ブール式の定数畳み込みと完全に対応します。なぜなら、この言語にはブール値の変数がないからです。

Fixpoint pe_bexp (pe_st : pe_state) (b : bexp) : bexp :=
match b with
| BTrue        => BTrue
| BFalse       => BFalse
| BEq a1 a2 =>
match (pe_aexp pe_st a1, pe_aexp pe_st a2) with
| (ANum n1, ANum n2) => if beq_nat n1 n2 then BTrue else BFalse
| (a1', a2') => BEq a1' a2'
end
| BLe a1 a2 =>
match (pe_aexp pe_st a1, pe_aexp pe_st a2) with
| (ANum n1, ANum n2) => if ble_nat n1 n2 then BTrue else BFalse
| (a1', a2') => BLe a1' a2'
end
| BNot b1 =>
match (pe_bexp pe_st b1) with
| BTrue => BFalse
| BFalse => BTrue
| b1' => BNot b1'
end
| BAnd b1 b2 =>
match (pe_bexp pe_st b1, pe_bexp pe_st b2) with
| (BTrue, BTrue) => BTrue
| (BTrue, BFalse) => BFalse
| (BFalse, BTrue) => BFalse
| (BFalse, BFalse) => BFalse
| (b1', b2') => BAnd b1' b2'
end
end.

Example test_pe_bexp1:
pe_bexp [(X,3)] (BNot (BLe (AId X) (ANum 3)))
= BFalse.
Proof. reflexivity. Qed.

Example test_pe_bexp2: forall b,
b = BNot (BLe (AId X) (APlus (AId X) (ANum 1))) ->
pe_bexp [] b = b.
Proof. intros b H. rewrite -> H. reflexivity. Qed.

pe_bexpの正しさは上述のpe_aexpの正しさと同様です。

Theorem pe_bexp_correct: forall (pe_st:pe_state) (b:bexp) (st:state),
beval (pe_override st pe_st) b = beval st (pe_bexp pe_st b).
Proof.
intros pe_st b st.
bexp_cases (induction b) Case; simpl;
try reflexivity;
try (remember (pe_aexp pe_st a) as a';
remember (pe_aexp pe_st a0) as a0';
assert (Ha: aeval (pe_override st pe_st) a = aeval st a');
assert (Ha0: aeval (pe_override st pe_st) a0 = aeval st a0');
try (subst; apply pe_aexp_correct);
destruct a'; destruct a0'; rewrite Ha; rewrite Ha0;
simpl; try destruct (beq_nat n n0); try destruct (ble_nat n n0);
reflexivity);
try (destruct (pe_bexp pe_st b); rewrite IHb; reflexivity);
try (destruct (pe_bexp pe_st b1);
destruct (pe_bexp pe_st b2);
rewrite IHb1; rewrite IHb2; reflexivity).
Qed.

ループ以外のコマンドの部分評価

コマンドの部分評価はどうなるでしょうか？部分評価と完全評価の対応関係は続きます。コマンドの完全評価が初期状態を終了状態に変換するのと同じように、コマンドの部分評価は初期部分状態を終了部分状態に変換します。違いは、状態が完全ではないことから、コマンドのある部分が静的ステージでは実行可能でない可能性があることです。上記のpe_aexpが残留aexpを返し、pe_bexpが残留bexpを返すように、コマンドを部分評価すると残留コマンドとなります。

部分評価器が完全評価器と似ている別の点は、すべてのコマンドに対して停止するとは限らないということです。すべてのコマンドに対して停止する部分評価器を構築することは難しくはありません。難しいのは、すべてのコマンドに対して停止し、かつ、ループの展開のような最適化を自動的に行う部分評価器を構築することです。しばしば、ソースプログラムの書き方を変えて、静的情報と動的情報の区別をより明確にしてやることで、部分評価器がより多くの場合に停止し、より良い最適化をしてくれるように誘導することができます。そのような誘導は「束縛時改良術」(the art of binding-time improvement)です。変数の束縛の時が、その値が「静的」(“static”)か「動的」(“dynamic”)かがわかる時です。

とにかく、今のところは、対象とする部分評価器は、ソースコマンドと初期部分状態から残留コマンドと最終部分状態への全関数ではない、という事実を受け入れておきます。この非停止性をモデル化するため、コマンドの完全評価と同様、帰納的に定義された関係を使います。次の記述:

c1 / st || c1' / st'

は、ソースコマンドc1を初期部分状態stのもとで部分評価すると、残留コマンドc1'と最終部分状態st'になることを意味します。例えば、次のようなことが成立することを期待するでしょう:

(X ::= ANum 3 ; Y ::= AMult (AId Z) (APlus (AId X) (AId X)))
/ [] || (Y ::= AMult (AId Z) (ANum 6)) / [(X,3)]

Xへの代入は残留コマンドではなく、最終部分状態に現れます。

代入

代入がどのように部分評価されるかを考えることから始めましょう。上述のソースプログラムにおける2つの代入は、違った形で扱う必要があります。最初の代入X ::= ANum 3は「静的」です。その右辺は定数(より一般には定数に簡単化されるもの)です。これから部分状態のXを3に更新し、残留コードは生成しません。(実際には、残留コードとしてSKIPを作ります。)2つ目の代入Y ::= AMult (AId Z) (APlus (AId X) (AId X))は「動的」です。右辺は定数に単純化されることはありません。これから、この代入は残留コードに残され、Yがもし部分状態に存在していたなら、そのYが除去されます。この2つの場合を実装するために、関数pe_addとpe_removeを定義します。上述のpe_overrideのように、これらの関数はpe_stateを表現する具体的なlistを操作しますが、定理pe_add_correctとpe_remove_correctはこれらの関数のふるまいをpe_stateのpe_lookupによる解釈にもとづいて規定します。

Fixpoint pe_remove (pe_st:pe_state) (V:id) : pe_state :=
match pe_st with
| [] => []
| (V',n')::pe_st => if beq_id V V' then pe_remove pe_st V
else (V',n') :: pe_remove pe_st V
end.

Theorem pe_remove_correct: forall pe_st V V0,
pe_lookup (pe_remove pe_st V) V0
= if beq_id V V0 then None else pe_lookup pe_st V0.
Proof. intros pe_st V V0. induction pe_st as [| [V' n'] pe_st].
Case "[]". destruct (beq_id V V0); reflexivity.
Case "::". simpl. compare V V' SCase.
SCase "equal". rewrite IHpe_st.
replace (beq_id V0 V) with (beq_id V V0) by apply beq_id_sym.
destruct (beq_id V V0); reflexivity.
SCase "not equal". simpl. compare V0 V' SSCase.
SSCase "equal". rewrite HeqVV'. reflexivity.
SSCase "not equal". rewrite IHpe_st. reflexivity.
Qed.

Definition pe_add (pe_st:pe_state) (V:id) (n:nat) : pe_state :=
(V,n) :: pe_remove pe_st V.

Theorem pe_add_correct: forall pe_st V n V0,
pe_lookup (pe_add pe_st V n) V0
= if beq_id V V0 then Some n else pe_lookup pe_st V0.
Proof. intros pe_st V n V0. unfold pe_add. simpl. rewrite beq_id_sym.
compare V V0 Case.
Case "equal". reflexivity.
Case "not equal". rewrite pe_remove_correct. rewrite HeqVV0. reflexivity.
Qed.

以下の2つ定理は、定義する部分評価器が動的代入と静的代入をそれぞれ正しく扱うことを示すのに使われます。

Theorem pe_override_update_remove: forall st pe_st V n,
update (pe_override st pe_st) V n =
pe_override (update st V n) (pe_remove pe_st V).
Proof. intros st pe_st V n. apply functional_extensionality. intros V0.
unfold update. rewrite !pe_override_correct. rewrite pe_remove_correct.
destruct (beq_id V V0); reflexivity. Qed.

Theorem pe_override_update_add: forall st pe_st V n,
update (pe_override st pe_st) V n =
pe_override st (pe_add pe_st V n).
Proof. intros st pe_st V n. apply functional_extensionality. intros V0.
unfold update. rewrite !pe_override_correct. rewrite pe_add_correct.
destruct (beq_id V V0); reflexivity. Qed.

条件分岐

部分評価について代入よりトリッキーなのは条件分岐IFB b1 THEN c1 ELSE c2 FIです。もしb1がBTrueまたはBFalseに単純化されるならば、簡単です。どちらの選択肢が選ばれるか分かっているのですから、その選択肢を考えるだけです。もしb1が定数に単純化されないならば、両方の選択肢を考える必要があります。そして、最終部分状態は2つの選択肢で違うかもしれません!

次のプログラムは、問題の難しさを表します:

X ::= ANum 3;
IFB BLe (AId Y) (ANum 4) THEN
Y ::= ANum 4;
IFB BEq (AId X) (AId Y) THEN Y ::= ANum 999 ELSE SKIP FI
ELSE SKIP FI

初期部分状態が空とします。静的にYを4と比較する方法を知りません。これから、(外側の)条件分岐の両方の選択肢を部分評価しなければなりません。THENの側では、Yが4になり、コードを単純化する知識をいくらか使うことができるでしょう。ELSEの側では最後の段階で未だにYの値が確定しません。最終部分状態と残留プログラムはどうなるべきでしょうか？

このような動的条件分岐を扱う一つの方法は、2つの選択肢の最終部分状態の共通部分をとるというものです。この例では、(Y,4),(X,3)と(X,3)の共通部分をとります。従って、全体の最終部分状態は(X,3)です。Yが4であるという情報を失なった代償として、THEN選択肢の最後に代入Y ::= ANum 4を追加する必要があります。結局、残留プログラムは次のようなものになります:

SKIP;
IFB BLe (AId Y) (ANum 4) THEN
SKIP;
SKIP;
Y ::= ANum 4
ELSE SKIP FI

Coqでこの場合をプログラミングするには、いくつものさらなる関数が必要です。2つのpe_stateの共通部分を計算する必要があります。また、2つのpe_stateの違いを代入に変換する必要もあります。

最初に、2つのpe_stateが特定の変数について不一致かどうかを計算する方法を示します。定理pe_disagree_domainにおいて、2つのpe_stateが変数について不一致になるのは、少なくとも一方にその変数が現れるときだけであることを証明します。

Definition pe_disagree_at (pe_st1 pe_st2 : pe_state) (V:id) : bool :=
match pe_lookup pe_st1 V, pe_lookup pe_st2 V with
| Some x, Some y => negb (beq_nat x y)
| None, None => false
| _, _ => true
end.

Lemma existsb_app: forall X (f:X->bool) l1 l2,
existsb f (l1 ++ l2) = orb (existsb f l1) (existsb f l2).
Proof. intros X f l1 l2. induction l1. reflexivity.
simpl. rewrite IHl1. rewrite orb_assoc. reflexivity. Qed.

Theorem pe_disagree_domain: forall (pe_st1 pe_st2 : pe_state) (V:id),
true = pe_disagree_at pe_st1 pe_st2 V ->
true = existsb (beq_id V) (map (@fst _ _) pe_st1 ++
map (@fst _ _) pe_st2).
Proof. unfold pe_disagree_at. intros pe_st1 pe_st2 V H.
rewrite existsb_app. symmetry. apply orb_true_intro.
remember (pe_lookup pe_st1 V) as lookup1.
destruct lookup1 as [n1|]. left. symmetry. apply pe_domain with n1. auto.
remember (pe_lookup pe_st2 V) as lookup2.
destruct lookup2 as [n2|]. right. symmetry. apply pe_domain with n2. auto.
inversion H. Qed.

2つの与えられたpe_stateの不一致の変数をリストアップする関数pe_compareを定義します。このリストはまさに、定理pe_compare_correctに従うならば、このリストにある変数が現れることと、与えられた2つのpe_stateがその変数で不一致であることが同値である、というものです。さらに、リストから重複を除去するためにpe_unique関数を使います。

Fixpoint pe_unique (l : list id) : list id :=
match l with
| [] => []
| x::l => x :: filter (fun y => negb (beq_id x y)) (pe_unique l)
end.

Lemma existsb_beq_id_filter: forall V f l,
existsb (beq_id V) (filter f l) = andb (existsb (beq_id V) l) (f V).
Proof. intros V f l. induction l as [| h l].
Case "[]". reflexivity.
Case "h::l". simpl. remember (f h) as fh. destruct fh.
SCase "true = f h". simpl. rewrite IHl. compare V h SSCase.
rewrite <- Heqfh. reflexivity. reflexivity.
SCase "false = f h". rewrite IHl. compare V h SSCase.
rewrite <- Heqfh. rewrite !andb_false_r. reflexivity. reflexivity.
Qed.

Theorem pe_unique_correct: forall l x,
existsb (beq_id x) l = existsb (beq_id x) (pe_unique l).
Proof. intros l x. induction l as [| h t]. reflexivity.
simpl in *. compare x h Case.
Case "equal". reflexivity.
Case "not equal".
rewrite -> existsb_beq_id_filter, <- IHt, -> beq_id_sym, -> Heqxh,
-> andb_true_r. reflexivity. Qed.

Definition pe_compare (pe_st1 pe_st2 : pe_state) : list id :=
pe_unique (filter (pe_disagree_at pe_st1 pe_st2)
(map (@fst _ _) pe_st1 ++ map (@fst _ _) pe_st2)).

Theorem pe_compare_correct: forall pe_st1 pe_st2 V,
pe_lookup pe_st1 V = pe_lookup pe_st2 V <->
false = existsb (beq_id V) (pe_compare pe_st1 pe_st2).
Proof. intros pe_st1 pe_st2 V.
unfold pe_compare. rewrite <- pe_unique_correct, -> existsb_beq_id_filter.
split; intros Heq.
Case "->".
symmetry. apply andb_false_intro2. unfold pe_disagree_at. rewrite Heq.
destruct (pe_lookup pe_st2 V).
rewrite <- beq_nat_refl. reflexivity.
reflexivity.
Case "<-".
assert (Hagree: pe_disagree_at pe_st1 pe_st2 V = false).
SCase "Proof of assertion".
remember (pe_disagree_at pe_st1 pe_st2 V) as disagree.
destruct disagree; [| reflexivity].
rewrite -> andb_true_r, <- pe_disagree_domain in Heq.
inversion Heq.
apply Heqdisagree.
unfold pe_disagree_at in Hagree.
destruct (pe_lookup pe_st1 V) as [n1|];
destruct (pe_lookup pe_st2 V) as [n2|];
try reflexivity; try solve by inversion.
rewrite beq_nat_eq with n1 n2. reflexivity.
rewrite <- negb_involutive. rewrite Hagree. reflexivity. Qed.

2つの部分状態の共通部分は、どちらか一方から、不一致の変数のすべてを除去したものです。このような変数のリスト全体の除去を一度に行う関数pe_removesを、上述のpe_removeを使って定義します。

定理pe_compare_removesは、共通部分をとる操作の結果のpe_lookupによる解釈が、変数を除去する元として2つの部分状態のどちらを使っても同じであることを述べます。pe_overrideは部分状態のpe_lookupによる解釈だけに依存していることから、pe_overrideもまた2つの部分状態のどちらから変数を除去するかに関係ないことが言えます。定理pe_compare_overrideは正しさの証明の中で簡単に使われます。

Fixpoint pe_removes (pe_st:pe_state) (ids : list id) : pe_state :=
match ids with
| [] => pe_st
| V::ids => pe_remove (pe_removes pe_st ids) V
end.

Theorem pe_removes_correct: forall pe_st ids V,
pe_lookup (pe_removes pe_st ids) V =
if existsb (beq_id V) ids then None else pe_lookup pe_st V.
Proof. intros pe_st ids V. induction ids as [| V' ids]. reflexivity.
simpl. rewrite pe_remove_correct. rewrite IHids.
replace (beq_id V' V) with (beq_id V V') by apply beq_id_sym.
destruct (beq_id V V'); destruct (existsb (beq_id V) ids); reflexivity.
Qed.

Theorem pe_compare_removes: forall pe_st1 pe_st2 V,
pe_lookup (pe_removes pe_st1 (pe_compare pe_st1 pe_st2)) V =
pe_lookup (pe_removes pe_st2 (pe_compare pe_st1 pe_st2)) V.
Proof. intros pe_st1 pe_st2 V. rewrite !pe_removes_correct.
remember (existsb (beq_id V) (pe_compare pe_st1 pe_st2)) as b.
destruct b. reflexivity.
apply pe_compare_correct in Heqb. apply Heqb. Qed.

Theorem pe_compare_override: forall pe_st1 pe_st2 st,
pe_override st (pe_removes pe_st1 (pe_compare pe_st1 pe_st2)) =
pe_override st (pe_removes pe_st2 (pe_compare pe_st1 pe_st2)).
Proof. intros. apply functional_extensionality. intros V.
rewrite !pe_override_correct. rewrite pe_compare_removes. reflexivity.
Qed.

最後に、2つの部分状態の違いを代入コマンドの列に変換するassign関数を定義します。より詳しくは、assign pe_st idsは、idsにリストアップされたそれぞれの変数に対して代入コマンドを生成します。

Fixpoint assign (pe_st : pe_state) (ids : list id) : com :=
match ids with
| [] => SKIP
| V::ids => match pe_lookup pe_st V with
| Some n => (assign pe_st ids; V ::= ANum n)
| None => assign pe_st ids
end
end.

assignにより生成されたコマンドは常に停止します。なぜなら、単に代入の列だからです。下記の(全)関数assignedはコマンドの(動的状態での)効果を計算します。そして定理assign_removesは、生成された代入の列が部分状態からの変数の除去を完全に補償することを保証します。

Definition assigned (pe_st:pe_state) (ids : list id) (st:state) : state :=
fun V => match existsb (beq_id V) ids, pe_lookup pe_st V with
| true, Some n => n
| _, _ => st V
end.

Theorem assign_removes: forall pe_st ids st,
pe_override st pe_st =
pe_override (assigned pe_st ids st) (pe_removes pe_st ids).
Proof. intros pe_st ids st. apply functional_extensionality. intros V.
rewrite !pe_override_correct. rewrite pe_removes_correct. unfold assigned.
destruct (existsb (beq_id V)); destruct (pe_lookup pe_st V); reflexivity.
Qed.

Lemma ceval_extensionality: forall c st st1 st2,
c / st || st1 -> (forall V, st1 V = st2 V) -> c / st || st2.
Proof. intros c st st1 st2 H Heq.
apply functional_extensionality in Heq. rewrite <- Heq. apply H. Qed.

Theorem eval_assign: forall pe_st ids st,
assign pe_st ids / st || assigned pe_st ids st.
Proof. intros pe_st ids st. induction ids as [| V ids]; simpl.
Case "[]". eapply ceval_extensionality. apply E_Skip. reflexivity.
Case "V::ids".
remember (pe_lookup pe_st V) as lookup. destruct lookup.
SCase "Some". eapply E_Seq. apply IHids. unfold assigned. simpl.
eapply ceval_extensionality. apply E_Ass. simpl. reflexivity.
intros V0. unfold update. rewrite beq_id_sym. compare V0 V SSCase.
SSCase "equal". rewrite <- Heqlookup. reflexivity.
SSCase "not equal". reflexivity.
SCase "None". eapply ceval_extensionality. apply IHids.
unfold assigned. intros V0. simpl. compare V0 V SSCase.
SSCase "equal". rewrite <- Heqlookup.
destruct (existsb (beq_id V0) ids); reflexivity.
SSCase "not equal". reflexivity. Qed.

部分評価関係

遂に、ループ以外のコマンドに対する部分評価器を、帰納的関係として定義することができます!PE_AssDynamicとPE_Ifにおける非等号(<>)条件は、部分評価器に決定性を持たせるためのものです。これらは正しさのためには必要ありません。

Reserved Notation "c1 '/' st '||' c1' '/' st'"
(at level 40, st at level 39, c1' at level 39).

Inductive pe_com : com -> pe_state -> com -> pe_state -> Prop :=
| PE_Skip : forall pe_st,
SKIP / pe_st || SKIP / pe_st
| PE_AssStatic : forall pe_st a1 n1 l,
pe_aexp pe_st a1 = ANum n1 ->
(l ::= a1) / pe_st || SKIP / pe_add pe_st l n1
| PE_AssDynamic : forall pe_st a1 a1' l,
pe_aexp pe_st a1 = a1' ->
(forall n, a1' <> ANum n) ->
(l ::= a1) / pe_st || (l ::= a1') / pe_remove pe_st l
| PE_Seq : forall pe_st pe_st' pe_st'' c1 c2 c1' c2',
c1 / pe_st  || c1' / pe_st' ->
c2 / pe_st' || c2' / pe_st'' ->
(c1 ; c2) / pe_st || (c1' ; c2') / pe_st''
| PE_IfTrue : forall pe_st pe_st' b1 c1 c2 c1',
pe_bexp pe_st b1 = BTrue ->
c1 / pe_st || c1' / pe_st' ->
(IFB b1 THEN c1 ELSE c2 FI) / pe_st || c1' / pe_st'
| PE_IfFalse : forall pe_st pe_st' b1 c1 c2 c2',
pe_bexp pe_st b1 = BFalse ->
c2 / pe_st || c2' / pe_st' ->
(IFB b1 THEN c1 ELSE c2 FI) / pe_st || c2' / pe_st'
| PE_If : forall pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2',
pe_bexp pe_st b1 <> BTrue ->
pe_bexp pe_st b1 <> BFalse ->
c1 / pe_st || c1' / pe_st1 ->
c2 / pe_st || c2' / pe_st2 ->
(IFB b1 THEN c1 ELSE c2 FI) / pe_st
|| (IFB pe_bexp pe_st b1
THEN c1' ; assign pe_st1 (pe_compare pe_st1 pe_st2)
ELSE c2' ; assign pe_st2 (pe_compare pe_st1 pe_st2) FI)
/ pe_removes pe_st1 (pe_compare pe_st1 pe_st2)

where "c1 '/' st '||' c1' '/' st'" := (pe_com c1 st c1' st').

Tactic Notation "pe_com_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "PE_Skip"
| Case_aux c "PE_AssStatic" | Case_aux c "PE_AssDynamic"
| Case_aux c "PE_Seq"
| Case_aux c "PE_IfTrue" | Case_aux c "PE_IfFalse" | Case_aux c "PE_If" ].

Hint Constructors pe_com.
Hint Constructors ceval.

例

以下は部分評価器を利用する例のいくつかです。pe_com関係を自動部分評価に実際に利用可能にするためには、Coqにより多くの自動化タクティックを定義する必要があるでしょう。それは難しいことではありませんが、ここでは必要ありません。

Example pe_example1:
(X ::= ANum 3 ; Y ::= AMult (AId Z) (APlus (AId X) (AId X)))
/ [] || (SKIP; Y ::= AMult (AId Z) (ANum 6)) / [(X,3)].
Proof. eapply PE_Seq. eapply PE_AssStatic. reflexivity.
eapply PE_AssDynamic. reflexivity. intros n H. inversion H. Qed.

Example pe_example2:
(X ::= ANum 3 ; IFB BLe (AId X) (ANum 4) THEN X ::= ANum 4 ELSE SKIP FI)
/ [] || (SKIP; SKIP) / [(X,4)].
Proof. eapply PE_Seq. eapply PE_AssStatic. reflexivity.
eapply PE_IfTrue. reflexivity.
eapply PE_AssStatic. reflexivity. Qed.

Example pe_example3:
(X ::= ANum 3;
IFB BLe (AId Y) (ANum 4) THEN
Y ::= ANum 4;
IFB BEq (AId X) (AId Y) THEN Y ::= ANum 999 ELSE SKIP FI
ELSE SKIP FI) / []
|| (SKIP;
IFB BLe (AId Y) (ANum 4) THEN
(SKIP; SKIP); (SKIP; Y ::= ANum 4)
ELSE SKIP; SKIP FI)
/ [(X,3)].
Proof. erewrite f_equal2 with (f := fun c st => _ / _ || c / st).
eapply PE_Seq. eapply PE_AssStatic. reflexivity.
eapply PE_If; intuition eauto; try solve by inversion.
econstructor. eapply PE_AssStatic. reflexivity.
eapply PE_IfFalse. reflexivity. econstructor.
reflexivity. reflexivity. Qed.

部分評価の正しさ

最後に、定義した部分評価器が正しいことを証明しましょう!

Reserved Notation "c' '/' pe_st' '/' st '||' st''"
(at level 40, pe_st' at level 39, st at level 39).

Inductive pe_ceval
(c':com) (pe_st':pe_state) (st:state) (st'':state) : Prop :=
| pe_ceval_intro : forall st',
c' / st || st' ->
pe_override st' pe_st' = st'' ->
c' / pe_st' / st || st''
where "c' '/' pe_st' '/' st '||' st''" := (pe_ceval c' pe_st' st st'').

Hint Constructors pe_ceval.

Theorem pe_com_complete:
forall c pe_st pe_st' c', c / pe_st || c' / pe_st' ->
forall st st'',
(c / pe_override st pe_st || st'') ->
(c' / pe_st' / st || st'').
Proof. intros c pe_st pe_st' c' Hpe.
pe_com_cases (induction Hpe) Case; intros st st'' Heval;
try (inversion Heval; subst;
try (rewrite -> pe_bexp_correct, -> H in *; solve by inversion);
[]);
eauto.
Case "PE_AssStatic". econstructor. econstructor.
rewrite -> pe_aexp_correct. rewrite <- pe_override_update_add.
rewrite -> H. reflexivity.
Case "PE_AssDynamic". econstructor. econstructor. reflexivity.
rewrite -> pe_aexp_correct. rewrite <- pe_override_update_remove.
reflexivity.
Case "PE_Seq".
edestruct IHHpe1. eassumption. subst.
edestruct IHHpe2. eassumption.
eauto.
Case "PE_If". inversion Heval; subst.
SCase "E'IfTrue". edestruct IHHpe1. eassumption.
econstructor. apply E_IfTrue. rewrite <- pe_bexp_correct. assumption.
eapply E_Seq. eassumption. apply eval_assign.
rewrite <- assign_removes. eassumption.
SCase "E_IfFalse". edestruct IHHpe2. eassumption.
econstructor. apply E_IfFalse. rewrite <- pe_bexp_correct. assumption.
eapply E_Seq. eassumption. apply eval_assign.
rewrite -> pe_compare_override.
rewrite <- assign_removes. eassumption.
Qed.

Theorem pe_com_sound:
forall c pe_st pe_st' c', c / pe_st || c' / pe_st' ->
forall st st'',
(c' / pe_st' / st || st'') ->
(c / pe_override st pe_st || st'').
Proof. intros c pe_st pe_st' c' Hpe.
pe_com_cases (induction Hpe) Case;
intros st st'' [st' Heval Heq];
try (inversion Heval; []; subst); auto.
Case "PE_AssStatic". rewrite <- pe_override_update_add. apply E_Ass.
rewrite -> pe_aexp_correct. rewrite -> H. reflexivity.
Case "PE_AssDynamic". rewrite <- pe_override_update_remove. apply E_Ass.
rewrite <- pe_aexp_correct. reflexivity.
Case "PE_Seq". eapply E_Seq; eauto.
Case "PE_IfTrue". apply E_IfTrue.
rewrite -> pe_bexp_correct. rewrite -> H. reflexivity. eauto.
Case "PE_IfFalse". apply E_IfFalse.
rewrite -> pe_bexp_correct. rewrite -> H. reflexivity. eauto.
Case "PE_If".
inversion Heval; subst; inversion H7;
(eapply ceval_deterministic in H8; [| apply eval_assign]); subst.
SCase "E_IfTrue".
apply E_IfTrue. rewrite -> pe_bexp_correct. assumption.
rewrite <- assign_removes. eauto.
SCase "E_IfFalse".
rewrite -> pe_compare_override.
apply E_IfFalse. rewrite -> pe_bexp_correct. assumption.
rewrite <- assign_removes. eauto.
Qed.

メインの定理です。この形式化について David Menendez に感謝します!

Corollary pe_com_correct:
forall c pe_st pe_st' c', c / pe_st || c' / pe_st' ->
forall st st'',
(c / pe_override st pe_st || st'') <->
(c' / pe_st' / st || st'').
Proof. intros c pe_st pe_st' c' H st st''. split.
Case "->". apply pe_com_complete. apply H.
Case "<-". apply pe_com_sound. apply H.
Qed.

ループの部分評価

一見すると、部分評価関係pe_comをループに拡張することは簡単に見えます。実際、多くのループは扱うのは簡単です。例えば次の、二乗を繰り返すループを考えます:

WHILE BLe (ANum 1) (AId X) DO
Y ::= AMult (AId Y) (AId Y);
X ::= AMinus (AId X) (ANum 1)
END

XもYも静的には分からないとき、ループ全体が動的で、残留コマンドはループ全体と同じです。Xが分かりYが分からないときは、ループは完全に展開でき、もしXが最初は3(で最後は0)だとすると、残留コマンドは

Y ::= AMult (AId Y) (AId Y);
Y ::= AMult (AId Y) (AId Y);
Y ::= AMult (AId Y) (AId Y)

となります。一般にループは、ループ本体の最終部分状態が初期状態と同じである場合、または、ガード条件が静的である場合には、部分評価は簡単です。

しかし、Impには、残留プログラムを示すのが難しい別のループが存在します。例えば、Yが偶数か奇数かをチェックする次のプログラムを考えます:

X ::= ANum 0;
WHILE BLe (ANum 1) (AId Y) DO
Y ::= AMinus (AId Y) (ANum 1);
X ::= AMinus (ANum 1) (AId X)
END

Xの値はループの間、0と1を交互にとります。理想的には、ループを完全にではなく2段階展開したいところです。次のような感じです:

WHILE BLe (ANum 1) (AId Y) DO
Y ::= AMinus (AId Y) (ANum 1);
IF BLe (ANum 1) (AId Y) THEN
Y ::= AMinus (AId Y) (ANum 1)
ELSE
X ::= ANum 1; EXIT
FI
END;
X ::= ANum 0

残念ながら、ImpにはEXITコマンドはありません。言語の制御構造を拡張しない範囲では、できることは、ループのガードのテストを繰り返すか、フラグ変数を追加することです。どちらにしても、ひどいものです。

それでも、本筋から逸れますが、以下はImpコマンドに部分評価を行おうとする試みです。pe_com関係にもう1つコマンド引数c''を追加して、展開するループを追跡します。

Module Loop.

Reserved Notation "c1 '/' st '||' c1' '/' st' '/' c''"
(at level 40, st at level 39, c1' at level 39, st' at level 39).

Inductive pe_com : com -> pe_state -> com -> pe_state -> com -> Prop :=
| PE_Skip : forall pe_st,
SKIP / pe_st || SKIP / pe_st / SKIP
| PE_AssStatic : forall pe_st a1 n1 l,
pe_aexp pe_st a1 = ANum n1 ->
(l ::= a1) / pe_st || SKIP / pe_add pe_st l n1 / SKIP
| PE_AssDynamic : forall pe_st a1 a1' l,
pe_aexp pe_st a1 = a1' ->
(forall n, a1' <> ANum n) ->
(l ::= a1) / pe_st || (l ::= a1') / pe_remove pe_st l / SKIP
| PE_Seq : forall pe_st pe_st' pe_st'' c1 c2 c1' c2' c'',
c1 / pe_st  || c1' / pe_st' / SKIP ->
c2 / pe_st' || c2' / pe_st'' / c'' ->
(c1 ; c2) / pe_st || (c1' ; c2') / pe_st'' / c''
| PE_IfTrue : forall pe_st pe_st' b1 c1 c2 c1' c'',
pe_bexp pe_st b1 = BTrue ->
c1 / pe_st || c1' / pe_st' / c'' ->
(IFB b1 THEN c1 ELSE c2 FI) / pe_st || c1' / pe_st' / c''
| PE_IfFalse : forall pe_st pe_st' b1 c1 c2 c2' c'',
pe_bexp pe_st b1 = BFalse ->
c2 / pe_st || c2' / pe_st' / c'' ->
(IFB b1 THEN c1 ELSE c2 FI) / pe_st || c2' / pe_st' / c''
| PE_If : forall pe_st pe_st1 pe_st2 b1 c1 c2 c1' c2' c'',
pe_bexp pe_st b1 <> BTrue ->
pe_bexp pe_st b1 <> BFalse ->
c1 / pe_st || c1' / pe_st1 / c'' ->
c2 / pe_st || c2' / pe_st2 / c'' ->
(IFB b1 THEN c1 ELSE c2 FI) / pe_st
|| (IFB pe_bexp pe_st b1
THEN c1' ; assign pe_st1 (pe_compare pe_st1 pe_st2)
ELSE c2' ; assign pe_st2 (pe_compare pe_st1 pe_st2) FI)
/ pe_removes pe_st1 (pe_compare pe_st1 pe_st2)
/ c''
| PE_WhileEnd : forall pe_st b1 c1,
pe_bexp pe_st b1 = BFalse ->
(WHILE b1 DO c1 END) / pe_st || SKIP / pe_st / SKIP
| PE_WhileLoop : forall pe_st pe_st' pe_st'' b1 c1 c1' c2' c2'',
pe_bexp pe_st b1 = BTrue ->
c1 / pe_st || c1' / pe_st' / SKIP ->
(WHILE b1 DO c1 END) / pe_st' || c2' / pe_st'' / c2'' ->
pe_compare pe_st pe_st'' <> [] ->
(WHILE b1 DO c1 END) / pe_st || (c1';c2') / pe_st'' / c2''
| PE_While : forall pe_st pe_st' pe_st'' b1 c1 c1' c2' c2'',
pe_bexp pe_st b1 <> BFalse ->
pe_bexp pe_st b1 <> BTrue ->
c1 / pe_st || c1' / pe_st' / SKIP ->
(WHILE b1 DO c1 END) / pe_st' || c2' / pe_st'' / c2'' ->
pe_compare pe_st pe_st'' <> [] ->
(c2'' = SKIP \/ c2'' = WHILE b1 DO c1 END) ->
(WHILE b1 DO c1 END) / pe_st
|| (IFB pe_bexp pe_st b1
THEN c1'; c2'; assign pe_st'' (pe_compare pe_st pe_st'')
ELSE assign pe_st (pe_compare pe_st pe_st'') FI)
/ pe_removes pe_st (pe_compare pe_st pe_st'')
/ c2''
| PE_WhileFixedEnd : forall pe_st b1 c1,
pe_bexp pe_st b1 <> BFalse ->
(WHILE b1 DO c1 END) / pe_st || SKIP / pe_st / (WHILE b1 DO c1 END)
| PE_WhileFixedLoop : forall pe_st pe_st' pe_st'' b1 c1 c1' c2',
pe_bexp pe_st b1 = BTrue ->
c1 / pe_st || c1' / pe_st' / SKIP ->
(WHILE b1 DO c1 END) / pe_st'
|| c2' / pe_st'' / (WHILE b1 DO c1 END) ->
pe_compare pe_st pe_st'' = [] ->
(WHILE b1 DO c1 END) / pe_st
|| (WHILE BTrue DO SKIP END) / pe_st / SKIP

| PE_WhileFixed : forall pe_st pe_st' pe_st'' b1 c1 c1' c2',
pe_bexp pe_st b1 <> BFalse ->
pe_bexp pe_st b1 <> BTrue ->
c1 / pe_st || c1' / pe_st' / SKIP ->
(WHILE b1 DO c1 END) / pe_st'
|| c2' / pe_st'' / (WHILE b1 DO c1 END) ->
pe_compare pe_st pe_st'' = [] ->
(WHILE b1 DO c1 END) / pe_st
|| (WHILE pe_bexp pe_st b1 DO c1'; c2' END) / pe_st / SKIP

where "c1 '/' st '||' c1' '/' st' '/' c''" := (pe_com c1 st c1' st' c'').

Tactic Notation "pe_com_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "PE_Skip"
| Case_aux c "PE_AssStatic" | Case_aux c "PE_AssDynamic"
| Case_aux c "PE_Seq"
| Case_aux c "PE_IfTrue" | Case_aux c "PE_IfFalse" | Case_aux c "PE_If"
| Case_aux c "PE_WhileEnd" | Case_aux c "PE_WhileLoop"
| Case_aux c "PE_While" | Case_aux c "PE_WhileFixedEnd"
| Case_aux c "PE_WhileFixedLoop" | Case_aux c "PE_WhileFixed" ].

Hint Constructors pe_com.

例

Tactic Notation "step" ident(i) :=
(eapply i; intuition eauto; try solve by inversion);
repeat (try eapply PE_Seq;
try (eapply PE_AssStatic; simpl; reflexivity);
try (eapply PE_AssDynamic;
[ simpl; reflexivity
| intuition eauto; solve by inversion ])).

Definition square_loop: com :=
WHILE BLe (ANum 1) (AId X) DO
Y ::= AMult (AId Y) (AId Y);
X ::= AMinus (AId X) (ANum 1)
END.

Example pe_loop_example1:
square_loop / []
|| (WHILE BLe (ANum 1) (AId X) DO
(Y ::= AMult (AId Y) (AId Y);
X ::= AMinus (AId X) (ANum 1)); SKIP
END) / [] / SKIP.
Proof. erewrite f_equal2 with (f := fun c st => _ / _ || c / st / SKIP).
step PE_WhileFixed. step PE_WhileFixedEnd. reflexivity.
reflexivity. reflexivity. Qed.

Example pe_loop_example2:
(X ::= ANum 3; square_loop) / []
|| (SKIP;
(Y ::= AMult (AId Y) (AId Y); SKIP);
(Y ::= AMult (AId Y) (AId Y); SKIP);
(Y ::= AMult (AId Y) (AId Y); SKIP);
SKIP) / [(X,0)] / SKIP.
Proof. erewrite f_equal2 with (f := fun c st => _ / _ || c / st / SKIP).
eapply PE_Seq. eapply PE_AssStatic. reflexivity.
step PE_WhileLoop.
step PE_WhileLoop.
step PE_WhileLoop.
step PE_WhileEnd.
inversion H. inversion H. inversion H.
reflexivity. reflexivity. Qed.

Example pe_loop_example3:
(Z ::= ANum 3; subtract_slowly) / []
|| (SKIP;
IFB BNot (BEq (AId X) (ANum 0)) THEN
(SKIP; X ::= AMinus (AId X) (ANum 1));
IFB BNot (BEq (AId X) (ANum 0)) THEN
(SKIP; X ::= AMinus (AId X) (ANum 1));
IFB BNot (BEq (AId X) (ANum 0)) THEN
(SKIP; X ::= AMinus (AId X) (ANum 1));
WHILE BNot (BEq (AId X) (ANum 0)) DO
(SKIP; X ::= AMinus (AId X) (ANum 1)); SKIP
END;
SKIP; Z ::= ANum 0
ELSE SKIP; Z ::= ANum 1 FI; SKIP
ELSE SKIP; Z ::= ANum 2 FI; SKIP
ELSE SKIP; Z ::= ANum 3 FI) / [] / SKIP.
Proof. erewrite f_equal2 with (f := fun c st => _ / _ || c / st / SKIP).
eapply PE_Seq. eapply PE_AssStatic. reflexivity.
step PE_While.
step PE_While.
step PE_While.
step PE_WhileFixed.
step PE_WhileFixedEnd.
reflexivity. inversion H. inversion H. inversion H.
reflexivity. reflexivity. Qed.

Example pe_loop_example4:
(X ::= ANum 0;
WHILE BLe (AId X) (ANum 2) DO
X ::= AMinus (ANum 1) (AId X)
END) / [] || (SKIP; WHILE BTrue DO SKIP END) / [(X,0)] / SKIP.
Proof. erewrite f_equal2 with (f := fun c st => _ / _ || c / st / SKIP).
eapply PE_Seq. eapply PE_AssStatic. reflexivity.
step PE_WhileFixedLoop.
step PE_WhileLoop.
step PE_WhileFixedEnd.
inversion H. reflexivity. reflexivity. reflexivity. Qed.

正しさ

この部分評価器は1より大きい(有限)整数 n について、ループをn回展開することができます。このため、正しさを示すためには、動的評価の構造についての帰納法ではなく、動的評価がループの本体に入る回数についての帰納法が必要です。

Reserved Notation "c1 '/' st '||' st' '#' n"
(at level 40, st at level 39, st' at level 39).

Inductive ceval_count : com -> state -> state -> nat -> Prop :=
| E'Skip : forall st,
SKIP / st || st # 0
| E'Ass  : forall st a1 n l,
aeval st a1 = n ->
(l ::= a1) / st || (update st l n) # 0
| E'Seq : forall c1 c2 st st' st'' n1 n2,
c1 / st  || st'  # n1 ->
c2 / st' || st'' # n2 ->
(c1 ; c2) / st || st'' # (n1 + n2)
| E'IfTrue : forall st st' b1 c1 c2 n,
beval st b1 = true ->
c1 / st || st' # n ->
(IFB b1 THEN c1 ELSE c2 FI) / st || st' # n
| E'IfFalse : forall st st' b1 c1 c2 n,
beval st b1 = false ->
c2 / st || st' # n ->
(IFB b1 THEN c1 ELSE c2 FI) / st || st' # n
| E'WhileEnd : forall b1 st c1,
beval st b1 = false ->
(WHILE b1 DO c1 END) / st || st # 0
| E'WhileLoop : forall st st' st'' b1 c1 n1 n2,
beval st b1 = true ->
c1 / st || st' # n1 ->
(WHILE b1 DO c1 END) / st' || st'' # n2 ->
(WHILE b1 DO c1 END) / st || st'' # S (n1 + n2)

where "c1 '/' st '||' st' # n" := (ceval_count c1 st st' n).

Tactic Notation "ceval_count_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E'Skip" | Case_aux c "E'Ass" | Case_aux c "E'Seq"
| Case_aux c "E'IfTrue" | Case_aux c "E'IfFalse"
| Case_aux c "E'WhileEnd" | Case_aux c "E'WhileLoop" ].

Hint Constructors ceval_count.

Theorem ceval_count_complete: forall c st st',
c / st || st' -> exists n, c / st || st' # n.
Proof. intros c st st' Heval.
induction Heval;
try inversion IHHeval1;
try inversion IHHeval2;
try inversion IHHeval;
eauto. Qed.

Theorem ceval_count_sound: forall c st st' n,
c / st || st' # n -> c / st || st'.
Proof. intros c st st' n Heval. induction Heval; eauto. Qed.

Theorem pe_compare_nil_lookup: forall pe_st1 pe_st2,
pe_compare pe_st1 pe_st2 = [] ->
forall V, pe_lookup pe_st1 V = pe_lookup pe_st2 V.
Proof. intros pe_st1 pe_st2 H V.
apply (pe_compare_correct pe_st1 pe_st2 V).
rewrite H. reflexivity. Qed.

Theorem pe_compare_nil_override: forall pe_st1 pe_st2,
pe_compare pe_st1 pe_st2 = [] ->
forall st, pe_override st pe_st1 = pe_override st pe_st2.
Proof. intros pe_st1 pe_st2 H st.
apply functional_extensionality. intros V.
rewrite !pe_override_correct.
apply pe_compare_nil_lookup with (V:=V) in H.
rewrite H. reflexivity. Qed.

Reserved Notation "c' '/' pe_st' '/' c'' '/' st '||' st'' '#' n"
(at level 40, pe_st' at level 39, c'' at level 39,
st at level 39, st'' at level 39).

Inductive pe_ceval_count (c':com) (pe_st':pe_state) (c'':com)
(st:state) (st'':state) (n:nat) : Prop :=
| pe_ceval_count_intro : forall st' n',
c' / st || st' ->
c'' / pe_override st' pe_st' || st'' # n' ->
n' <= n ->
c' / pe_st' / c'' / st || st'' # n
where "c' '/' pe_st' '/' c'' '/' st '||' st'' '#' n" :=
(pe_ceval_count c' pe_st' c'' st st'' n).

Hint Constructors pe_ceval_count.

Lemma pe_ceval_count_le: forall c' pe_st' c'' st st'' n n',
n' <= n ->
c' / pe_st' / c'' / st || st'' # n' ->
c' / pe_st' / c'' / st || st'' # n.
Proof. intros c' pe_st' c'' st st'' n n' Hle H. inversion H.
econstructor; try eassumption. omega. Qed.

Theorem pe_com_complete:
forall c pe_st pe_st' c' c'', c / pe_st || c' / pe_st' / c'' ->
forall st st'' n,
(c / pe_override st pe_st || st'' # n) ->
(c' / pe_st' / c'' / st || st'' # n).
Proof. intros c pe_st pe_st' c' c'' Hpe.
pe_com_cases (induction Hpe) Case; intros st st'' n Heval;
try (inversion Heval; subst;
try (rewrite -> pe_bexp_correct, -> H in *; solve by inversion);
[]);
eauto.
Case "PE_AssStatic". econstructor. econstructor.
rewrite -> pe_aexp_correct. rewrite <- pe_override_update_add.
rewrite -> H. apply E'Skip. auto.
Case "PE_AssDynamic". econstructor. econstructor. reflexivity.
rewrite -> pe_aexp_correct. rewrite <- pe_override_update_remove.
apply E'Skip. auto.
Case "PE_Seq".
edestruct IHHpe1 as [? ? ? Hskip ?]. eassumption.
inversion Hskip. subst.
edestruct IHHpe2. eassumption.
econstructor; eauto. omega.
Case "PE_If". inversion Heval; subst.
SCase "E'IfTrue". edestruct IHHpe1. eassumption.
econstructor. apply E_IfTrue. rewrite <- pe_bexp_correct. assumption.
eapply E_Seq. eassumption. apply eval_assign.
rewrite <- assign_removes. eassumption. eassumption.
SCase "E_IfFalse". edestruct IHHpe2. eassumption.
econstructor. apply E_IfFalse. rewrite <- pe_bexp_correct. assumption.
eapply E_Seq. eassumption. apply eval_assign.
rewrite -> pe_compare_override.
rewrite <- assign_removes. eassumption. eassumption.
Case "PE_WhileLoop".
edestruct IHHpe1 as [? ? ? Hskip ?]. eassumption.
inversion Hskip. subst.
edestruct IHHpe2. eassumption.
econstructor; eauto. omega.
Case "PE_While". inversion Heval; subst.
SCase "E_WhileEnd". econstructor. apply E_IfFalse.
rewrite <- pe_bexp_correct. assumption.
apply eval_assign.
rewrite <- assign_removes. inversion H2; subst; auto.
auto.
SCase "E_WhileLoop".
edestruct IHHpe1 as [? ? ? Hskip ?]. eassumption.
inversion Hskip. subst.
edestruct IHHpe2. eassumption.
econstructor. apply E_IfTrue.
rewrite <- pe_bexp_correct. assumption.
repeat eapply E_Seq; eauto. apply eval_assign.
rewrite -> pe_compare_override, <- assign_removes. eassumption.
omega.
Case "PE_WhileFixedLoop". apply ex_falso_quodlibet.
generalize dependent (S (n1 + n2)). intros n.
clear - Case H H0 IHHpe1 IHHpe2. generalize dependent st.
induction n using lt_wf_ind; intros st Heval. inversion Heval; subst.
SCase "E'WhileEnd". rewrite pe_bexp_correct, H in H7. inversion H7.
SCase "E'WhileLoop".
edestruct IHHpe1 as [? ? ? Hskip ?]. eassumption.
inversion Hskip. subst.
edestruct IHHpe2. eassumption.
rewrite <- (pe_compare_nil_override _ _ H0) in H7.
apply H1 in H7; [| omega]. inversion H7.
Case "PE_WhileFixed". generalize dependent st.
induction n using lt_wf_ind; intros st Heval. inversion Heval; subst.
SCase "E'WhileEnd". rewrite pe_bexp_correct in H8. eauto.
SCase "E'WhileLoop". rewrite pe_bexp_correct in H5.
edestruct IHHpe1 as [? ? ? Hskip ?]. eassumption.
inversion Hskip. subst.
edestruct IHHpe2. eassumption.
rewrite <- (pe_compare_nil_override _ _ H1) in H8.
apply H2 in H8; [| omega]. inversion H8.
econstructor; [ eapply E_WhileLoop; eauto | eassumption | omega].
Qed.

Theorem pe_com_sound:
forall c pe_st pe_st' c' c'', c / pe_st || c' / pe_st' / c'' ->
forall st st'' n,
(c' / pe_st' / c'' / st || st'' # n) ->
(c / pe_override st pe_st || st'').
Proof. intros c pe_st pe_st' c' c'' Hpe.
pe_com_cases (induction Hpe) Case;
intros st st'' n [st' n' Heval Heval' Hle];
try (inversion Heval; []; subst);
try (inversion Heval'; []; subst); eauto.
Case "PE_AssStatic". rewrite <- pe_override_update_add. apply E_Ass.
rewrite -> pe_aexp_correct. rewrite -> H. reflexivity.
Case "PE_AssDynamic". rewrite <- pe_override_update_remove. apply E_Ass.
rewrite <- pe_aexp_correct. reflexivity.
Case "PE_Seq". eapply E_Seq; eauto.
Case "PE_IfTrue". apply E_IfTrue.
rewrite -> pe_bexp_correct. rewrite -> H. reflexivity.
eapply IHHpe. eauto.
Case "PE_IfFalse". apply E_IfFalse.
rewrite -> pe_bexp_correct. rewrite -> H. reflexivity.
eapply IHHpe. eauto.
Case "PE_If". inversion Heval; subst; inversion H7; subst; clear H7.
SCase "E_IfTrue".
eapply ceval_deterministic in H8; [| apply eval_assign]. subst.
rewrite <- assign_removes in Heval'.
apply E_IfTrue. rewrite -> pe_bexp_correct. assumption.
eapply IHHpe1. eauto.
SCase "E_IfFalse".
eapply ceval_deterministic in H8; [| apply eval_assign]. subst.
rewrite -> pe_compare_override in Heval'.
rewrite <- assign_removes in Heval'.
apply E_IfFalse. rewrite -> pe_bexp_correct. assumption.
eapply IHHpe2. eauto.
Case "PE_WhileEnd". apply E_WhileEnd.
rewrite -> pe_bexp_correct. rewrite -> H. reflexivity.
Case "PE_WhileLoop". eapply E_WhileLoop.
rewrite -> pe_bexp_correct. rewrite -> H. reflexivity.
eapply IHHpe1. eauto. eapply IHHpe2. eauto.
Case "PE_While". inversion Heval; subst.
SCase "E_IfTrue".
inversion H9. subst. clear H9.
inversion H10. subst. clear H10.
eapply ceval_deterministic in H11; [| apply eval_assign]. subst.
rewrite -> pe_compare_override in Heval'.
rewrite <- assign_removes in Heval'.
eapply E_WhileLoop. rewrite -> pe_bexp_correct. assumption.
eapply IHHpe1. eauto.
eapply IHHpe2. eauto.
SCase "E_IfFalse". apply ceval_count_sound in Heval'.
eapply ceval_deterministic in H9; [| apply eval_assign]. subst.
rewrite <- assign_removes in Heval'.
inversion H2; subst.
SSCase "c2'' = SKIP". inversion Heval'. subst. apply E_WhileEnd.
rewrite -> pe_bexp_correct. assumption.
SSCase "c2'' = WHILE b1 DO c1 END". assumption.
Case "PE_WhileFixedEnd". eapply ceval_count_sound. apply Heval'.
Case "PE_WhileFixedLoop".
apply loop_never_stops in Heval. inversion Heval.
Case "PE_WhileFixed".
clear - Case H1 IHHpe1 IHHpe2 Heval.
remember (WHILE pe_bexp pe_st b1 DO c1'; c2' END) as c'.
ceval_cases (induction Heval) SCase;
inversion Heqc'; subst; clear Heqc'.
SCase "E_WhileEnd". apply E_WhileEnd.
rewrite pe_bexp_correct. assumption.
SCase "E_WhileLoop".
assert (IHHeval2' := IHHeval2 (refl_equal _)).
apply ceval_count_complete in IHHeval2'. inversion IHHeval2'.
clear IHHeval1 IHHeval2 IHHeval2'.
inversion Heval1. subst.
eapply E_WhileLoop. rewrite pe_bexp_correct. assumption. eauto.
eapply IHHpe2. econstructor. eassumption.
rewrite <- (pe_compare_nil_override _ _ H1). eassumption. apply le_n.
Qed.

Corollary pe_com_correct:
forall c pe_st pe_st' c', c / pe_st || c' / pe_st' / SKIP ->
forall st st'',
(c / pe_override st pe_st || st'') <->
(exists st', c' / st || st' /\ pe_override st' pe_st' = st'').
Proof. intros c pe_st pe_st' c' H st st''. split.
Case "->". intros Heval.
apply ceval_count_complete in Heval. inversion Heval as [n Heval'].
apply pe_com_complete with (st:=st) (st'':=st'') (n:=n) in H.
inversion H as [? ? ? Hskip ?]. inversion Hskip. subst. eauto.
assumption.
Case "<-". intros [st' [Heval Heq]]. subst st''.
eapply pe_com_sound in H. apply H.
econstructor. apply Heval. apply E'Skip. apply le_n.
Qed.

End Loop.

フローチャートプログラムの部分評価

命令型プログラムを部分評価する標準的アプローチは、WHILEループを直接部分評価する代わりに、それをフローチャート(flowcharts)に変換することです。言い換えると、言語にラベルとジャンプを追加すると、部分評価がずいぶん簡単になることがわかります。フローチャートを部分評価した結果は、残留フローチャートになります。ラッキーな場合は、残留フローチャートのジャンプはWHILEループに戻すことができます。ただし、これは一般にできるわけではありません。ここではこのことは追求しません。

基本ブロック

フローチャートは基本ブロック(basic blocks)から成ります。これをここでは、帰納型blockで表します。基本ブロックは、代入(コンストラクタAssign)の列の最後に条件ジャンプ(コンストラクタIf)または無条件ジャンプ(コンストラクタGoto)が付いたものです。ジャンプ先は任意の型のラベル(labels)で特定されます。これから、block型をラベルの型でパラメータ化します。

Inductive block (Label:Type) : Type :=
| Goto : Label -> block Label
| If : bexp -> Label -> Label -> block Label
| Assign : id -> aexp -> block Label -> block Label.

Tactic Notation "block_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "Goto" | Case_aux c "If" | Case_aux c "Assign" ].

Implicit Arguments Goto   [[Label]].
Implicit Arguments If     [[Label]].
Implicit Arguments Assign [[Label]].

以下では、上述のImpによる「奇数/偶数」プログラムを、全体を通した例として使います。このプログラムをフローチャートに変換するには、4つのラベルが必要です。それを以下のように定義します。

Inductive parity_label : Type :=
| entry : parity_label
| loop  : parity_label
| body  : parity_label
| done  : parity_label.

以下のblockは例プログラムのbodyラベルに対する基本ブロックです。

Definition parity_body : block parity_label :=
Assign Y (AMinus (AId Y) (ANum 1))
(Assign X (AMinus (ANum 1) (AId X))
(Goto loop)).

与えられた初期状態で基本ブロックを評価することは、最終状態と次にジャンプするためのラベルを計算することです。基本ブロックはループや他の制御構造を含まないことから、基本ブロックの評価は全関数です。非停止性の心配をする必要はありません。

Fixpoint keval {L:Type} (st:state) (k : block L) : state * L :=
match k with
| Goto l => (st, l)
| If b l1 l2 => (st, if beval st b then l1 else l2)
| Assign i a k => keval (update st i (aeval st a)) k
end.

Example keval_example:
keval empty_state parity_body
= (update (update empty_state Y 0) X 1, loop).
Proof. reflexivity. Qed.

フローチャートプログラム

フローチャートプログラムは単にラベルを基本ブロックに写像する検索関数です。実際には、いくつかのラベルは停止状態(halting states)で、基本ブロックには写像されません。これから、より正確には、ラベルの型がLであるフローチャートprogramはLからoption (block L)への関数です。

Definition program (L:Type) : Type := L -> option (block L).

Definition parity : program parity_label := fun l =>
match l with
| entry => Some (Assign X (ANum 0) (Goto loop))
| loop => Some (If (BLe (ANum 1) (AId Y)) body done)
| body => Some parity_body
| done => None
end.

基本ブロックとは異なり、プログラムは停止しないこともあります。これからプログラムの評価は再帰関数ではなく帰納的関係pevalでモデル化します。

Inductive peval {L:Type} (p : program L)
: state -> L -> state -> L -> Prop :=
| E_None: forall st l,
p l = None ->
peval p st l st l
| E_Some: forall st l k st' l' st'' l'',
p l = Some k ->
keval st k = (st', l') ->
peval p st' l' st'' l'' ->
peval p st l st'' l''.

Example parity_eval: peval parity empty_state entry empty_state done.
Proof. erewrite f_equal with (f := fun st => peval _ _ _ st _).
eapply E_Some. reflexivity. reflexivity.
eapply E_Some. reflexivity. reflexivity.
apply E_None. reflexivity.
apply functional_extensionality. intros i. rewrite update_same; auto.
Qed.

Tactic Notation "peval_cases" tactic(first) ident(c) :=
first;
[ Case_aux c "E_None" | Case_aux c "E_Some" ].

基本ブロックとフローチャートプログラムの部分評価

部分評価はラベルの型を体系的に変更します。もとのラベルの型がLならば、pe_state * Lになります。そして、オリジナルプログラムと同じラベルが、異なる部分状態と対にされることで、複数のラベルに拡大されます。例えば、parityプログラムのラベルloopは2つのラベル:([(X,0), loop)] と([(X,1), loop)] になります。このラベルの型の変更は以前に定義したpe_blockとpe_programの型に反映されます。

Fixpoint pe_block {L:Type} (pe_st:pe_state) (k : block L)
: block (pe_state * L) :=
match k with
| Goto l => Goto (pe_st, l)
| If b l1 l2 =>
match pe_bexp pe_st b with
| BTrue  => Goto (pe_st, l1)
| BFalse => Goto (pe_st, l2)
| b'     => If b' (pe_st, l1) (pe_st, l2)
end
| Assign i a k =>
match pe_aexp pe_st a with
| ANum n => pe_block (pe_add pe_st i n) k
| a' => Assign i a' (pe_block (pe_remove pe_st i) k)
end
end.

Example pe_block_example:
pe_block [(X,0)] parity_body
= Assign Y (AMinus (AId Y) (ANum 1)) (Goto ([(X,1)], loop)).
Proof. reflexivity. Qed.

Theorem pe_block_correct: forall (L:Type) st pe_st k st' pe_st' (l':L),
keval st (pe_block pe_st k) = (st', (pe_st', l')) ->
keval (pe_override st pe_st) k = (pe_override st' pe_st', l').
Proof. intros. generalize dependent pe_st. generalize dependent st.
block_cases (induction k as [l | b l1 l2 | i a k]) Case;
intros st pe_st H.
Case "Goto". inversion H; reflexivity.
Case "If".
replace (keval st (pe_block pe_st (If b l1 l2)))
with (keval st (If (pe_bexp pe_st b) (pe_st, l1) (pe_st, l2)))
in H by (simpl; destruct (pe_bexp pe_st b); reflexivity).
simpl in *. rewrite pe_bexp_correct.
destruct (beval st (pe_bexp pe_st b)); inversion H; reflexivity.
Case "Assign".
simpl in *. rewrite pe_aexp_correct.
destruct (pe_aexp pe_st a); simpl;
try solve [rewrite pe_override_update_add; apply IHk; apply H];
solve [rewrite pe_override_update_remove; apply IHk; apply H].
Qed.

Definition pe_program {L:Type} (p : program L)
: program (pe_state * L) :=
fun pe_l => match pe_l with (pe_st, l) =>
option_map (pe_block pe_st) (p l)
end.

Inductive pe_peval {L:Type} (p : program L)
(st:state) (pe_st:pe_state) (l:L) (st'o:state) (l':L) : Prop :=
| pe_peval_intro : forall st' pe_st',
peval (pe_program p) st (pe_st, l) st' (pe_st', l') ->
pe_override st' pe_st' = st'o ->
pe_peval p st pe_st l st'o l'.

Theorem pe_program_correct:
forall (L:Type) (p : program L) st pe_st l st'o l',
peval p (pe_override st pe_st) l st'o l' <->
pe_peval p st pe_st l st'o l'.
Proof. intros.
split; [Case "->" | Case "<-"].
Case "->". intros Heval.
remember (pe_override st pe_st) as sto.
generalize dependent pe_st. generalize dependent st.
peval_cases (induction Heval as
[ sto l Hlookup | sto l k st'o l' st''o l'' Hlookup Hkeval Heval ])
SCase; intros st pe_st Heqsto; subst sto.
SCase "E_None". eapply pe_peval_intro. apply E_None.
simpl. rewrite Hlookup. reflexivity. reflexivity.
SCase "E_Some".
remember (keval st (pe_block pe_st k)) as x.
destruct x as [st' [pe_st' l'_]].
symmetry in Heqx. erewrite pe_block_correct in Hkeval by apply Heqx.
inversion Hkeval. subst st'o l'_. clear Hkeval.
edestruct IHHeval. reflexivity. subst st''o. clear IHHeval.
eapply pe_peval_intro; [| reflexivity]. eapply E_Some; eauto.
simpl. rewrite Hlookup. reflexivity.
Case "<-". intros [st' pe_st' Heval Heqst'o].
remember (pe_st, l) as pe_st_l.
remember (pe_st', l') as pe_st'_l'.
generalize dependent pe_st. generalize dependent l.
peval_cases (induction Heval as
[ st [pe_st_ l_] Hlookup
| st [pe_st_ l_] pe_k st' [pe_st'_ l'_] st'' [pe_st'' l'']
Hlookup Hkeval Heval ])
SCase; intros l pe_st Heqpe_st_l;
inversion Heqpe_st_l; inversion Heqpe_st'_l'; repeat subst.
SCase "E_None". apply E_None. simpl in Hlookup.
destruct (p l'); [ solve [ inversion Hlookup ] | reflexivity ].
SCase "E_Some".
simpl in Hlookup. remember (p l) as k.
destruct k as [k|]; inversion Hlookup; subst.
eapply E_Some; eauto. apply pe_block_correct. apply Hkeval.
Qed.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- 前へ |

- ソフトウェアの基礎 1.0.2 documentation »

Postscript_J: あとがき

ふりかえり...

- 関数プログラミング - 「宣言的」プログラミング(永続データ構造上の再帰)

- 高階関数

- 多相性

- Coq、産業用途に耐え得る証明支援器

- 論理学、ソフトウェア工学の数学的基盤:

論理学                        微積分学
--------------------   =   ----------------------------
ソフトウェア工学                  機械/土木工学

- 帰納的に定義された集合と関係

- 帰納的証明

- 証明オブジェクト

- プログラミング言語の基礎

- 以下を精密に定めるための記法と定義法 - 抽象構文

- 操作的意味 - ビッグステップスタイル

- スモールステップスタイル

- 型システム

- ホーア論理

- プログラム同値性

- 型システムの基本的メタ理論

- 進行と保存

- 動的にアロケートされるヒープを持つ言語の型健全性

- サブタイプ理論

さらなる読み物

次のステップに適したものをいくつか...

- Types and Programming Languages, by Benjamin C. Pierce. MIT Press, 2002.

- Interactive Theorem Proving and Program Development: Coq’Art: The Calculus of Inductive Constructions, by Yves Bertot andPierre Castéran. Springer-Verlag, 2004.

- Certified Programming with Dependent Types, by Adam Chlipala. A draft textbook on practical proof engineering with Coq,available from his web page.

- Practical Foundations for Programming Languages, by Robert Harper. Manuscript, available from his web page.

- The Formal Semantics of Programming Languages: An Introduction, by Glynn Winskel. MIT Press, 1993.

- Foundations for Programming Languages, by John C. Mitchell. MIT Press, 1996.

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- ソフトウェアの基礎 1.0.2 documentation »

索引

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- ソフトウェアの基礎 1.0.2 documentation »

検索

検索機能を使うには JavaScript を有効にしてください。

このページからドキュメントを検索できます。キーワードを下のボックスに入力して、「検索」をクリックしてください。入力された全てのキーワードを含むページが検索されます。一部のキーワードしか含まないページは検索結果に表示されないので注意してください。

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。

ナビゲーション

- 索引

- ソフトウェアの基礎 1.0.2 documentation »

printing || #⇓#

printing ==> #⇒#

printing ==>* #⇒*#

printing ==>+ #⇒+#

printing -> #→#

printing <- #←#

printing <-> #↔#

printing forall #∀#

printing exists #∃#

printing / #∧#

printing / #∨#

printing ~~> #⇒#

printing <~~> #⇔#

printing |- #⊢#

printing Gamma #Γ#

printing Gamma’ #Γ’#

© Copyright Packt Publishing 2008, ASCII MEDIA WORKS Inc., Copyright 2010. このドキュメントは Sphinx 1.1.3 で生成しました。