From 7d744693f635577790450124383ea64728bb4a43 Mon Sep 17 00:00:00 2001 From: h7x4 Date: Tue, 10 Mar 2026 11:17:41 +0900 Subject: [PATCH] Initial commit --- .devcontainer/.zshrc | 13 + .devcontainer/Dockerfile | 58 + .devcontainer/devcontainer.json | 49 + .devcontainer/hack.sh | 17 + .envrc | 1 + .gitignore | 12 + AltAuto.v | 1828 +++++++++++++++++++ AltAutoTest.v | 274 +++ Auto.v | 747 ++++++++ AutoTest.v | 68 + Basics.v | 2052 +++++++++++++++++++++ BasicsTest.v | 554 ++++++ Bib.v | 35 + BibTest.v | 68 + Extraction.v | 134 ++ ExtractionTest.v | 68 + Imp.v | 2092 ++++++++++++++++++++++ ImpCEvalFun.v | 398 +++++ ImpCEvalFunTest.v | 97 + ImpParser.v | 466 +++++ ImpParserTest.v | 68 + ImpTest.v | 292 +++ IndPrinciples.v | 966 ++++++++++ IndPrinciplesTest.v | 118 ++ IndProp.v | 2962 +++++++++++++++++++++++++++++++ IndPropTest.v | 632 +++++++ Induction.v | 764 ++++++++ InductionTest.v | 257 +++ LICENSE | 19 + Lists.v | 1207 +++++++++++++ ListsTest.v | 544 ++++++ Logic.v | 1805 +++++++++++++++++++ LogicTest.v | 423 +++++ Makefile | 17 + Maps.v | 380 ++++ MapsTest.v | 102 ++ Poly.v | 1246 +++++++++++++ PolyTest.v | 552 ++++++ Postscript.v | 85 + PostscriptTest.v | 68 + Preface.v | 549 ++++++ PrefaceTest.v | 68 + ProofObjects.v | 946 ++++++++++ ProofObjectsTest.v | 375 ++++ README.md | 38 + Rel.v | 412 +++++ RelTest.v | 68 + Tactics.v | 1301 ++++++++++++++ TacticsTest.v | 275 +++ _CoqProject | 1 + deps.svg | 387 ++++ impdriver.ml | 37 + shell.nix | 14 + 53 files changed, 26009 insertions(+) create mode 100755 .devcontainer/.zshrc create mode 100644 .devcontainer/Dockerfile create mode 100644 .devcontainer/devcontainer.json create mode 100644 .devcontainer/hack.sh create mode 100644 .envrc create mode 100644 .gitignore create mode 100644 AltAuto.v create mode 100644 AltAutoTest.v create mode 100644 Auto.v create mode 100644 AutoTest.v create mode 100644 Basics.v create mode 100644 BasicsTest.v create mode 100644 Bib.v create mode 100644 BibTest.v create mode 100644 Extraction.v create mode 100644 ExtractionTest.v create mode 100644 Imp.v create mode 100644 ImpCEvalFun.v create mode 100644 ImpCEvalFunTest.v create mode 100644 ImpParser.v create mode 100644 ImpParserTest.v create mode 100644 ImpTest.v create mode 100644 IndPrinciples.v create mode 100644 IndPrinciplesTest.v create mode 100644 IndProp.v create mode 100644 IndPropTest.v create mode 100644 Induction.v create mode 100644 InductionTest.v create mode 100644 LICENSE create mode 100644 Lists.v create mode 100644 ListsTest.v create mode 100644 Logic.v create mode 100644 LogicTest.v create mode 100644 Makefile create mode 100644 Maps.v create mode 100644 MapsTest.v create mode 100644 Poly.v create mode 100644 PolyTest.v create mode 100644 Postscript.v create mode 100644 PostscriptTest.v create mode 100644 Preface.v create mode 100644 PrefaceTest.v create mode 100644 ProofObjects.v create mode 100644 ProofObjectsTest.v create mode 100644 README.md create mode 100644 Rel.v create mode 100644 RelTest.v create mode 100644 Tactics.v create mode 100644 TacticsTest.v create mode 100644 _CoqProject create mode 100644 deps.svg create mode 100644 impdriver.ml create mode 100644 shell.nix diff --git a/.devcontainer/.zshrc b/.devcontainer/.zshrc new file mode 100755 index 0000000..d38a73f --- /dev/null +++ b/.devcontainer/.zshrc @@ -0,0 +1,13 @@ +autoload -U colors && colors +precmd() { + drawline="" + for i in {1..$COLUMNS}; drawline=" $drawline" + drawline="%U${drawline}%u" + PS1="%F{252}${drawline} +%B%F{124}%n:%~>%b%f " +} + +eval $(opam env) + +alias ls="ls --color" + diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile new file mode 100644 index 0000000..10e7170 --- /dev/null +++ b/.devcontainer/Dockerfile @@ -0,0 +1,58 @@ +FROM ubuntu:20.04 + +## BEGIN: RUNS AS ROOT + +# Create a user + +ARG USERNAME=cis5000 +ARG USER_UID=1000 +ARG USER_GID=$USER_UID + +RUN apt-get update -y + +RUN groupadd --gid $USER_GID $USERNAME \ + && useradd --uid $USER_UID --gid $USER_GID -m $USERNAME --shell /bin/zsh \ + # + # [Optional] Add sudo support. Omit if you don't need to install software after connecting. + && apt-get install -y sudo \ + && echo $USERNAME ALL=\(root\) NOPASSWD:ALL > /etc/sudoers.d/$USERNAME \ + && chmod 0440 /etc/sudoers.d/$USERNAME + +## Hack needs root permissions + +# See hack.sh +COPY hack.sh /tmp/hack.sh +RUN chmod +x /tmp/hack.sh +RUN /tmp/hack.sh + +RUN apt-get install -y build-essential +RUN apt-get install -y linux-libc-dev +RUN apt-get install -y m4 +RUN apt-get install -y opam +RUN apt-get install -y time +RUN apt-get install -y zip +RUN apt-get install -y zsh +RUN apt-get install -y libgmp3-dev +RUN DEBIAN_FRONTEND=noninteractive apt-get install -y pkg-config + +## Set up user environmnent +COPY .zshrc /home/$USERNAME/ + + +## Run in usermode + +# [Optional] Set the default user. Omit if you want to keep the default as root. +USER $USERNAME + +# Configure opam/ocaml +RUN opam init -y --disable-sandboxing --compiler=5.3.0 +RUN opam switch 5.3.0 +RUN opam install -y num +RUN opam repo add -y coq-released https://coq.inria.fr/opam/released +RUN opam pin add -y coq 9.0.0 +RUN opam install -y coq-simple-io +RUN opam install -y vscoq-language-server +RUN opam update -y +RUN opam upgrade -y +RUN eval `opam config env` + diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json new file mode 100644 index 0000000..8cd956a --- /dev/null +++ b/.devcontainer/devcontainer.json @@ -0,0 +1,49 @@ +// For format details, see https://aka.ms/devcontainer.json. For config options, see the +// README at: https://github.com/devcontainers/templates/tree/main/src/ubuntu +{ + "name": "Ubuntu", + // Or use a Dockerfile or Docker Compose file. More info: https://containers.dev/guide/dockerfile + "build": { + "dockerfile": "Dockerfile" + }, + + // Features to add to the dev container. More info: https://containers.dev/features. + // "features": {}, + + // Use 'forwardPorts' to make a list of ports inside the container available locally. + // "forwardPorts": [], + + // Use 'postCreateCommand' to run commands after the container is created. + // "postCreateCommand": "uname -a", + + // Configure tool-specific properties. + "customizations": { + "vscode": { + "extensions": [ + "maximedenes.vscoq" + ], + "settings": { + "coqtop.binPath" : "/home/cis5000/.opam/4.14.0/bin", + "files.exclude": { + "**/*.aux": true, + "**/*.glob": true, + "**/*.vo": true, + "**/*.vos": true, + "**/*.vok": true, + "**/*.html": true, + "**/.*.report": true, + "**/.*.cache": true + }, + "coq.loadCoqProject": true, + "coq.coqProjectRoot": ".", + "[coq]": { + "editor.tabSize": 2, + "editor.insertSpaces": true + } + } + } + } + + // Uncomment to connect as root instead. More info: https://aka.ms/dev-containers-non-root. + // "remoteUser": "root" +} diff --git a/.devcontainer/hack.sh b/.devcontainer/hack.sh new file mode 100644 index 0000000..b6d2c3f --- /dev/null +++ b/.devcontainer/hack.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env bash + +### HACK - workaround ubuntu libc6 version number bug see: https://forum.odroid.com/viewtopic.php?p=344373 + +mv /bin/uname /bin/uname.orig +tee -a /bin/uname < re_opt_e re2 + | App re1 re2 => App (re_opt_e re1) (re_opt_e re2) + | Union re1 re2 => Union (re_opt_e re1) (re_opt_e re2) + | Star re => Star (re_opt_e re) + | _ => re + end. + +(** We would like to show the equivalence of re's with their + "optimized" form. One direction of this equivalence looks like + this (the other is similar). *) + +Lemma re_opt_e_match : forall T (re: reg_exp T) s, + s =~ re -> s =~ re_opt_e re. +Proof. + intros T re s M. + induction M + as [| x' + | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2]. + - (* MEmpty *) simpl. apply MEmpty. + - (* MChar *) simpl. apply MChar. + - (* MApp *) simpl. + destruct re1. + + apply MApp. + * apply IH1. + * apply IH2. + + inversion Hmatch1. simpl. apply IH2. + + apply MApp. + * apply IH1. + * apply IH2. + + apply MApp. + * apply IH1. + * apply IH2. + + apply MApp. + * apply IH1. + * apply IH2. + + apply MApp. + * apply IH1. + * apply IH2. + - (* MUnionL *) simpl. apply MUnionL. apply IH. + - (* MUnionR *) simpl. apply MUnionR. apply IH. + - (* MStar0 *) simpl. apply MStar0. + - (* MStarApp *) simpl. apply MStarApp. + * apply IH1. + * apply IH2. +Qed. + +(** The amount of repetition in that proof is annoying. And if + we wanted to extend the optimization function to handle other, + similar, rewriting opportunities, it would start to be a real + problem. We can streamline the proof with _tacticals_, which we + turn to, next. *) + +(* ################################################################# *) +(** * Tacticals *) + +(** _Tacticals_ are tactics that take other tactics as arguments -- + "higher-order tactics," if you will. *) + +(* ================================================================= *) +(** ** The [try] Tactical *) + +(** If [T] is a tactic, then [try T] is a tactic that is just like [T] + except that, if [T] fails, [try T] _successfully_ does nothing at + all instead of failing. *) + +Theorem silly1 : forall n, 1 + n = S n. +Proof. try reflexivity. (* this just does [reflexivity] *) Qed. + +Theorem silly2 : forall (P : Prop), P -> P. +Proof. + intros P HP. + Fail reflexivity. + try reflexivity. (* proof state is unchanged *) + apply HP. +Qed. + +(** There is no real reason to use [try] in completely manual + proofs like these, but it is very useful for doing automated + proofs in conjunction with the [;] tactical, which we show + next. *) + +(* ================================================================= *) +(** ** The Sequence Tactical [;] (Simple Form) *) + +(** In its most common form, the sequence tactical, written with + semicolon [;], takes two tactics as arguments. The compound + tactic [T; T'] first performs [T] and then performs [T'] on _each + subgoal_ generated by [T]. *) + +(** For example, consider the following trivial lemma: *) + +Lemma simple_semi : forall n, (n + 1 =? 0) = false. +Proof. + intros n. + destruct n eqn:E. + (* Leaves two subgoals, which are discharged identically... *) + - (* n=0 *) simpl. reflexivity. + - (* n=Sn' *) simpl. reflexivity. +Qed. + +(** We can simplify this proof using the [;] tactical: *) + +Lemma simple_semi' : forall n, (n + 1 =? 0) = false. +Proof. + intros n. + (* [destruct] the current goal *) + destruct n; + (* then [simpl] each resulting subgoal *) + simpl; + (* and do [reflexivity] on each resulting subgoal *) + reflexivity. +Qed. + +(** Or even more tersely, [destruct] can do the [intro], and [simpl] + can be omitted: *) + +Lemma simple_semi'' : forall n, (n + 1 =? 0) = false. +Proof. + destruct n; reflexivity. +Qed. + +(** **** Exercise: 3 stars, standard (try_sequence) *) + +(** Prove the following theorems using [try] and [;]. Like + [simple_semi''] above, each proof script should be a sequence [t1; + ...; tn.] of tactics, and there should be only one period in + between [Proof.] and [Qed.]. Let's call that a "one shot" + proof. *) + +Theorem andb_eq_orb : + forall (b c : bool), + (andb b c = orb b c) -> + b = c. +Proof. (* FILL IN HERE *) Admitted. + +Theorem add_assoc : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. (* FILL IN HERE *) Admitted. + +Fixpoint nonzeros (lst : list nat) := + match lst with + | [] => [] + | 0 :: t => nonzeros t + | h :: t => h :: nonzeros t + end. + +Lemma nonzeros_app : forall lst1 lst2 : list nat, + nonzeros (lst1 ++ lst2) = (nonzeros lst1) ++ (nonzeros lst2). +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(** Using [try] and [;] together, we can improve the proof about + regular expression optimization. *) + +Lemma re_opt_e_match' : forall T (re: reg_exp T) s, + s =~ re -> s =~ re_opt_e re. +Proof. + intros T re s M. + induction M + as [| x' + | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2]; + (* Do the [simpl] for every case here: *) + simpl. + - (* MEmpty *) apply MEmpty. + - (* MChar *) apply MChar. + - (* MApp *) + destruct re1; + (* Most cases follow by the same formula. Notice that [apply + MApp] gives two subgoals: [try apply IH1] is run on _both_ of + them and succeeds on the first but not the second; [apply IH2] + is then run on this remaining goal. *) + try (apply MApp; try apply IH1; apply IH2). + (* The interesting case, on which [try...] does nothing, is when + [re1 = EmptyStr]. In this case, we have to appeal to the fact + that [re1] matches only the empty string: *) + inversion Hmatch1. simpl. apply IH2. + - (* MUnionL *) apply MUnionL. apply IH. + - (* MUnionR *) apply MUnionR. apply IH. + - (* MStar0 *) apply MStar0. + - (* MStarApp *) apply MStarApp. apply IH1. apply IH2. +Qed. + +(* ================================================================= *) +(** ** The Sequence Tactical [;] (Local Form) *) + +(** The sequence tactical [;] also has a more general form than the + simple [T; T'] we saw above. If [T], [T1], ..., [Tn] are tactics, + then + +[[ T; [T1 | T2 | ... | Tn] ]] + + is a tactic that first performs [T] and then locally performs [T1] + on the first subgoal generated by [T], locally performs [T2] on + the second subgoal, etc. + + So [T; T'] is just special notation for the case when all of the + [Ti]'s are the same tactic; i.e., [T; T'] is shorthand for: + + T; [T' | T' | ... | T'] + + For example, the following proof makes it clear which tactics are + used to solve the base case vs. the inductive case. + *) + +Theorem app_length : forall (X : Type) (lst1 lst2 : list X), + length (lst1 ++ lst2) = (length lst1) + (length lst2). +Proof. + intros; induction lst1; + [reflexivity | simpl; rewrite IHlst1; reflexivity]. +Qed. + +(** The identity tactic [idtac] always succeeds without changing the + proof state. We can use it to factor out [reflexivity] in the + previous proof. *) + +Theorem app_length' : forall (X : Type) (lst1 lst2 : list X), + length (lst1 ++ lst2) = (length lst1) + (length lst2). +Proof. + intros; induction lst1; + [idtac | simpl; rewrite IHlst1]; + reflexivity. +Qed. + +(** **** Exercise: 1 star, standard (notry_sequence) *) + +(** Prove the following theorem with a one-shot proof, but this + time, do not use [try]. *) + +Theorem add_assoc' : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(** We can use the local form of the sequence tactical to give a + slightly neater version of our optimization proof. Two lines + change, as shown below with [<===]. *) + +Lemma re_opt_e_match'' : forall T (re: reg_exp T) s, + s =~ re -> s =~ re_opt_e re. +Proof. + intros T re s M. + induction M + as [| x' + | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2]; + (* Do the [simpl] for every case here: *) + simpl. + - (* MEmpty *) apply MEmpty. + - (* MChar *) apply MChar. + - (* MApp *) + destruct re1; + try (apply MApp; [apply IH1 | apply IH2]). (* <=== *) + inversion Hmatch1. simpl. apply IH2. + - (* MUnionL *) apply MUnionL. apply IH. + - (* MUnionR *) apply MUnionR. apply IH. + - (* MStar0 *) apply MStar0. + - (* MStarApp *) apply MStarApp; [apply IH1 | apply IH2]. (* <=== *) +Qed. + +(* ================================================================= *) +(** ** The [repeat] Tactical *) + +(** The [repeat] tactical takes another tactic and keeps + applying this tactic until it fails or stops making progress. Here + is an example showing that [10] is in a long list: *) + +Theorem In10 : In 10 [1;2;3;4;5;6;7;8;9;10]. +Proof. + repeat (try (left; reflexivity); right). +Qed. + +(** The tactic [repeat T] never fails: if the tactic [T] doesn't apply + to the original goal, then [repeat] still succeeds without + changing the original goal (i.e., it repeats zero times). *) + +Theorem In10' : In 10 [1;2;3;4;5;6;7;8;9;10]. +Proof. + repeat (left; reflexivity). + repeat (right; try (left; reflexivity)). +Qed. + +(** The tactic [repeat T] also does not have any upper bound on the + number of times it applies [T]. If [T] is a tactic that always + succeeds, then repeat [T] will loop forever (e.g., [repeat simpl] + loops, since [simpl] always succeeds). Evaluation in Rocq's term + language, Gallina, is guaranteed to terminate, but tactic + evaluation is not. This does not affect Rocq's logical consistency, + however, since the job of [repeat] and other tactics is to guide + Rocq in constructing proofs. If the construction process diverges, + it simply means that we have failed to construct a proof, not that + we have constructed an incorrect proof. *) + +(** **** Exercise: 1 star, standard (ev100) + + Prove that 100 is even. Your proof script should be quite short. *) + +Theorem ev100: ev 100. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ================================================================= *) +(** ** An Optimization Exercise *) +(** **** Exercise: 4 stars, standard (re_opt) *) + +(** Consider this more powerful version of the regular expression + optimizer. *) + +Fixpoint re_opt {T:Type} (re: reg_exp T) : reg_exp T := + match re with + | App _ EmptySet => EmptySet + | App EmptyStr re2 => re_opt re2 + | App re1 EmptyStr => re_opt re1 + | App re1 re2 => App (re_opt re1) (re_opt re2) + | Union EmptySet re2 => re_opt re2 + | Union re1 EmptySet => re_opt re1 + | Union re1 re2 => Union (re_opt re1) (re_opt re2) + | Star EmptySet => EmptyStr + | Star EmptyStr => EmptyStr + | Star re => Star (re_opt re) + | EmptySet => EmptySet + | EmptyStr => EmptyStr + | Char x => Char x + end. + +(* Here is an incredibly tedious manual proof of (one direction of) + its correctness: *) + +Lemma re_opt_match : forall T (re: reg_exp T) s, + s =~ re -> s =~ re_opt re. +Proof. + intros T re s M. + induction M + as [| x' + | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2]. + - (* MEmpty *) simpl. apply MEmpty. + - (* MChar *) simpl. apply MChar. + - (* MApp *) simpl. + destruct re1. + + inversion IH1. + + inversion IH1. simpl. destruct re2. + * apply IH2. + * apply IH2. + * apply IH2. + * apply IH2. + * apply IH2. + * apply IH2. + + destruct re2. + * inversion IH2. + * inversion IH2. rewrite app_nil_r. apply IH1. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + + destruct re2. + * inversion IH2. + * inversion IH2. rewrite app_nil_r. apply IH1. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + + destruct re2. + * inversion IH2. + * inversion IH2. rewrite app_nil_r. apply IH1. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + + destruct re2. + * inversion IH2. + * inversion IH2. rewrite app_nil_r. apply IH1. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + * apply MApp. + -- apply IH1. + -- apply IH2. + - (* MUnionL *) simpl. + destruct re1. + + inversion IH. + + destruct re2. + * apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + + destruct re2. + * apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + + destruct re2. + * apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + + destruct re2. + * apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + + destruct re2. + * apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + * apply MUnionL. apply IH. + - (* MUnionR *) simpl. + destruct re1. + + apply IH. + + destruct re2. + * inversion IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + + destruct re2. + * inversion IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + + destruct re2. + * inversion IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + + destruct re2. + * inversion IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + + destruct re2. + * inversion IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + * apply MUnionR. apply IH. + - (* MStar0 *) simpl. + destruct re. + + apply MEmpty. + + apply MEmpty. + + apply MStar0. + + apply MStar0. + + apply MStar0. + + simpl. + destruct re. + * apply MStar0. + * apply MStar0. + * apply MStar0. + * apply MStar0. + * apply MStar0. + * apply MStar0. + - (* MStarApp *) simpl. + destruct re. + + inversion IH1. + + inversion IH1. inversion IH2. apply MEmpty. + + apply star_app. + * apply MStar1. apply IH1. + * apply IH2. + + apply star_app. + * apply MStar1. apply IH1. + * apply IH2. + + apply star_app. + * apply MStar1. apply IH1. + * apply IH2. + + apply star_app. + * apply MStar1. apply IH1. + * apply IH2. +Qed. + +(* Use the tacticals described so far to shorten the proof. The proof + above is about 200 lines. Reduce it to 50 or fewer lines of similar + density. Solve each of the seven top-level bullets with a one-shot + proof. + + Hint: use a bottom-up approach. First copy-paste the entire proof + below. Then automate the innermost bullets first, proceeding + outwards. Frequently double-check that the entire proof still + compiles. If it doesn't, undo the most recent changes you made + until you get back to a compiling proof. *) + +Lemma re_opt_match' : forall T (re: reg_exp T) s, + s =~ re -> s =~ re_opt re. +Proof. +(* FILL IN HERE *) Admitted. +(* Do not modify the following line: *) +Definition manual_grade_for_re_opt : option (nat*string) := None. +(** [] *) + +(* ################################################################# *) +(** * Tactics that Make Mentioning Names Unnecessary *) + +(** So far we have been dependent on knowing the names of + hypotheses. For example, to prove the following simple theorem, + we hardcode the name [HP]: *) + +Theorem hyp_name : forall (P : Prop), P -> P. +Proof. + intros P HP. apply HP. +Qed. + +(** We took the trouble to invent a name for [HP], then we had + to remember that name. If we later change the name in one place, + we have to change it everywhere. Likewise, if we were to add new + arguments to the theorem, we would have to adjust the [intros] + list. That makes it challenging to maintain large proofs. So, Rocq + provides several tactics that make it possible to write proof + scripts that do not hardcode names. *) + +(* ================================================================= *) +(** ** The [assumption] tactic *) + +(** The [assumption] tactic is useful to streamline the proof + above. It looks through the hypotheses and, if it finds the goal + as one them, it uses that to finish the proof. *) + +Theorem no_hyp_name : forall (P : Prop), P -> P. +Proof. + intros. assumption. +Qed. + +(** Some might argue to the contrary that hypothesis names + improve self-documention of proof scripts. Maybe they do, + sometimes. But in the case of the two proofs above, the first + mentions unnecessary detail, whereas the second could be + paraphrased simply as "the conclusion follows from the + assumptions." + + Anyway, unlike informal (good) mathematical proofs, Rocq proof + scripts are generally not that illuminating to readers. Worries + about rich, self-documenting names for hypotheses might be + misplaced. *) + +(* ================================================================= *) +(** ** The [contradiction] tactic *) + +(** The [contradiction] tactic handles some ad hoc situations where a + hypothesis contains [False], or two hypotheses derive [False]. *) + +Theorem false_assumed : False -> 0 = 1. +Proof. + intros H. destruct H. +Qed. + +Theorem false_assumed' : False -> 0 = 1. +Proof. + intros. contradiction. +Qed. + +Theorem contras : forall (P : Prop), P -> ~P -> 0 = 1. +Proof. + intros P HP HNP. exfalso. apply HNP. apply HP. +Qed. + +Theorem contras' : forall (P : Prop), P -> ~P -> 0 = 1. +Proof. + intros. contradiction. +Qed. + +(* ================================================================= *) +(** ** The [subst] tactic *) + +(** The [subst] tactic substitutes away an identifier, replacing + it everywhere and eliminating it from the context. That helps + us to avoid naming hypotheses in [rewrite]s. *) + +Theorem many_eq : forall (n m o p : nat), + n = m -> + o = p -> + [n; o] = [m; p]. +Proof. + intros n m o p Hnm Hop. rewrite Hnm. rewrite Hop. reflexivity. +Qed. + +Theorem many_eq' : forall (n m o p : nat), + n = m -> + o = p -> + [n; o] = [m; p]. +Proof. + intros. subst. reflexivity. +Qed. + +(** Actually there are two forms of this tactic. + + - [subst x] finds an assumption [x = e] or [e = x] in the + context, replaces [x] with [e] throughout the context and + current goal, and removes the assumption from the context. + + - [subst] substitutes away _all_ assumptions of the form [x = e] + or [e = x]. *) + +(* ================================================================= *) +(** ** The [constructor] tactic *) + +(** The [constructor] tactic tries to find a constructor [c] (from the + appropriate [Inductive] definition in the current environment) + that can be applied to solve the current goal. *) + +Check ev_0 : ev 0. +Check ev_SS : forall n : nat, ev n -> ev (S (S n)). + +Example constructor_example: forall (n:nat), + ev (n + n). +Proof. + induction n; simpl. + - constructor. (* applies ev_0 *) + - rewrite add_comm. simpl. constructor. (* applies ev_SS *) + assumption. +Qed. + +(** Warning: if more than one constructor can apply, + [constructor] picks the first one, in the order in which they were + defined in the [Inductive] definition. That might not be the one + you want. *) + +(* ################################################################# *) +(** * Automatic Solvers *) + +(** Rocq has several special-purpose tactics that can solve + certain kinds of goals in a completely automated way. These + tactics are based on sophisticated algorithms developed for + verification in specific mathematical or logical domains. + + Some automatic solvers are _decision procedures_, which are + algorithms that always terminate, and always give a correct + answer. Here, that means that they always find a correct proof, or + correctly determine that the goal is invalid. Other automatic + solvers are _incomplete_: they might fail to find a proof of a + valid goal. *) + +(* ================================================================= *) +(** ** Linear Integer Arithmetic: The [lia] Tactic *) + +(** The [lia] tactic implements a decision procedure for integer + linear arithmetic, a subset of propositional logic and arithmetic. + As input it accepts goals constructed as follows: + + - variables and constants of type [nat], [Z], and other integer + types; + + - arithmetic operators [+], [-], [*], and [^]; + + - equality [=] and ordering [<], [>], [<=], [>=]; and + + - the logical connectives [/\], [\/], [~], [->], and [<->]; and + constants [True] and [False]. + + _Linear_ goals involve (in)equalities over expressions of the form + [c1 * x1 + ... + cn * xn], where [ci] are constants and [xi] are + variables. + + - For linear goals, [lia] will either solve the goal or fail, + meaning that the goal is actually invalid. + + - For non-linear goals, [lia] will also either solve the goal or + fail. But in this case, the failure does not necessarily mean + that the goal is invalid -- it might just be beyond [lia]'s + reach to prove because of non-linearity. + + Also, [lia] will do [intros] as necessary. *) + +From Stdlib Require Import Lia. + +Theorem lia_succeed1 : forall (n : nat), + n > 0 -> n * 2 > n. +Proof. lia. Qed. + +Theorem lia_succeed2 : forall (n m : nat), + n * m = m * n. +Proof. + lia. (* solvable though non-linear *) +Qed. + +Theorem lia_fail1 : 0 = 1. +Proof. + Fail lia. (* goal is invalid *) +Abort. + +Theorem lia_fail2 : forall (n : nat), + n >= 1 -> 2 ^ n = 2 * 2 ^ (n - 1). +Proof. + Fail lia. (*goal is non-linear, valid, but unsolvable by lia *) +Abort. + +(** There are other tactics that can solve arithmetic goals. The + [ring] and [field] tactics, for example, can solve equations over + the algebraic structures of _rings_ and _fields_, from which the + tactics get their names. These tactics do not do [intros]. *) + +From Stdlib Require Import Ring. + +Theorem mult_comm : forall (n m : nat), + n * m = m * n. +Proof. + intros n m. ring. +Qed. + +(* ================================================================= *) +(** ** Equalities: The [congruence] Tactic *) + +(** The [lia] tactic makes use of facts about addition and + multiplication to prove equalities. A more basic way of treating + such formulas is to regard every function appearing in them as + a black box: nothing is known about the function's behavior. + Based on the properties of equality itself, it is still possible + to prove some formulas. For example, [y = f x -> g y = g (f x)], + even if we know nothing about [f] or [g]: + *) + +Theorem eq_example1 : + forall (A B C : Type) (f : A -> B) (g : B -> C) (x : A) (y : B), + y = f x -> g y = g (f x). +Proof. + intros. rewrite H. reflexivity. +Qed. + +(** The essential properties of equality are that it is: + + - reflexive + + - symmetric + + - transitive + + - a _congruence_: it respects function and predicate + application. *) + +(** It is that congruence property that we're using when we + [rewrite] in the proof above: if [a = b] then [f a = f b]. (The + [ProofObjects] chapter explores this idea further under the + name "Leibniz equality".) *) + +(** The [congruence] tactic is a decision procedure for equality with + uninterpreted functions and other symbols. *) + +Theorem eq_example1' : + forall (A B C : Type) (f : A -> B) (g : B -> C) (x : A) (y : B), + y = f x -> g y = g (f x). +Proof. + congruence. +Qed. + +(** The [congruence] tactic is able to work with constructors, + even taking advantage of their injectivity and distinctness. *) + +Theorem eq_example2 : forall (n m o p : nat), + n = m -> + o = p -> + (n, o) = (m, p). +Proof. + congruence. +Qed. + +Theorem eq_example3 : forall (X : Type) (h : X) (t : list X), + [] <> h :: t. +Proof. + congruence. +Qed. + +(* ================================================================= *) +(** ** Propositions: The [intuition] Tactic *) + +(** A _tautology_ is a logical formula that is always + provable. A formula is _propositional_ if it does not use + quantifiers -- or at least, if quantifiers do not have to be + instantiated to carry out the proof. The [intuition] tactic + implements a decision procedure for propositional tautologies in + Rocq's constructive (that is, intuitionistic) logic. Even if a goal + is not a propositional tautology, [intuition] will still attempt + to reduce it to simpler subgoals. *) + +Theorem intuition_succeed1 : forall (P : Prop), + P -> P. +Proof. intuition. Qed. + +Theorem intuition_succeed2 : forall (P Q : Prop), + ~ (P \/ Q) -> ~P /\ ~Q. +Proof. intuition. Qed. + +Theorem intuition_simplify1 : forall (P : Prop), + ~~P -> P. +Proof. + intuition. (* not a constructively valid formula *) +Abort. + +Theorem intuition_simplify2 : forall (x y : nat) (P Q : nat -> Prop), + x = y /\ (P x -> Q x) /\ P x -> Q y. +Proof. + Fail congruence. (* the propositions stump it *) + intuition. (* the [=] stumps it, but it simplifies the propositions *) + congruence. +Qed. + +(** In the previous example, neither [congruence] nor + [intuition] alone can solve the goal. But after [intuition] + simplifies the propositions involved in the goal, [congruence] can + succeed. For situations like this, [intuition] takes an optional + argument, which is a tactic to apply to all the unsolved goals + that [intuition] generated. Using that we can offer a shorter + proof: *) + +Theorem intuition_simplify2' : forall (x y : nat) (P Q : nat -> Prop), + x = y /\ (P x -> Q x) /\ P x -> Q y. +Proof. + intuition congruence. +Qed. + +(* ================================================================= *) +(** ** Exercises with Automatic Solvers *) + +(** **** Exercise: 2 stars, standard (automatic_solvers) + + The exercises below are gleaned from previous chapters, where they + were proved with (relatively) long proof scripts. Each should now + be provable with just a single invocation of an automatic + solver. *) + +Theorem plus_id_exercise_from_basics : forall n m o : nat, + n = m -> m = o -> n + m = m + o. +Proof. (* FILL IN HERE *) Admitted. + +Theorem add_assoc_from_induction : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. (* FILL IN HERE *) Admitted. + +Theorem S_injective_from_tactics : forall (n m : nat), + S n = S m -> + n = m. +Proof. (* FILL IN HERE *) Admitted. + +Theorem or_distributes_over_and_from_logic : forall P Q R : Prop, + P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R). +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ################################################################# *) +(** * Search Tactics *) + +(** The automated solvers we just discussed are capable of finding + proofs in specific domains. Some of them might pay attention to + local hypotheses, but overall they don't make use of any custom + lemmas we've proved, or that are provided by libraries that we + load. + + Another kind of automation that Rocq provides does just that: the + [auto] tactic and its variants search for proofs that can be + assembled out of hypotheses and lemmas. *) + +(* ================================================================= *) +(** ** The [auto] Tactic *) + +(** Until this chapter, our proof scripts mostly applied relevant + hypotheses or lemmas by name, and one at a time. *) + +Example auto_example_1 : forall (P Q R: Prop), + (P -> Q) -> (Q -> R) -> P -> R. +Proof. + intros P Q R H1 H2 H3. + apply H2. apply H1. apply H3. +Qed. + +(** The [auto] tactic frees us from this drudgery by _searching_ for a + sequence of applications that will prove the goal: *) + +Example auto_example_1' : forall (P Q R: Prop), + (P -> Q) -> (Q -> R) -> P -> R. +Proof. + auto. +Qed. + +(** The [auto] tactic solves goals that are solvable by any combination of + - [intros] and + - [apply] (of hypotheses from the local context, by default). *) + +(** Using [auto] is always "safe" in the sense that it will + never fail and will never change the proof state: either it + completely solves the current goal, or it does nothing. *) + +(** Here is a more interesting example showing [auto]'s power: *) + +Example auto_example_2 : 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. + +(** Proof search could, in principle, take an arbitrarily long time, + so there are limits to how far [auto] will search by default. *) + +Example auto_example_3 : forall (P Q R S T U: Prop), + (P -> Q) -> + (Q -> R) -> + (R -> S) -> + (S -> T) -> + (T -> U) -> + P -> + U. +Proof. + (* When it cannot solve the goal, [auto] does nothing *) + auto. + (* Optional argument says how deep to search (default is 5) *) + auto 6. +Qed. + +(** The [auto] tactic considers the hypotheses in the current context + together with a _hint database_ of other lemmas and constructors. + Some common facts about equality and logical operators are + installed in the hint database by default. *) + +Example auto_example_4 : forall P Q R : Prop, + Q -> + (Q -> R) -> + P \/ (Q /\ R). +Proof. auto. Qed. + +(** If we want to see which facts [auto] is using, we can use + [info_auto] instead. *) + +Example auto_example_5 : 2 = 2. +Proof. + (* [auto] subsumes [reflexivity] because [eq_refl] is in the hint + database. *) + info_auto. +Qed. + +(** We can extend the hint database with theorem [t] just for the + purposes of one application of [auto] by writing [auto using + t]. *) + +Lemma le_antisym : forall n m: nat, (n <= m /\ m <= n) -> n = m. +Proof. intros. lia. Qed. + +Example auto_example_6 : forall n m p : nat, + (n <= p -> (n <= m /\ m <= n)) -> + n <= p -> + n = m. +Proof. + auto using le_antisym. +Qed. + +(** Of course, in any given development there will probably be + some specific constructors and lemmas that are used very often in + proofs. We can add these to a hint database named [db] by writing + + Create HintDb db. + + to create the database, then + + Hint Resolve T : db. + + to add [T] to the database, where [T] is a top-level theorem or a + constructor of an inductively defined proposition (i.e., anything + whose type is an implication). We tell [auto] to use that database + by writing [auto with db]. Technically creation of the database + is optional; Rocq will create it automatically the first time + we use [Hint]. *) + +Create HintDb le_db. +Hint Resolve le_antisym : le_db. + +Example auto_example_6' : forall n m p : nat, + (n <= p -> (n <= m /\ m <= n)) -> + n <= p -> + n = m. +Proof. + auto with le_db. +Qed. + +(** As a shorthand, we can write + + Hint Constructors c : db. + + to tell Rocq to do a [Hint Resolve] for _all_ of the constructors + from the inductive definition of [c]. + + It is also sometimes necessary to add + + Hint Unfold d : db. + + where [d] is a defined symbol, so that [auto] knows to expand uses + of [d], thus enabling further possibilities for applying lemmas that + it knows about. *) + +Definition is_fortytwo x := (x = 42). + +Example auto_example_7: forall x, + (x <= 42 /\ 42 <= x) -> is_fortytwo x. +Proof. + auto. (* does nothing *) +Abort. + +Hint Unfold is_fortytwo : le_db. + +Example auto_example_7' : forall x, + (x <= 42 /\ 42 <= x) -> is_fortytwo x. +Proof. info_auto with le_db. Qed. + +(** The "global" database that [auto] always uses is named [core]. + You can add your own hints to it, but the Rocq manual discourages + that, preferring instead to have specialized databases for + specific developments. Many of the important libraries have their + own hint databases that you can tag in: [arith], [bool], [datatypes] + (including lists), etc. *) + +Example auto_example_8 : forall (n m : nat), + n + m = m + n. +Proof. + auto. (* no progress *) + info_auto with arith. (* uses [Nat.add_comm] *) +Qed. + +(** **** Exercise: 3 stars, standard (re_opt_match_auto) *) + +(** Use [auto] to shorten your proof of [re_opt_match] even + more. Eliminate all uses of [apply], thus removing the need to + name specific constructors and lemmas about regular expressions. + The number of lines of proof script won't decrease that much, + because [auto] won't be able to find [induction], [destruct], or + [inversion] opportunities by itself. + + Hint: again, use a bottom-up approach. Always keep the proof + compiling. You might find it easier to return to the original, + very long proof, and shorten it, rather than starting with + [re_opt_match']; but, either way can work. *) + +Lemma re_opt_match'' : forall T (re: reg_exp T) s, + s =~ re -> s =~ re_opt re. +Proof. +(* FILL IN HERE *) Admitted. +(* Do not modify the following line: *) +Definition manual_grade_for_re_opt_match'' : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 3 stars, advanced, optional (pumping_redux) + + Use [auto], [lia], and any other useful tactics from this chapter + to shorten your proof (or the "official" solution proof) of the + weak Pumping Lemma exercise from [IndProp]. *) + +Import Pumping. + +Lemma weak_pumping : forall T (re : reg_exp T) s, + s =~ re -> + pumping_constant re <= length s -> + exists s1 s2 s3, + s = s1 ++ s2 ++ s3 /\ + s2 <> [] /\ + forall m, s1 ++ napp m s2 ++ s3 =~ re. + +Proof. +(* FILL IN HERE *) Admitted. +(* Do not modify the following line: *) +Definition manual_grade_for_pumping_redux : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 3 stars, advanced, optional (pumping_redux_strong) + + Use [auto], [lia], and any other useful tactics from this chapter + to shorten your proof (or the "official" solution proof) of the + stronger Pumping Lemma exercise from [IndProp]. *) + +Lemma pumping : forall T (re : reg_exp T) s, + s =~ re -> + pumping_constant re <= length s -> + exists s1 s2 s3, + s = s1 ++ s2 ++ s3 /\ + s2 <> [] /\ + length s1 + length s2 <= pumping_constant re /\ + forall m, s1 ++ napp m s2 ++ s3 =~ re. + +Proof. + (* FILL IN HERE *) Admitted. +(* Do not modify the following line: *) +Definition manual_grade_for_pumping_redux_strong : option (nat*string) := None. +(** [] *) + +(* ================================================================= *) +(** ** The [eauto] variant *) + +(** There is a variant of [auto] (and other tactics, such as + [apply]) that makes it possible to delay instantiation of + quantifiers. To motivate this feature, consider again this simple + example: *) + +Example trans_example1: forall a b c d, + a <= b + b * c -> + (1 + c) * b <= d -> + a <= d. +Proof. + intros a b c d H1 H2. + apply Nat.le_trans with (b + b * c). + (* ^ We must supply the intermediate value *) + - apply H1. + - simpl in H2. rewrite mul_comm. apply H2. +Qed. + +(** In the first step of the proof, we had to explicitly provide a + longish expression to help Rocq instantiate a "hidden" argument to + the [le_trans] constructor. This was needed because the definition + of [le_trans]... + + le_trans : forall m n o : nat, m <= n -> n <= o -> m <= o + + is quantified over a variable, [n], that does not appear in its + conclusion, so unifying its conclusion with the goal state doesn't + help Rocq find a suitable value for this variable. If we leave + out the [with], this step fails ("Error: Unable to find an + instance for the variable [n]"). + + We already know one way to avoid an explicit [with] clause, namely + to provide [H1] as the (first) explicit argument to [le_trans]. + But here's another way, using the [eapply tactic]: *) + +Example trans_example1': forall a b c d, + a <= b + b * c -> + (1 + c) * b <= d -> + a <= d. +Proof. + intros a b c d H1 H2. + eapply Nat.le_trans. (* 1 *) + - apply H1. (* 2 *) + - simpl in H2. rewrite mul_comm. apply H2. +Qed. + +(** The [eapply H] tactic behaves just like [apply H] except + that, after it finishes unifying the goal state with the + conclusion of [H], it does not bother to check whether all the + variables that were introduced in the process have been given + concrete values during unification. + + If you step through the proof above, you'll see that the goal + state at position [1] mentions the _existential variable_ [?n] in + both of the generated subgoals. The next step (which gets us to + position [2]) replaces [?n] with a concrete value. When we start + working on the second subgoal (position [3]), we observe that the + occurrence of [?n] in this subgoal has been replaced by the value + that it was given during the first subgoal. *) + +(** Several of the tactics that we've seen so far, including + [exists], [constructor], and [auto], have [e...] variants. For + example, here's a proof using [eauto]: *) + +Example trans_example2: forall a b c d, + a <= b + b * c -> + b + b * c <= d -> + a <= d. +Proof. + intros a b c d H1 H2. + info_eauto using Nat.le_trans. +Qed. + +(** The [eauto] tactic works just like [auto], except that it + uses [eapply] instead of [apply]. + + Pro tip: One might think that, since [eapply] and [eauto] are more + powerful than [apply] and [auto], it would be a good idea to use + them all the time. Unfortunately, they are also significantly + slower -- especially [eauto]. Rocq experts tend to use [apply] and + [auto] most of the time, only switching to the [e] variants when + the ordinary variants don't do the job. *) + +(* ################################################################# *) +(** * Ltac: The Tactic Language *) + +(** Most of the tactics we have been using are implemented in + OCaml, where they are able to use an API to access Rocq's internal + structures at a low level. But this is seldom worth the trouble + for ordinary Rocq users. + + Rocq has a high-level language called Ltac for programming new + tactics in Rocq itself, without having to escape to OCaml. + Actually we've been using Ltac all along -- anytime we are in + proof mode, we've been writing Ltac programs. At their most basic, + those programs are just invocations of built-in tactics. The + tactical constructs we learned at the beginning of this chapter + are also part of Ltac. + + What we turn to, next, is ways to use Ltac to reduce the amount of + proof script we have to write ourselves. *) + +(* ================================================================= *) +(** ** Ltac Functions *) + +(** Here is a simple [Ltac] example: *) + +Ltac simpl_and_try tac := simpl; try tac. + +(** This defines a new tactic called [simpl_and_try] that takes one + tactic [tac] as an argument and is defined to be equivalent to + [simpl; try tac]. Now writing "[simpl_and_try reflexivity.]" in a + proof will be the same as writing "[simpl; try reflexivity.]" *) + +Example sat_ex1 : 1 + 1 = 2. +Proof. simpl_and_try reflexivity. Qed. + +Example sat_ex2 : forall (n : nat), 1 - 1 + n + 1 = 1 + n. +Proof. simpl_and_try reflexivity. lia. Qed. + +(** Of course, that little tactic is not so useful. But it + demonstrates that we can parameterize Ltac-defined tactics, and + that their bodies are themselves tactics that will be run in the + context of a proof. So Ltac can be used to create functions on + tactics. *) + +(** For a more useful tactic, consider these three proofs from + [Basics], and how structurally similar they all are: *) + +Theorem plus_1_neq_0 : forall n : nat, + (n + 1) =? 0 = false. +Proof. + intros n. destruct n. + - reflexivity. + - reflexivity. +Qed. + +Theorem negb_involutive : forall b : bool, + negb (negb b) = b. +Proof. + intros b. destruct b. + - reflexivity. + - reflexivity. +Qed. + +Theorem andb_commutative : forall b c, andb b c = andb c b. +Proof. + intros b c. destruct b. + - destruct c. + + reflexivity. + + reflexivity. + - destruct c. + + reflexivity. + + reflexivity. +Qed. + +(** We can factor out the common structure: + + - Do a destruct. + + - For each branch, finish with [reflexivity] -- if possible. *) + +Ltac destructpf x := + destruct x; try reflexivity. + +Theorem plus_1_neq_0' : forall n : nat, + (n + 1) =? 0 = false. +Proof. intros n; destructpf n. Qed. + +Theorem negb_involutive' : forall b : bool, + negb (negb b) = b. +Proof. intros b; destructpf b. Qed. + +Theorem andb_commutative' : forall b c, andb b c = andb c b. +Proof. + intros b c; destructpf b; destructpf c. +Qed. + +(** **** Exercise: 1 star, standard (andb3_exchange) + + Re-prove the following theorem from [Basics], using only + [intros] and [destructpf]. You should have a one-shot proof. *) + +Theorem andb3_exchange : + forall b c d, andb (andb b c) d = andb (andb b d) c. +Proof. (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (andb_true_elim2) + + The following theorem from [Basics] can't be proved with + [destructpf]. *) + +Theorem andb_true_elim2 : forall b c : bool, + andb b c = true -> c = true. +Proof. + intros b c. destruct b eqn:Eb. + - simpl. intros H. rewrite H. reflexivity. + - simpl. intros H. destruct c eqn:Ec. + + reflexivity. + + rewrite H. reflexivity. +Qed. + +(** Uncomment the definition of [destructpf'], below, and define your + own, improved version of [destructpf]. Use it to prove the + theorem. *) + +(* +Ltac destructpf' x := ... +*) + +(** Your one-shot proof should need only [intros] and + [destructpf']. *) + +Theorem andb_true_elim2' : forall b c : bool, + andb b c = true -> c = true. +Proof. (* FILL IN HERE *) Admitted. + +(** Double-check that [intros] and your new [destructpf'] still + suffice to prove this earlier theorem -- i.e., that your improved + tactic is general enough to still prove it in one shot: *) + +Theorem andb3_exchange' : + forall b c d, andb (andb b c) d = andb (andb b d) c. +Proof. (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Ltac Pattern Matching *) + +(** Here is another common proof pattern that we have seen in + many simple proofs by induction: *) + +Theorem app_nil_r : forall (X : Type) (lst : list X), + lst ++ [] = lst. +Proof. + intros X lst. induction lst as [ | h t IHt]. + - reflexivity. + - simpl. rewrite IHt. reflexivity. +Qed. + +(** At the point we [rewrite], we can't substitute away [t]: it + is present on both sides of the equality in the inductive + hypothesis [IHt : t ++ [] = t]. How can we pick out which + hypothesis to rewrite in an Ltac tactic? + + To solve this and other problems, Ltac contains a pattern-matching + tactic [match goal]. It allows us to match against the _proof + state_ rather than against a program. *) + +Theorem match_ex1 : True. +Proof. + match goal with + | [ |- True ] => apply I + end. +Qed. + +(** The syntax is similar to a [match] in Gallina (Rocq's term + language), but has some new features: + + - The word [goal] here is a keyword, rather than an expression + being matched. It means to match against the proof state, rather + than a program term. + + - The square brackets around the pattern can often be omitted, but + they do make it easier to visually distinguish which part of the + code is the pattern. + + - The turnstile [|-] separates the hypothesis patterns (if any) + from the conclusion pattern. It represents the big horizontal + line shown by your IDE in the proof state: the hypotheses are to + the left of it, the conclusion is to the right. + + - The hypotheses in the pattern need not completely describe all + the hypotheses present in the proof state. It is fine for there + to be additional hypotheses in the proof state that do not match + any of the patterns. The point is for [match goal] to pick out + particular hypotheses of interest, rather than fully specify the + proof state. + + - The right-hand side of a branch is a tactic to run, rather than + a program term. + + The single branch above therefore specifies to match a goal whose + conclusion is the term [True] and whose hypotheses may be anything. + If such a match occurs, it will run [apply I]. *) + +(** There may be multiple branches, which are tried in order. *) + +Theorem match_ex2 : True /\ True. +Proof. + match goal with + | [ |- True ] => apply I + | [ |- True /\ True ] => split; apply I + end. +Qed. + +(** To see what branches are being tried, it can help to insert calls + to the identity tactic [idtac]. It optionally accepts an argument + to print out as debugging information. *) + +Theorem match_ex2' : True /\ True. +Proof. + match goal with + | [ |- True ] => idtac "branch 1"; apply I + | [ |- True /\ True ] => idtac "branch 2"; split; apply I + end. +Qed. + +(** Only the second branch was tried. The first one did not match the + goal. *) + +(** The semantics of the tactic [match goal] have a big + difference with the semantics of the term [match]. With the + latter, the first matching pattern is chosen, and later branches + are never considered. In fact, an error is produced if later + branches are known to be redundant. *) + +Fail Definition redundant_match (n : nat) : nat := + match n with + | x => x + | 0 => 1 + end. + +(** But with [match goal], if the tactic for the branch fails, + pattern matching continues with the next branch, until a branch + succeeds, or all branches have failed. *) + +Theorem match_ex2'' : True /\ True. +Proof. + match goal with + | [ |- _ ] => idtac "branch 1"; apply I + | [ |- True /\ True ] => idtac "branch 2"; split; apply I + end. +Qed. + +(** The first branch was tried but failed, then the second + branch was tried and succeeded. If all the branches fail, the + [match goal] fails. *) + +Theorem match_ex2''' : True /\ True. +Proof. + Fail match goal with + | [ |- _ ] => idtac "branch 1"; apply I + | [ |- _ ] => idtac "branch 2"; apply I + end. +Abort. + +(** Next, let's try matching against hypotheses. We can bind a + hypothesis name, as with [H] below, and use that name on the + right-hand side of the branch. *) + +Theorem match_ex3 : forall (P : Prop), P -> P. +Proof. + intros P HP. + match goal with + | [ H : _ |- _ ] => apply H + end. +Qed. + +(** The actual name of the hypothesis is of course [HP], but the + pattern binds it as [H]. Using [idtac], we can even observe the + actual name: stepping through the following proof causes "HP" to + be printed. *) + +Theorem match_ex3' : forall (P : Prop), P -> P. +Proof. + intros P HP. + match goal with + | [ H : _ |- _ ] => idtac H; apply H + end. +Qed. + +(** We'll keep using [idtac] for awhile to observe the behavior + of [match goal], but, note that it isn't necessary for the + successful proof of any of the following examples. + + If there are multiple hypotheses that match, which one does Ltac + choose? Here is a big difference with regular [match] against + terms: Ltac will try all possible matches until one succeeds (or + all have failed). *) + +Theorem match_ex4 : forall (P Q : Prop), P -> Q -> P. +Proof. + intros P Q HP HQ. + match goal with + | [ H : _ |- _ ] => idtac H; apply H + end. +Qed. + +(** That example prints "HQ" followed by "HP". Ltac first + matched against the most recently introduced hypothesis [HQ] and + tried applying it. That did not solve the goal. So Ltac + _backtracks_ and tries the next most-recent matching hypothesis, + which is [HP]. Applying that does succeed. *) + +(** But if there were no successful hypotheses, the entire match + would fail: *) + +Theorem match_ex5 : forall (P Q R : Prop), P -> Q -> R. +Proof. + intros P Q R HP HQ. + Fail match goal with + | [ H : _ |- _ ] => idtac H; apply H + end. +Abort. + +(** So far we haven't been very demanding in how to match + hypotheses. The _wildcard_ (aka _joker_) pattern we've used + matches everything. We could be more specific by using + _metavariables_: *) + +Theorem match_ex5 : forall (P Q : Prop), P -> Q -> P. +Proof. + intros P Q HP HQ. + match goal with + | [ H : ?X |- ?X ] => idtac H; apply H + end. +Qed. + +(** Note that this time, the only hypothesis printed by [idtac] + is [HP]. The [HQ] hypothesis is ruled out, because it does not + have the form [?X |- ?X]. + + The occurrences of [?X] in that pattern are as _metavariables_ + that stand for the same term appearing both as the type of + hypothesis [H] and as the conclusion of the goal. + + (The syntax of [match goal] requires that [?] to distinguish + metavariables from other identifiers that might be in + scope. However, the [?] is used only in the pattern. On the + right-hand side of the branch, it's actually required to drop the + [?].) *) + +(** Now we have seen yet another difference between [match goal] + and regular [match] against terms: [match goal] allows a + metavariable to be used multiple times in a pattern, each time + standing for the same term. The regular [match] does not allow + that: *) + +Fail Definition dup_first_two_elts (lst : list nat) := + match lst with + | x :: x :: _ => true + | _ => false + end. + +(** The technical term for this is _linearity_: regular [match] + requires pattern variables to be _linear_, meaning that they are + used only once. Tactic [match goal] permits _non-linear_ + metavariables, meaning that they can be used multiple times in a + pattern and must bind the same term each time. *) + +(** Now that we've learned a bit about [match goal], let's return + to the proof pattern of some simple inductions: *) + +Theorem app_nil_r' : forall (X : Type) (lst : list X), + lst ++ [] = lst. +Proof. + intros X lst. induction lst as [ | h t IHt]. + - reflexivity. + - simpl. rewrite IHt. reflexivity. +Qed. + +(** With [match goal], we can automate that proof pattern: *) + +Ltac simple_induction t := + induction t; simpl; + try match goal with + | [H : _ = _ |- _] => rewrite H + end; + reflexivity. + +Theorem app_nil_r'' : forall (X : Type) (lst : list X), + lst ++ [] = lst. +Proof. + intros X lst. simple_induction lst. +Qed. + +(** That works great! Here are two other proofs that follow the same + pattern. *) + +Theorem add_assoc'' : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. + intros n m p. induction n. + - reflexivity. + - simpl. rewrite IHn. reflexivity. +Qed. + +Theorem add_assoc''' : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. + intros n m p. simple_induction n. +Qed. + +Theorem plus_n_Sm : forall n m : nat, + S (n + m) = n + (S m). +Proof. + intros n m. induction n. + - reflexivity. + - simpl. rewrite IHn. reflexivity. +Qed. + +Theorem plus_n_Sm' : forall n m : nat, + S (n + m) = n + (S m). +Proof. + intros n m. simple_induction n. +Qed. + +(* ================================================================= *) +(** ** Using [match goal] to Prove Tautologies *) + +(** The Ltac source code of [intuition] can be found in the GitHub + repo for Rocq in [theories/Init/Tauto.v]. At heart, it is a big + loop that runs [match goal] to find propositions it can [apply] + and [destruct]. + + Let's build our own simplified "knock off" of [intuition]. Here's + a start on implication: *) + +Ltac imp_intuition := + repeat match goal with + | [ H : ?P |- ?P ] => apply H + | [ |- forall _, _ ] => intro + | [ H1 : ?P -> ?Q, H2 : ?P |- _ ] => apply H1 in H2 + end. + +(** That tactic repeatedly matches against the goal until the match + fails to make progress. At each step, the [match goal] does one of + three things: + + - Finds that the conclusion is already in the hypotheses, in which + case the goal is finished. + + - Finds that the conclusion is a quantification, in which case it + is introduced. Since implication [P -> Q] is itself a + quantification [forall (_ : P), Q], this case handles introduction of + implications, too. + + - Finds that two formulas of the form [?P -> ?Q] and [?P] are in + the hypotheses. This is the first time we've seen an example of + matching against two hypotheses simultaneously. Note that the + metavariable [?P] is once more non-linear: the same formula must + occur in two different hypotheses. In this case, the tactic + uses forward reasoning to change hypothesis [H2] into [?Q]. + + Already we can prove many theorems with this tactic: *) + +Example imp1 : forall (P : Prop), P -> P. +Proof. imp_intuition. Qed. + +Example imp2 : forall (P Q : Prop), P -> (P -> Q) -> Q. +Proof. imp_intuition. Qed. + +Example imp3 : forall (P Q R : Prop), (P -> Q -> R) -> (Q -> P -> R). +Proof. imp_intuition. Qed. + +(** Suppose we were to add a new logical connective: [nor], the "not + or" connective. *) + +Inductive nor (P Q : Prop) := +| stroke : ~P -> ~Q -> nor P Q. + +(** Classically, [nor P Q] would be equivalent to [~(P \/ Q)]. But + constructively, only one direction of that is provable. *) + +Theorem nor_not_or : forall (P Q : Prop), + nor P Q -> ~ (P \/ Q). +Proof. + intros. destruct H. unfold not. intros. destruct H. auto. auto. +Qed. + +(** Some other usual theorems about [nor] are still provable, + though. *) + +Theorem nor_comm : forall (P Q : Prop), + nor P Q <-> nor Q P. +Proof. + intros P Q. split. + - intros H. destruct H. apply stroke; assumption. + - intros H. destruct H. apply stroke; assumption. +Qed. + +Theorem nor_not : forall (P : Prop), + nor P P <-> ~P. +Proof. + intros P. split. + - intros H. destruct H. assumption. + - intros H. apply stroke; assumption. +Qed. + +(** **** Exercise: 4 stars, advanced (nor_intuition) *) + +(** Create your own tactic [nor_intuition]. It should be able to + prove the three theorems above -- [nor_not_and], [nor_comm], and + [nor_not] -- fully automatically. You may not use [intuition] or + any other automated solvers in your solution. + + Begin by copying the code from [imp_intuition]. You will then need + to expand it to handle conjunctions, negations, bi-implications, + and [nor]. *) + +(* Ltac nor_intuition := ... *) + +(** Each of the three theorems below, and many others involving these + logical connectives, should be provable with just + [Proof. nor_intuition. Qed.] *) + +Theorem nor_comm' : forall (P Q : Prop), + nor P Q <-> nor Q P. +Proof. (* FILL IN HERE *) Admitted. + +Theorem nor_not' : forall (P : Prop), + nor P P <-> ~P. +Proof. (* FILL IN HERE *) Admitted. + +Theorem nor_not_and' : forall (P Q : Prop), + nor P Q -> ~ (P /\ Q). +Proof. (* FILL IN HERE *) Admitted. +(* Do not modify the following line: *) +Definition manual_grade_for_nor_intuition : option (nat*string) := None. +(** [] *) + +(* ################################################################# *) +(** * Review *) + +(** We've learned a lot of new features and tactics in this chapter: + + - [try], [;], [repeat] + + - [assumption], [contradiction], [subst], [constructor] + + - [lia], [congruence], [intuition] + + - [auto], [eauto], [eapply] + + - Ltac functions and [match goal] *) + +(* 2026-01-07 13:18 *) diff --git a/AltAutoTest.v b/AltAutoTest.v new file mode 100644 index 0000000..7711931 --- /dev/null +++ b/AltAutoTest.v @@ -0,0 +1,274 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import AltAuto. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import AltAuto. +Import Check. + +Goal True. + +idtac "------------------- try_sequence --------------------". +idtac " ". + +idtac "#> andb_eq_orb". +idtac "Possible points: 1". +check_type @andb_eq_orb ( +(forall (b c : Basics.bool) + (_ : @eq Basics.bool (Basics.andb b c) (Basics.orb b c)), + @eq Basics.bool b c)). +idtac "Assumptions:". +Abort. +Print Assumptions andb_eq_orb. +Goal True. +idtac " ". + +idtac "#> add_assoc". +idtac "Possible points: 1". +check_type @add_assoc ( +(forall n m p : nat, + @eq nat (Nat.add n (Nat.add m p)) (Nat.add (Nat.add n m) p))). +idtac "Assumptions:". +Abort. +Print Assumptions add_assoc. +Goal True. +idtac " ". + +idtac "#> nonzeros_app". +idtac "Possible points: 1". +check_type @nonzeros_app ( +(forall lst1 lst2 : Poly.list nat, + @eq (Poly.list nat) (nonzeros (@Poly.app nat lst1 lst2)) + (@Poly.app nat (nonzeros lst1) (nonzeros lst2)))). +idtac "Assumptions:". +Abort. +Print Assumptions nonzeros_app. +Goal True. +idtac " ". + +idtac "------------------- notry_sequence --------------------". +idtac " ". + +idtac "#> add_assoc'". +idtac "Possible points: 1". +check_type @add_assoc' ( +(forall n m p : nat, + @eq nat (Nat.add n (Nat.add m p)) (Nat.add (Nat.add n m) p))). +idtac "Assumptions:". +Abort. +Print Assumptions add_assoc'. +Goal True. +idtac " ". + +idtac "------------------- ev100 --------------------". +idtac " ". + +idtac "#> ev100". +idtac "Possible points: 1". +check_type @ev100 ((IndProp.ev 100)). +idtac "Assumptions:". +Abort. +Print Assumptions ev100. +Goal True. +idtac " ". + +idtac "------------------- re_opt --------------------". +idtac " ". + +idtac "#> Manually graded: re_opt". +idtac "Possible points: 6". +print_manual_grade manual_grade_for_re_opt. +idtac " ". + +idtac "------------------- automatic_solvers --------------------". +idtac " ". + +idtac "#> plus_id_exercise_from_basics". +idtac "Possible points: 0.5". +check_type @plus_id_exercise_from_basics ( +(forall (n m o : nat) (_ : @eq nat n m) (_ : @eq nat m o), + @eq nat (Nat.add n m) (Nat.add m o))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_id_exercise_from_basics. +Goal True. +idtac " ". + +idtac "#> add_assoc_from_induction". +idtac "Possible points: 0.5". +check_type @add_assoc_from_induction ( +(forall n m p : nat, + @eq nat (Nat.add n (Nat.add m p)) (Nat.add (Nat.add n m) p))). +idtac "Assumptions:". +Abort. +Print Assumptions add_assoc_from_induction. +Goal True. +idtac " ". + +idtac "#> S_injective_from_tactics". +idtac "Possible points: 0.5". +check_type @S_injective_from_tactics ( +(forall (n m : nat) (_ : @eq nat (S n) (S m)), @eq nat n m)). +idtac "Assumptions:". +Abort. +Print Assumptions S_injective_from_tactics. +Goal True. +idtac " ". + +idtac "#> or_distributes_over_and_from_logic". +idtac "Possible points: 0.5". +check_type @or_distributes_over_and_from_logic ( +(forall P Q R : Prop, iff (or P (and Q R)) (and (or P Q) (or P R)))). +idtac "Assumptions:". +Abort. +Print Assumptions or_distributes_over_and_from_logic. +Goal True. +idtac " ". + +idtac "------------------- re_opt_match_auto --------------------". +idtac " ". + +idtac "#> Manually graded: re_opt_match''". +idtac "Possible points: 3". +print_manual_grade manual_grade_for_re_opt_match''. +idtac " ". + +idtac "------------------- andb3_exchange --------------------". +idtac " ". + +idtac "#> andb3_exchange". +idtac "Possible points: 1". +check_type @andb3_exchange ( +(forall b c d : Basics.bool, + @eq Basics.bool (Basics.andb (Basics.andb b c) d) + (Basics.andb (Basics.andb b d) c))). +idtac "Assumptions:". +Abort. +Print Assumptions andb3_exchange. +Goal True. +idtac " ". + +idtac "------------------- andb_true_elim2 --------------------". +idtac " ". + +idtac "#> andb_true_elim2'". +idtac "Possible points: 1.5". +check_type @andb_true_elim2' ( +(forall (b c : Basics.bool) + (_ : @eq Basics.bool (Basics.andb b c) Basics.true), + @eq Basics.bool c Basics.true)). +idtac "Assumptions:". +Abort. +Print Assumptions andb_true_elim2'. +Goal True. +idtac " ". + +idtac "#> andb3_exchange'". +idtac "Possible points: 0.5". +check_type @andb3_exchange' ( +(forall b c d : Basics.bool, + @eq Basics.bool (Basics.andb (Basics.andb b c) d) + (Basics.andb (Basics.andb b d) c))). +idtac "Assumptions:". +Abort. +Print Assumptions andb3_exchange'. +Goal True. +idtac " ". + +idtac "------------------- nor_intuition --------------------". +idtac " ". + +idtac "#> Manually graded: nor_intuition". +idtac "Advanced". +idtac "Possible points: 6". +print_manual_grade manual_grade_for_nor_intuition. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 19". +idtac "Max points - advanced: 25". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- andb_eq_orb ---------". +Print Assumptions andb_eq_orb. +idtac "---------- add_assoc ---------". +Print Assumptions add_assoc. +idtac "---------- nonzeros_app ---------". +Print Assumptions nonzeros_app. +idtac "---------- add_assoc' ---------". +Print Assumptions add_assoc'. +idtac "---------- ev100 ---------". +Print Assumptions ev100. +idtac "---------- re_opt ---------". +idtac "MANUAL". +idtac "---------- plus_id_exercise_from_basics ---------". +Print Assumptions plus_id_exercise_from_basics. +idtac "---------- add_assoc_from_induction ---------". +Print Assumptions add_assoc_from_induction. +idtac "---------- S_injective_from_tactics ---------". +Print Assumptions S_injective_from_tactics. +idtac "---------- or_distributes_over_and_from_logic ---------". +Print Assumptions or_distributes_over_and_from_logic. +idtac "---------- re_opt_match'' ---------". +idtac "MANUAL". +idtac "---------- andb3_exchange ---------". +Print Assumptions andb3_exchange. +idtac "---------- andb_true_elim2' ---------". +Print Assumptions andb_true_elim2'. +idtac "---------- andb3_exchange' ---------". +Print Assumptions andb3_exchange'. +idtac "". +idtac "********** Advanced **********". +idtac "---------- nor_intuition ---------". +idtac "MANUAL". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Auto.v b/Auto.v new file mode 100644 index 0000000..d3797eb --- /dev/null +++ b/Auto.v @@ -0,0 +1,747 @@ +(** * Auto: More Automation *) + +Set Warnings "-notation-overridden,-notation-incompatible-prefix". +From Stdlib Require Import Lia. +From Stdlib Require Import Strings.String. +From LF Require Import Maps. +From LF Require Import Imp. + +(** Up to now, we've used the manual part of Rocq's tactic + facilities. In this chapter, we'll learn more about some of + Rocq's powerful automation features: proof search via the [auto] + tactic, automated forward reasoning via the [Ltac] hypothesis + matching machinery, and deferred instantiation of existential + variables using [eapply] and [eauto]. Using these features + together with Ltac's scripting facilities will enable us to make + some of our proofs startlingly short! Used properly, they can + also make proofs more maintainable and robust to changes in + underlying definitions. A deeper treatment of [auto] and [eauto] + can be found in the [UseAuto] chapter in _Programming Language + Foundations_. + + (There's one other major category of automation we haven't + discussed much yet, namely built-in decision procedures for + specific kinds of problems: [lia] is one example, but there are + others. This topic will be deferred for a while longer.) + + Our motivating example will be the following proof, repeated with + just a few small changes from the [Imp] chapter. We will + simplify this proof in several stages. *) + +Theorem ceval_deterministic: forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2; + generalize dependent st2; + induction E1; intros st2 E2; inversion E2; subst. + - (* E_Skip *) reflexivity. + - (* E_Asgn *) reflexivity. + - (* E_Seq *) + rewrite (IHE1_1 st'0 H1) in *. + apply IHE1_2. assumption. + (* E_IfTrue *) + - (* b evaluates to true *) + apply IHE1. assumption. + - (* b evaluates to false (contradiction) *) + rewrite H in H5. discriminate. + (* E_IfFalse *) + - (* b evaluates to true (contradiction) *) + rewrite H in H5. discriminate. + - (* b evaluates to false *) + apply IHE1. assumption. + (* E_WhileFalse *) + - (* b evaluates to false *) + reflexivity. + - (* b evaluates to true (contradiction) *) + rewrite H in H2. discriminate. + (* E_WhileTrue *) + - (* b evaluates to false (contradiction) *) + rewrite H in H4. discriminate. + - (* b evaluates to true *) + rewrite (IHE1_1 st'0 H3) in *. + apply IHE1_2. assumption. Qed. + +(* ################################################################# *) +(** * The [auto] Tactic *) + +(** Thus far, our proof scripts mostly apply relevant hypotheses or + lemmas by name, and only one at a time. *) + +Example auto_example_1 : forall (P Q R: Prop), + (P -> Q) -> (Q -> R) -> P -> R. +Proof. + intros P Q R H1 H2 H3. + apply H2. apply H1. assumption. +Qed. + +(** The [auto] tactic tries to free us from this drudgery by _searching_ + for a sequence of applications that will prove the goal: *) + +Example auto_example_1' : forall (P Q R: Prop), + (P -> Q) -> (Q -> R) -> P -> R. +Proof. + auto. +Qed. + +(** The [auto] tactic solves goals that are solvable by any combination of + [intros] and [apply]. *) + +(** Using [auto] is always "safe" in the sense that it will + never fail and will never change the proof state: either it + completely solves the current goal, or it does nothing. *) + +(** Here is a larger example showing [auto]'s power: *) + +Example auto_example_2 : 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. + +(** Proof search could, in principle, take an arbitrarily long time, + so there is a limit to how deep [auto] will search by default. *) + +(** If [auto] is not solving our goal as expected we can use [debug auto] + to see a trace. *) +Example auto_example_3 : forall (P Q R S T U: Prop), + (P -> Q) -> + (Q -> R) -> + (R -> S) -> + (S -> T) -> + (T -> U) -> + P -> + U. +Proof. + (* When it cannot solve the goal, [auto] does nothing *) + auto. + + (* Let's see where [auto] gets stuck using [debug auto] *) + debug auto. + + (* Optional argument to [auto] says how deep to search + (default is 5) *) + auto 6. +Qed. + +(** When searching for potential proofs of the current goal, + [auto] considers the hypotheses in the current context together + with a _hint database_ of other lemmas and constructors. Some + common lemmas about equality and logical operators are installed + in this hint database by default. *) + +Example auto_example_4 : forall P Q R : Prop, + Q -> + (Q -> R) -> + P \/ (Q /\ R). +Proof. auto. Qed. + +(** If we want to see which facts [auto] is using, we can use + [info_auto] instead. *) + +Example auto_example_5: 2 = 2. +Proof. + info_auto. +Qed. + +Example auto_example_5' : forall (P Q R S T U W: Prop), + (U -> T) -> + (W -> U) -> + (R -> S) -> + (S -> T) -> + (P -> R) -> + (U -> T) -> + P -> + T. +Proof. + intros. + info_auto. +Qed. + +(** We can extend the hint database just for the purposes of one + application of [auto] by writing "[auto using ...]". *) + +Lemma le_antisym : forall n m: nat, (n <= m /\ m <= n) -> n = m. +Proof. lia. Qed. + +Example auto_example_6 : forall n m p q : nat, + (p = q -> (n <= m /\ m <= n)) -> + p = q -> + n = m. +Proof. + auto using le_antisym. +Qed. + +(** Of course, in any given development there will probably be + some specific constructors and lemmas that are used very often in + proofs. We can add these to the global hint database by writing + + Hint Resolve T : core. + + at the top level, where [T] is a top-level theorem or a + constructor of an inductively defined proposition (i.e., anything + whose type is an implication). As a shorthand, we can write + + Hint Constructors c : core. + + to tell Rocq to do a [Hint Resolve] for _all_ of the constructors + from the inductive definition of [c]. + + It is also sometimes necessary to add + + Hint Unfold d : core. + + where [d] is a defined symbol, so that [auto] knows to unfold uses + of [d], thus enabling further possibilities for applying lemmas that + it knows about. *) + +(** It is also possible to define specialized hint databases (besides + [core]) that can be activated only when needed; indeed, it is good + style to create your own hint databases instead of polluting + [core]. + + See the Rocq reference manual for details. *) + +Hint Resolve le_antisym : core. + +Example auto_example_6' : forall n m p q : nat, + (p = q -> (n <= m /\ m <= n)) -> + p = q -> + n = m. +Proof. + auto. (* picks up hint from database *) +Qed. + +Definition is_fortytwo x := (x = 42). + +Example auto_example_7: forall x, + (x <= 42 /\ 42 <= x) -> is_fortytwo x. +Proof. + auto. (* does nothing *) +Abort. + +Hint Unfold is_fortytwo : core. + +Example auto_example_7' : forall x, + (x <= 42 /\ 42 <= x) -> is_fortytwo x. +Proof. + auto. (* try also: info_auto. *) +Qed. + +(** Note that the [Hint Unfold is_fortytwo] command above the + example is needed because, unlike the normal [apply] tactic, the + [simple apply] steps that are performed by [auto] do not do any + automatic unfolding. *) + +(** Let's take a first pass over [ceval_deterministic], using [auto] + to simplify the proof script. *) + +Theorem ceval_deterministic': forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2; + induction E1; intros st2 E2; inversion E2; subst; + auto. (* <---- here's one good place for auto *) + - (* E_Seq *) + rewrite (IHE1_1 st'0 H1) in *. + auto. (* <---- here's another *) + - (* E_IfTrue *) + rewrite H in H5. discriminate. + - (* E_IfFalse *) + rewrite H in H5. discriminate. + - (* E_WhileFalse *) + rewrite H in H2. discriminate. + - (* E_WhileTrue, with b false *) + rewrite H in H4. discriminate. + - (* E_WhileTrue, with b true *) + rewrite (IHE1_1 st'0 H3) in *. + auto. (* <---- and another *) +Qed. + +(** When we are using a particular tactic many times in a proof, we + can use a variant of the [Proof] command to make that tactic into + a default within the proof. Saying [Proof with t] (where [t] is + an arbitrary tactic) allows us to use [t1...] as a shorthand for + [t1;t] within the proof. As an illustration, here is an alternate + version of the previous proof, using [Proof with auto]. *) + +Theorem ceval_deterministic'_alt: forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof with auto. + intros c st st1 st2 E1 E2; + generalize dependent st2; + induction E1; + intros st2 E2; inversion E2; subst... + - (* E_Seq *) + rewrite (IHE1_1 st'0 H1) in *... + - (* E_IfTrue *) + rewrite H in H5. discriminate. + - (* E_IfFalse *) + rewrite H in H5. discriminate. + - (* E_WhileFalse *) + rewrite H in H2. discriminate. + - (* E_WhileTrue, with b false *) + rewrite H in H4. discriminate. + - (* E_WhileTrue, with b true *) + rewrite (IHE1_1 st'0 H3) in *... +Qed. + +(* ################################################################# *) +(** * Searching For Hypotheses *) + +(** The proof has become simpler, but there is still an annoying + degree of repetition. Let's start by tackling the contradiction + cases. Each of them occurs in a situation where we have both + + H1: beval st b = false + + and + + H2: beval st b = true + + as hypotheses. The contradiction is evident, but demonstrating it + is a little complicated: we have to locate the two hypotheses [H1] + and [H2] and do a [rewrite] following by a [discriminate]. We'd + like to automate this process. + + (In fact, Rocq has a built-in tactic [congruence] that will do the + job in this case. We'll ignore this tactic for now, in order to + demonstrate how to build forward-search tactics by hand.) + + As a first step, we can abstract out the piece of script in + question by writing a little function in Ltac. *) + +Ltac rwd H1 H2 := rewrite H1 in H2; discriminate. + +Theorem ceval_deterministic'': forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2; + induction E1; intros st2 E2; inversion E2; subst; auto. + - (* E_Seq *) + rewrite (IHE1_1 st'0 H1) in *. + auto. + - (* E_IfTrue *) + rwd H H5. (* <----- *) + - (* E_IfFalse *) + rwd H H5. (* <----- *) + - (* E_WhileFalse *) + rwd H H2. (* <----- *) + - (* E_WhileTrue - b false *) + rwd H H4. (* <----- *) + - (* EWhileTrue - b true *) + rewrite (IHE1_1 st'0 H3) in *. + auto. Qed. + +(** That's a bit better, but we really want Rocq to discover the + relevant hypotheses for us. We can do this by using the [match + goal] facility of Ltac. *) + +Ltac find_rwd := + match goal with + H1: ?E = true, H2: ?E = false |- _ + => + rwd H1 H2 + end. + +(** This [match goal] looks for two distinct hypotheses that + have the form of equalities, with the same arbitrary expression + [E] on the left and with conflicting boolean values on the right. + If such hypotheses are found, it binds [H1] and [H2] to their + names and applies the [rwd] tactic to [H1] and [H2]. + + Adding this tactic to the ones that we invoke in each case of the + induction handles all of the contradictory cases. *) + +Theorem ceval_deterministic''': forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2; + induction E1; intros st2 E2; inversion E2; subst; + try find_rwd; (* <------ *) + auto. + - (* E_Seq *) + rewrite (IHE1_1 st'0 H1) in *. + auto. + - (* E_WhileTrue - b true *) + rewrite (IHE1_1 st'0 H3) in *. + auto. Qed. + +(** Let's see about the remaining cases. Each of them involves + rewriting a hypothesis after feeding it with the required + condition. We can automate the task of finding the relevant + hypotheses to rewrite with. *) + +Ltac find_eqn := + match goal with + H1: forall x, ?P x -> ?L = ?R, + H2: ?P ?X + |- _ + => rewrite (H1 X H2) in * + end. + +(** The pattern [forall x, ?P x -> ?L = ?R] matches any hypothesis of + the form "for all [x], _some property of [x]_ implies _some + equality_." The property of [x] is bound to the pattern variable + [P], and the left- and right-hand sides of the equality are bound + to [L] and [R]. The name of this hypothesis is bound to [H1]. + Then the pattern [?P ?X] matches any hypothesis that provides + evidence that [P] holds for some concrete [X]. If both patterns + succeed, we apply the [rewrite] tactic (instantiating the + quantified [x] with [X] and providing [H2] as the required + evidence for [P X]) in all hypotheses and the goal. *) + + + +Theorem ceval_deterministic'''': forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2; + induction E1; intros st2 E2; inversion E2; subst; + try find_rwd; + try find_eqn; (* <------- *) + auto. +Qed. + +(** The big payoff in this approach is that the new proof script is + more robust in the face of changes to our language. To test this, + let's try adding a [REPEAT] command to the language. *) + +Module Repeat. + +Inductive com : Type := + | CSkip + | CAsgn (x : string) (a : aexp) + | CSeq (c1 c2 : com) + | CIf (b : bexp) (c1 c2 : com) + | CWhile (b : bexp) (c : com) + | CRepeat (c : com) (b : bexp). + +(** [REPEAT] behaves like [while], except that the loop guard is + checked _after_ each execution of the body, with the loop + repeating as long as the guard stays _false_. Because of this, + the body will always execute at least once. *) + +Notation "'repeat' x 'until' y 'end'" := + (CRepeat x y) + (in custom com at level 0, + x at level 99, y at level 99). +Notation "'skip'" := + CSkip (in custom com at level 0). +Notation "x := y" := + (CAsgn x y) + (in custom com at level 0, x constr at level 0, + y at level 85, no associativity). +Notation "x ; y" := + (CSeq x y) + (in custom com at level 90, right associativity). +Notation "'if' x 'then' y 'else' z 'end'" := + (CIf x y z) + (in custom com at level 89, x at level 99, + y at level 99, z at level 99). +Notation "'while' x 'do' y 'end'" := + (CWhile x y) + (in custom com at level 89, x at level 99, y at level 99). + +Reserved Notation "st '=[' c ']=>' st'" + (at level 40, c custom com at level 99, st' constr at next level). + +Inductive ceval : com -> state -> state -> Prop := + | E_Skip : forall st, + st =[ skip ]=> st + | E_Asgn : forall st a1 n x, + aeval st a1 = n -> + st =[ x := a1 ]=> (x !-> n ; st) + | E_Seq : forall c1 c2 st st' st'', + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ; c2 ]=> st'' + | E_IfTrue : forall st st' b c1 c2, + beval st b = true -> + st =[ c1 ]=> st' -> + st =[ if b then c1 else c2 end ]=> st' + | E_IfFalse : forall st st' b c1 c2, + beval st b = false -> + st =[ c2 ]=> st' -> + st =[ if b then c1 else c2 end ]=> st' + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ while b do c end ]=> st + | E_WhileTrue : forall st st' st'' b c, + beval st b = true -> + st =[ c ]=> st' -> + st' =[ while b do c end ]=> st'' -> + st =[ while b do c end ]=> st'' + | E_RepeatEnd : forall st st' b c, + st =[ c ]=> st' -> + beval st' b = true -> + st =[ repeat c until b end ]=> st' + | E_RepeatLoop : forall st st' st'' b c, + st =[ c ]=> st' -> + beval st' b = false -> + st' =[ repeat c until b end ]=> st'' -> + st =[ repeat c until b end ]=> st'' + + where "st =[ c ]=> st'" := (ceval c st st'). + +(** Our first attempt at the determinacy proof does not quite succeed: + the [E_RepeatEnd] and [E_RepeatLoop] cases are not handled by our + previous automation. *) + +Theorem ceval_deterministic: forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2; + induction E1; + intros st2 E2; inversion E2; subst; try find_rwd; try find_eqn; auto. + - (* E_RepeatEnd *) + + (* b evaluates to false (contradiction) *) + find_rwd. + (* oops: why didn't [find_rwd] solve this for us already? + answer: we did things in the wrong order. *) + - (* E_RepeatLoop *) + + (* b evaluates to true (contradiction) *) + find_rwd. +Qed. + +(** Fortunately, to fix this, we just have to swap the invocations of + [find_eqn] and [find_rwd]. *) + +Theorem ceval_deterministic': forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2; + induction E1; + intros st2 E2; inversion E2; subst; try find_eqn; try find_rwd; auto. +Qed. + +End Repeat. + +(** These examples just give a flavor of what "hyper-automation" + can achieve in Rocq. The details of [match goal] are a bit + tricky (and debugging scripts using it is, frankly, not very + pleasant). But it is well worth adding at least simple uses to + your proofs, both to avoid tedium and to "future proof" them. *) + +(* ################################################################# *) +(** * The [eapply] and [eauto] tactics *) + +(** To close the chapter, let's look at one more convenience + feature of Rocq: its ability to delay instantiation of + quantifiers. To motivate this feature, recall this example from + the [Imp] chapter: *) + +Example ceval_example1: + empty_st =[ + X := 2; + if (X <= 1) + then Y := 3 + else Z := 4 + end + ]=> (Z !-> 4 ; X !-> 2). +Proof. + (* We supply the intermediate state [st']... *) + apply E_Seq with (X !-> 2). + - apply E_Asgn. reflexivity. + - apply E_IfFalse. reflexivity. apply E_Asgn. reflexivity. +Qed. + + +(** In the first step of the proof, we had to explicitly provide a + longish expression to help Rocq instantiate a "hidden" argument to + the [E_Seq] constructor. This was needed because the definition + of [E_Seq]... + + E_Seq : forall c1 c2 st st' st'', + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ; c2 ]=> st'' + + is quantified over a variable, [st'], that does not appear in its + conclusion, so unifying its conclusion with the goal state doesn't + help Rocq find a suitable value for this variable. If we leave + out the [with], this step fails ("Error: Unable to find an + instance for the variable [st']"). + + What's silly about this error is that the appropriate value for + [st'] will actually become obvious in the very next step, where we + apply [E_Asgn]. If Rocq could just wait until we get to this step, + there would be no need for us to give the value explicitly. This + is exactly what the [eapply] tactic allows: *) + +Example ceval'_example1: + empty_st =[ + X := 2; + if (X <= 1) + then Y := 3 + else Z := 4 + end + ]=> (Z !-> 4 ; X !-> 2). +Proof. + (* 1 *) eapply E_Seq. + - (* 2 *) apply E_Asgn. + (* 3 *) reflexivity. + - (* 4 *) apply E_IfFalse. reflexivity. apply E_Asgn. reflexivity. +Qed. + +(** The [eapply H] tactic behaves just like [apply H] except + that, after it finishes unifying the goal state with the + conclusion of [H], it skips checking whether all the variables + that were introduced in the process have been given concrete + values during unification. + + If you step through the proof above, you'll see that the goal + state at position [1] mentions the _existential variable_ [?st'] + in both of the generated subgoals. The next step (which gets us + to position [2]) replaces [?st'] with a concrete value. This new + value contains a new existential variable [?n], which is + instantiated in its turn by the following [reflexivity] step, + position [3]. When we start working on the second subgoal + (position [4]), we observe that the occurrence of [?st'] in this + subgoal has been replaced by the value that it was given during + the first subgoal. *) + +(** Several of the tactics that we've seen so far, including [exists], + [constructor], and [auto], have similar variants. The [eauto] + tactic works like [auto], except that it uses [eapply] instead of + [apply]. Tactic [info_eauto] shows us which tactics [eauto] uses + in its proof search. + + Below is an example of [eauto]. Before using it, we need to give + some hints to [auto] about using the constructors of [ceval] + and the definitions of [state] and [total_map] as part of its + proof search. *) + +Hint Constructors ceval : core. +Hint Transparent state total_map : core. + +Example eauto_example : exists s', + (Y !-> 1 ; X !-> 2) =[ + if (X <= Y) + then Z := Y - X + else Y := X + Z + end + ]=> s'. +Proof. info_eauto. Qed. + +(** The [eauto] tactic works just like [auto], except that it uses + [eapply] instead of [apply]; [info_eauto] shows us which facts + [eauto] uses. *) + +(** Pro tip: One might think that, since [eapply] and [eauto] + are more powerful than [apply] and [auto], we should just use them + all the time. Unfortunately, they are also significantly slower + -- especially [eauto]. Rocq experts tend to use [apply] and [auto] + most of the time, only switching to the [e] variants when the + ordinary variants don't do the job. *) + +(* ################################################################# *) +(** * Constraints on Existential Variables *) + +(** In order for [Qed] to succeed, all existential variables need to + be determined by the end of the proof. Otherwise Rocq + will (rightly) refuse to accept the proof. Remember that the Rocq + tactics build proof objects, and proof objects containing + existential variables are not complete. *) + +Lemma silly1 : forall (P : nat -> nat -> Prop) (Q : nat -> Prop), + (forall x y : nat, P x y) -> + (forall x y : nat, P x y -> Q x) -> + Q 42. +Proof. + intros P Q HP HQ. eapply HQ. apply HP. Unshelve. exact 0. +(** Rocq gives a warning after [apply HP]: "All the remaining goals + are on the shelf," means that we've finished all our top-level + proof obligations but along the way we've put some aside to be + done later, and we have not finished those. Trying to close the + proof with [Qed] would yield an error. (Try it!) *) +Abort. + +(** An additional constraint is that existential variables cannot be + instantiated with terms containing ordinary variables that did not + exist at the time the existential variable was created. (The + reason for this technical restriction is that allowing such + instantiation would lead to inconsistency of Rocq's logic.) *) + +Lemma silly2 : + forall (P : nat -> nat -> Prop) (Q : nat -> Prop), + (exists y, P 42 y) -> + (forall x y : nat, P x y -> Q x) -> + Q 42. +Proof. + intros P Q HP HQ. eapply HQ. destruct HP as [y HP']. + Fail apply HP'. + +(** The error we get, with some details elided, is: + + cannot instantiate "?y" because "y" is not in its scope + + In this case there is an easy fix: doing [destruct HP] _before_ + doing [eapply HQ]. *) +Abort. + +Lemma silly2_fixed : + forall (P : nat -> nat -> Prop) (Q : nat -> Prop), + (exists y, P 42 y) -> + (forall x y : nat, P x y -> Q x) -> + Q 42. +Proof. + intros P Q HP HQ. destruct HP as [y HP']. + eapply HQ. apply HP'. +Qed. + +(** The [apply HP'] in the last step unifies the existential variable + in the goal with the variable [y]. + + Note that the [assumption] tactic doesn't work in this case, since + it cannot handle existential variables. However, Rocq also + provides an [eassumption] tactic that solves the goal if one of + the premises matches the goal up to instantiations of existential + variables. We can use it instead of [apply HP'] if we like. *) + +Lemma silly2_eassumption : forall (P : nat -> nat -> Prop) (Q : nat -> Prop), + (exists y, P 42 y) -> + (forall x y : nat, P x y -> Q x) -> + Q 42. +Proof. + intros P Q HP HQ. destruct HP as [y HP']. eapply HQ. eassumption. +Qed. + +(** The [eauto] tactic will use [eapply] and [eassumption], streamlining + the proof even further. *) + +Lemma silly2_eauto : forall (P : nat -> nat -> Prop) (Q : nat -> Prop), + (exists y, P 42 y) -> + (forall x y : nat, P x y -> Q x) -> + Q 42. +Proof. + intros P Q HP HQ. destruct HP as [y HP']. eauto. +Qed. + +(* 2026-01-07 13:18 *) diff --git a/AutoTest.v b/AutoTest.v new file mode 100644 index 0000000..4414f68 --- /dev/null +++ b/AutoTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Auto. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Auto. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Basics.v b/Basics.v new file mode 100644 index 0000000..d5d3867 --- /dev/null +++ b/Basics.v @@ -0,0 +1,2052 @@ +(** * Basics: Functional Programming in Rocq *) + +(* REMINDER: + + ##################################################### + ### PLEASE DO NOT DISTRIBUTE SOLUTIONS PUBLICLY ### + ##################################################### + + (See the [Preface] for why.) +*) + +(* ################################################################# *) +(** * Introduction *) + +(** The _functional style_ of programming is founded on simple, + everyday mathematical intuitions: If a procedure or method has no + side effects, then (ignoring efficiency) all we need to understand + about it is how it maps inputs to outputs -- that is, we can think + of it as just a concrete method for computing a mathematical + function. This is one sense of the word "functional" in + "functional programming." The direct connection between programs + and simple mathematical objects supports both formal correctness + proofs and sound informal reasoning about program behavior. + + The other sense in which functional programming is "functional" is + that it emphasizes the use of functions as _first-class_ values -- + i.e., values that can be passed as arguments to other functions, + returned as results, included in data structures, etc. The + recognition that functions can be treated as data gives rise to a + host of useful and powerful programming idioms. + + Other common features of functional languages include _algebraic + data types_ and _pattern matching_, which make it easy to + construct and manipulate rich data structures, and _polymorphic + type systems_ supporting abstraction and code reuse. Rocq offers + all of these features. + + The first half of this chapter introduces some key elements of + Rocq's native functional programming language, _Gallina_. The + second half introduces some basic _tactics_ that can be used to + prove properties of Gallina programs. *) + +(* ################################################################# *) +(** * Homework Submission Guidelines *) + +(** If you are using _Software Foundations_ in a course, your + instructor may use automatic scripts to help grade your homework + assignments. In order for these scripts to work correctly (and + ensure that you get full credit for your work!), please be + careful to follow these rules: + + - Do not change the names of exercises. Otherwise the grading + scripts will be unable to find your solution. + - Do not delete exercises. If you skip an exercise (e.g., + because it is marked "optional," or because you can't solve it), + it is OK to leave a partial proof in your [.v] file; in + this case, please make sure it ends with the keyword [Admitted] + (not, for example, [Abort]). + - It is fine to use additional definitions (of helper functions, + useful lemmas, etc.) in your solutions. You can put these + before the theorem you are asked to prove. + - If you introduce a helper lemma that you end up being unable + to prove, hence end it with [Admitted], then make sure to also + end the main theorem in which you use it with [Admitted], not + [Qed]. This will make sure you get partial credit if you + use that main theorem to solve a later exercise. + + You will also notice that each chapter (e.g., [Basics.v]) is + accompanied by a _test script_ (e.g., [BasicsTest.v]) that + automatically calculates points for the finished homework problems + in the chapter. These scripts are mostly for the auto-grading + tools, but you may also want to use them to double-check that your + file is well formatted before handing it in. In a terminal + window, either type "[make BasicsTest.vo]" or do the following: + + rocq compile -Q . LF Basics.v + rocq compile -Q . LF BasicsTest.v + + See the end of this chapter for more information about how to interpret + the output of test scripts. + + There is no need to hand in [BasicsTest.v] itself (or [Preface.v]). + + If your class is using the Canvas system to hand in assignments... + - If you submit multiple versions of the assignment, you may + notice that they are given different names. This is fine: The + most recent submission is the one that will be graded. + - If you are handing in multiple files at the same time (i.e., + if more than one chapter is assigned in the same week), you + should make a _single_ submission with all the files at once + by using the "Add another file" button just above the comment + box. *) + +(* ################################################################# *) +(** * Data and Functions *) + +(* ================================================================= *) +(** ** Enumerated Types *) + +(** One notable thing about Rocq is that its set of built-in + features is _extremely_ small. For example, instead of the usual + palette of atomic data types (booleans, integers, strings, etc.), + Rocq offers a powerful mechanism for defining new data types from + scratch, with all these familiar types as instances. + + Naturally, the Rocq distribution also comes with an extensive + standard library providing definitions of booleans, numbers, and + many common data structures like lists and hash tables. But there + is nothing magic or primitive about these library definitions. To + illustrate this, in this course we will explicitly recapitulate + almost all the definitions we need, rather than getting them + from the standard library. *) + +(* ================================================================= *) +(** ** Days of the Week *) + +(** To see how the datatype definition mechanism works, let's + start with a very simple example. The following declaration tells + Rocq that we are defining a set of data values -- a _type_. *) + +Inductive day : Type := + | monday + | tuesday + | wednesday + | thursday + | friday + | saturday + | sunday. + +(** The new type is called [day], and its members are [monday], + [tuesday], etc. + + Having defined [day], we can write functions that operate on + days. *) + +Definition next_working_day (d:day) : day := + match d with + | monday => tuesday + | tuesday => wednesday + | wednesday => thursday + | thursday => friday + | friday => monday + | saturday => monday + | sunday => monday + end. + +(** Note that the argument and return types of this function are + explicitly declared on the first line. Like most functional + programming languages, Rocq can often figure out these types for + itself when they are not given explicitly -- i.e., it can do _type + inference_ -- but we'll generally include them to make reading + easier. *) + +(** Having defined a function, we can check that it works on + some examples. There are actually three different ways to do + examples in Rocq. First, we can use the command [Compute] to + evaluate a compound expression involving [next_working_day]. *) + +Compute (next_working_day friday). +(* ==> monday : day *) + +Compute (next_working_day (next_working_day saturday)). +(* ==> tuesday : day *) + +(** (We show Rocq's responses in comments; if you have a computer + handy, this would be an excellent moment to fire up the Rocq + interpreter under your favorite IDE (see the [Preface] for + installation instructions) and try it for yourself. Load this + file, [Basics.v], from the book's Rocq sources, find the above + example, submit it to Rocq, and observe the result.) *) + +(** Second, we can record what we _expect_ the result to be in the + form of a Rocq "example": *) + +Example test_next_working_day: + (next_working_day (next_working_day saturday)) = tuesday. + +(** This declaration does two things: it makes an assertion + (that the second working day after [saturday] is [tuesday]), and it + gives the assertion a name that can be used to refer to it later. + Having made the assertion, we can also ask Rocq to _verify_ it, like + this: *) + +Proof. simpl. reflexivity. Qed. + +(** The details are not important just now, but essentially this + little script can be read as "The assertion we've just made can be + proved by observing that both sides of the equality evaluate to + the same thing." *) + +(** Third, we can ask Rocq to _extract_, from our [Definition], a + program in a more conventional programming language (OCaml, + Scheme, or Haskell) with a high-performance compiler. This + facility is very useful, since it gives us a path from + proved-correct algorithms written in Gallina to efficient machine + code. + + (Of course, we are trusting the correctness of the + OCaml/Haskell/Scheme compiler, and of Rocq's extraction facility + itself, but this is still a big step forward from the way most + software is developed today!) + + Indeed, this is one of the main uses for which Rocq was developed. + We'll come back to this topic in later chapters. *) + +(** The [Require Export] statement on the next line tells Rocq to use + the [String] module from the standard library. We'll use strings + for various things in later chapters, but we need to [Require] it here so + that the grading scripts can use it for internal purposes. *) +From Stdlib Require Export String. + +(* ================================================================= *) +(** ** Booleans *) + +(** Following the pattern of the days of the week above, we can + define the standard type [bool] of booleans, with members [true] + and [false]. *) + +Inductive bool : Type := + | true + | false. + +(** Functions over booleans can be defined in the same way as + above: *) + +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. + +(** (Although we are rolling our own booleans here for the sake + of building up everything from scratch, Rocq does, of course, + provide a default implementation of the booleans, together with a + multitude of useful functions and lemmas. Wherever possible, + we've named our own definitions and theorems to match the ones in + the standard library.) *) + +(** The last two of these illustrate Rocq's syntax for + multi-argument function definitions. The corresponding + multi-argument _application_ syntax is illustrated by the + following "unit tests," which constitute a complete specification + -- a truth table -- for the [orb] function: *) + +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. + +(** We can also introduce more familiar and readable infix + syntax for the boolean operations we have just defined. The + [Notation] command defines a new symbolic notation for an existing + definition. *) + +Notation "x && y" := (andb x y). +Notation "x || y" := (orb x y). + +Example test_orb5: false || false || true = true. +Proof. simpl. reflexivity. Qed. + +(** _A note on notation_: In [.v] files, we use square brackets + to delimit fragments of Rocq code within comments; this + convention, also used by the [rocq doc] documentation tool, keeps + them visually separate from the surrounding text. In the HTML + version of the files, these pieces of text appear in a different + font (and without the brackets). *) + +(** These examples are also an opportunity to introduce one more + feature of Rocq's programming language: conditional expressions... *) + +Definition negb' (b:bool) : bool := + if b then false + else true. + +Definition andb' (b1:bool) (b2:bool) : bool := + if b1 then b2 + else false. + +Definition orb' (b1:bool) (b2:bool) : bool := + if b1 then true + else b2. + +(** Rocq's conditionals are exactly like those found in any other + language, with one small generalization: + + Since the [bool] type is not built in, Rocq actually supports + conditional expressions over _any_ inductively defined type with + exactly two clauses in its definition. The guard is considered + true if it evaluates to the "constructor" of the first clause of + the [Inductive] definition (which happens to be called [true] in + this case) and false if it evaluates to the second. *) + +(** For example we can define the following datatype [bw], with + two constructors representing black ([b]) and white ([w]) and + define a function [invert] that inverts values of this type using + a conditional. *) + +Inductive bw : Type := + | bw_black + | bw_white. + +Definition invert (x: bw) : bw := + if x then bw_white + else bw_black. + +Compute (invert bw_black). +(* ==> bw_white : bw *) + +Compute (invert bw_white). +(* ==> bw_black : bw *) + +(** **** Exercise: 1 star, standard (nandb) + + The [Admitted] command can be used as a placeholder for an + incomplete proof. We use it in exercises to indicate the parts + that we're leaving for you -- i.e., your job is to replace + [Admitted]s with real proofs. + + Remove "[Admitted.]" below and complete the definition of the + following function; then make sure that the [Example] assertions + below can each be verified by Rocq. (I.e., fill in each proof, + following the model of the [orb] tests above, and make sure Rocq + accepts it.) The function should return [true] if either or both + of its inputs are [false]. + + Hint: if [simpl] will not simplify the goal in your proof, it's + probably because you defined [nandb] without using a [match] + expression. Try a different definition of [nandb], or just skip + over [simpl] and go directly to [reflexivity]. We'll explain + what's happening later in the chapter. *) + +Definition nandb (b1:bool) (b2:bool) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(** **** Exercise: 1 star, standard (andb3) + + Do the same for the [andb3] function below. This function should + return [true] when all of its inputs are [true], and [false] + otherwise. *) + +Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(* ================================================================= *) +(** ** Types *) + +(** Every expression in Rocq has a type describing what sort of + thing it computes. The [Check] command asks Rocq to print the type + of an expression. *) + +Check true. +(* ===> true : bool *) + +(** If the thing after [Check] is followed by a colon and a type + declaration, Rocq will verify that the type of the expression + matches the given type and signal an error if not. *) + +Check true + : bool. +Check (negb true) + : bool. + +(** Functions like [negb] itself are also data values, just like + [true] and [false]. Their types are called _function types_, and + they are written with arrows. *) + +Check negb + : bool -> bool. + +(** The type of [negb], written [bool -> bool] and pronounced + "[bool] arrow [bool]," can be read, "Given an input of type + [bool], this function produces an output of type [bool]." + Similarly, the type of [andb], written [bool -> bool -> bool], can + be read, "Given two inputs, each of type [bool], this function + produces an output of type [bool]." *) + +(* ================================================================= *) +(** ** New Types from Old *) + +(** The types we have defined so far are examples of simple + "enumerated types": their definitions explicitly enumerate a + finite set of elements, called _constructors_. Here is a more + interesting type definition, [color], where one of the + constructors takes an argument: *) + +Inductive rgb : Type := + | red + | green + | blue. + +Inductive color : Type := + | black + | white + | primary (p : rgb). + +(** Let's look at this in a little more detail. + + An [Inductive] definition does two things: + + - It introduces a set of new _constructors_. E.g., [red], + [primary], [true], [false], [monday], etc. are constructors. + + - It groups them into a new named type, like [bool], [rgb], or + [color]. + + _Constructor expressions_ are formed by applying a constructor + to zero or more other constructors or constructor expressions, + obeying the declared number and types of the constructor arguments. + E.g., these are valid constructor expressions... + - [red] + - [true] + - [primary red] + - etc. + ...but these are not: + - [red primary] + - [true red] + - [primary (primary red)] + - etc. +*) + +(** In particular, the definitions of [rgb] and [color] say + which constructor expressions belong to the sets [rgb] and + [color]: + + - [red], [green], and [blue] belong to the set [rgb]; + - [black] and [white] belong to the set [color]; + - if [p] is a constructor expression belonging to the set [rgb], + then [primary p] ("the constructor [primary] applied to the + argument [p]") is a constructor expression belonging to the set + [color]; and + - constructor expressions formed in these ways are the _only_ ones + belonging to the sets [rgb] and [color]. *) + +(** We can define functions on colors using pattern matching just as + we did for [day] and [bool]. *) + +Definition monochrome (c : color) : bool := + match c with + | black => true + | white => true + | primary p => false + end. + +(** Since the [primary] constructor takes an argument, a pattern + matching [primary] should include either a variable, as we just + did (note that we can choose its name freely), or a constant of + appropriate type (as below). *) + +Definition isred (c : color) : bool := + match c with + | black => false + | white => false + | primary red => true + | primary _ => false + end. + +(** The pattern "[primary _]" here is shorthand for "the constructor + [primary] applied to any [rgb] constructor except [red]." *) + +(** (The wildcard pattern [_] has the same effect as the dummy + pattern variable [p] in the definition of [monochrome].) *) + +(* ================================================================= *) +(** ** Modules *) + +(** Rocq provides a _module system_ to aid in organizing large + developments. We won't need most of its features, but one is + useful here: If we enclose a collection of declarations between + [Module X] and [End X] markers, then, in the remainder of the file + after the [End], these definitions are referred to by names like + [X.foo] instead of just [foo]. We will use this feature to limit + the scope of definitions, so that we are free to reuse names. *) + +Module Playground. + Definition foo : rgb := blue. +End Playground. + +Definition foo : bool := true. + +Check Playground.foo : rgb. +Check foo : bool. + +(* ================================================================= *) +(** ** Tuples *) + +Module TuplePlayground. + +(** A single constructor with multiple parameters can be used + to create a tuple type. As an example, consider representing + the four bits in a nybble (half a byte). We first define + a datatype [bit] that resembles [bool] (using the + constructors [B0] and [B1] for the two possible bit values) + and then define the datatype [nybble], which is essentially + a tuple of four bits. *) + +Inductive bit : Type := + | B1 + | B0. + +Inductive nybble : Type := + | bits (b0 b1 b2 b3 : bit). + +Check (bits B1 B0 B1 B0) + : nybble. + +(** The [bits] constructor acts as a wrapper for its contents. + Unwrapping can be done by pattern-matching, as in the [all_zero] + function below, which tests a nybble to see if all its bits are + [B0]. *) + +Definition all_zero (nb : nybble) : bool := + match nb with + | (bits B0 B0 B0 B0) => true + | (bits _ _ _ _) => false + end. + +(** (The underscore (_) here is a _wildcard pattern_, which avoids + inventing variable names that will not be used.) *) + +Compute (all_zero (bits B1 B0 B1 B0)). +(* ===> false : bool *) +Compute (all_zero (bits B0 B0 B0 B0)). +(* ===> true : bool *) + +End TuplePlayground. + +(* ================================================================= *) +(** ** Numbers *) + +(** We put this section in a module so that our own definition of + natural numbers does not interfere with the one from the + standard library. In the rest of the book, we'll want to use + the standard library's. *) + +Module NatPlayground. + +(** All the types we have defined so far -- both "enumerated + types" such as [day], [bool], and [bit] and tuple types such as + [nybble] built from them -- are finite. The natural numbers, on + the other hand, are an infinite set, so we'll need to use a + slightly richer form of type declaration to represent them. + + There are many representations of numbers to choose from. You are + certainly familiar with decimal notation (base 10), using the + digits 0 through 9, for example, to form the number 123. You may + very likely also have encountered hexadecimal notation (base 16), + in which the same number is represented as 7B, or octal (base 8), + where it is 173, or binary (base 2), where it is 1111011. Using an + enumerated type to represent digits, we could use any of these as + our representation natural numbers. Indeed, there are + circumstances where each of these choices would be useful. + + The binary representation is valuable in computer hardware because + the digits can be represented with just two distinct voltage + levels, resulting in simple circuitry. Analogously, we wish here + to choose a representation that makes _proofs_ simpler. + + In fact, there is a representation of numbers that is even simpler + than binary, namely unary (base 1), in which only a single digit + is used -- as our forebears might have done to count days by + making scratches on the walls of their caves. To represent unary + numbers with a Rocq datatype, we use two constructors. The + capital-letter [O] constructor represents zero. The [S] + constructor can be applied to the representation of the natural + number [n], yielding the representation of [n+1], where [S] stands for + "successor" (or "scratch"). Here is the complete datatype + definition: *) + +Inductive nat : Type := + | O + | S (n : nat). + +(** With this definition, 0 is represented by [O], 1 by [S O], + 2 by [S (S O)], and so on. *) + +(** Informally, the clauses of the definition can be read: + - [O] is a natural number (remember this is the letter "[O]," + not the numeral "[0]"). + - [S] can be put in front of a natural number to yield another + one -- i.e., if [n] is a natural number, then [S n] is too. *) + +(** Again, let's look at this a bit more closely. The definition + of [nat] says how expressions in the set [nat] can be built: + + - the constructor expression [O] belongs to the set [nat]; + - if [n] is a constructor expression belonging to the set [nat], + then [S n] is also a constructor expression belonging to the set + [nat]; and + - constructor expressions formed in these two ways are the only + ones belonging to the set [nat]. *) + +(** These conditions are the precise force of the [Inductive] + declaration that we gave to Rocq. They imply that the constructor + expression [O], the constructor expression [S O], the constructor + expression [S (S O)], the constructor expression [S (S (S O))], + and so on all belong to the set [nat], while other constructor + expressions like [true], [andb true false], [S (S false)], and + [O (O (O S))] do not. + + A critical point here is that what we've done so far is just to + define a _representation_ of numbers: a way of writing them down. + The names [O] and [S] are arbitrary, and at this point they have + no special meaning -- they are just two different marks that we + can use to write down numbers, together with a rule that says any + [nat] will be written as some string of [S] marks followed by an + [O]. If we like, we can write essentially the same definition + this way: *) + +Inductive otherNat : Type := + | stop + | tick (foo : otherNat). + +(** The _interpretation_ of these marks arises from how we use them to + compute. *) + +(** We can do this by writing functions that pattern match on + representations of natural numbers just as we did above with + booleans and days -- for example, here is the predecessor + function: *) + +Definition pred (n : nat) : nat := + match n with + | O => O + | S n' => n' + end. + +(** The second branch can be read: "if [n] has the form [S n'] + for some [n'], then return [n']." *) + +(** The following [End] command closes the current module, so + [nat] will refer back to the type from the standard library. *) + +End NatPlayground. + +(** Because natural numbers are such a pervasive kind of data, + Rocq does provide a tiny bit of built-in magic for parsing and + printing them: ordinary decimal numerals can be used as an + alternative to the "unary" notation defined by the constructors + [S] and [O]. Rocq prints numbers in decimal form by default: *) + +Check (S (S (S (S O)))). +(* ===> 4 : nat *) + +Definition minustwo (n : nat) : nat := + match n with + | O => O + | S O => O + | S (S n') => n' + end. + +Compute (minustwo 4). +(* ===> 2 : nat *) + +(** The constructor [S] has the type [nat -> nat], just like functions + such as [pred] and [minustwo]: *) + +Check S : nat -> nat. +Check pred : nat -> nat. +Check minustwo : nat -> nat. + +(** These are all things that can be applied to a number to yield a + number. However, there is a fundamental difference between [S] + and the other two: functions like [pred] and [minustwo] are + defined by giving _computation rules_ -- e.g., the definition of + [pred] says that [pred 2] can be simplified to [1] -- while the + definition of [S] has no such behavior attached. Although it is + _like_ a function in the sense that it can be applied to an + argument, it does not _do_ anything at all! It is just a way of + writing down numbers. + + Think about standard decimal numerals: the numeral [1] is not a + computation; it's a piece of data. When we write [111] to mean + the number one hundred and eleven, we are using [1], three times, + to write down a concrete representation of a number. + + Let's go on and define some more functions over numbers. + + For most interesting computations involving numbers, simple + pattern matching is not enough: we also need recursion. For + example, to check that a number [n] is even, we may need to + recursively check whether [n-2] is even. Such functions are + introduced with the keyword [Fixpoint] instead of [Definition]. *) + +Fixpoint even (n:nat) : bool := + match n with + | O => true + | S O => false + | S (S n') => even n' + end. + +(** We could define [odd] by a similar [Fixpoint] declaration, but + here is a simpler way: *) + +Definition odd (n:nat) : bool := + negb (even n). + +Example test_odd1: odd 1 = true. +Proof. simpl. reflexivity. Qed. +Example test_odd2: odd 4 = false. +Proof. simpl. reflexivity. Qed. + +(** (You may notice if you step through these proofs that + [simpl] actually has no effect on the goal -- all of the work is + done by [reflexivity]. We'll discuss why shortly.) + + Naturally, we can also define multi-argument functions by + recursion. *) + +Module NatPlayground2. + +Fixpoint plus (n : nat) (m : nat) : nat := + match n with + | O => m + | S n' => S (plus n' m) + end. + +(** Adding three to two gives us five (whew!): *) + +Compute (plus 3 2). +(* ===> 5 : nat *) + +(** The steps of simplification that Rocq performs here can be + visualized as follows: *) + +(* [plus 3 2] + i.e. [plus (S (S (S O))) (S (S O))] + ==> [S (plus (S (S O)) (S (S O)))] + by the second clause of the [match] + ==> [S (S (plus (S O) (S (S O))))] + by the second clause of the [match] + ==> [S (S (S (plus O (S (S O)))))] + by the second clause of the [match] + ==> [S (S (S (S (S O))))] + by the first clause of the [match] + i.e. [5] *) + +(** As a notational convenience, if two or more arguments have + the same type, they can be grouped together. In the following + definition, [(n m : nat)] means just the same as if we had written + [(n : nat) (m : nat)]. *) + +Fixpoint mult (n m : nat) : nat := + match n with + | O => O + | S n' => plus m (mult n' m) + end. + +Example test_mult1: (mult 3 3) = 9. +Proof. simpl. reflexivity. Qed. + +(** We can match two expressions at once by putting a comma + between them: *) + +Fixpoint minus (n m:nat) : nat := + match n, m with + | O , _ => O + | S _ , O => n + | S n', S m' => minus n' m' + end. + +End NatPlayground2. + +Fixpoint exp (base power : nat) : nat := + match power with + | O => S O + | S p => mult base (exp base p) + end. + +(** **** Exercise: 1 star, standard (factorial) + + Recall the standard mathematical factorial function: + + factorial(0) = 1 + factorial(n) = n * factorial(n-1) (if n>0) + + Translate this into Rocq. + + Hint: Make sure you put a [:=] between the header we've provided + and your definition. If you see an error like "The reference + factorial was not found in the current environment," it means + you've forgotten the [:=]. *) + +Fixpoint factorial (n:nat) : nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_factorial1: (factorial 3) = 6. +(* FILL IN HERE *) Admitted. +Example test_factorial2: (factorial 5) = (mult 10 12). +(* FILL IN HERE *) Admitted. +(** [] *) + +(** Again, we can make numerical expressions easier to read and write + by introducing notations for addition, subtraction, and + multiplication. *) + +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) : nat. + +(** (The [level], [associativity], and [nat_scope] annotations + control how these notations are treated by Rocq's parser. The + details are not important for present purposes, but interested + readers can check out the "More on Notation" section at the end of + this chapter.) + + Note that these declarations do not change the definitions we've + already made: they are simply instructions to Rocq's parser to + accept [x + y] in place of [plus x y] and, conversely, to its + pretty-printer to display [plus x y] as [x + y]. *) + +(** When we say that Rocq comes with almost nothing built-in, we really + mean it: even testing equality is a user-defined operation! + Here is a function [eqb] that tests natural numbers for + [eq]uality, yielding a [b]oolean. Note the use of nested + [match]es -- we could also have used a simultaneous match, as + in [minus]. *) + +Fixpoint eqb (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' => eqb n' m' + end + end. + +(** Similarly, the [leb] function tests whether its first argument is + less than or equal to its second argument, yielding a boolean. *) + +Fixpoint leb (n m : nat) : bool := + match n with + | O => true + | S n' => + match m with + | O => false + | S m' => leb n' m' + end + end. + +Example test_leb1: leb 2 2 = true. +Proof. simpl. reflexivity. Qed. +Example test_leb2: leb 2 4 = true. +Proof. simpl. reflexivity. Qed. +Example test_leb3: leb 4 2 = false. +Proof. simpl. reflexivity. Qed. + +(** We'll be using these (especially [eqb]) a lot, so let's give + them infix notations. *) + +Notation "x =? y" := (eqb x y) (at level 70) : nat_scope. +Notation "x <=? y" := (leb x y) (at level 70) : nat_scope. + +Example test_leb3': (4 <=? 2) = false. +Proof. simpl. reflexivity. Qed. + +(** We now have two symbols that both look like equality: [=] + and [=?]. We'll have much more to say about their differences and + similarities later. For now, the main thing to notice is that + [x = y] is a logical _claim_ -- a "proposition" -- that we can try to + prove, while [x =? y] is a boolean _expression_ whose value (either + [true] or [false]) we can compute. *) + +(** **** Exercise: 1 star, standard (ltb) + + Fill in the definition of an [ltb] function that tests natural + numbers for [l]ess-[t]han, yielding a [b]oolean. + + Hint: Instead of making up a new [Fixpoint] for + this one, define it in terms of a previously defined + function. It can be done with just one previously defined + function, but you can use two if you want. *) + +Definition ltb (n m : nat) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Notation "x + n + n = m + m. + +(** Instead of making a universal claim about all numbers [n] and [m], + it talks about a more specialized property that only holds when + [n = m]. The arrow symbol is pronounced "implies." + + As before, we need to be able to reason by assuming we are given such + numbers [n] and [m]. We also need to assume the hypothesis + [n = m]. The [intros] tactic will serve to move all three of these + from the goal into assumptions in the current context. + + Since [n] and [m] are arbitrary numbers, we can't just use + simplification to prove this theorem. Instead, we prove it by + observing that, if we are assuming [n = m], then we can replace + [n] with [m] in the goal statement and obtain an equality with the + same expression on both sides. The tactic that tells Rocq to + perform this replacement is called [rewrite]. *) + +Proof. + (* move both quantifiers into the context: *) + intros n m. + (* move the hypothesis into the context: *) + intros H. + (* rewrite the goal using the hypothesis: *) + rewrite -> H. + reflexivity. Qed. + +(** The first line of the proof moves the universally quantified + variables [n] and [m] into the context. The second moves the + hypothesis [n = m] into the context and gives it the name [H]. + The third tells Rocq to rewrite the current goal ([n + n = m + m]) + by replacing the left side of the equality hypothesis [H] with the + right side. + + (The arrow symbol in the [rewrite] has nothing to do with + implication: it tells Rocq to apply the rewrite from left to right. + Indeed, we can omit the arrow, and Rocq will default to rewriting + left to right. To rewrite from right to left, use [rewrite <-]. + Try making this change in the above proof and see what changes.) *) +(** **** Exercise: 1 star, standard (plus_id_exercise) + + Remove "[Admitted.]" and fill in the proof. (Note that the + theorem has _two_ hypotheses -- [n = m] and [m = o] -- each to the + left of an implication arrow.) *) + +Theorem plus_id_exercise : forall n m o : nat, + n = m -> m = o -> n + m = m + o. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The [Admitted] command tells Rocq that we want to skip trying + to prove this theorem and just accept it as a given. This is + often useful for developing longer proofs: we can state subsidiary + lemmas that we believe will be useful for making some larger + argument, use [Admitted] to accept them on faith for the moment, + and continue working on the main argument until we are sure it + makes sense; then we can go back and fill in the proofs we + skipped. + + Be careful, though: every time you say [Admitted] you are leaving + a door open for total nonsense to enter Rocq's safe, formally + checked world! *) + +(** The [Check] command can also be used to examine the statements of + previously declared lemmas and theorems. The two examples below + are lemmas about multiplication that are proved in the standard + library. (We will see how to prove them ourselves in the next + chapter.) *) + +Check mult_n_O. +(* ===> forall n : nat, 0 = n * 0 *) + +Check mult_n_Sm. +(* ===> forall n m : nat, n * m + n = n * S m *) + +(** We can use the [rewrite] tactic with a previously proved theorem + instead of a hypothesis from the context. If the statement of the + previously proved theorem involves quantified variables, as in the + example below, Rocq will try to fill in appropriate values for them + by matching the body of the previous theorem statement against the + current goal. *) + +Theorem mult_n_0_m_0 : forall p q : nat, + (p * 0) + (q * 0) = 0. +Proof. + intros p q. + rewrite <- mult_n_O. + rewrite <- mult_n_O. + reflexivity. Qed. + +(** **** Exercise: 1 star, standard (mult_n_1) + + Use [mult_n_Sm] and [mult_n_O] to prove the following + theorem. (Recall that [1] is [S O].) *) + +Theorem mult_n_1 : forall p : nat, + p * 1 = p. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ################################################################# *) +(** * Proof by Case Analysis *) + +(** Of course, not everything can be proved by simple + calculation and rewriting: In general, unknown, hypothetical + values (arbitrary numbers, booleans, lists, etc.) can block + simplification. For example, if we try to prove the following + fact using the [simpl] tactic as above, we get stuck. (We then + use the [Abort] command to give up on it for the moment.)*) + +Theorem plus_1_neq_0_firsttry : forall n : nat, + (n + 1) =? 0 = false. +Proof. + intros n. + simpl. (* does nothing! *) +Abort. + +(** The reason for getting stuck is that the definitions of both + [eqb] and [+] begin by performing a [match] on their first argument. + Here, the first argument to [+] is the unknown number [n] and the + argument to [eqb] is the compound expression [n + 1]; neither can + be simplified. + + To make progress, we need to consider the possible forms of [n], + separately. If [n] is [O], then we can calculate the final result + of [(n + 1) =? 0] and check that it is, indeed, [false]. And if + [n = S n'] for some [n'], then -- although we don't know exactly + what number [n + 1] represents -- we can calculate that at least + it will begin with one [S]; and this is enough to calculate that, + again, [(n + 1) =? 0] will yield [false]. + + The tactic that tells Rocq to consider separate cases where + [n = O] and [n = S n'] is called [destruct]. *) + +Theorem plus_1_neq_0 : forall n : nat, + (n + 1) =? 0 = false. +Proof. + intros n. destruct n as [| n'] eqn:E. + - reflexivity. + - reflexivity. Qed. + +(** The [destruct] generates _two_ subgoals, which we must then + prove, separately, in order to get Rocq to accept the theorem. + + The annotation "[as [| n']]" is called an _intro pattern_. It + tells Rocq what variable names to introduce in each subgoal. In + general, what goes between the square brackets is a _list of + lists_ of names, separated by [|]. In this case, the first + component is empty, since the [O] constructor doesn't take any + arguments. The second component gives a single name, [n'], since + [S] is a unary constructor. + + In each subgoal, Rocq remembers the assumption about [n] that is + relevant for this subgoal -- either [n = 0] or [n = S n'] for some + n'. The [eqn:E] annotation tells [destruct] to give the name [E] + to this equation. (Leaving off the [eqn:E] annotation causes Rocq + to elide these assumptions in the subgoals. This slightly + streamlines proofs where the assumptions are not explicitly used, + but it is better practice to keep them for the sake of + documentation, as they can help keep you oriented when working + with the subgoals.) + + The [-] signs on the second and third lines are called _bullets_, + and they mark the parts of the proof that correspond to the two + generated subgoals. The part of the proof script that comes after + a bullet is the entire proof for the corresponding subgoal. In + this example, each of the subgoals is easily proved by a single + use of [reflexivity], which itself performs some simplification -- + e.g., the second one simplifies [(S n' + 1) =? 0] to [false] by + first rewriting [(S n' + 1)] to [S (n' + 1)], then unfolding + [eqb], and then simplifying the [match]. + + Marking cases with bullets is optional: if bullets are not + present, Rocq simply expects you to prove each subgoal in + sequence, one at a time. But it is a good idea to use bullets, and + you should make a habit of doing it! For one thing, bullets make + the structure of a proof apparent, improving readability. + Moreover, bullets instruct Rocq to ensure that a subgoal is + complete before trying to verify the next one, preventing proofs + for different subgoals from getting mixed up. These issues become + especially important in larger developments, where fragile proofs + can lead to long debugging sessions! + + There are no hard and fast rules for how proofs should be + formatted in Rocq -- e.g., where lines should be broken and how + sections of the proof should be indented to indicate their nested + structure. However, if the places where multiple subgoals are + generated are marked with explicit bullets at the beginning of + lines, then the proof will be readable almost no matter what + choices are made about other aspects of layout. + + This is also a good place to mention one other piece of somewhat + obvious advice about line lengths. Beginning Rocq users sometimes + tend to the extremes, either writing each tactic on its own line + or writing entire proofs on a single line. Good style lies + somewhere in the middle. One reasonable guideline is to limit + yourself to 80 (or, if you have a wide screen or good eyes, + 120) character lines. + + The [destruct] tactic can be used with any inductively defined + datatype. For example, we use it next to prove that boolean + negation is involutive -- i.e., that negation is its own + inverse. *) + +Theorem negb_involutive : forall b : bool, + negb (negb b) = b. +Proof. + intros b. destruct b eqn:E. + - reflexivity. + - reflexivity. Qed. + +(** Note that the [destruct] here has no [as] clause because + none of the subcases of the [destruct] need to bind any variables, + so there is no need to specify any names. In fact, we can omit + the [as] clause from _any_ [destruct] and Rocq will fill in + variable names automatically. This is generally considered bad + style, since Rocq often makes confusing choices of names when left + to its own devices. + + It is sometimes useful to invoke [destruct] inside a subgoal, + generating yet more proof obligations. In this case, we use + different kinds of bullets to mark goals on different "levels." + For example: *) + +Theorem andb_commutative : forall b c, andb b c = andb c b. +Proof. + intros b c. destruct b eqn:Eb. + - destruct c eqn:Ec. + + reflexivity. + + reflexivity. + - destruct c eqn:Ec. + + reflexivity. + + reflexivity. +Qed. + +(** Each pair of calls to [reflexivity] corresponds to the + subgoals that were generated after the execution of the [destruct c] + line right above it. *) + +(** Besides [-] and [+], we can use [*] (asterisk) or any repetition + of a bullet symbol (e.g. [--] or [***]) as a bullet. We can also + enclose sub-proofs in curly braces instead of using bullets: *) + +Theorem andb_commutative' : forall b c, andb b c = andb c b. +Proof. + intros b c. destruct b eqn:Eb. + { destruct c eqn:Ec. + { reflexivity. } + { reflexivity. } } + { destruct c eqn:Ec. + { reflexivity. } + { reflexivity. } } +Qed. + +(** Since curly braces mark both the beginning and the end of a proof, + they can be used for multiple subgoal levels, as this example + shows. Furthermore, curly braces allow us to reuse the same bullet + shapes at multiple levels in a proof. + + The choice of braces, bullets, or a combination of the two is purely + a matter of taste. *) + +Theorem andb3_exchange : + forall b c d, andb (andb b c) d = andb (andb b d) c. +Proof. + intros b c d. destruct b eqn:Eb. + - destruct c eqn:Ec. + { destruct d eqn:Ed. + - reflexivity. + - reflexivity. } + { destruct d eqn:Ed. + - reflexivity. + - reflexivity. } + - destruct c eqn:Ec. + { destruct d eqn:Ed. + - reflexivity. + - reflexivity. } + { destruct d eqn:Ed. + - reflexivity. + - reflexivity. } +Qed. + +(** **** Exercise: 2 stars, standard (andb_true_elim2) + + Prove the following claim, marking cases (and subcases) with + bullets when you use [destruct]. + + Hint 1: Thus far, we've only ever used [simpl] to simplify the goal. + It is also possible to use it to simplify hypotheses: + use [simpl in H], where [H] is a hypothesis, to simplify it. + You may find this useful in this exercise. + + Hint 2: You will eventually need to destruct both booleans, as in + the theorems above. It is better to simplify the hypothesis + before attempting to destruct the second boolean. + + Hint 3: If you reach a contradiction in the hypotheses, focus on + how to [rewrite] using that contradiction. *) + +Theorem andb_true_elim2 : forall b c : bool, + andb b c = true -> c = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Before closing the chapter, we should mention one final + convenience. As you may have noticed, many proofs perform case + analysis on a variable right after introducing it: + + intros x y. destruct y as [|y] eqn:E. + + This pattern is so common that Rocq provides a shorthand for it: we + can perform case analysis on a variable when introducing it by + using an intro pattern instead of a variable name. For instance, + here is a shorter proof of the [plus_1_neq_0] theorem + above. (You'll also note one downside of this shorthand: we lose + the equation recording the assumption we are making in each + subgoal, which we previously got from the [eqn:E] annotation.) *) + +Theorem plus_1_neq_0' : forall n : nat, + (n + 1) =? 0 = false. +Proof. + intros [|n]. + - reflexivity. + - reflexivity. Qed. + +(** If there are no constructor arguments that need names, we can just + write [[]] to get the case analysis. *) + +Theorem andb_commutative'' : + forall b c, andb b c = andb c b. +Proof. + intros [] []. + - reflexivity. + - reflexivity. + - reflexivity. + - reflexivity. +Qed. + +(** **** Exercise: 1 star, standard (zero_nbeq_plus_1) *) +Theorem zero_nbeq_plus_1 : forall n : nat, + 0 =? (n + 1) = false. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** More on Notation (Optional) *) + +(** (In general, sections marked Optional are not needed to follow the + rest of the book, except possibly other Optional sections. On a + first reading, you might want to just skim these sections so that + you know what's there for future reference.) + + Recall the notation definitions for infix plus and times: *) + +Notation "x + y" := (plus x y) + (at level 50, left associativity) + : nat_scope. +Notation "x * y" := (mult x y) + (at level 40, left associativity) + : nat_scope. + +(** For each notation symbol in Rocq, we can specify its _precedence + level_ and its _associativity_. The precedence level [n] is + specified by writing [at level n]; this helps Rocq parse compound + expressions. The associativity setting helps to disambiguate + expressions containing multiple occurrences of the same + symbol. For example, the parameters specified above for [+] and + [*] say that the expression [1+2*3*4] is shorthand for + [(1+((2*3)*4))]. Rocq uses precedence levels from 0 to 100, and + _left_, _right_, or _no_ associativity. We will see more examples + of this later, e.g., in the [Lists] chapter. + + Each notation symbol is also associated with a _notation scope_. + Rocq tries to guess what scope is meant from context, so when it + sees [S (O*O)] it guesses [nat_scope], but when it sees the pair + type type [bool*bool] (which we'll see in a later chapter) it + guesses [type_scope]. Occasionally, it is necessary to help it + out by writing, for example, [(x*y)%nat], and sometimes in what + Rocq prints it will use [%nat] to indicate what scope a notation is + in. + + Notation scopes also apply to numeral notations ([3], [4], [5], + [42], etc.), so you may sometimes see [0%nat], which means + [O] (the natural number [0] that we're using in this chapter), or + [0%Z], which means the integer zero (which comes from a different + part of the standard library). + + Pro tip: Rocq's notation mechanism is not especially powerful. + Don't expect too much from it. *) + +(* ================================================================= *) +(** ** Fixpoints and Structural Recursion (Optional) *) + +(** Here is a copy of the definition of addition: *) + +Fixpoint plus' (n : nat) (m : nat) : nat := + match n with + | O => m + | S n' => S (plus' n' m) + end. + +(** When Rocq checks this definition, it notes that [plus'] is + "decreasing on 1st argument." What this means is that we are + performing a _structural recursion_ over the argument [n] -- i.e., + that we make recursive calls only on strictly smaller values of + [n]. This implies that all calls to [plus'] will eventually + terminate. Rocq demands that some argument of _every_ [Fixpoint] + definition be "decreasing." + + This requirement is a fundamental feature of Rocq's design: In + particular, it guarantees that every function that can be defined + in Rocq will terminate on all inputs. However, because Rocq's + "decreasing analysis" is not very sophisticated, it is sometimes + necessary to write functions in slightly unnatural ways. *) + +(** **** Exercise: 2 stars, standard, optional (decreasing) + + To get a concrete sense of this, find a way to write a sensible + [Fixpoint] definition (of a simple function on numbers, say) that + _does_ terminate on all inputs, but that Rocq will reject because + of this restriction. + + (If you choose to turn in this optional exercise as part of a + homework assignment, make sure you comment out your solution so + that it doesn't cause Rocq to reject the whole file!) *) + +(* FILL IN HERE + + [] *) + +(* ################################################################# *) +(** * More Exercises *) + +(* ================================================================= *) +(** ** Warmups *) + +(** **** Exercise: 1 star, standard (identity_fn_applied_twice) + + Use the tactics you have learned so far to prove the following + theorem about boolean functions. *) + +Theorem identity_fn_applied_twice : + forall (f : bool -> bool), + (forall (x : bool), f x = x) -> + forall (b : bool), f (f b) = b. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 1 star, standard (negation_fn_applied_twice) + + Now state and prove a theorem [negation_fn_applied_twice] similar + to the previous one but where the hypothesis says that the + function [f] has the property that [f x = negb x]. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_negation_fn_applied_twice : option (nat*string) := None. +(** (The last definition is used by the autograder.) + + [] *) + +(** **** Exercise: 3 stars, standard, optional (andb_eq_orb) + + Prove the following theorem. (Hint: This can be a bit tricky, + depending on how you approach it. You will probably need both + [destruct] and [rewrite], but destructing everything in sight is + not the best way.) *) + +Theorem andb_eq_orb : + forall (b c : bool), + (andb b c = orb b c) -> + b = c. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ================================================================= *) +(** ** Course Late Policies, Formalized *) + +(** Suppose that a course has a grading policy based on late days, + where a student's final letter grade is lowered if they submit too + many homework assignments late. + + In the next series of problems, we model this situation using the + features of Rocq that we have seen so far and prove some simple + facts about this grading policy. *) + +Module LateDays. + +(** First, we inroduce a datatype for modeling the "letter" component + of a grade. *) +Inductive letter : Type := + | A | B | C | D | F. + +(** Then we define the modifiers -- a [Natural] [A] is just a "plain" + grade of [A]. *) +Inductive modifier : Type := + | Plus | Natural | Minus. + +(** A full [grade], then, is just a [letter] and a [modifier]. + + We might write, informally, "A-" for the Rocq value [Grade A Minus], + and similarly "C" for the Rocq value [Grade C Natural]. *) +Inductive grade : Type := + Grade (l:letter) (m:modifier). + +(** We will want to be able to say when one grade is "better" than + another. In other words, we need a way to compare two grades. As + with natural numbers, we could define [bool]-valued functions + [grade_eqb], [grade_ltb], etc., and that would work fine. + However, we can also define a slightly more informative type for + comparing two values, as shown below. This datatype has three + constructors that can be used to indicate whether two values are + "equal", "less than", or "greater than" one another. (This + definition also appears in the Rocq standard libary.) *) + +Inductive comparison : Type := + | Eq (* "equal" *) + | Lt (* "less than" *) + | Gt. (* "greater than" *) + +(** Using pattern matching, it is not difficult to define the + comparison operation for two letters [l1] and [l2] (see below). + This definition uses two features of [match] patterns: First, + recall that we can match against _two_ values simultaneously by + separating them and the corresponding patterns with comma [,]. + This is simply a convenient abbreviation for nested pattern + matching. For example, the match expression on the left below is + just shorthand for the lower-level "expanded version" shown on the + right: + + match l1, l2 with match l1 with + | A, A => Eq | A => match l2 with + | A, _ => Gt | A => Eq + end | _ => Gt + end + end +*) +(** As another shorthand, we can also match one of several + possibilites by using [|] in the pattern. For example the pattern + [C , (A | B)] stands for two cases: [C, A] and [C, B]. *) + +Definition letter_comparison (l1 l2 : letter) : comparison := + match l1, l2 with + | A, A => Eq + | A, _ => Gt + | B, A => Lt + | B, B => Eq + | B, _ => Gt + | C, (A | B) => Lt + | C, C => Eq + | C, _ => Gt + | D, (A | B | C) => Lt + | D, D => Eq + | D, _ => Gt + | F, (A | B | C | D) => Lt + | F, F => Eq + end. + +(** We can test the [letter_comparison] operation by trying it out on a few + examples. *) +Compute letter_comparison B A. +(** ==> Lt *) +Compute letter_comparison D D. +(** ==> Eq *) +Compute letter_comparison B F. +(** ==> Gt *) + +(** As a further sanity check, we can prove that the + [letter_comparison] function does indeed give the result [Eq] when + comparing a letter [l] against itself. *) +(** **** Exercise: 1 star, standard (letter_comparison) *) +Theorem letter_comparison_Eq : + forall l, letter_comparison l l = Eq. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** We can follow the same strategy to define the comparison operation + for two grade modifiers. We consider them to be ordered as + [Plus > Natural > Minus]. *) +Definition modifier_comparison (m1 m2 : modifier) : comparison := + match m1, m2 with + | Plus, Plus => Eq + | Plus, _ => Gt + | Natural, Plus => Lt + | Natural, Natural => Eq + | Natural, _ => Gt + | Minus, (Plus | Natural) => Lt + | Minus, Minus => Eq + end. + +(** **** Exercise: 2 stars, standard (grade_comparison) + + Use pattern matching to complete the following definition. + + (This ordering on grades is sometimes called "lexicographic" + ordering: we first compare the letters, and we only consider the + modifiers in the case that the letters are equal. I.e. all grade + variants of [A] are greater than all grade variants of [B].) + + Hint: match against [g1] and [g2] simultaneously, but don't try to + enumerate all the cases. Instead do case analysis on the result + of a suitable call to [letter_comparison] to end up with just [3] + possibilities. *) + +Definition grade_comparison (g1 g2 : grade) : comparison + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** The following "unit tests" of your [grade_comparison] function + should pass once you have defined it correctly. *) + +Example test_grade_comparison1 : + (grade_comparison (Grade A Minus) (Grade B Plus)) = Gt. +(* FILL IN HERE *) Admitted. + +Example test_grade_comparison2 : + (grade_comparison (Grade A Minus) (Grade A Plus)) = Lt. +(* FILL IN HERE *) Admitted. + +Example test_grade_comparison3 : + (grade_comparison (Grade F Plus) (Grade F Plus)) = Eq. +(* FILL IN HERE *) Admitted. + +Example test_grade_comparison4 : + (grade_comparison (Grade B Minus) (Grade C Plus)) = Gt. +(* FILL IN HERE *) Admitted. + +(** [] *) + +(** Now that we have a definition of grades and how they compare to + one another, let us implement a late-penalty fuction. *) + +(** First, we define what it means to lower the [letter] component of + a grade. Since [F] is already the lowest grade possible, we just + leave it alone. *) +Definition lower_letter (l : letter) : letter := + match l with + | A => B + | B => C + | C => D + | D => F + | F => F (* Can't go lower than [F]! *) + end. + +(** Our formalization can already help us understand some corner cases + of the grading policy. For example, we might expect that if we + use the [lower_letter] function its result will actually be lower, + as claimed in the following theorem. But this theorem is not + provable! (Do you see why?) *) +Theorem lower_letter_lowers: forall (l : letter), + letter_comparison (lower_letter l) l = Lt. +Proof. + intros l. + destruct l. + - simpl. reflexivity. + - simpl. reflexivity. + - simpl. reflexivity. + - simpl. reflexivity. + - simpl. (* We get stuck here. *) +Abort. + +(** The problem, of course, has to do with the "edge case" of lowering + [F], as we can see like this: *) +Theorem lower_letter_F_is_F: + lower_letter F = F. +Proof. + simpl. reflexivity. +Qed. + +(** With this insight, we can state a better version of the lower + letter theorem that actually is provable. In this version, the + hypothesis about [F] says that [F] is strictly smaller than [l], + which rules out the problematic case above. In other words, as + long as [l] is bigger than [F], it will be lowered. *) +(** **** Exercise: 2 stars, standard (lower_letter_lowers) + + Prove the following theorem. *) + +Theorem lower_letter_lowers: + forall (l : letter), + letter_comparison F l = Lt -> + letter_comparison (lower_letter l) l = Lt. +Proof. +(* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 2 stars, standard (lower_grade) + + We can now use the [lower_letter] definition as a helper to define + what it means to lower a grade by one step. Complete the + definition below so that it sends a grade [g] to one step lower + (unless it is already [Grade F Minus], which should remain + unchanged). Once you have implemented it correctly, the subsequent + "unit test" examples should hold trivially. + + Hint: To make this a succinct definition that is easy to prove + properties about, you will probably want to use nested pattern + matching. The outer match should not match on the specific letter + component of the grade -- it should consider only the modifier. + You should definitely _not_ try to enumerate all of the + cases. + + Our solution is under 10 lines of code total. *) +Definition lower_grade (g : grade) : grade + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example lower_grade_A_Plus : + lower_grade (Grade A Plus) = (Grade A Natural). +Proof. +(* FILL IN HERE *) Admitted. + +Example lower_grade_A_Natural : + lower_grade (Grade A Natural) = (Grade A Minus). +Proof. +(* FILL IN HERE *) Admitted. + +Example lower_grade_A_Minus : + lower_grade (Grade A Minus) = (Grade B Plus). +Proof. +(* FILL IN HERE *) Admitted. + +Example lower_grade_B_Plus : + lower_grade (Grade B Plus) = (Grade B Natural). +Proof. +(* FILL IN HERE *) Admitted. + +Example lower_grade_F_Natural : + lower_grade (Grade F Natural) = (Grade F Minus). +Proof. +(* FILL IN HERE *) Admitted. + +Example lower_grade_twice : + lower_grade (lower_grade (Grade B Minus)) = (Grade C Natural). +Proof. +(* FILL IN HERE *) Admitted. + +Example lower_grade_thrice : + lower_grade (lower_grade (lower_grade (Grade B Minus))) = (Grade C Minus). +Proof. +(* FILL IN HERE *) Admitted. + +(** Rocq makes no distinction between an [Example] and a [Theorem]. We + state the following as a [Theorem] only as a hint that we will use + it in proofs below. *) +Theorem lower_grade_F_Minus : lower_grade (Grade F Minus) = (Grade F Minus). +Proof. +(* FILL IN HERE *) Admitted. + +(* GRADE_THEOREM 0.25: lower_grade_A_Plus *) +(* GRADE_THEOREM 0.25: lower_grade_A_Natural *) +(* GRADE_THEOREM 0.25: lower_grade_A_Minus *) +(* GRADE_THEOREM 0.25: lower_grade_B_Plus *) +(* GRADE_THEOREM 0.25: lower_grade_F_Natural *) +(* GRADE_THEOREM 0.25: lower_grade_twice *) +(* GRADE_THEOREM 0.25: lower_grade_thrice *) +(* GRADE_THEOREM 0.25: lower_grade_F_Minus + + [] *) + +(** **** Exercise: 3 stars, standard (lower_grade_lowers) + + Prove the following theorem, which says that, as long as the grade + starts out above F-, the [lower_grade] option does indeed lower + the grade. As usual, destructing everything in sight is _not_ a + good idea. Judicious use of [destruct] along with rewriting is a + better strategy. + + Hint: If you defined your [grade_comparison] function as suggested, + you will only need to destruct a [letter] in one case. + The case for [F] will probably benefit from [lower_grade_F_Minus]. + *) +Theorem lower_grade_lowers : + forall (g : grade), + grade_comparison (Grade F Minus) g = Lt -> + grade_comparison (lower_grade g) g = Lt. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** Now that we have implemented and tested a function that lowers a + grade by one step, we can implement a specific late-days policy. + Given a number of [late_days], the [apply_late_policy] function + computes the final grade from [g], the initial grade. + + This function encodes the following policy: + + # late days penalty + 0 - 8 no penalty + 9 - 16 lower grade by one step (A+ => A, A => A-, A- => B+, etc.) + 17 - 20 lower grade by two steps + >= 21 lower grade by three steps (a whole letter) +*) +Definition apply_late_policy (late_days : nat) (g : grade) : grade := + if late_days + apply_late_policy late_days g = g. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** The following theorem states that, if a student has between 9 and + 16 late days, their final grade is lowered by one step. *) + +(** **** Exercise: 2 stars, standard (graded_lowered_once) *) +Theorem grade_lowered_once : + forall (late_days : nat) (g : grade), + (late_days + (late_days + (apply_late_policy late_days g) = (lower_grade g). +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) +End LateDays. + +(* ================================================================= *) +(** ** Binary Numerals *) + +(** **** Exercise: 3 stars, standard (binary) + + We can generalize our unary representation of natural numbers to + the more efficient binary representation by treating a binary + number as a sequence of constructors [B0] and [B1] (representing 0s + and 1s), terminated by a [Z]. For comparison, in the unary + representation, a number is a sequence of [S] constructors terminated + by an [O]. + + For example: + + decimal binary unary + 0 Z O + 1 B1 Z S O + 2 B0 (B1 Z) S (S O) + 3 B1 (B1 Z) S (S (S O)) + 4 B0 (B0 (B1 Z)) S (S (S (S O))) + 5 B1 (B0 (B1 Z)) S (S (S (S (S O)))) + 6 B0 (B1 (B1 Z)) S (S (S (S (S (S O))))) + 7 B1 (B1 (B1 Z)) S (S (S (S (S (S (S O)))))) + 8 B0 (B0 (B0 (B1 Z))) S (S (S (S (S (S (S (S O))))))) + + Note that the low-order bit is on the left and the high-order bit + is on the right -- the opposite of the way binary numbers are + usually written. This choice makes them easier to manipulate. + + (Comprehension check: What unary numeral does [B0 Z] represent?) *) + +Inductive bin : Type := + | Z + | B0 (n : bin) + | B1 (n : bin). + +(** Complete the definitions below of an increment function [incr] + for binary numbers, and a function [bin_to_nat] to convert + binary numbers to unary numbers. *) + +Fixpoint incr (m:bin) : bin + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Fixpoint bin_to_nat (m:bin) : nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** The following "unit tests" of your increment and binary-to-unary + functions should pass after you have defined those functions correctly. + Of course, unit tests don't fully demonstrate the correctness of + your functions! We'll return to that thought at the end of the + next chapter. *) + +Example test_bin_incr1 : (incr (B1 Z)) = B0 (B1 Z). +(* FILL IN HERE *) Admitted. + +Example test_bin_incr2 : (incr (B0 (B1 Z))) = B1 (B1 Z). +(* FILL IN HERE *) Admitted. + +Example test_bin_incr3 : (incr (B1 (B1 Z))) = B0 (B0 (B1 Z)). +(* FILL IN HERE *) Admitted. + +Example test_bin_incr4 : bin_to_nat (B0 (B1 Z)) = 2. +(* FILL IN HERE *) Admitted. + +Example test_bin_incr5 : + bin_to_nat (incr (B1 Z)) = 1 + bin_to_nat (B1 Z). +(* FILL IN HERE *) Admitted. + +Example test_bin_incr6 : + bin_to_nat (incr (incr (B1 Z))) = 2 + bin_to_nat (B1 Z). +(* FILL IN HERE *) Admitted. + +Example test_bin_incr7 : bin_to_nat (B0 (B0 (B0 (B1 Z)))) = 8. +(* FILL IN HERE *) Admitted. + +(** [] *) + +(* ################################################################# *) +(** * Optional: Testing Your Solutions *) + +(** Each SF chapter comes with a test file containing scripts that + check whether you have solved the required exercises. If you're + using SF as part of a course, your instructor will likely be + running these test files to autograde your solutions. You can also + use these test files, if you like, to make sure you haven't missed + anything. + + Important: This step is _optional_: if you've completed all the + non-optional exercises and Rocq accepts your answers, this already + shows that you are in good shape. + + The test file for this chapter is [BasicsTest.v]. To run it, make + sure you have saved [Basics.v] to disk. Then first run + [rocq compile -Q . LF Basics.v] and then run [rocq compile -Q . LF BasicsTest.v]; + or, if you have make installed, you can run [make BasicsTest.vo]. + (Make sure you do this in a directory that also contains a file + named [_CoqProject] containing the single line [-Q . LF].) + + If you accidentally deleted an exercise or changed its name, then + [make BasicsTest.vo] will fail with an error that tells you the + name of the missing exercise. Otherwise, you will get a lot of + useful output: + + - First will be all the output produced by [Basics.v] itself. + + - Second, for each required exercise, there is a report that tells + you its point value (the number of stars or some fraction + thereof if there are multiple parts to the exercise), whether + its type is ok, and what assumptions it relies upon. + + If the _type_ is not [ok], it means you proved the wrong thing: + most likely, you accidentally modified the theorem statement + while you were proving it. The autograder won't give you any + points in this case, so make sure to correct the theorem. + + The _assumptions_ are any unproved theorems which your solution + relies upon. "Closed under the global context" is a fancy way + of saying "none": you have solved the exercise. (Hooray!) On + the other hand, a list of axioms means you haven't fully solved + the exercise. (But see below regarding "Allowed Axioms.") If the + exercise name itself is in the list, that means you haven't + solved it; probably you have [Admitted] it. + + - Third, you will see the maximum number of points in standard and + advanced versions of the assignment. That number is based on + the number of stars in the non-optional exercises. (In the + present file, there are no advanced exercises.) + + - Fourth, you will see a list of "Allowed Axioms". These are + unproven theorems that your solution is permitted to depend + upon, aside from the fundamental axioms of Rocq's logic. You'll + probably see something about [functional_extensionality] for + this chapter; we'll cover what that means in a later chapter. + + - Finally, you will see a summary of whether you have solved each + exercise. Note that summary does not include the critical + information of whether the type is ok (that is, whether you + accidentally changed the theorem statement): you have to look + above for that information. + + Exercises that are manually graded will also show up in the + output. But since they have to be graded by a human, the test + script won't be able to tell you much about them. *) + +(* 2026-01-07 13:17 *) diff --git a/BasicsTest.v b/BasicsTest.v new file mode 100644 index 0000000..83d5cf2 --- /dev/null +++ b/BasicsTest.v @@ -0,0 +1,554 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Basics. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Basics. +Import Check. + +Goal True. + +idtac "------------------- nandb --------------------". +idtac " ". + +idtac "#> test_nandb4". +idtac "Possible points: 1". +check_type @test_nandb4 ((@eq bool (nandb true true) false)). +idtac "Assumptions:". +Abort. +Print Assumptions test_nandb4. +Goal True. +idtac " ". + +idtac "------------------- andb3 --------------------". +idtac " ". + +idtac "#> test_andb34". +idtac "Possible points: 1". +check_type @test_andb34 ((@eq bool (andb3 true true false) false)). +idtac "Assumptions:". +Abort. +Print Assumptions test_andb34. +Goal True. +idtac " ". + +idtac "------------------- factorial --------------------". +idtac " ". + +idtac "#> test_factorial2". +idtac "Possible points: 1". +check_type @test_factorial2 ((@eq nat (factorial 5) (Nat.mul 10 12))). +idtac "Assumptions:". +Abort. +Print Assumptions test_factorial2. +Goal True. +idtac " ". + +idtac "------------------- ltb --------------------". +idtac " ". + +idtac "#> test_ltb3". +idtac "Possible points: 1". +check_type @test_ltb3 ((@eq bool (ltb 4 2) false)). +idtac "Assumptions:". +Abort. +Print Assumptions test_ltb3. +Goal True. +idtac " ". + +idtac "------------------- plus_id_exercise --------------------". +idtac " ". + +idtac "#> plus_id_exercise". +idtac "Possible points: 1". +check_type @plus_id_exercise ( +(forall (n m o : nat) (_ : @eq nat n m) (_ : @eq nat m o), + @eq nat (Nat.add n m) (Nat.add m o))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_id_exercise. +Goal True. +idtac " ". + +idtac "------------------- mult_n_1 --------------------". +idtac " ". + +idtac "#> mult_n_1". +idtac "Possible points: 1". +check_type @mult_n_1 ((forall p : nat, @eq nat (Nat.mul p 1) p)). +idtac "Assumptions:". +Abort. +Print Assumptions mult_n_1. +Goal True. +idtac " ". + +idtac "------------------- andb_true_elim2 --------------------". +idtac " ". + +idtac "#> andb_true_elim2". +idtac "Possible points: 2". +check_type @andb_true_elim2 ( +(forall (b c : bool) (_ : @eq bool (andb b c) true), @eq bool c true)). +idtac "Assumptions:". +Abort. +Print Assumptions andb_true_elim2. +Goal True. +idtac " ". + +idtac "------------------- zero_nbeq_plus_1 --------------------". +idtac " ". + +idtac "#> zero_nbeq_plus_1". +idtac "Possible points: 1". +check_type @zero_nbeq_plus_1 ((forall n : nat, @eq bool (eqb 0 (Nat.add n 1)) false)). +idtac "Assumptions:". +Abort. +Print Assumptions zero_nbeq_plus_1. +Goal True. +idtac " ". + +idtac "------------------- identity_fn_applied_twice --------------------". +idtac " ". + +idtac "#> identity_fn_applied_twice". +idtac "Possible points: 1". +check_type @identity_fn_applied_twice ( +(forall (f : forall _ : bool, bool) (_ : forall x : bool, @eq bool (f x) x) + (b : bool), + @eq bool (f (f b)) b)). +idtac "Assumptions:". +Abort. +Print Assumptions identity_fn_applied_twice. +Goal True. +idtac " ". + +idtac "------------------- negation_fn_applied_twice --------------------". +idtac " ". + +idtac "#> Manually graded: negation_fn_applied_twice". +idtac "Possible points: 1". +print_manual_grade manual_grade_for_negation_fn_applied_twice. +idtac " ". + +idtac "------------------- letter_comparison --------------------". +idtac " ". + +idtac "#> LateDays.letter_comparison_Eq". +idtac "Possible points: 1". +check_type @LateDays.letter_comparison_Eq ( +(forall l : LateDays.letter, + @eq LateDays.comparison (LateDays.letter_comparison l l) LateDays.Eq)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.letter_comparison_Eq. +Goal True. +idtac " ". + +idtac "------------------- grade_comparison --------------------". +idtac " ". + +idtac "#> LateDays.test_grade_comparison1". +idtac "Possible points: 0.5". +check_type @LateDays.test_grade_comparison1 ( +(@eq LateDays.comparison + (LateDays.grade_comparison (LateDays.Grade LateDays.A LateDays.Minus) + (LateDays.Grade LateDays.B LateDays.Plus)) + LateDays.Gt)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.test_grade_comparison1. +Goal True. +idtac " ". + +idtac "#> LateDays.test_grade_comparison2". +idtac "Possible points: 0.5". +check_type @LateDays.test_grade_comparison2 ( +(@eq LateDays.comparison + (LateDays.grade_comparison (LateDays.Grade LateDays.A LateDays.Minus) + (LateDays.Grade LateDays.A LateDays.Plus)) + LateDays.Lt)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.test_grade_comparison2. +Goal True. +idtac " ". + +idtac "#> LateDays.test_grade_comparison3". +idtac "Possible points: 0.5". +check_type @LateDays.test_grade_comparison3 ( +(@eq LateDays.comparison + (LateDays.grade_comparison (LateDays.Grade LateDays.F LateDays.Plus) + (LateDays.Grade LateDays.F LateDays.Plus)) + LateDays.Eq)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.test_grade_comparison3. +Goal True. +idtac " ". + +idtac "#> LateDays.test_grade_comparison4". +idtac "Possible points: 0.5". +check_type @LateDays.test_grade_comparison4 ( +(@eq LateDays.comparison + (LateDays.grade_comparison (LateDays.Grade LateDays.B LateDays.Minus) + (LateDays.Grade LateDays.C LateDays.Plus)) + LateDays.Gt)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.test_grade_comparison4. +Goal True. +idtac " ". + +idtac "------------------- lower_letter_lowers --------------------". +idtac " ". + +idtac "#> LateDays.lower_letter_lowers". +idtac "Possible points: 2". +check_type @LateDays.lower_letter_lowers ( +(forall (l : LateDays.letter) + (_ : @eq LateDays.comparison (LateDays.letter_comparison LateDays.F l) + LateDays.Lt), + @eq LateDays.comparison + (LateDays.letter_comparison (LateDays.lower_letter l) l) LateDays.Lt)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_letter_lowers. +Goal True. +idtac " ". + +idtac "------------------- lower_grade --------------------". +idtac " ". + +idtac "#> LateDays.lower_grade_A_Plus". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_A_Plus ( +(@eq LateDays.grade + (LateDays.lower_grade (LateDays.Grade LateDays.A LateDays.Plus)) + (LateDays.Grade LateDays.A LateDays.Natural))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_A_Plus. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_A_Natural". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_A_Natural ( +(@eq LateDays.grade + (LateDays.lower_grade (LateDays.Grade LateDays.A LateDays.Natural)) + (LateDays.Grade LateDays.A LateDays.Minus))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_A_Natural. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_A_Minus". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_A_Minus ( +(@eq LateDays.grade + (LateDays.lower_grade (LateDays.Grade LateDays.A LateDays.Minus)) + (LateDays.Grade LateDays.B LateDays.Plus))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_A_Minus. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_B_Plus". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_B_Plus ( +(@eq LateDays.grade + (LateDays.lower_grade (LateDays.Grade LateDays.B LateDays.Plus)) + (LateDays.Grade LateDays.B LateDays.Natural))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_B_Plus. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_F_Natural". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_F_Natural ( +(@eq LateDays.grade + (LateDays.lower_grade (LateDays.Grade LateDays.F LateDays.Natural)) + (LateDays.Grade LateDays.F LateDays.Minus))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_F_Natural. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_twice". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_twice ( +(@eq LateDays.grade + (LateDays.lower_grade + (LateDays.lower_grade (LateDays.Grade LateDays.B LateDays.Minus))) + (LateDays.Grade LateDays.C LateDays.Natural))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_twice. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_thrice". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_thrice ( +(@eq LateDays.grade + (LateDays.lower_grade + (LateDays.lower_grade + (LateDays.lower_grade (LateDays.Grade LateDays.B LateDays.Minus)))) + (LateDays.Grade LateDays.C LateDays.Minus))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_thrice. +Goal True. +idtac " ". + +idtac "#> LateDays.lower_grade_F_Minus". +idtac "Possible points: 0.25". +check_type @LateDays.lower_grade_F_Minus ( +(@eq LateDays.grade + (LateDays.lower_grade (LateDays.Grade LateDays.F LateDays.Minus)) + (LateDays.Grade LateDays.F LateDays.Minus))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_F_Minus. +Goal True. +idtac " ". + +idtac "------------------- lower_grade_lowers --------------------". +idtac " ". + +idtac "#> LateDays.lower_grade_lowers". +idtac "Possible points: 3". +check_type @LateDays.lower_grade_lowers ( +(forall (g : LateDays.grade) + (_ : @eq LateDays.comparison + (LateDays.grade_comparison + (LateDays.Grade LateDays.F LateDays.Minus) g) + LateDays.Lt), + @eq LateDays.comparison + (LateDays.grade_comparison (LateDays.lower_grade g) g) LateDays.Lt)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.lower_grade_lowers. +Goal True. +idtac " ". + +idtac "------------------- no_penalty_for_mostly_on_time --------------------". +idtac " ". + +idtac "#> LateDays.no_penalty_for_mostly_on_time". +idtac "Possible points: 2". +check_type @LateDays.no_penalty_for_mostly_on_time ( +(forall (late_days : nat) (g : LateDays.grade) + (_ : @eq bool (ltb late_days 9) true), + @eq LateDays.grade (LateDays.apply_late_policy late_days g) g)). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.no_penalty_for_mostly_on_time. +Goal True. +idtac " ". + +idtac "------------------- graded_lowered_once --------------------". +idtac " ". + +idtac "#> LateDays.grade_lowered_once". +idtac "Possible points: 2". +check_type @LateDays.grade_lowered_once ( +(forall (late_days : nat) (g : LateDays.grade) + (_ : @eq bool (ltb late_days 9) false) + (_ : @eq bool (ltb late_days 17) true), + @eq LateDays.grade (LateDays.apply_late_policy late_days g) + (LateDays.lower_grade g))). +idtac "Assumptions:". +Abort. +Print Assumptions LateDays.grade_lowered_once. +Goal True. +idtac " ". + +idtac "------------------- binary --------------------". +idtac " ". + +idtac "#> test_bin_incr1". +idtac "Possible points: 0.5". +check_type @test_bin_incr1 ((@eq bin (incr (B1 Z)) (B0 (B1 Z)))). +idtac "Assumptions:". +Abort. +Print Assumptions test_bin_incr1. +Goal True. +idtac " ". + +idtac "#> test_bin_incr2". +idtac "Possible points: 0.5". +check_type @test_bin_incr2 ((@eq bin (incr (B0 (B1 Z))) (B1 (B1 Z)))). +idtac "Assumptions:". +Abort. +Print Assumptions test_bin_incr2. +Goal True. +idtac " ". + +idtac "#> test_bin_incr3". +idtac "Possible points: 0.5". +check_type @test_bin_incr3 ((@eq bin (incr (B1 (B1 Z))) (B0 (B0 (B1 Z))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_bin_incr3. +Goal True. +idtac " ". + +idtac "#> test_bin_incr4". +idtac "Possible points: 0.5". +check_type @test_bin_incr4 ((@eq nat (bin_to_nat (B0 (B1 Z))) 2)). +idtac "Assumptions:". +Abort. +Print Assumptions test_bin_incr4. +Goal True. +idtac " ". + +idtac "#> test_bin_incr5". +idtac "Possible points: 0.5". +check_type @test_bin_incr5 ( +(@eq nat (bin_to_nat (incr (B1 Z))) (Nat.add 1 (bin_to_nat (B1 Z))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_bin_incr5. +Goal True. +idtac " ". + +idtac "#> test_bin_incr6". +idtac "Possible points: 0.5". +check_type @test_bin_incr6 ( +(@eq nat (bin_to_nat (incr (incr (B1 Z)))) (Nat.add 2 (bin_to_nat (B1 Z))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_bin_incr6. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 28". +idtac "Max points - advanced: 28". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- test_nandb4 ---------". +Print Assumptions test_nandb4. +idtac "---------- test_andb34 ---------". +Print Assumptions test_andb34. +idtac "---------- test_factorial2 ---------". +Print Assumptions test_factorial2. +idtac "---------- test_ltb3 ---------". +Print Assumptions test_ltb3. +idtac "---------- plus_id_exercise ---------". +Print Assumptions plus_id_exercise. +idtac "---------- mult_n_1 ---------". +Print Assumptions mult_n_1. +idtac "---------- andb_true_elim2 ---------". +Print Assumptions andb_true_elim2. +idtac "---------- zero_nbeq_plus_1 ---------". +Print Assumptions zero_nbeq_plus_1. +idtac "---------- identity_fn_applied_twice ---------". +Print Assumptions identity_fn_applied_twice. +idtac "---------- negation_fn_applied_twice ---------". +idtac "MANUAL". +idtac "---------- LateDays.letter_comparison_Eq ---------". +Print Assumptions LateDays.letter_comparison_Eq. +idtac "---------- LateDays.test_grade_comparison1 ---------". +Print Assumptions LateDays.test_grade_comparison1. +idtac "---------- LateDays.test_grade_comparison2 ---------". +Print Assumptions LateDays.test_grade_comparison2. +idtac "---------- LateDays.test_grade_comparison3 ---------". +Print Assumptions LateDays.test_grade_comparison3. +idtac "---------- LateDays.test_grade_comparison4 ---------". +Print Assumptions LateDays.test_grade_comparison4. +idtac "---------- LateDays.lower_letter_lowers ---------". +Print Assumptions LateDays.lower_letter_lowers. +idtac "---------- LateDays.lower_grade_A_Plus ---------". +Print Assumptions LateDays.lower_grade_A_Plus. +idtac "---------- LateDays.lower_grade_A_Natural ---------". +Print Assumptions LateDays.lower_grade_A_Natural. +idtac "---------- LateDays.lower_grade_A_Minus ---------". +Print Assumptions LateDays.lower_grade_A_Minus. +idtac "---------- LateDays.lower_grade_B_Plus ---------". +Print Assumptions LateDays.lower_grade_B_Plus. +idtac "---------- LateDays.lower_grade_F_Natural ---------". +Print Assumptions LateDays.lower_grade_F_Natural. +idtac "---------- LateDays.lower_grade_twice ---------". +Print Assumptions LateDays.lower_grade_twice. +idtac "---------- LateDays.lower_grade_thrice ---------". +Print Assumptions LateDays.lower_grade_thrice. +idtac "---------- LateDays.lower_grade_F_Minus ---------". +Print Assumptions LateDays.lower_grade_F_Minus. +idtac "---------- LateDays.lower_grade_lowers ---------". +Print Assumptions LateDays.lower_grade_lowers. +idtac "---------- LateDays.no_penalty_for_mostly_on_time ---------". +Print Assumptions LateDays.no_penalty_for_mostly_on_time. +idtac "---------- LateDays.grade_lowered_once ---------". +Print Assumptions LateDays.grade_lowered_once. +idtac "---------- test_bin_incr1 ---------". +Print Assumptions test_bin_incr1. +idtac "---------- test_bin_incr2 ---------". +Print Assumptions test_bin_incr2. +idtac "---------- test_bin_incr3 ---------". +Print Assumptions test_bin_incr3. +idtac "---------- test_bin_incr4 ---------". +Print Assumptions test_bin_incr4. +idtac "---------- test_bin_incr5 ---------". +Print Assumptions test_bin_incr5. +idtac "---------- test_bin_incr6 ---------". +Print Assumptions test_bin_incr6. +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Bib.v b/Bib.v new file mode 100644 index 0000000..d06137a --- /dev/null +++ b/Bib.v @@ -0,0 +1,35 @@ +(** * Bib: Bibliography *) + +(* ################################################################# *) +(** * Resources cited in this volume *) + +(** + +[Bertot 2004] Interactive Theorem Proving and Program Development: + Coq'Art: The Calculus of Inductive Constructions, by Yves Bertot and + Pierre Casteran. Springer-Verlag, 2004. + {https://tinyurl.com/z3o7nqu} + +[Chlipala 2013] Certified Programming with Dependent Types, by + Adam Chlipala. MIT Press. 2013. {https://tinyurl.com/zqdnyg2} + +[Lipovaca 2011] Learn You a Haskell for Great Good! A Beginner's + Guide, by Miran Lipovaca, No Starch Press, April 2011. + {http://learnyouahaskell.com} + +[O'Sullivan 2008] Bryan O'Sullivan, John Goerzen, and Don Stewart: + Real world Haskell - code you can believe in. O'Reilly + 2008. {http://book.realworldhaskell.org} + +[Pugh 1991] Pugh, William. "The Omega test: a fast and practical + integer programming algorithm for dependence analysis." Proceedings + of the 1991 ACM/IEEE conference on Supercomputing. ACM, 1991. + {https://dl.acm.org/citation.cfm?id=125848} + +[Wadler 2015] Philip Wadler. "Propositions as types." + Communications of the ACM 58, no. 12 (2015): 75-84. + {https://dl.acm.org/citation.cfm?id=2699407} + +*) + +(* 2026-01-06 11:47 *) diff --git a/BibTest.v b/BibTest.v new file mode 100644 index 0000000..e9b0561 --- /dev/null +++ b/BibTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Bib. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Bib. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-06 11:47 *) + +(* 2026-01-06 11:47 *) diff --git a/Extraction.v b/Extraction.v new file mode 100644 index 0000000..a353b93 --- /dev/null +++ b/Extraction.v @@ -0,0 +1,134 @@ +(** * Extraction: Extracting OCaml from Rocq *) + +(* ################################################################# *) +(** * Basic Extraction *) + +(** In its simplest form, extracting an efficient program from one + written in Rocq is completely straightforward. + + First we say what language we want to extract into. Options are + OCaml (the most mature), Haskell (mostly works), and Scheme (a bit + out of date). *) + +From Stdlib Require Extraction. +Set Extraction Output Directory ".". +Extraction Language OCaml. + +(** Now we load up the Rocq environment with some definitions, either + directly or by importing them from other modules. *) + +Set Warnings "-notation-overridden,-notation-incompatible-prefix". +From Stdlib Require Import Arith. +From Stdlib Require Import Init.Nat. +From Stdlib Require Import EqNat. +From LF Require Import ImpCEvalFun. + +(** Finally, we tell Rocq the name of a definition to extract and the + name of a file to put the extracted code into. *) + +Extraction "imp1.ml" ceval_step. + +(** When Rocq processes this command, it generates a file [imp1.ml] + containing an extracted version of [ceval_step], together with + everything that it recursively depends on. Compile the present + [.v] file and have a look at [imp1.ml] now. *) + +(* ################################################################# *) +(** * Controlling Extraction of Specific Types *) + +(** We can tell Rocq to extract certain [Inductive] definitions to + specific OCaml types. For each one, we must say + - how the Rocq type itself should be represented in OCaml, and + - how each constructor should be translated. *) + +Extract Inductive bool => "bool" [ "true" "false" ]. + +(** Also, for non-enumeration types (where the constructors take + arguments), we give an OCaml expression that can be used as a + "recursor" over elements of the type. (Think Church numerals.) *) + +Extract Inductive nat => "int" + [ "0" "(fun x -> x + 1)" ] + "(fun zero succ n -> + if n=0 then zero () else succ (n-1))". + +(** We can also extract defined constants to specific OCaml terms or + operators. *) + +Extract Constant plus => "( + )". +Extract Constant mult => "( * )". +Extract Constant eqb => "( = )". + +(** Important: It is entirely _your responsibility_ to make sure that + the translations you're proving make sense. For example, it might + be tempting to include this one + + Extract Constant minus => "( - )". + + but doing so could lead to serious confusion! (Why?) +*) + +Extraction "imp2.ml" ceval_step. + +(** Have a look at the file [imp2.ml]. Notice how the fundamental + definitions have changed from [imp1.ml]. *) + +(* ################################################################# *) +(** * A Complete Example *) + +(** To use our extracted evaluator to run Imp programs, all we need to + add is a tiny driver program that calls the evaluator and prints + out the result. + + For simplicity, we'll print results by dumping out the first four + memory locations in the final state. + + Also, to make it easier to type in examples, let's extract a + parser from the [ImpParser] Rocq module. To do this, we first need + to set up the right correspondence between Rocq strings and lists + of OCaml characters. *) + +From Stdlib Require Import ExtrOcamlBasic. +From Stdlib Require Import ExtrOcamlString. + +(** We also need one more variant of booleans. *) + +Extract Inductive sumbool => "bool" ["true" "false"]. + +(** The extraction is the same as always. *) + +From LF Require Import Imp. +From LF Require Import ImpParser. + +From LF Require Import Maps. +Extraction "imp.ml" empty_st ceval_step parse. + +(** Now let's run our generated Imp evaluator. First, have a look at + [impdriver.ml]. (This was written by hand, not extracted.) + + Next, compile the driver together with the extracted code and + execute it, as follows. + + ocamlc -w -20 -w -26 -o impdriver imp.mli imp.ml impdriver.ml + ./impdriver + + (The [-w] flags to [ocamlc] are just there to suppress a few + spurious warnings.) *) + +(* ################################################################# *) +(** * Discussion *) + +(** Since we've proved that the [ceval_step] function behaves the same + as the [ceval] relation in an appropriate sense, the extracted + program can be viewed as a _certified_ Imp interpreter. Of + course, the parser we're using is not certified, since we didn't + prove anything about it! *) + +(* ################################################################# *) +(** * Going Further *) + +(** Further details about extraction can be found in the Extract + chapter in _Verified Functional Algorithms_ (_Software + Foundations_ volume 3). *) + +(* 2026-01-07 13:18 *) diff --git a/ExtractionTest.v b/ExtractionTest.v new file mode 100644 index 0000000..b937c83 --- /dev/null +++ b/ExtractionTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Extraction. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Extraction. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Imp.v b/Imp.v new file mode 100644 index 0000000..b8a14dd --- /dev/null +++ b/Imp.v @@ -0,0 +1,2092 @@ +(** * Imp: Simple Imperative Programs *) + +(** In this chapter, we take a more serious look at how to use Rocq as + a tool to study other things. Our case study is a _simple + imperative programming language_ called Imp, embodying a tiny core + fragment of conventional mainstream languages such as C and Java. + + Here is a familiar mathematical function written in Imp. + + Z := X; + Y := 1; + while Z <> 0 do + Y := Y * Z; + Z := Z - 1 + end +*) + +(** We concentrate here on defining the _syntax_ and _semantics_ of + Imp; later, in _Programming Language Foundations_ (_Software + Foundations_, volume 2), we develop a theory of _program + equivalence_ and introduce _Hoare Logic_, a popular logic for + reasoning about imperative programs. *) + +Set Warnings "-notation-overridden". +From Stdlib Require Import Bool. +From Stdlib Require Import Init.Nat. +From Stdlib Require Import Arith. +From Stdlib Require Import EqNat. Import Nat. +From Stdlib Require Import Lia. +From Stdlib Require Import List. Import ListNotations. +From Stdlib Require Import Strings.String. +From LF Require Import Maps. + +(* ################################################################# *) +(** * Arithmetic and Boolean Expressions *) + +(** We'll present Imp in three parts: first a core language of + _arithmetic and boolean expressions_, then an extension of these + with _variables_, and finally a language of _commands_ including + assignment, conditionals, sequencing, and loops. *) + +(* ================================================================= *) +(** ** Syntax *) + +Module AExp. + +(** These two definitions specify the _abstract syntax_ of + arithmetic and boolean expressions. *) + +Inductive aexp : Type := + | ANum (n : nat) + | APlus (a1 a2 : aexp) + | AMinus (a1 a2 : aexp) + | AMult (a1 a2 : aexp). + +Inductive bexp : Type := + | BTrue + | BFalse + | BEq (a1 a2 : aexp) + | BNeq (a1 a2 : aexp) + | BLe (a1 a2 : aexp) + | BGt (a1 a2 : aexp) + | BNot (b : bexp) + | BAnd (b1 b2 : bexp). + +(** In this chapter, we'll mostly elide the translation from the + concrete syntax that a programmer would actually write to these + abstract syntax trees -- the process that, for example, would + translate the string ["1 + 2 * 3"] to the AST + + APlus (ANum 1) (AMult (ANum 2) (ANum 3)). + + The optional chapter [ImpParser] develops a simple lexical + analyzer and parser that can perform this translation. You do not + need to understand that chapter to understand this one, but if you + haven't already taken a course where these techniques are + covered (e.g., a course on compilers) you may want to skim it. *) + +(** For comparison, here's a conventional BNF (Backus-Naur Form) + grammar defining the same abstract syntax: + + a := nat + | a + a + | a - a + | a * a + + b := true + | false + | a = a + | a <> a + | a <= a + | a > a + | ~ b + | b && b +*) + +(** Compared to the Rocq version above... + + - The BNF is more informal -- for example, it gives some + suggestions about the surface syntax of expressions (like the + fact that the addition operation is written with an infix + [+]) while leaving other aspects of lexical analysis and + parsing (like the relative precedence of [+], [-], and [*], + the use of parens to group subexpressions, etc.) + unspecified. Some additional information -- and human + intelligence -- would be required to turn this description + into a formal definition, e.g., for implementing a compiler. + + The Rocq version consistently omits all this information and + concentrates on the abstract syntax only. + + - Conversely, the BNF version is lighter and easier to read. + Its informality makes it flexible, a big advantage in + situations like discussions at the blackboard, where + conveying general ideas is more important than nailing down + every detail precisely. + + Indeed, there are dozens of BNF-like notations and people + switch freely among them -- usually without bothering to say + which kind of BNF they're using, because there is no need to: + a rough-and-ready informal understanding is all that's + important. + + It's good to be comfortable with both sorts of notations: informal + ones for communicating between humans and formal ones for carrying + out implementations and proofs. *) + +(* ================================================================= *) +(** ** Evaluation *) + +(** _Evaluating_ an arithmetic expression produces a number. *) + +Fixpoint aeval (a : aexp) : nat := + match a 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. + +(** Similarly, evaluating a boolean expression yields a boolean. *) + +Fixpoint beval (b : bexp) : bool := + match b with + | BTrue => true + | BFalse => false + | BEq a1 a2 => (aeval a1) =? (aeval a2) + | BNeq a1 a2 => negb ((aeval a1) =? (aeval a2)) + | BLe a1 a2 => (aeval a1) <=? (aeval a2) + | BGt a1 a2 => negb ((aeval a1) <=? (aeval a2)) + | BNot b1 => negb (beval b1) + | BAnd b1 b2 => andb (beval b1) (beval b2) + end. + +(* ================================================================= *) +(** ** Optimization *) + +(** We haven't defined very much yet, but we can already get + some mileage out of the definitions. Suppose we define a function + that takes an arithmetic expression and slightly simplifies it, + changing every occurrence of [0 + e] (i.e., [(APlus (ANum 0) e]) + into just [e]. *) + +Fixpoint optimize_0plus (a:aexp) : aexp := + match a 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. + +(** To gain confidence that our optimization is doing the right + thing we can test it on some examples and see if the output looks + OK. *) + +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. + +(** But if we want to be certain the optimization is correct -- + that evaluating an optimized expression _always_ gives the same + result as the original -- we should prove it! *) + +Theorem optimize_0plus_sound: forall a, + aeval (optimize_0plus a) = aeval a. +Proof. + intros a. induction a. + - (* ANum *) reflexivity. + - (* APlus *) destruct a1 eqn:Ea1. + + (* a1 = ANum n *) destruct n eqn:En. + * (* n = 0 *) simpl. apply IHa2. + * (* n <> 0 *) simpl. rewrite IHa2. reflexivity. + + (* a1 = APlus a1_1 a1_2 *) + simpl. simpl in IHa1. rewrite IHa1. + rewrite IHa2. reflexivity. + + (* a1 = AMinus a1_1 a1_2 *) + simpl. simpl in IHa1. rewrite IHa1. + rewrite IHa2. reflexivity. + + (* a1 = AMult a1_1 a1_2 *) + simpl. simpl in IHa1. rewrite IHa1. + rewrite IHa2. reflexivity. + - (* AMinus *) + simpl. rewrite IHa1. rewrite IHa2. reflexivity. + - (* AMult *) + simpl. rewrite IHa1. rewrite IHa2. reflexivity. Qed. + +(* ################################################################# *) +(** * Rocq Automation *) + +(** The amount of repetition in this last proof is a little + annoying. And if either the language of arithmetic expressions or + the optimization being proved sound were significantly more + complex, it would start to be a real problem. + + So far, we've been doing all our proofs using just a small handful + of Rocq's tactics and completely ignoring its powerful facilities + for constructing parts of proofs automatically. This section + introduces some of these facilities, and we will see more over the + next several chapters. Getting used to them will take some + energy -- Rocq's automation is a power tool -- but it will allow us + to scale up our efforts to more complex definitions and more + interesting properties without becoming overwhelmed by boring, + repetitive, low-level details. *) + +(* ================================================================= *) +(** ** Tacticals *) + +(** _Tacticals_ is Rocq's term for tactics that take other tactics as + arguments -- "higher-order tactics," if you will. *) + +(* ----------------------------------------------------------------- *) +(** *** The [try] Tactical *) + +(** If [T] is a tactic, then [try T] is a tactic that is just like [T] + except that, if [T] fails, [try T] _successfully_ does nothing at + all (rather than failing). *) +Theorem silly1 : forall (P : Prop), P -> P. +Proof. + intros P HP. + try reflexivity. (* Plain [reflexivity] would have failed. *) + apply HP. (* We can still finish the proof in some other way. *) +Qed. + +Theorem silly2 : forall ae, aeval ae = aeval ae. +Proof. + try reflexivity. (* This just does [reflexivity]. *) +Qed. + +(** There is not much reason to use [try] in completely manual + proofs like these, but it is very useful for doing automated + proofs in conjunction with the [;] tactical, which we show + next. *) + +(* ----------------------------------------------------------------- *) +(** *** The [;] Tactical (Simple Form) *) + +(** In its most common form, the [;] tactical takes two tactics as + arguments. The compound tactic [T;T'] first performs [T] and then + performs [T'] on _each subgoal_ generated by [T]. *) + +(** For example, consider the following trivial lemma: *) + +Lemma foo : forall n, 0 <=? n = true. +Proof. + intros. + destruct n. + (* Leaves two subgoals, which are discharged identically... *) + - (* n=0 *) simpl. reflexivity. + - (* n=Sn' *) simpl. reflexivity. +Qed. + +(** We can simplify this proof using the [;] tactical: *) + +Lemma foo' : forall n, 0 <=? n = true. +Proof. + intros. + (* [destruct] the current goal *) + destruct n; + (* then [simpl] each resulting subgoal *) + simpl; + (* and do [reflexivity] on each resulting subgoal *) + reflexivity. +Qed. + +(** Using [try] and [;] together, we can get rid of the repetition in + the proof that was bothering us a little while ago. *) + +Theorem optimize_0plus_sound': forall a, + aeval (optimize_0plus a) = aeval a. +Proof. + intros a. + induction a; + (* Most cases follow directly by the IH... *) + try (simpl; rewrite IHa1; rewrite IHa2; reflexivity). + (* ... but the remaining cases -- ANum and APlus -- + are different: *) + - (* ANum *) reflexivity. + - (* APlus *) + destruct a1 eqn:Ea1; + (* Again, most cases follow directly by the IH: *) + try (simpl; simpl in IHa1; rewrite IHa1; + rewrite IHa2; reflexivity). + (* The interesting case, on which the [try...] + does nothing, is when [e1 = ANum n]. In this + case, we have to destruct [n] (to see whether + the optimization applies) and rewrite with the + induction hypothesis. *) + + (* a1 = ANum n *) destruct n eqn:En; + simpl; rewrite IHa2; reflexivity. Qed. + +(** Rocq experts often use this "[...; try... ]" idiom after a tactic + like [induction] to take care of many similar cases all at once. + Indeed, this practice has an analog in informal proofs. For + example, here is an informal proof of the optimization theorem + that matches the structure of the formal one: + + _Theorem_: For all arithmetic expressions [a], + + aeval (optimize_0plus a) = aeval a. + + _Proof_: By induction on [a]. Most cases follow directly from the + IH. The remaining cases are as follows: + + - Suppose [a = ANum n] for some [n]. We must show + + aeval (optimize_0plus (ANum n)) = aeval (ANum n). + + This is immediate from the definition of [optimize_0plus]. + + - Suppose [a = APlus a1 a2] for some [a1] and [a2]. We must + show + + aeval (optimize_0plus (APlus a1 a2)) = aeval (APlus a1 a2). + + Consider the possible forms of [a1]. For most of them, + [optimize_0plus] simply calls itself recursively for the + subexpressions and rebuilds a new expression of the same form + as [a1]; in these cases, the result follows directly from the + IH. + + The interesting case is when [a1 = ANum n] for some [n]. If + [n = 0], then + + optimize_0plus (APlus a1 a2) = optimize_0plus a2 + + and the IH for [a2] is exactly what we need. On the other + hand, if [n = S n'] for some [n'], then again [optimize_0plus] + simply calls itself recursively, and the result follows from + the IH. [] *) + +(** However, this proof can still be improved: the first case (for + [a = ANum n]) is very trivial -- even more trivial than the cases + that we said simply followed from the IH -- yet we have chosen to + write it out in full. It would be better and clearer to drop it + and just say, at the top, "Most cases are either immediate or + direct from the IH. The only interesting case is the one for + [APlus]..." We can make the same improvement in our formal proof + too. Here's how it looks: *) + +Theorem optimize_0plus_sound'': forall a, + aeval (optimize_0plus a) = aeval a. +Proof. + intros a. + induction a; + (* Most cases follow directly by the IH *) + try (simpl; rewrite IHa1; rewrite IHa2; reflexivity); + (* ... or are immediate by definition *) + try reflexivity. + (* The interesting case is when a = APlus a1 a2. *) + - (* APlus *) + destruct a1; try (simpl; simpl in IHa1; rewrite IHa1; + rewrite IHa2; reflexivity). + + (* a1 = ANum n *) destruct n; + simpl; rewrite IHa2; reflexivity. Qed. + +(* ----------------------------------------------------------------- *) +(** *** The [;] Tactical (General Form) *) + +(** The [;] tactical also has a more general form than the simple + [T;T'] we've seen above. If [T], [T1], ..., [Tn] are tactics, + then + + T; [T1 | T2 | ... | Tn] + + is a tactic that first performs [T] and then performs [T1] on the + first subgoal generated by [T], performs [T2] on the second + subgoal, etc. + + So [T;T'] is just special notation for the case when all of the + [Ti]'s are the same tactic; i.e., [T;T'] is shorthand for: + + T; [T' | T' | ... | T'] +*) + +(* ----------------------------------------------------------------- *) +(** *** The [repeat] Tactical *) + +(** The [repeat] tactical takes another tactic and keeps applying this + tactic until it fails or until it succeeds but doesn't make any + progress. + + Here is an example proving that [10] is in a long list using + [repeat]. *) + +Theorem In10 : In 10 [1;2;3;4;5;6;7;8;9;10]. +Proof. + repeat (try (left; reflexivity); right). +Qed. + +(** The tactic [repeat T] never fails: if the tactic [T] doesn't apply + to the original goal, then repeat _succeeds_ without changing the + goal at all (i.e., it repeats zero times). *) + +Theorem In10' : In 10 [1;2;3;4;5;6;7;8;9;10]. +Proof. + repeat simpl. + repeat (left; reflexivity). + repeat (right; try (left; reflexivity)). +Qed. + +(** The tactic [repeat T] does not have any upper bound on the + number of times it applies [T]. If [T] is a tactic that _always_ + succeeds (and makes progress), then repeat [T] will loop + forever. *) + +Theorem repeat_loop : forall (m n : nat), + m + n = n + m. +Proof. + intros m n. + (* Uncomment the next line to see the infinite loop occur. You will + then need to interrupt Rocq to make it listen to you again. (In + Proof General, [C-c C-c] does this.) *) + (* repeat rewrite Nat.add_comm. *) +Admitted. + +(** Wait -- did we just write an infinite loop in Rocq?!?! + + Sort of. + + While evaluation in Rocq's term language, Gallina, is guaranteed to + terminate, _tactic_ evaluation is not. This does not affect Rocq's + logical consistency, however, since the job of [repeat] and other + tactics is to guide Rocq in constructing proofs; if the + construction process diverges (i.e., it does not terminate), this + simply means that we have failed to construct a proof at all, not + that we have constructed a bad proof. *) + +(** **** Exercise: 3 stars, standard (optimize_0plus_b_sound) + + Since the [optimize_0plus] transformation doesn't change the value + of [aexp]s, we should be able to apply it to all the [aexp]s that + appear in a [bexp] without changing the [bexp]'s value. Write a + function that performs this transformation on [bexp]s and prove + it is sound. Use the tacticals we've just seen to make the proof + as short and elegant as possible. *) + +Fixpoint optimize_0plus_b (b : bexp) : bexp + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example optimize_0plus_b_test1: + optimize_0plus_b (BNot (BGt (APlus (ANum 0) (ANum 4)) (ANum 8))) = + (BNot (BGt (ANum 4) (ANum 8))). +Proof. (* FILL IN HERE *) Admitted. + +Example optimize_0plus_b_test2: + optimize_0plus_b (BAnd (BLe (APlus (ANum 0) (ANum 4)) (ANum 5)) BTrue) = + (BAnd (BLe (ANum 4) (ANum 5)) BTrue). +Proof. (* FILL IN HERE *) Admitted. + +Theorem optimize_0plus_b_sound : forall b, + beval (optimize_0plus_b b) = beval b. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 4 stars, standard, optional (optimize) + + _Design exercise_: The optimization implemented by our + [optimize_0plus] function is only one of many possible + optimizations on arithmetic and boolean expressions. Write a more + sophisticated optimizer and prove it correct. (You will probably + find it easiest to start small -- add just a single, simple + optimization and its correctness proof -- and build up + incrementally to something more interesting.) *) + +(* FILL IN HERE + + [] *) + +(* ================================================================= *) +(** ** Defining New Tactics *) + +(** Rocq also provides facilities for "programming" in tactic + scripts. + + The [Ltac] idiom illustrated below gives a handy way to define + "shorthand tactics" that bundle several tactics into a single + command. + + Ltac also includes syntactic pattern-matching on the goal and + context, as well as general programming facilities. + + It is useful for proof automation and there are several idioms for + programming with Ltac. Because it is a language style you might + not have seen before, a good reference is the textbook "Certified + Programming with dependent types" [CPDT], which is more advanced + that what we will need in this course, but is considered by many + the best reference for Ltac programming. + + Just for future reference: Rocq provides two other ways of defining + new tactics. There is a [Tactic Notation] command that allows + defining new tactics with custom control over their concrete + syntax. And there is also a low-level API that can be used to + build tactics that directly manipulate Rocq's internal structures. + We will not need either of these for present purposes. + + Here's an example [Ltac] script called [invert]. *) + +Ltac invert H := + inversion H; subst; clear H. + +(** This defines a new tactic called [invert] that takes a hypothesis + [H] as an argument and performs the sequence of commands + [inversion H; subst; clear H]. This gives us quick way to do + inversion on evidence and constructors, rewrite with the generated + equations, and remove the redundant hypothesis at the end. *) + +Lemma invert_example1: forall {a b c: nat}, [a ;b] = [a;c] -> b = c. + intros. + invert H. + reflexivity. +Qed. + +(* ================================================================= *) +(** ** The [lia] Tactic *) + +(** The [lia] tactic implements a decision procedure for integer linear + arithmetic, a subset of propositional logic and arithmetic. + + If the goal is a universally quantified formula made out of + + - numeric constants, addition ([+] and [S]), subtraction ([-] + and [pred]), and multiplication by constants (this is what + makes it Presburger arithmetic), + + - equality ([=] and [<>]) and ordering ([<=] and [>]), and + + - the logical connectives [/\], [\/], [~], and [->], + + then invoking [lia] will either solve the goal or fail, meaning + that the goal is actually false. (If the goal is _not_ of this + form, [lia] will fail.) *) + +Example silly_presburger_example : forall m n o p, + m + n <= n + o /\ o + 3 = p + 3 -> + m <= p. +Proof. + intros. lia. +Qed. + +Example add_comm__lia : forall m n, + m + n = n + m. +Proof. + intros. lia. +Qed. + +Example add_assoc__lia : forall m n p, + m + (n + p) = m + n + p. +Proof. + intros. lia. +Qed. + +(** (Note the [From Stdlib Require Import Lia.] at the top of + this file, which makes [lia] available.) *) + +(* ================================================================= *) +(** ** A Few More Handy Tactics *) + +(** Finally, here are some miscellaneous tactics that you may find + convenient. + + - [clear H]: Delete hypothesis [H] from the context. + + - [subst x]: Given a variable [x], find an assumption [x = e] or + [e = x] in the context, replace [x] with [e] throughout the + context and current goal, and clear the assumption. + + - [subst]: Substitute away _all_ assumptions of the form [x = e] + or [e = x] (where [x] is a variable). + + - [rename... into...]: Change the name of a hypothesis in the + proof context. For example, if the context includes a variable + named [x], then [rename x into y] will change all occurrences + of [x] to [y]. + + - [assumption]: Try to find a hypothesis [H] in the context that + exactly matches the goal; if one is found, solve the goal. + + - [contradiction]: Try to find a hypothesis [H] in the context + that is logically equivalent to [False]. If one is found, + solve the goal. + + - [constructor]: Try to find a constructor [c] (from some + [Inductive] definition in the current environment) that can be + applied to solve the current goal. If one is found, behave + like [apply c]. + + We'll see examples of all of these as we go along. *) + +(* ################################################################# *) +(** * Evaluation as a Relation *) + +(** We have presented [aeval] and [beval] as functions defined by + [Fixpoint]s. Another way to think about evaluation -- one that is + often more flexible -- is as a _relation_ between expressions and + their values. This perspective leads to [Inductive] definitions + like the following... *) + +Module aevalR_first_try. + +Inductive aevalR : aexp -> nat -> Prop := + | E_ANum (n : nat) : + aevalR (ANum n) n + | E_APlus (e1 e2 : aexp) (n1 n2 : nat) : + aevalR e1 n1 -> + aevalR e2 n2 -> + aevalR (APlus e1 e2) (n1 + n2) + | E_AMinus (e1 e2 : aexp) (n1 n2 : nat) : + aevalR e1 n1 -> + aevalR e2 n2 -> + aevalR (AMinus e1 e2) (n1 - n2) + | E_AMult (e1 e2 : aexp) (n1 n2 : nat) : + aevalR e1 n1 -> + aevalR e2 n2 -> + aevalR (AMult e1 e2) (n1 * n2). + +Module HypothesisNames. + +(** A small notational aside. We could also write the definition of + [aevalR] as follow, with explicit names for the hypotheses in each + case: *) + +Inductive aevalR : aexp -> nat -> Prop := + | E_ANum (n : nat) : + aevalR (ANum n) n + | E_APlus (e1 e2 : aexp) (n1 n2 : nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (APlus e1 e2) (n1 + n2) + | E_AMinus (e1 e2 : aexp) (n1 n2 : nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (AMinus e1 e2) (n1 - n2) + | E_AMult (e1 e2 : aexp) (n1 n2 : nat) + (H1 : aevalR e1 n1) + (H2 : aevalR e2 n2) : + aevalR (AMult e1 e2) (n1 * n2). + +(** This style gives us more control over the names that Rocq chooses + during proofs involving [aevalR], at the cost of making the + definition a little more verbose. *) + +End HypothesisNames. + +(** It will be convenient to have an infix notation for + [aevalR]. We'll write [e ==> n] to mean that arithmetic expression + [e] evaluates to value [n]. *) + +Notation "e '==>' n" + := (aevalR e n) + (at level 90, left associativity) + : type_scope. + +End aevalR_first_try. + +(** As we saw in our case study of regular expressions in + chapter [IndProp], Rocq provides a way to use this notation in + the definition of [aevalR] itself. *) + +Reserved Notation "e '==>' n" (at level 90, left associativity). + +Inductive aevalR : aexp -> nat -> Prop := + | E_ANum (n : nat) : + (ANum n) ==> n + | E_APlus (e1 e2 : aexp) (n1 n2 : nat) : + (e1 ==> n1) -> + (e2 ==> n2) -> + (APlus e1 e2) ==> (n1 + n2) + | E_AMinus (e1 e2 : aexp) (n1 n2 : nat) : + (e1 ==> n1) -> + (e2 ==> n2) -> + (AMinus e1 e2) ==> (n1 - n2) + | E_AMult (e1 e2 : aexp) (n1 n2 : nat) : + (e1 ==> n1) -> + (e2 ==> n2) -> + (AMult e1 e2) ==> (n1 * n2) + + where "e '==>' n" := (aevalR e n) : type_scope. + +(* ================================================================= *) +(** ** Inference Rule Notation *) + +(** In informal discussions, it is convenient to write the rules + for [aevalR] and similar relations in the more readable graphical + form of _inference rules_, where the premises above the line + justify the conclusion below the line. + + For example, the constructor [E_APlus]... + + | E_APlus : forall (e1 e2 : aexp) (n1 n2 : nat), + aevalR e1 n1 -> + aevalR e2 n2 -> + aevalR (APlus e1 e2) (n1 + n2) + + ...can be written like this as an inference rule: + + e1 ==> n1 + e2 ==> n2 + -------------------- (E_APlus) + APlus e1 e2 ==> n1+n2 +*) + +(** Formally, there is nothing deep about inference rules: they + are just implications. + + You can read the rule name on the right as the name of the + constructor and read each of the linebreaks between the premises + above the line (as well as the line itself) as [->]. + + All the variables mentioned in the rule ([e1], [n1], etc.) are + implicitly bound by universal quantifiers at the beginning. (Such + variables are often called _metavariables_ to distinguish them + from the variables of the language we are defining. At the + moment, our arithmetic expressions don't include variables, but + we'll soon be adding them.) + + The whole collection of rules is understood as being wrapped in an + [Inductive] declaration. In informal prose, this is sometimes + indicated by saying something like "Let [aevalR] be the smallest + relation closed under the following rules...". *) + +(** For example, we could define [==>] as the smallest relation + closed under these rules: + + ----------- (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 +*) + +(** **** Exercise: 1 star, standard, optional (beval_rules) + + Here, again, is the Rocq definition of the [beval] function: + + Fixpoint beval (e : bexp) : bool := + match e with + | BTrue => true + | BFalse => false + | BEq a1 a2 => (aeval a1) =? (aeval a2) + | BNeq a1 a2 => negb ((aeval a1) =? (aeval a2)) + | BLe a1 a2 => (aeval a1) <=? (aeval a2) + | BGt a1 a2 => ~((aeval a1) <=? (aeval a2)) + | BNot b => negb (beval b) + | BAnd b1 b2 => andb (beval b1) (beval b2) + end. + + Write out a corresponding definition of boolean evaluation as a + relation (in inference rule notation). *) +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_beval_rules : option (nat*string) := None. +(** [] *) + +(* ================================================================= *) +(** ** Equivalence of the Definitions *) + +(** It is straightforward to prove that the relational and functional + definitions of evaluation agree: *) + +Theorem aevalR_iff_aeval : forall a n, + (a ==> n) <-> aeval a = n. +Proof. + split. + - (* -> *) + intros H. + induction H; simpl. + + (* E_ANum *) + reflexivity. + + (* E_APlus *) + rewrite IHaevalR1. rewrite IHaevalR2. reflexivity. + + (* E_AMinus *) + rewrite IHaevalR1. rewrite IHaevalR2. reflexivity. + + (* E_AMult *) + rewrite IHaevalR1. rewrite IHaevalR2. reflexivity. + - (* <- *) + generalize dependent n. + induction a; + simpl; intros; subst. + + (* ANum *) + apply E_ANum. + + (* APlus *) + apply E_APlus. + * apply IHa1. reflexivity. + * apply IHa2. reflexivity. + + (* AMinus *) + apply E_AMinus. + * apply IHa1. reflexivity. + * apply IHa2. reflexivity. + + (* AMult *) + apply E_AMult. + * apply IHa1. reflexivity. + * apply IHa2. reflexivity. +Qed. + +(** Again, we can make the proof quite a bit shorter using some + tacticals. *) + +Theorem aevalR_iff_aeval' : forall a n, + (a ==> n) <-> aeval a = n. +Proof. + (* WORKED IN CLASS *) + split. + - (* -> *) + intros H; induction H; subst; reflexivity. + - (* <- *) + generalize dependent n. + induction a; simpl; intros; subst; constructor; + try apply IHa1; try apply IHa2; reflexivity. +Qed. + +(** **** Exercise: 3 stars, standard (bevalR) + + Write a relation [bevalR] in the same style as + [aevalR], and prove that it is equivalent to [beval]. *) + +Reserved Notation "e '==>b' b" (at level 90, left associativity). +Inductive bevalR: bexp -> bool -> Prop := +(* FILL IN HERE *) +where "e '==>b' b" := (bevalR e b) : type_scope +. + +Lemma bevalR_iff_beval : forall b bv, + b ==>b bv <-> beval b = bv. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +End AExp. + +(* ================================================================= *) +(** ** Computational vs. Relational Definitions *) + +(** For the definitions of evaluation for arithmetic and boolean + expressions, the choice of whether to use functional or relational + definitions is mainly a matter of taste: either way works fine. + + However, there are many situations where relational definitions of + evaluation work much better than functional ones. *) + +Module aevalR_division. + +(** For example, suppose that we wanted to extend the arithmetic + operations with division: *) + +Inductive aexp : Type := + | ANum (n : nat) + | APlus (a1 a2 : aexp) + | AMinus (a1 a2 : aexp) + | AMult (a1 a2 : aexp) + | ADiv (a1 a2 : aexp). (* <--- NEW *) + +(** Extending the definition of [aeval] to handle this new + operation would not be straightforward (what should we return as + the result of [ADiv (ANum 5) (ANum 0)]?). But extending [aevalR] + is very easy. *) + +Reserved Notation "e '==>' n" + (at level 90, left associativity). + +Inductive aevalR : aexp -> nat -> Prop := + | E_ANum (n : nat) : + (ANum n) ==> n + | E_APlus (a1 a2 : aexp) (n1 n2 : nat) : + (a1 ==> n1) -> (a2 ==> n2) -> (APlus a1 a2) ==> (n1 + n2) + | E_AMinus (a1 a2 : aexp) (n1 n2 : nat) : + (a1 ==> n1) -> (a2 ==> n2) -> (AMinus a1 a2) ==> (n1 - n2) + | E_AMult (a1 a2 : aexp) (n1 n2 : nat) : + (a1 ==> n1) -> (a2 ==> n2) -> (AMult a1 a2) ==> (n1 * n2) + | E_ADiv (a1 a2 : aexp) (n1 n2 n3 : nat) : (* <----- NEW *) + (a1 ==> n1) -> (a2 ==> n2) -> (n2 > 0) -> + (mult n2 n3 = n1) -> (ADiv a1 a2) ==> n3 + +where "a '==>' n" := (aevalR a n) : type_scope. + +(** Notice that this evaluation relation corresponds to a _partial_ + function: There are some inputs for which it does not specify an + output. *) + +End aevalR_division. + +Module aevalR_extended. + +(** Or suppose that we want to extend the arithmetic operations + by a nondeterministic number generator [any] that, when evaluated, + may yield any number. + + (Note that this is not the same as making a _probabilistic_ choice + among all possible numbers -- we're not specifying any particular + probability distribution for the results, just saying what results + are _possible_.) *) + +Reserved Notation "e '==>' n" (at level 90, left associativity). + +Inductive aexp : Type := + | AAny (* <--- NEW *) + | ANum (n : nat) + | APlus (a1 a2 : aexp) + | AMinus (a1 a2 : aexp) + | AMult (a1 a2 : aexp). + +(** Again, extending [aeval] would be tricky, since now + evaluation is _not_ a deterministic function from expressions to + numbers; but extending [aevalR] is no problem... *) + +Inductive aevalR : aexp -> nat -> Prop := + | E_Any (n : nat) : + AAny ==> n (* <--- NEW *) + | E_ANum (n : nat) : + (ANum n) ==> n + | E_APlus (a1 a2 : aexp) (n1 n2 : nat) : + (a1 ==> n1) -> (a2 ==> n2) -> (APlus a1 a2) ==> (n1 + n2) + | E_AMinus (a1 a2 : aexp) (n1 n2 : nat) : + (a1 ==> n1) -> (a2 ==> n2) -> (AMinus a1 a2) ==> (n1 - n2) + | E_AMult (a1 a2 : aexp) (n1 n2 : nat) : + (a1 ==> n1) -> (a2 ==> n2) -> (AMult a1 a2) ==> (n1 * n2) + +where "a '==>' n" := (aevalR a n) : type_scope. + +End aevalR_extended. + +(** At this point you maybe wondering: Which of these styles + should I use by default? + + In the examples we've just seen, relational definitions turned out + to be more useful than functional ones. For situations like + these, where the thing being defined is not easy to express as a + function, or indeed where it is _not_ a function, there is no real + choice. But what about when both styles are workable? + + One point in favor of relational definitions is that they can be + more elegant and easier to understand. + + Another is that Rocq automatically generates nice inversion and + induction principles from [Inductive] definitions. + + On the other hand, functional definitions can often be more + convenient: + - Functions are automatically deterministic and total; for a + relational definition, we have to _prove_ these properties + explicitly if we need them. + - With functions we can also take advantage of Rocq's computation + mechanism to simplify expressions during proofs. + + Furthermore, functions can be directly "extracted" from Gallina to + executable code in OCaml or Haskell. + + Ultimately, the choice often comes down to either the specifics of + a particular situation or simply a question of taste. Indeed, in + large Rocq developments it is common to see a definition given in + _both_ functional and relational styles, plus a lemma stating that + the two coincide, allowing further proofs to switch from one point + of view to the other at will. *) + +(* ################################################################# *) +(** * Expressions With Variables *) + +(** Let's return to defining Imp, where the next thing we need to do + is to enrich our arithmetic and boolean expressions with + variables. + + To keep things simple, we'll assume that all variables are global + and that they only hold numbers. *) + +(* ================================================================= *) +(** ** States *) + +(** Since we'll want to look variables up to find out their current + values, we'll use total maps from the [Maps] chapter. + + A _machine state_ (or just _state_) represents the current values + of all variables at some point in the execution of a program. *) + +(** For simplicity, we assume that the state is defined for + _all_ variables, even though any given program is only able to + mention a finite number of them. Because each variable stores a + natural number, we can represent the state as a total map from + strings (variable names) to [nat], and will use [0] as default + value in the store. *) + +Definition state := total_map nat. + +(* ================================================================= *) +(** ** Syntax *) + +(** We can add variables to the arithmetic expressions we had before + simply by including one more constructor: *) + +Inductive aexp : Type := + | ANum (n : nat) + | AId (x : string) (* <--- NEW *) + | APlus (a1 a2 : aexp) + | AMinus (a1 a2 : aexp) + | AMult (a1 a2 : aexp). + +(** Defining a few variable names as notational shorthands will make + examples easier to read: *) + +Definition W : string := "W". +Definition X : string := "X". +Definition Y : string := "Y". +Definition Z : string := "Z". + +(** (This convention for naming program variables ([X], [Y], + [Z]) clashes a bit with our earlier use of uppercase letters for + types. Since we're not using polymorphism heavily in the chapters + developed to Imp, this overloading should not cause confusion.) *) + +(** The definition of [bexp]s is unchanged (except that it now refers + to the new [aexp]s): *) + +Inductive bexp : Type := + | BTrue + | BFalse + | BEq (a1 a2 : aexp) + | BNeq (a1 a2 : aexp) + | BLe (a1 a2 : aexp) + | BGt (a1 a2 : aexp) + | BNot (b : bexp) + | BAnd (b1 b2 : bexp). + +(* ================================================================= *) +(** ** Notations *) + +(** To make Imp programs easier to read and write, we introduce some + notations and implicit coercions. *) + +(** You do not need to understand exactly what these declarations do. + + Briefly, though: + - The [Coercion] declaration stipulates that a function (or + constructor) can be implicitly used by the type system to + coerce a value of the input type to a value of the output + type. For instance, the coercion declaration for [AId] + allows us to use plain strings when an [aexp] is expected; + the string will implicitly be wrapped with [AId]. + - [Declare Custom Entry com] tells Rocq to create a new "custom + grammar" for parsing Imp expressions and programs. The first + notation declaration after this tells Rocq that anything + between [<{] and [}>] should be parsed using the Imp + grammar. Again, it is not necessary to understand the + details, but it is important to recognize that we are + defining _new_ interpretations for some familiar operators + like [+], [-], [*], [=], [<=], etc., when they occur between + [<{] and [}>]. *) + +Coercion AId : string >-> aexp. +Coercion ANum : nat >-> aexp. + +Declare Custom Entry com. +Declare Scope com_scope. + +Notation "<{ e }>" := e + (e custom com, format "'[hv' <{ '/ ' '[v' e ']' '/' }> ']'") : com_scope. + +Notation "( x )" := x (in custom com, x at level 99). +Notation "x" := x (in custom com at level 0, x constr at level 0). + +Notation "f x .. y" := (.. (f x) .. y) + (in custom com at level 0, only parsing, + f constr at level 0, x constr at level 1, + y constr at level 1). +Notation "x + y" := (APlus x y) (in custom com at level 50, left associativity). +Notation "x - y" := (AMinus x y) (in custom com at level 50, left associativity). +Notation "x * y" := (AMult x y) (in custom com at level 40, left associativity). +Notation "'true'" := true (at level 1). +Notation "'true'" := BTrue (in custom com at level 0). +Notation "'false'" := false (at level 1). +Notation "'false'" := BFalse (in custom com at level 0). +Notation "x <= y" := (BLe x y) (in custom com at level 70, no associativity). +Notation "x > y" := (BGt x y) (in custom com at level 70, no associativity). +Notation "x = y" := (BEq x y) (in custom com at level 70, no associativity). +Notation "x <> y" := (BNeq x y) (in custom com at level 70, no associativity). +Notation "x && y" := (BAnd x y) (in custom com at level 80, left associativity). +Notation "'~' b" := (BNot b) (in custom com at level 75, right associativity). + +Open Scope com_scope. + +(** We can now write [3 + (X * 2)] instead of [APlus 3 (AMult X 2)], + and [true && ~(X <= 4)] instead of [BAnd true (BNot (BLe X 4))]. *) + +Definition example_aexp : aexp := <{ 3 + (X * 2) }>. +Definition example_bexp : bexp := <{ true && ~(X <= 4) }>. + +(* ================================================================= *) +(** ** Evaluation *) + +(** The arith and boolean evaluators must now be extended to + handle variables in the obvious way, taking a state [st] as an + extra argument: *) + +Fixpoint aeval (st : state) (* <--- NEW *) + (a : aexp) : nat := + match a with + | ANum n => n + | AId x => st x (* <--- NEW *) + | <{a1 + a2}> => (aeval st a1) + (aeval st a2) + | <{a1 - a2}> => (aeval st a1) - (aeval st a2) + | <{a1 * a2}> => (aeval st a1) * (aeval st a2) + end. + +Fixpoint beval (st : state) (* <--- NEW *) + (b : bexp) : bool := + match b with + | <{true}> => true + | <{false}> => false + | <{a1 = a2}> => (aeval st a1) =? (aeval st a2) + | <{a1 <> a2}> => negb ((aeval st a1) =? (aeval st a2)) + | <{a1 <= a2}> => (aeval st a1) <=? (aeval st a2) + | <{a1 > a2}> => negb ((aeval st a1) <=? (aeval st a2)) + | <{~ b1}> => negb (beval st b1) + | <{b1 && b2}> => andb (beval st b1) (beval st b2) + end. + +(** We can use our notation for total maps in the specific case of + states -- i.e., we write the empty state as [(__ !-> 0)]. *) + +Definition empty_st := (__ !-> 0). + +(** Also, we can add a notation for a "singleton state" with just one + variable bound to a value. *) +Notation "x '!->' v" := (x !-> v ; empty_st) (at level 100, right associativity). + +Example aexp1 : + aeval (X !-> 5) <{ 3 + (X * 2) }> + = 13. +Proof. reflexivity. Qed. +Example aexp2 : + aeval (X !-> 5 ; Y !-> 4) <{ Z + (X * Y) }> + = 20. +Proof. reflexivity. Qed. + +Example bexp1 : + beval (X !-> 5) <{ true && ~(X <= 4) }> + = true. +Proof. reflexivity. Qed. + +(* ################################################################# *) +(** * Commands *) + +(** Now we are ready to define the syntax and behavior of Imp + _commands_ (or _statements_). *) + +(* ================================================================= *) +(** ** Syntax *) + +(** Informally, commands [c] are described by the following BNF + grammar. + + c := skip + | x := a + | c ; c + | if b then c else c end + | while b do c end +*) + +(** Here is the formal definition of the abstract syntax of + commands: *) + +Inductive com : Type := + | CSkip + | CAsgn (x : string) (a : aexp) + | CSeq (c1 c2 : com) + | CIf (b : bexp) (c1 c2 : com) + | CWhile (b : bexp) (c : com). + +(** As we did for expressions, we can use a few [Notation] + declarations to make reading and writing Imp programs more + convenient. *) + +(* SOON: (NOTATION NDS'25) + I considered changing maps to also span multiple lines, but I + have not attempted this yet, as this would have required changes + in earlier chapters. *) +Notation "'skip'" := CSkip + (in custom com at level 0) : com_scope. +Notation "x := y" := (CAsgn x y) + (in custom com at level 0, x constr at level 0, y at level 85, no associativity, + format "x := y") : com_scope. +Notation "x ; y" := (CSeq x y) + (in custom com at level 90, + right associativity, + format "'[v' x ; '/' y ']'") : com_scope. +Notation "'if' x 'then' y 'else' z 'end'" := (CIf x y z) + (in custom com at level 89, x at level 99, y at level 99, z at level 99, + format "'[v' 'if' x 'then' '/ ' y '/' 'else' '/ ' z '/' 'end' ']'") : com_scope. +Notation "'while' x 'do' y 'end'" := (CWhile x y) + (in custom com at level 89, x at level 99, y at level 99, + format "'[v' 'while' x 'do' '/ ' y '/' 'end' ']'") : com_scope. + +(** For example, here is the factorial function again, written as a + formal Rocq definition. When this command terminates, the variable + [Y] will contain the factorial of the initial value of [X]. *) + +Definition fact_in_coq : com := + <{ Z := X; + Y := 1; + while Z <> 0 do + Y := Y * Z; + Z := Z - 1 + end }>. + +Print fact_in_coq. + +(* ================================================================= *) +(** ** Desugaring Notations *) + +(** Rocq offers a rich set of features to manage the increasing + complexity of the objects we work with, such as coercions and + notations. However, their heavy usage can make it hard to + understand what the expressions we enter actually mean. In such + situations it is often instructive to "turn off" those features to + get a more elementary picture of things, using the following + commands: + + - [Unset Printing Notations] (undo with [Set Printing Notations]) + - [Set Printing Coercions] (undo with [Unset Printing Coercions]) + - [Set Printing All] (undo with [Unset Printing All]) + + These commands can also be used in the middle of a proof, to + elaborate the current goal and context. *) + +Unset Printing Notations. +Print fact_in_coq. +(* ===> + fact_in_coq = + CSeq (CAsgn Z X) + (CSeq (CAsgn Y (S O)) + (CWhile (BNot (BEq Z O)) + (CSeq (CAsgn Y (AMult Y Z)) + (CAsgn Z (AMinus Z (S O)))))) + : com *) +Set Printing Notations. + +Print example_bexp. +(* ===> example_bexp = <{(true && ~ (X <= 4))}> *) + +Set Printing Coercions. +Print example_bexp. +(* ===> example_bexp = <{(true && ~ (AId X <= ANum 4))}> *) + +Print fact_in_coq. +(* ===> + fact_in_coq = + <{ Z := (AId X); + Y := (ANum 1); + while ~ (AId Z) = (ANum 0) do + Y := (AId Y) * (AId Z); + Z := (AId Z) - (ANum 1) + end }> + : com *) +Unset Printing Coercions. + +(* ================================================================= *) +(** ** [Locate] Again *) + +(* ----------------------------------------------------------------- *) +(** *** Finding identifiers *) + +(** When used with an identifier, the [Locate] prints the full path to + every value in scope with the same name. This is useful to + troubleshoot problems due to variable shadowing. *) +Locate aexp. +(* ===> + Inductive LF.Imp.aexp + Inductive LF.Imp.AExp.aexp + (shorter name to refer to it in current context is AExp.aexp) + Inductive LF.Imp.aevalR_division.aexp + (shorter name to refer to it in current context is aevalR_division.aexp) + Inductive LF.Imp.aevalR_extended.aexp + (shorter name to refer to it in current context is aevalR_extended.aexp) +*) +(* ----------------------------------------------------------------- *) +(** *** Finding notations *) + +(** When faced with an unknown notation, you can use [Locate] with a + string containing one of its symbols to see its possible + interpretations. *) +Locate "&&". +(* ===> + Notation + "x && y" := BAnd x y (default interpretation) + "x && y" := andb x y : bool_scope (default interpretation) +*) +Locate ";". +(* ===> + Notation + "x '|->' v ';' m" := (update m x v) (default interpretation) + "x ; y" := (CSeq x y) (default interpretation) + "x '!->' v ';' m" := (t_update m x v) (default interpretation) + "[ x ; y ; .. ; z ]" := cons x (cons y .. (cons z nil) ..) : list_scope + (default interpretation) *) + +Locate "while". +(* ===> + Notation + "'while' x 'do' y 'end'" := + (CWhile x y) (default interpretation) +*) + +(* ================================================================= *) +(** ** More Examples *) + +(* ----------------------------------------------------------------- *) +(** *** Assignment: *) + +Definition plus2 : com := + <{ X := X + 2 }>. + +Definition XtimesYinZ : com := + <{ Z := X * Y }>. + +(* ----------------------------------------------------------------- *) +(** *** Loops *) + +Definition subtract_slowly_body : com := + <{ Z := Z - 1 ; + X := X - 1 }>. + +Definition subtract_slowly : com := + <{ while X <> 0 do + subtract_slowly_body + end }>. + +Definition subtract_3_from_5_slowly : com := + <{ X := 3 ; + Z := 5 ; + subtract_slowly }>. + +(* ----------------------------------------------------------------- *) +(** *** An infinite loop: *) + +Definition loop : com := + <{ while true do + skip + end }>. + +(* ################################################################# *) +(** * Evaluating Commands *) + +(** Next we need to define what it means to evaluate an Imp command. + The fact that [while] loops don't necessarily terminate makes + defining an evaluation function tricky... *) + +(* ================================================================= *) +(** ** Evaluation as a Function (Failed Attempt) *) + +(** Here's an attempt at defining an evaluation function for commands + (with a bogus [while] case). *) + +Fixpoint ceval_fun_no_while (st : state) (c : com) : state := + match c with + | <{ skip }> => + st + | <{ x := a }> => + (x !-> aeval st a ; st) + | <{ c1 ; c2 }> => + let st' := ceval_fun_no_while st c1 in + ceval_fun_no_while st' c2 + | <{ if b then c1 else c2 end}> => + if (beval st b) + then ceval_fun_no_while st c1 + else ceval_fun_no_while st c2 + | <{ while b do c end }> => + st (* bogus *) + end. + +(** In a more conventional functional programming language like OCaml or + Haskell we could add the [while] case as follows: + + Fixpoint ceval_fun (st : state) (c : com) : state := + match c with + ... + | <{ while b do c end}> => + if (beval st b) + then ceval_fun st <{c ; while b do c end}> + else st + end. + + Rocq doesn't accept such a definition ("Error: Cannot guess + decreasing argument of fix") because the function we want to + define is not guaranteed to terminate. Indeed, it _doesn't_ always + terminate: for example, the full version of the [ceval_fun] + function applied to the [loop] program above would never + terminate. Since Rocq aims to be not just a functional programming + language but also a consistent logic, any potentially + non-terminating function needs to be rejected. + + Here is an example showing what would go wrong if Rocq allowed + non-terminating recursive functions: + + Fixpoint loop_false (n : nat) : False := loop_false n. + + That is, propositions like [False] would become provable + ([loop_false 0] would be a proof of [False]), which would be + a disaster for Rocq's logical consistency. + + Thus, because it doesn't terminate on all inputs, [ceval_fun] + cannot be written in Rocq -- at least not without additional tricks + and workarounds (see chapter [ImpCEvalFun] if you're curious + about those). *) + +(* ================================================================= *) +(** ** Evaluation as a Relation *) + +(** Here's a better way: define [ceval] as a _relation_ rather than a + _function_ -- i.e., make its result a [Prop] rather than a + [state], similar to what we did for [aevalR] above. *) + +(** This is an important change. Besides freeing us from awkward + workarounds, it gives us a ton more flexibility in the definition. + For example, if we add nondeterministic features like [any] to the + language, we want the definition of evaluation to be + nondeterministic -- i.e., not only will it not be total, it will + not even be a function! *) + +(** We'll use the notation [st =[ c ]=> st'] for the [ceval] relation: + [st =[ c ]=> st'] means that executing program [c] in a starting + state [st] results in an ending state [st']. This can be + pronounced "[c] takes state [st] to [st']". *) + +(* ----------------------------------------------------------------- *) +(** *** Operational Semantics *) + +(** Here is an informal definition of evaluation, presented as inference + rules for readability: + + ----------------- (E_Skip) + st =[ skip ]=> st + + aeval st a = n + ------------------------------- (E_Asgn) + st =[ x := a ]=> (x !-> n ; st) + + st =[ c1 ]=> st' + st' =[ c2 ]=> st'' + --------------------- (E_Seq) + st =[ c1;c2 ]=> st'' + + beval st b = true + st =[ c1 ]=> st' + -------------------------------------- (E_IfTrue) + st =[ if b then c1 else c2 end ]=> st' + + beval st b = false + st =[ c2 ]=> st' + -------------------------------------- (E_IfFalse) + st =[ if b then c1 else c2 end ]=> st' + + beval st b = false + ----------------------------- (E_WhileFalse) + st =[ while b do c end ]=> st + + beval st b = true + st =[ c ]=> st' + st' =[ while b do c end ]=> st'' + -------------------------------- (E_WhileTrue) + st =[ while b do c end ]=> st'' +*) + +(** Here is the formal definition. Make sure you understand + how it corresponds to the inference rules. *) + +Reserved Notation + "st0 '=[' c ']=>' st1" + (at level 40, c custom com at level 99, + st0 constr, st1 constr at next level, + format "'[hv' st0 =[ '/ ' '[' c ']' '/' ]=> st1 ']'"). + +Inductive ceval : com -> state -> state -> Prop := + | E_Skip : forall st, + st =[ skip ]=> st + | E_Asgn : forall st a n x, + aeval st a = n -> + st =[ x := a ]=> (x !-> n ; st) + | E_Seq : forall c1 c2 st st' st'', + st =[ c1 ]=> st' -> + st' =[ c2 ]=> st'' -> + st =[ c1 ; c2 ]=> st'' + | E_IfTrue : forall st st' b c1 c2, + beval st b = true -> + st =[ c1 ]=> st' -> + st =[ if b then c1 else c2 end]=> st' + | E_IfFalse : forall st st' b c1 c2, + beval st b = false -> + st =[ c2 ]=> st' -> + st =[ if b then c1 else c2 end]=> st' + | E_WhileFalse : forall b st c, + beval st b = false -> + st =[ while b do c end ]=> st + | E_WhileTrue : forall st st' st'' b c, + beval st b = true -> + st =[ c ]=> st' -> + st' =[ while b do c end ]=> st'' -> + st =[ while b do c end ]=> st'' + + where "st0 =[ c ]=> st1" := (ceval c st0 st1). + +(** The cost of defining evaluation as a relation instead of a + function is that we now need to construct a _proof_ that some + program evaluates to some result state, rather than just letting + Rocq's computation mechanism do it for us. *) + +Example ceval_example1: + empty_st =[ + X := 2; + if (X <= 1) + then Y := 3 + else Z := 4 + end + ]=> (Z !-> 4 ; X !-> 2). +Proof. + (* We must supply the intermediate state *) + apply E_Seq with (X !-> 2). + - (* assignment command *) + apply E_Asgn. reflexivity. + - (* if command *) + apply E_IfFalse. + + reflexivity. + + apply E_Asgn. reflexivity. +Qed. + +(** **** Exercise: 2 stars, standard (ceval_example2) *) +Example ceval_example2: + empty_st =[ + X := 0; + Y := 1; + Z := 2 + ]=> (Z !-> 2 ; Y !-> 1 ; X !-> 0). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +Set Printing Implicit. +Check @ceval_example2. + +(** **** Exercise: 3 stars, standard, optional (pup_to_n) + + Write an Imp program that sums the numbers from [1] to [X] + (inclusive: [1 + 2 + ... + X]) in the variable [Y]. Your program + should update the state as shown in theorem [pup_to_2_ceval], + which you can reverse-engineer to discover the program you should + write. The proof of that theorem will be somewhat lengthy. *) + +Definition pup_to_n : com + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem pup_to_2_ceval : + (X !-> 2) =[ + pup_to_n + ]=> (X !-> 0 ; Y !-> 3 ; X !-> 1 ; Y !-> 2 ; Y !-> 0 ; X !-> 2). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Determinism of Evaluation *) + +(** Changing from a computational to a relational definition of + evaluation is a good move because it frees us from the artificial + requirement that evaluation should be a total function. But it + also raises a question: Is the second definition of evaluation + really a partial _function_? Or is it possible that, beginning from + the same state [st], we could evaluate some command [c] in + different ways to reach two different output states [st'] and + [st'']? + + In fact, this cannot happen: [ceval] _is_ a partial function: *) + +Theorem ceval_deterministic: forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> st2 -> + st1 = st2. +Proof. + intros c st st1 st2 E1 E2. + generalize dependent st2. + induction E1; intros st2 E2; inversion E2; subst. + - (* E_Skip *) reflexivity. + - (* E_Asgn *) reflexivity. + - (* E_Seq *) + rewrite (IHE1_1 st'0 H1) in *. + apply IHE1_2. assumption. + - (* E_IfTrue, b evaluates to true *) + apply IHE1. assumption. + - (* E_IfTrue, b evaluates to false (contradiction) *) + rewrite H in H5. discriminate. + - (* E_IfFalse, b evaluates to true (contradiction) *) + rewrite H in H5. discriminate. + - (* E_IfFalse, b evaluates to false *) + apply IHE1. assumption. + - (* E_WhileFalse, b evaluates to false *) + reflexivity. + - (* E_WhileFalse, b evaluates to true (contradiction) *) + rewrite H in H2. discriminate. + - (* E_WhileTrue, b evaluates to false (contradiction) *) + rewrite H in H4. discriminate. + - (* E_WhileTrue, b evaluates to true *) + rewrite (IHE1_1 st'0 H3) in *. + apply IHE1_2. assumption. Qed. + +(* ################################################################# *) +(** * Reasoning About Imp Programs *) + +(** We'll get into more systematic and powerful techniques for + reasoning about Imp programs in _Programming Language + Foundations_, but we can already do a few things (albeit in a + somewhat low-level way) just by working with the bare definitions. + This section explores some examples. *) + +Theorem plus2_spec : forall st n st', + st X = n -> + st =[ plus2 ]=> st' -> + st' X = n + 2. +Proof. + intros st n st' HX Heval. + + (** Inverting [Heval] essentially forces Rocq to expand one step of + the [ceval] computation -- in this case revealing that [st'] + must be [st] extended with the new value of [X], since [plus2] + is an assignment. *) + + inversion Heval. subst. clear Heval. simpl. + apply t_update_eq. Qed. + +(** **** Exercise: 3 stars, standard, optional (XtimesYinZ_spec) + + State and prove a specification of [XtimesYinZ]. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_XtimesYinZ_spec : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 3 stars, standard, especially useful (loop_never_stops) *) +Theorem loop_never_stops : forall st st', + ~(st =[ loop ]=> st'). +Proof. + intros st st' contra. unfold loop in contra. + remember <{ while true do skip end }> as loopdef + eqn:Heqloopdef. + + (** Proceed by induction on the assumed derivation showing that + [loopdef] terminates. Most of the cases are immediately + contradictory and so can be solved in one step with + [discriminate]. *) + + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (no_whiles_eqv) + + Consider the following function: *) + +Fixpoint no_whiles (c : com) : bool := + match c with + | <{ skip }> => + true + | <{ _ := _ }> => + true + | <{ c1 ; c2 }> => + andb (no_whiles c1) (no_whiles c2) + | <{ if _ then ct else cf end }> => + andb (no_whiles ct) (no_whiles cf) + | <{ while _ do _ end }> => + false + end. + +(** This predicate yields [true] just on programs that have no while + loops. Using [Inductive], write a property [no_whilesR] such that + [no_whilesR c] is provable exactly when [c] is a program with no + while loops. Then prove its equivalence with [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. +(** [] *) + +(** **** Exercise: 4 stars, standard (no_whiles_terminating) + + Imp programs that don't involve while loops always terminate. + State and prove a theorem [no_whiles_terminating] that says this. + + Use either [no_whiles] or [no_whilesR], as you prefer. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_no_whiles_terminating : option (nat*string) := None. +(** [] *) + +(* ################################################################# *) +(** * Additional Exercises *) + +(** **** Exercise: 3 stars, standard (stack_compiler) + + Old HP Calculators, programming languages like Forth and Postscript, + and abstract machines like the Java Virtual Machine all evaluate + arithmetic expressions using a _stack_. For instance, the expression + + (2*3)+(3*(4-2)) + + would be written as + + 2 3 * 3 4 2 - * + + + and evaluated like this (where we show the program being evaluated + on the right and the contents of the stack on the left): + + [ ] | 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] | + + The goal of this exercise is to write a small compiler that + translates [aexp]s into stack machine instructions. + + The instruction set for our stack language will consist of the + following instructions: + - [SPush n]: Push the number [n] on the stack. + - [SLoad x]: Load the identifier [x] from the store and push it + on the stack + - [SPlus]: Pop the two top numbers from the stack, add them, and + push the result onto the stack. + - [SMinus]: Similar, but subtract the first number from the second. + - [SMult]: Similar, but multiply. *) + +Inductive sinstr : Type := +| SPush (n : nat) +| SLoad (x : string) +| SPlus +| SMinus +| SMult. + +(** Write a function to evaluate programs in the stack language. It + should take as input a state, a stack represented as a list of + numbers (top stack item is the head of the list), and a program + represented as a list of instructions, and it should return the + stack after executing the program. Test your function on the + examples below. + + Note that it is unspecified what to do when encountering an + [SPlus], [SMinus], or [SMult] instruction if the stack contains + fewer than two elements. In a sense, it is immaterial what we do, + since a correct compiler will never emit such a malformed program. + But for sake of later exercises, it would be best to skip the + offending instruction and continue with the next one. *) + +Fixpoint s_execute (st : state) (stack : list nat) + (prog : list sinstr) + : list nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Check s_execute. + +Example s_execute1 : + s_execute empty_st [] + [SPush 5; SPush 3; SPush 1; SMinus] + = [2; 5]. +(* FILL IN HERE *) Admitted. + +Example s_execute2 : + s_execute (X !-> 3) [3;4] + [SPush 4; SLoad X; SMult; SPlus] + = [15; 4]. +(* FILL IN HERE *) Admitted. + +(** Next, write a function that compiles an [aexp] into a stack + machine program. The effect of running the program should be the + same as pushing the value of the expression on the stack. *) + +Fixpoint s_compile (e : aexp) : list sinstr + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** After you've defined [s_compile], prove the following to test + that it works. *) + +Example s_compile1 : + s_compile <{ X - (2 * Y) }> + = [SLoad X; SPush 2; SLoad Y; SMult; SMinus]. +(* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (execute_app) *) + +(** Execution can be decomposed in the following sense: executing + stack program [p1 ++ p2] is the same as executing [p1], taking + the resulting stack, and executing [p2] from that stack. Prove + that fact. *) + +Theorem execute_app : forall st p1 p2 stack, + s_execute st stack (p1 ++ p2) = s_execute st (s_execute st stack p1) p2. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 3 stars, standard (stack_compiler_correct) *) + +(** Now we'll prove the correctness of the compiler implemented in the + previous exercise. Begin by proving the following lemma. If it + becomes difficult, consider whether your implementation of + [s_execute] or [s_compile] could be simplified. *) + +Lemma s_compile_correct_aux : forall st e stack, + s_execute st stack (s_compile e) = aeval st e :: stack. +Proof. + (* FILL IN HERE *) Admitted. + +(** The main theorem should be a very easy corollary of that lemma. *) + +Theorem s_compile_correct : forall (st : state) (e : aexp), + s_execute st [] (s_compile e) = [ aeval st e ]. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (short_circuit) + + Most modern programming languages use a "short-circuit" evaluation + rule for boolean [and]: to evaluate [BAnd b1 b2], first evaluate + [b1]. If it evaluates to [false], then the entire [BAnd] + expression evaluates to [false] immediately, without evaluating + [b2]. Otherwise, [b2] is evaluated to determine the result of the + [BAnd] expression. + + Write an alternate version of [beval] that performs short-circuit + evaluation of [BAnd] in this manner, and prove that it is + equivalent to [beval]. (N.b. This is only true because expression + evaluation in Imp is rather simple. In a bigger language where + evaluating an expression might diverge, the short-circuiting [BAnd] + would _not_ be equivalent to the original, since it would make more + programs terminate.) *) + +(* FILL IN HERE + + [] *) + +Module BreakImp. +(** **** Exercise: 4 stars, standard, optional (break_imp) + + Imperative languages like C and Java often include a [break] or + similar statement for interrupting the execution of loops. In this + exercise we consider how to add [break] to Imp. First, we need to + enrich the language of commands with an additional case. *) + +Inductive com : Type := + | CSkip + | CBreak (* <--- NEW *) + | CAsgn (x : string) (a : aexp) + | CSeq (c1 c2 : com) + | CIf (b : bexp) (c1 c2 : com) + | CWhile (b : bexp) (c : com). + +Notation "'break'" := CBreak (in custom com at level 0) : com_scope. +Notation "'skip'" := CSkip + (in custom com at level 0) : com_scope. +Notation "x := y" := (CAsgn x y) + (in custom com at level 0, x constr at level 0, y at level 85, no associativity, + format "x := y") : com_scope. +Notation "x ; y" := (CSeq x y) + (in custom com at level 90, + right associativity, + format "'[v' x ; '/' y ']'") : com_scope. +Notation "'if' x 'then' y 'else' z 'end'" := (CIf x y z) + (in custom com at level 89, x at level 99, y at level 99, z at level 99, + format "'[v' 'if' x 'then' '/ ' y '/' 'else' '/ ' z '/' 'end' ']'") : com_scope. +Notation "'while' x 'do' y 'end'" := (CWhile x y) + (in custom com at level 89, x at level 99, y at level 99, + format "'[v' 'while' x 'do' '/ ' y '/' 'end' ']'") : com_scope. + +(** Next, we need to define the behavior of [break]. Informally, + whenever [break] is executed in a sequence of commands, it stops + the execution of that sequence and signals that the innermost + enclosing loop should terminate. (If there aren't any + enclosing loops, then the whole program simply terminates.) The + final state should be the same as the one in which the [break] + statement was executed. + + One important point is what to do when there are multiple loops + enclosing a given [break]. In those cases, [break] should only + terminate the _innermost_ loop. Thus, after executing the + following... + + X := 0; + Y := 1; + while 0 <> Y do + while true do + break + end; + X := 1; + Y := Y - 1 + end + + ... the value of [X] should be [1], and not [0]. + + One way of expressing this behavior is to add another parameter to + the evaluation relation that specifies whether evaluation of a + command executes a [break] statement: *) + +Inductive result : Type := + | SContinue + | SBreak. + +Reserved Notation + "st0 '=[' c ']=>' st1 '/' s" + (at level 40, c custom com at level 99, + st0 constr, st1 constr at next level, + format "'[hv' st0 =[ '/ ' '[' c ']' '/' ]=> st1 / s ']'"). + +(** Intuitively, [st =[ c ]=> st' / s] means that, if [c] is started in + state [st], then it terminates in state [st'] and either signals + that the innermost surrounding loop (or the whole program) should + exit immediately ([s = SBreak]) or that execution should continue + normally ([s = SContinue]). + + The definition of the "[st =[ c ]=> st' / s]" relation is very + similar to the one we gave above for the regular evaluation + relation ([st =[ c ]=> st']) -- we just need to handle the + termination signals appropriately: + + - If the command is [skip], then the state doesn't change and + execution of any enclosing loop can continue normally. + + - If the command is [break], the state stays unchanged but we + signal a [SBreak]. + + - If the command is an assignment, then we update the binding for + that variable in the state accordingly and signal that execution + can continue normally. + + - If the command is of the form [if b then c1 else c2 end], then + the state is updated as in the original semantics of Imp, except + that we also propagate the signal from the execution of + whichever branch was taken. + + - If the command is a sequence [c1 ; c2], we first execute + [c1]. If this yields a [SBreak], we skip the execution of [c2] + and propagate the [SBreak] signal to the surrounding context; + the resulting state is the same as the one obtained by + executing [c1] alone. Otherwise, we execute [c2] on the state + obtained after executing [c1], and propagate the signal + generated there. + + - Finally, for a loop of the form [while b do c end], the + semantics is almost the same as before. The only difference is + that, when [b] evaluates to true, we execute [c] and check the + signal that it raises. If that signal is [SContinue], then the + execution proceeds as in the original semantics. Otherwise, we + stop the execution of the loop, and the resulting state is the + same as the one resulting from the execution of the current + iteration. In either case, since [break] only terminates the + innermost loop, [while] signals [SContinue]. *) + +(** Based on the above description, complete the definition of the + [ceval] relation. *) + +Inductive ceval : com -> state -> result -> state -> Prop := + | E_Skip : forall st, + st =[ CSkip ]=> st / SContinue + (* FILL IN HERE *) + + where "st '=[' c ']=>' st' '/' s" := (ceval c st s st'). + +(** Now prove the following properties of your definition of [ceval]: *) + +Theorem break_ignore : forall c st st' s, + st =[ break; c ]=> st' / s -> + st = st'. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem while_continue : forall b c st st' s, + st =[ while b do c end ]=> st' / s -> + s = SContinue. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem while_stops_on_break : forall b c st st', + beval st b = true -> + st =[ c ]=> st' / SBreak -> + st =[ while b do c end ]=> st' / SContinue. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem seq_continue : forall c1 c2 st st' st'', + st =[ c1 ]=> st' / SContinue -> + st' =[ c2 ]=> st'' / SContinue -> + st =[ c1 ; c2 ]=> st'' / SContinue. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem seq_stops_on_break : forall c1 c2 st st', + st =[ c1 ]=> st' / SBreak -> + st =[ c1 ; c2 ]=> st' / SBreak. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced, optional (while_break_true) *) +Theorem while_break_true : forall b c st st', + st =[ while b do c end ]=> st' / SContinue -> + beval st' b = true -> + exists st'', st'' =[ c ]=> st' / SBreak. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 4 stars, advanced, optional (ceval_deterministic) *) +Theorem ceval_deterministic: forall (c:com) st st1 st2 s1 s2, + st =[ c ]=> st1 / s1 -> + st =[ c ]=> st2 / s2 -> + st1 = st2 /\ s1 = s2. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) +End BreakImp. + +(** **** Exercise: 4 stars, standard, optional (add_for_loop) + + Add C-style [for] loops to the language of commands, update the + [ceval] definition to define the semantics of [for] loops, and add + cases for [for] loops as needed so that all the proofs in this + file are accepted by Rocq. + + A [for] loop should be parameterized by (a) a statement executed + initially, (b) a test that is run on each iteration of the loop to + determine whether the loop should continue, (c) a statement + executed at the end of each loop iteration, and (d) a statement + that makes up the body of the loop. (You don't need to worry + about making up a concrete Notation for [for] loops, but feel free + to play with this too if you like.) *) + +(* FILL IN HERE + + [] *) + +(* 2026-01-07 13:18 *) diff --git a/ImpCEvalFun.v b/ImpCEvalFun.v new file mode 100644 index 0000000..b44bbfa --- /dev/null +++ b/ImpCEvalFun.v @@ -0,0 +1,398 @@ +(** * ImpCEvalFun: An Evaluation Function for Imp *) + +(** We saw in the [Imp] chapter how a naive approach to defining a + function representing evaluation for Imp runs into difficulties. + There, we adopted the solution of changing from a functional to a + relational definition of evaluation. In this optional chapter, we + consider strategies for getting the functional approach to + work. *) + +(* ################################################################# *) +(** * A Broken Evaluator *) + +Set Warnings "-notation-overridden,-notation-incompatible-prefix". +From Stdlib Require Import Lia. +From Stdlib Require Import Arith. +From Stdlib Require Import PeanoNat. +Import Nat. +From Stdlib Require Import EqNat. +From LF Require Import Imp Maps. +Local Open Scope com_scope. + +(** Here was our first try at an evaluation function for commands, + omitting [while]. *) + +Fixpoint ceval_step1 (st : state) (c : com) : state := + match c with + | <{ skip }> => + st + | <{ l := a1 }> => + (l !-> aeval st a1 ; st) + | <{ c1 ; c2 }> => + let st' := ceval_step1 st c1 in + ceval_step1 st' c2 + | <{ if b then c1 else c2 end }> => + if (beval st b) + then ceval_step1 st c1 + else ceval_step1 st c2 + | <{ while b1 do c1 end }> => + st (* bogus *) + end. + +(** As we remarked in chapter [Imp], in a traditional functional + programming language like ML or Haskell we could write the while + case as follows: + + | while b1 do c1 end => + if (beval st b1) then + ceval_step1 st <{ c1; while b1 do c1 end }> + else st + + Rocq doesn't accept such a definition ([Error: Cannot guess + decreasing argument of fix]) because the function we want to + define is not guaranteed to terminate. Indeed, the changed + [ceval_step1] function applied to the [loop] program from [Imp.v] + would never terminate. Since Rocq is not just a functional + programming language, but also a consistent logic, any potentially + non-terminating function needs to be rejected. Here is an + invalid(!) Rocq program showing what would go wrong if Rocq allowed + non-terminating recursive functions: + + Fixpoint loop_false (n : nat) : False := loop_false n. + + That is, propositions like [False] would become + provable (e.g., [loop_false 0] would be a proof of [False]), which + would be a disaster for Rocq's logical consistency. + + Thus, because it doesn't terminate on all inputs, the full version + of [ceval_step1] cannot be written in Rocq -- at least not without + one additional trick... *) + +(* ################################################################# *) +(** * A Step-Indexed Evaluator *) + +(** The trick we need is to pass an _additional_ parameter to the + evaluation function that tells it how long to run. Informally, we + start the evaluator with a certain amount of "gas" in its tank, + and we allow it to run until either it terminates in the usual way + _or_ it runs out of gas, at which point we simply stop evaluating + and say that the final result is the empty memory. (We could also + say that the result is the current state at the point where the + evaluator runs out of gas -- it doesn't really matter because the + result is going to be wrong in either case!) *) + +Fixpoint ceval_step2 (st : state) (c : com) (i : nat) : state := + match i with + | O => empty_st + | S i' => + match c with + | <{ skip }> => + st + | <{ l := a1 }> => + (l !-> aeval st a1 ; st) + | <{ c1 ; c2 }> => + let st' := ceval_step2 st c1 i' in + ceval_step2 st' c2 i' + | <{ if b then c1 else c2 end }> => + 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. + +(** _Note_: It is tempting to think that the index [i] here is + counting the "number of steps of evaluation." But if you look + closely you'll see that this is not the case: for example, in the + rule for sequencing, the same [i] is passed to both recursive + calls. Understanding the exact way that [i] is treated will be + important in the proof of [ceval__ceval_step], which is given as + an exercise below. + + One thing that is not so nice about this evaluator is that we + can't tell, from its result, whether it stopped because the + program terminated normally or because it ran out of gas. Our + next version returns an [option state] instead of just a [state], + so that we can distinguish between normal and abnormal + termination. *) + +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 (l !-> aeval st a1 ; st) + | <{ c1 ; c2 }> => + match (ceval_step3 st c1 i') with + | Some st' => ceval_step3 st' c2 i' + | None => None + end + | <{ if b then c1 else c2 end }> => + 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. + +(** We can improve the readability of this version by introducing a + bit of auxiliary notation to hide the plumbing involved in + repeatedly matching against optional states. *) + +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 (l !-> aeval st a1 ; st) + | <{ c1 ; c2 }> => + LETOPT st' <== ceval_step st c1 i' IN + ceval_step st' c2 i' + | <{ if b then c1 else c2 end }> => + 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. + +Example example_test_ceval : + test_ceval empty_st + + <{ X := 2; + if (X <= 1) + then Y := 3 + else Z := 4 + end }> + + = Some (2, 0, 4). +Proof. reflexivity. Qed. + +(** **** Exercise: 1 star, standard, optional (pup_to_n) + + Write an Imp program that sums the numbers from [1] to + [X] (inclusive -- i.e., [1 + 2 + ... + X]) in the variable [Y]. Make + sure your solution satisfies the test that follows. *) + +Definition pup_to_n : com + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example pup_to_n_1 : + test_ceval (X !-> 5) pup_to_n + = Some (0, 15, 0). +(* FILL IN HERE *) Admitted. +(* +Proof. reflexivity. Qed. +*) +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (peven) + + Write an [Imp] program that sets [Z] to [0] if [X] is even and + sets [Z] to [1] otherwise. Use [test_ceval] to test your + program. *) + +(* FILL IN HERE + + [] *) + +(* ################################################################# *) +(** * Relational vs. Step-Indexed Evaluation *) + +(** As for arithmetic and boolean expressions, we'd hope that + the two alternative definitions of evaluation would actually + amount to the same thing in the end. This section shows that this + is the case. *) + +Theorem ceval_step__ceval: forall c st st', + (exists i, ceval_step st c i = Some st') -> + st =[ c ]=> 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' ]. + + - (* i = 0 -- contradictory *) + intros c st st' H. discriminate H. + + - (* i = S i' *) + intros c st st' H. + destruct c; + simpl in H; inversion H; subst; clear H. + + (* skip *) apply E_Skip. + + (* := *) apply E_Asgn. reflexivity. + + + (* ; *) + destruct (ceval_step st c1 i') eqn:Heqr1. + * (* Evaluation of r1 terminates normally *) + apply E_Seq with s. + apply IHi'. rewrite Heqr1. reflexivity. + apply IHi'. assumption. + * (* Otherwise -- contradiction *) + discriminate H1. + + + (* if *) + destruct (beval st b) eqn:Heqr. + * (* r = true *) + apply E_IfTrue. rewrite Heqr. reflexivity. + apply IHi'. assumption. + * (* r = false *) + apply E_IfFalse. rewrite Heqr. reflexivity. + apply IHi'. assumption. + + + (* while *) destruct (beval st b) eqn :Heqr. + * (* r = true *) + destruct (ceval_step st c i') eqn:Heqr1. + { (* r1 = Some s *) + apply E_WhileTrue with s. rewrite Heqr. + reflexivity. + apply IHi'. rewrite Heqr1. reflexivity. + apply IHi'. assumption. } + { (* r1 = None *) discriminate H1. } + * (* r = false *) + injection H1 as H2. rewrite <- H2. + apply E_WhileFalse. apply Heqr. Qed. + +(** **** Exercise: 4 stars, advanced (ceval_step__ceval_inf) + + Write an informal proof of [ceval_step__ceval], following the + usual template. (The template for case analysis on an inductively + defined value should look the same as for induction, except that + there is no induction hypothesis.) Make your proof communicate + the main ideas to a human reader; do not simply transcribe the + steps of the formal proof. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_ceval_step__ceval_inf : option (nat*string) := None. +(** [] *) + +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. + - (* i1 = 0 *) + simpl in Hceval. discriminate Hceval. + - (* i1 = S i1' *) + destruct i2 as [|i2']. inversion Hle. + assert (Hle': i1' <= i2') by lia. + destruct c. + + (* skip *) + simpl in Hceval. inversion Hceval. + reflexivity. + + (* := *) + simpl in Hceval. inversion Hceval. + reflexivity. + + (* ; *) + simpl in Hceval. simpl. + destruct (ceval_step st c1 i1') eqn:Heqst1'o. + * (* st1'o = Some *) + apply (IHi1' i2') in Heqst1'o; try assumption. + rewrite Heqst1'o. simpl. simpl in Hceval. + apply (IHi1' i2') in Hceval; try assumption. + * (* st1'o = None *) + discriminate Hceval. + + + (* if *) + simpl in Hceval. simpl. + destruct (beval st b); apply (IHi1' i2') in Hceval; + assumption. + + + (* while *) + simpl in Hceval. simpl. + destruct (beval st b); try assumption. + destruct (ceval_step st c i1') eqn: Heqst1'o. + * (* st1'o = Some *) + apply (IHi1' i2') in Heqst1'o; try assumption. + rewrite -> Heqst1'o. simpl. simpl in Hceval. + apply (IHi1' i2') in Hceval; try assumption. + * (* i1'o = None *) + simpl in Hceval. discriminate Hceval. Qed. + +(** **** Exercise: 3 stars, standard, especially useful (ceval__ceval_step) + + Finish the following proof. You'll need [ceval_step_more] in a + few places, as well as some basic facts about [<=] and [plus]. *) + +Theorem ceval__ceval_step: forall c st st', + st =[ c ]=> st' -> + exists i, ceval_step st c i = Some st'. +Proof. + intros c st st' Hce. + induction Hce. + (* FILL IN HERE *) Admitted. +(** [] *) + +Theorem ceval_and_ceval_step_coincide: forall c st st', + st =[ c ]=> 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. + +(* ################################################################# *) +(** * Determinism of Evaluation Again *) + +(** Using the fact that the relational and step-indexed definition of + evaluation are the same, we can give a slicker proof that the + evaluation _relation_ is deterministic. *) + +Theorem ceval_deterministic' : forall c st st1 st2, + st =[ c ]=> st1 -> + st =[ c ]=> 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. + lia. lia. Qed. + +(* 2026-01-07 13:18 *) diff --git a/ImpCEvalFunTest.v b/ImpCEvalFunTest.v new file mode 100644 index 0000000..6801615 --- /dev/null +++ b/ImpCEvalFunTest.v @@ -0,0 +1,97 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import ImpCEvalFun. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import ImpCEvalFun. +Import Check. + +Goal True. + +idtac "------------------- ceval_step__ceval_inf --------------------". +idtac " ". + +idtac "#> Manually graded: ceval_step__ceval_inf". +idtac "Advanced". +idtac "Possible points: 6". +print_manual_grade manual_grade_for_ceval_step__ceval_inf. +idtac " ". + +idtac "------------------- ceval__ceval_step --------------------". +idtac " ". + +idtac "#> ceval__ceval_step". +idtac "Possible points: 3". +check_type @ceval__ceval_step ( +(forall (c : Imp.com) (st st' : Imp.state) (_ : Imp.ceval c st st'), + @ex nat + (fun i : nat => + @eq (option Imp.state) (ceval_step st c i) (@Some Imp.state st')))). +idtac "Assumptions:". +Abort. +Print Assumptions ceval__ceval_step. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 3". +idtac "Max points - advanced: 9". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- ceval__ceval_step ---------". +Print Assumptions ceval__ceval_step. +idtac "". +idtac "********** Advanced **********". +idtac "---------- ceval_step__ceval_inf ---------". +idtac "MANUAL". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/ImpParser.v b/ImpParser.v new file mode 100644 index 0000000..8b5eab9 --- /dev/null +++ b/ImpParser.v @@ -0,0 +1,466 @@ +(** * ImpParser: Lexing and Parsing in Rocq *) + +(** The development of the Imp language in [Imp.v] completely ignores + issues of concrete syntax -- how an ascii string that a programmer + might write gets translated into abstract syntax trees defined by + the datatypes [aexp], [bexp], and [com]. In this chapter, we + illustrate how the rest of the story can be filled in by building + a simple lexical analyzer and parser using Rocq's functional + programming facilities. *) + +(** It is not important to understand all the details here (and + accordingly, the explanations are fairly terse and there are no + exercises). The main point is simply to demonstrate that it can + be done. You are invited to look through the code -- most of it + is not very complicated, though the parser relies on some + "monadic" programming idioms that may require a little work to + make out -- but most readers will probably want to just skim down + to the Examples section at the very end to get the punchline. *) + +Set Warnings "-notation-overridden,-notation-incompatible-prefix". +From Stdlib Require Import Strings.String. +From Stdlib Require Import Strings.Ascii. +From Stdlib Require Import Arith. +From Stdlib Require Import Init.Nat. +From Stdlib Require Import EqNat. +From Stdlib Require Import List. Import ListNotations. +From LF Require Import Maps Imp. +Local Open Scope com_scope. + +(* ################################################################# *) +(** * Internals *) + +(* ================================================================= *) +(** ** Lexical Analysis *) + +Definition isWhite (c : ascii) : bool := + let n := nat_of_ascii c in + orb (orb (n =? 32) (* space *) + (n =? 9)) (* tab *) + (orb (n =? 10) (* linefeed *) + (n =? 13)). (* Carriage return. *) + +Notation "x '<=?' y" := (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. + +Definition 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. + +(* ================================================================= *) +(** ** Parsing *) + +(* ----------------------------------------------------------------- *) +(** *** Options With Errors *) + +(** An [option] type with error messages: *) + +Inductive optionE (X:Type) : Type := + | SomeE (x : X) + | NoneE (s : string). + +Arguments SomeE {X}. +Arguments NoneE {X}. + +(** Some syntactic sugar to make writing nested match-expressions on + optionE more convenient. *) + +Notation "' p <- e1 ;; e2" + := (match e1 with + | SomeE p => e2 + | NoneE err => NoneE err + end) + (right associativity, p pattern, at level 60, e1 at next level). + +Notation "'TRY' e1 'OR' e2" + := ( + let result := e1 in + match result with + | SomeE _ => result + | NoneE _ => e2 + end) + (right associativity, + at level 60, e1 at next level, e2 at next level). + +(* ----------------------------------------------------------------- *) +(** *** Generic Combinators for Building Parsers *) + +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. + +(** A (step-indexed) parser that expects zero or more [p]s: *) + +Definition many {T} (p : parser T) (steps : nat) : parser (list T) := + many_helper p [] steps. + +(** A parser that expects a given token, followed by [p]: *) + +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. + +(** A parser that expects a particular token: *) + +Definition expect (t : token) : parser unit := + firstExpect t (fun xs => SomeE (tt, xs)). + +(* ----------------------------------------------------------------- *) +(** *** A Recursive-Descent Parser for Imp *) + +(** Identifiers: *) + +Definition parseIdentifier (xs : list token) + : optionE (string * list token) := +match xs with +| [] => NoneE "Expected identifier" +| x::xs' => + if forallb isLowerAlpha (list_of_string x) then + SomeE (x, xs') + else + NoneE ("Illegal identifier:'" ++ x ++ "'") +end. + +(** Numbers: *) + +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. + +(** Parse arithmetic expressions *) + +Fixpoint parsePrimaryExp (steps:nat) + (xs : list token) + : optionE (aexp * list token) := + match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + TRY ' (i, rest) <- parseIdentifier xs ;; + SomeE (AId i, rest) + OR + TRY ' (n, rest) <- parseNumber xs ;; + SomeE (ANum n, rest) + OR + ' (e, rest) <- firstExpect "(" (parseSumExp steps') xs ;; + ' (u, rest') <- expect ")" rest ;; + SomeE (e,rest') + end + +with parseProductExp (steps:nat) + (xs : list token) := + match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + ' (e, rest) <- parsePrimaryExp steps' xs ;; + ' (es, rest') <- many (firstExpect "*" (parsePrimaryExp steps')) + steps' rest ;; + SomeE (fold_left AMult es e, rest') + end + +with parseSumExp (steps:nat) (xs : list token) := + match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + ' (e, rest) <- parseProductExp steps' xs ;; + ' (es, rest') <- + many (fun xs => + TRY ' (e,rest') <- + firstExpect "+" + (parseProductExp steps') xs ;; + SomeE ( (true, e), rest') + OR + ' (e, rest') <- + firstExpect "-" + (parseProductExp steps') 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. + +(** Parsing boolean expressions: *) + +Fixpoint parseAtomicExp (steps:nat) + (xs : list token) := +match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + TRY ' (u,rest) <- expect "true" xs ;; + SomeE (BTrue,rest) + OR + TRY ' (u,rest) <- expect "false" xs ;; + SomeE (BFalse,rest) + OR + TRY ' (e,rest) <- firstExpect "~" + (parseAtomicExp steps') + xs ;; + SomeE (BNot e, rest) + OR + TRY ' (e,rest) <- firstExpect "(" + (parseConjunctionExp steps') + xs ;; + ' (u,rest') <- expect ")" rest ;; + SomeE (e, rest') + OR + ' (e, rest) <- parseProductExp steps' xs ;; + TRY ' (e', rest') <- firstExpect "=" + (parseAExp steps') rest ;; + SomeE (BEq e e', rest') + OR + TRY ' (e', rest') <- firstExpect "<=" + (parseAExp steps') rest ;; + SomeE (BLe e e', rest') + OR + NoneE "Expected '=' or '<=' after arithmetic expression" +end + +with parseConjunctionExp (steps:nat) + (xs : list token) := + match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + ' (e, rest) <- parseAtomicExp steps' xs ;; + ' (es, rest') <- many (firstExpect "&&" + (parseAtomicExp steps')) + steps' rest ;; + SomeE (fold_left BAnd es e, rest') + end. + +Definition parseBExp := parseConjunctionExp. + +Check parseConjunctionExp. + +Definition testParsing {X : Type} + (p : nat -> + list token -> + optionE (X * list token)) + (s : string) := + let t := tokenize s in + p 100 t. + +(* +Eval compute in + testParsing parseProductExp "x.y.(x.x).x". + +Eval compute in + testParsing parseConjunctionExp "~(x=x&&x*x<=(x*x)*x)&&x=x". +*) + +(** Parsing commands: *) + +Fixpoint parseSimpleCommand (steps:nat) + (xs : list token) := + match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + TRY ' (u, rest) <- expect "skip" xs ;; + SomeE (<{skip}>, rest) + OR + TRY ' (e,rest) <- + firstExpect "if" + (parseBExp steps') xs ;; + ' (c,rest') <- + firstExpect "then" + (parseSequencedCommand steps') rest ;; + ' (c',rest'') <- + firstExpect "else" + (parseSequencedCommand steps') rest' ;; + ' (tt,rest''') <- + expect "end" rest'' ;; + SomeE(<{if e then c else c' end}>, rest''') + OR + TRY ' (e,rest) <- + firstExpect "while" + (parseBExp steps') xs ;; + ' (c,rest') <- + firstExpect "do" + (parseSequencedCommand steps') rest ;; + ' (u,rest'') <- + expect "end" rest' ;; + SomeE(<{while e do c end}>, rest'') + OR + TRY ' (i, rest) <- parseIdentifier xs ;; + ' (e, rest') <- firstExpect ":=" (parseAExp steps') rest ;; + SomeE (<{i := e}>, rest') + OR + NoneE "Expecting a command" +end + +with parseSequencedCommand (steps:nat) + (xs : list token) := + match steps with + | 0 => NoneE "Too many recursive calls" + | S steps' => + ' (c, rest) <- parseSimpleCommand steps' xs ;; + TRY ' (c', rest') <- + firstExpect ";" + (parseSequencedCommand steps') rest ;; + SomeE (<{c ; c'}>, rest') + OR + SomeE (c, rest) + end. + +Definition bignumber := 1000. + +Definition parse (str : string) : optionE com := + let tokens := tokenize str in + match parseSequencedCommand bignumber tokens with + | SomeE (c, []) => SomeE c + | SomeE (_, t::_) => NoneE ("Trailing tokens remaining: " ++ t) + | NoneE err => NoneE err + end. + +(* ################################################################# *) +(** * Examples *) + +Example eg1 : parse " + if x = y + 1 + 2 - y * 6 + 3 then + x := x * 1; + y := 0 + else + skip + end " += + SomeE <{ + if ("x" = ("y" + 1 + 2 - "y" * 6 + 3)) then + "x" := "x" * 1; + "y" := 0 + else + skip + end }>. +Proof. cbv. reflexivity. Qed. + +Example eg2 : parse " + skip; + z:=x*y*(x*x); + while x=x do + if (z <= z*z) && ~(x = 2) then + x := z; + y := z + else + skip + end; + skip + end; + x:=z " += + SomeE <{ + skip; + "z" := "x" * "y" * ("x" * "x"); + while ("x" = "x") do + if ("z" <= "z" * "z") && ~("x" = 2) then + "x" := "z"; + "y" := "z" + else + skip + end; + skip + end; + "x" := "z" }>. +Proof. cbv. reflexivity. Qed. + +(* 2026-01-07 13:18 *) diff --git a/ImpParserTest.v b/ImpParserTest.v new file mode 100644 index 0000000..254f8ef --- /dev/null +++ b/ImpParserTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import ImpParser. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import ImpParser. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/ImpTest.v b/ImpTest.v new file mode 100644 index 0000000..82a5f38 --- /dev/null +++ b/ImpTest.v @@ -0,0 +1,292 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Imp. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Imp. +Import Check. + +Goal True. + +idtac "------------------- optimize_0plus_b_sound --------------------". +idtac " ". + +idtac "#> AExp.optimize_0plus_b_test1". +idtac "Possible points: 0.5". +check_type @AExp.optimize_0plus_b_test1 ( +(@eq AExp.bexp + (AExp.optimize_0plus_b + (AExp.BNot + (AExp.BGt (AExp.APlus (AExp.ANum 0) (AExp.ANum 4)) (AExp.ANum 8)))) + (AExp.BNot (AExp.BGt (AExp.ANum 4) (AExp.ANum 8))))). +idtac "Assumptions:". +Abort. +Print Assumptions AExp.optimize_0plus_b_test1. +Goal True. +idtac " ". + +idtac "#> AExp.optimize_0plus_b_test2". +idtac "Possible points: 0.5". +check_type @AExp.optimize_0plus_b_test2 ( +(@eq AExp.bexp + (AExp.optimize_0plus_b + (AExp.BAnd + (AExp.BLe (AExp.APlus (AExp.ANum 0) (AExp.ANum 4)) (AExp.ANum 5)) + AExp.BTrue)) + (AExp.BAnd (AExp.BLe (AExp.ANum 4) (AExp.ANum 5)) AExp.BTrue))). +idtac "Assumptions:". +Abort. +Print Assumptions AExp.optimize_0plus_b_test2. +Goal True. +idtac " ". + +idtac "#> AExp.optimize_0plus_b_sound". +idtac "Possible points: 2". +check_type @AExp.optimize_0plus_b_sound ( +(forall b : AExp.bexp, + @eq bool (AExp.beval (AExp.optimize_0plus_b b)) (AExp.beval b))). +idtac "Assumptions:". +Abort. +Print Assumptions AExp.optimize_0plus_b_sound. +Goal True. +idtac " ". + +idtac "------------------- bevalR --------------------". +idtac " ". + +idtac "#> AExp.bevalR_iff_beval". +idtac "Possible points: 3". +check_type @AExp.bevalR_iff_beval ( +(forall (b : AExp.bexp) (bv : bool), + iff (AExp.bevalR b bv) (@eq bool (AExp.beval b) bv))). +idtac "Assumptions:". +Abort. +Print Assumptions AExp.bevalR_iff_beval. +Goal True. +idtac " ". + +idtac "------------------- ceval_example2 --------------------". +idtac " ". + +idtac "#> ceval_example2". +idtac "Possible points: 2". +check_type @ceval_example2 ( +(ceval (CSeq (CAsgn X (ANum 0)) (CSeq (CAsgn Y (ANum 1)) (CAsgn Z (ANum 2)))) + empty_st + (@Maps.t_update nat + (@Maps.t_update nat (@Maps.t_update nat empty_st X 0) Y 1) Z 2))). +idtac "Assumptions:". +Abort. +Print Assumptions ceval_example2. +Goal True. +idtac " ". + +idtac "------------------- loop_never_stops --------------------". +idtac " ". + +idtac "#> loop_never_stops". +idtac "Possible points: 3". +check_type @loop_never_stops ((forall st st' : state, not (ceval loop st st'))). +idtac "Assumptions:". +Abort. +Print Assumptions loop_never_stops. +Goal True. +idtac " ". + +idtac "------------------- no_whiles_eqv --------------------". +idtac " ". + +idtac "#> no_whiles_eqv". +idtac "Possible points: 3". +check_type @no_whiles_eqv ( +(forall c : com, iff (@eq bool (no_whiles c) true) (no_whilesR c))). +idtac "Assumptions:". +Abort. +Print Assumptions no_whiles_eqv. +Goal True. +idtac " ". + +idtac "------------------- no_whiles_terminating --------------------". +idtac " ". + +idtac "#> Manually graded: no_whiles_terminating". +idtac "Possible points: 6". +print_manual_grade manual_grade_for_no_whiles_terminating. +idtac " ". + +idtac "------------------- stack_compiler --------------------". +idtac " ". + +idtac "#> s_execute1". +idtac "Possible points: 1". +check_type @s_execute1 ( +(@eq (list nat) + (s_execute empty_st (@nil nat) + (@cons sinstr (SPush 5) + (@cons sinstr (SPush 3) + (@cons sinstr (SPush 1) (@cons sinstr SMinus (@nil sinstr)))))) + (@cons nat 2 (@cons nat 5 (@nil nat))))). +idtac "Assumptions:". +Abort. +Print Assumptions s_execute1. +Goal True. +idtac " ". + +idtac "#> s_execute2". +idtac "Possible points: 0.5". +check_type @s_execute2 ( +(@eq (list nat) + (s_execute (@Maps.t_update nat empty_st X 3) + (@cons nat 3 (@cons nat 4 (@nil nat))) + (@cons sinstr (SPush 4) + (@cons sinstr (SLoad X) + (@cons sinstr SMult (@cons sinstr SPlus (@nil sinstr)))))) + (@cons nat 15 (@cons nat 4 (@nil nat))))). +idtac "Assumptions:". +Abort. +Print Assumptions s_execute2. +Goal True. +idtac " ". + +idtac "#> s_compile1". +idtac "Possible points: 1.5". +check_type @s_compile1 ( +(@eq (list sinstr) (s_compile (AMinus (AId X) (AMult (ANum 2) (AId Y)))) + (@cons sinstr (SLoad X) + (@cons sinstr (SPush 2) + (@cons sinstr (SLoad Y) + (@cons sinstr SMult (@cons sinstr SMinus (@nil sinstr)))))))). +idtac "Assumptions:". +Abort. +Print Assumptions s_compile1. +Goal True. +idtac " ". + +idtac "------------------- execute_app --------------------". +idtac " ". + +idtac "#> execute_app". +idtac "Possible points: 3". +check_type @execute_app ( +(forall (st : state) (p1 p2 : list sinstr) (stack : list nat), + @eq (list nat) (s_execute st stack (@app sinstr p1 p2)) + (s_execute st (s_execute st stack p1) p2))). +idtac "Assumptions:". +Abort. +Print Assumptions execute_app. +Goal True. +idtac " ". + +idtac "------------------- stack_compiler_correct --------------------". +idtac " ". + +idtac "#> s_compile_correct_aux". +idtac "Possible points: 2.5". +check_type @s_compile_correct_aux ( +(forall (st : state) (e : aexp) (stack : list nat), + @eq (list nat) (s_execute st stack (s_compile e)) + (@cons nat (aeval st e) stack))). +idtac "Assumptions:". +Abort. +Print Assumptions s_compile_correct_aux. +Goal True. +idtac " ". + +idtac "#> s_compile_correct". +idtac "Possible points: 0.5". +check_type @s_compile_correct ( +(forall (st : state) (e : aexp), + @eq (list nat) (s_execute st (@nil nat) (s_compile e)) + (@cons nat (aeval st e) (@nil nat)))). +idtac "Assumptions:". +Abort. +Print Assumptions s_compile_correct. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 29". +idtac "Max points - advanced: 29". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- AExp.optimize_0plus_b_test1 ---------". +Print Assumptions AExp.optimize_0plus_b_test1. +idtac "---------- AExp.optimize_0plus_b_test2 ---------". +Print Assumptions AExp.optimize_0plus_b_test2. +idtac "---------- AExp.optimize_0plus_b_sound ---------". +Print Assumptions AExp.optimize_0plus_b_sound. +idtac "---------- AExp.bevalR_iff_beval ---------". +Print Assumptions AExp.bevalR_iff_beval. +idtac "---------- ceval_example2 ---------". +Print Assumptions ceval_example2. +idtac "---------- loop_never_stops ---------". +Print Assumptions loop_never_stops. +idtac "---------- no_whiles_eqv ---------". +Print Assumptions no_whiles_eqv. +idtac "---------- no_whiles_terminating ---------". +idtac "MANUAL". +idtac "---------- s_execute1 ---------". +Print Assumptions s_execute1. +idtac "---------- s_execute2 ---------". +Print Assumptions s_execute2. +idtac "---------- s_compile1 ---------". +Print Assumptions s_compile1. +idtac "---------- execute_app ---------". +Print Assumptions execute_app. +idtac "---------- s_compile_correct_aux ---------". +Print Assumptions s_compile_correct_aux. +idtac "---------- s_compile_correct ---------". +Print Assumptions s_compile_correct. +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/IndPrinciples.v b/IndPrinciples.v new file mode 100644 index 0000000..18866dc --- /dev/null +++ b/IndPrinciples.v @@ -0,0 +1,966 @@ +(** * IndPrinciples: Induction Principles *) + +(** Every time we declare a new [Inductive] datatype, Rocq + automatically generates an _induction principle_ for this type. + This induction principle is a theorem like any other: If [t] is + defined inductively, the corresponding induction principle is + called [t_ind]. *) + +Set Warnings "-notation-overridden". +From LF Require Export ProofObjects. + +(* ################################################################# *) +(** * Basics *) + +(** Here is the induction principle for natural numbers: *) + +Check nat_ind : + forall P : nat -> Prop, + P 0 -> + (forall n : nat, P n -> P (S n)) -> + forall n : nat, P n. + +(** In English: Suppose [P] is a property of natural numbers (that is, + [P n] is a [Prop] for every [n]). To show that [P n] holds of all + [n], it suffices to show: + + - [P] holds of [0] + - for any [n], if [P] holds of [n], then [P] holds of [S n]. *) + +(** The [induction] tactic is a straightforward wrapper that, at its + core, simply performs [apply t_ind]. To see this more clearly, + let's experiment with directly using [apply nat_ind], instead of + the [induction] tactic, to carry out some proofs. Here, for + example, is an alternate proof of a theorem that we saw in the + [Induction] chapter. *) + +Theorem mul_0_r' : forall n:nat, + n * 0 = 0. +Proof. + apply nat_ind. + - (* n = O *) reflexivity. + - (* n = S n' *) simpl. intros n' IHn'. rewrite -> IHn'. + reflexivity. Qed. + +(** This proof is basically the same as the earlier one, but a + few minor differences are worth noting. + + First, in the induction step of the proof (the [S] case), we + have to do a little bookkeeping manually (the [intros]) that + [induction] does automatically. + + Second, we do not introduce [n] into the context before applying + [nat_ind] -- the conclusion of [nat_ind] is a quantified formula, + and [apply] needs this conclusion to exactly match the shape of + the goal state, including the quantifier. By contrast, the + [induction] tactic works either with a variable in the context or + a quantified variable in the goal. + + Third, we had to manually supply the name of the induction principle + with [apply], but [induction] figures that out itself. + + These conveniences make [induction] nicer to use in practice than + applying induction principles like [nat_ind] directly. But it is + important to realize that, modulo these bits of bookkeeping, + applying [nat_ind] is what we are really doing. *) + +(** **** Exercise: 2 stars, standard (plus_one_r') + + Complete this proof without using the [induction] tactic. *) + +Theorem plus_one_r' : forall n:nat, + n + 1 = S n. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Rocq generates induction principles for every datatype + defined with [Inductive], including those that aren't recursive. + Although of course we don't need the proof technique of induction + to prove properties of non-recursive datatypes, the idea of an + induction principle still makes sense for them: it gives a way to + prove that a property holds for all values of the type. *) + +(** These generated principles follow a similar pattern. If we + define a type [t] with constructors [c1] ... [cn], Rocq generates a + theorem with this shape: + + t_ind : forall P : t -> Prop, + ... case for c1 ... -> + ... case for c2 ... -> ... + ... case for cn ... -> + forall n : t, P n + + The specific shape of each case depends on the arguments to the + corresponding constructor. *) + +(** Before trying to write down a general rule, let's look at + some more examples. First, an example where the constructors take + no arguments: *) + +Inductive time : Type := + | day + | night. + +Check time_ind : + forall P : time -> Prop, + P day -> + P night -> + forall t : time, P t. + +(** **** Exercise: 1 star, standard, optional (rgb) + + Write out the induction principle that Rocq will generate for the + following datatype. Write down your answer on paper or type it + into a comment, and then compare it with what Rocq prints. *) + +Inductive rgb : Type := + | red + | green + | blue. +Check rgb_ind. +(** [] *) + +(** Here's another example, this time with one of the constructors + taking some arguments. *) + +Inductive natlist : Type := + | nnil + | ncons (n : nat) (l : natlist). + +Check natlist_ind : + forall P : natlist -> Prop, + P nnil -> + (forall (n : nat) (l : natlist), + P l -> P (ncons n l)) -> + forall l : natlist, P l. + +(** In general, the automatically generated induction principle for + inductive type [t] is formed as follows: + + - Each constructor [c] generates one case of the principle. + - If [c] takes no arguments, that case is: + + "P holds of c" + + - If [c] takes arguments [x1:a1] ... [xn:an], that case is: + + "For all x1:a1 ... xn:an, + if [P] holds of each of the arguments of type [t], + then [P] holds of [c x1 ... xn]" + + But that oversimplifies a little. An assumption about [P] + holding of an argument [x] of type [t] actually occurs + immediately after the quantification of [x]. +*) + +(** For example, suppose we had written the definition of [natlist] a little + differently: *) + +Inductive natlist' : Type := + | nnil' + | nsnoc (l : natlist') (n : nat). + +(** Now the induction principle case for [nsnoc] is a bit different + than the earlier case for [ncons]: *) + +Check natlist'_ind : + forall P : natlist' -> Prop, + P nnil' -> + (forall l : natlist', P l -> forall n : nat, P (nsnoc l n)) -> + forall n : natlist', P n. + +(** **** Exercise: 2 stars, standard (booltree_ind) + + Here is a type for trees that contain a boolean value at each leaf + and branch. *) + +Inductive booltree : Type := + | bt_empty + | bt_leaf (b : bool) + | bt_branch (b : bool) (t1 t2 : booltree). + +(* What is the induction principle for [booltree]? Of course you could + ask Rocq, but try not to do that. Instead, write it down yourself on + paper. Then look at the definition of [booltree_ind_type], below. + It has three missing pieces, which are provided by the definitions + in between here and there. Fill in those definitions based on what + you wrote on paper. *) + +Definition booltree_property_type : Type := booltree -> Prop. + +Definition base_case (P : booltree_property_type) : Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Definition leaf_case (P : booltree_property_type) : Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Definition branch_case (P : booltree_property_type) : Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Definition booltree_ind_type := + forall (P : booltree_property_type), + base_case P -> + leaf_case P -> + branch_case P -> + forall (b : booltree), P b. + +(** Now check the correctness of your answers by proving the following + theorem. If you have them right, you can complete the proof with + just one tactic: [exact booltree_ind]. That will work because the + automatically generated induction principle [booltree_ind] has the + same type as what you just defined. *) + +Theorem booltree_ind_type_correct : booltree_ind_type. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 2 stars, standard (toy_ind) + + Here is an induction principle for a toy type: + + forall P : Toy -> Prop, + (forall b : bool, P (con1 b)) -> + (forall (n : nat) (t : Toy), P t -> P (con2 n t)) -> + forall t : Toy, P t + + Give an [Inductive] definition of [Toy], such that the induction + principle Rocq generates is that given above: *) + +Inductive Toy : Type := + (* FILL IN HERE *) +. + +(** Show that your definition is correct by proving the following theorem. + You should be able to instantiate [f] and [g] with your two constructors, + then immediately finish the proof with [exact Toy_ind]. As in the previous + exercise, that will work because the automatically generated induction + principle [Toy_ind] will have the same type. *) + +Theorem Toy_correct : exists f g, + forall P : Toy -> Prop, + (forall b : bool, P (f b)) -> + (forall (n : nat) (t : Toy), P t -> P (g n t)) -> + forall t : Toy, P t. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ################################################################# *) +(** * Polymorphism *) + +(** What about polymorphic datatypes? + + The inductive definition of polymorphic lists + + Inductive list (X:Type) : Type := + | nil : list X + | cons : X -> list X -> list X. + + is very similar to that of [natlist]. The main difference is + that, here, the whole definition is _parameterized_ on a set [X]: + that is, we are defining a _family_ of inductive types [list X], + one for each [X]. (Note that, wherever [list] appears in the body + of the declaration, it is always applied to the parameter [X].) +*) + +(** The induction principle is likewise parameterized on [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 + + Note that the _whole_ induction principle is parameterized on + [X]. That is, [list_ind] can be thought of as a polymorphic + function that, when applied to a type [X], gives us back an + induction principle specialized to the type [list X]. *) + +(** **** Exercise: 1 star, standard, optional (tree) + + Write out the induction principle that Rocq will generate for + the following datatype. Compare your answer with what Rocq + prints. *) + +Inductive tree (X:Type) : Type := + | leaf (x : X) + | node (t1 t2 : tree X). +Check tree_ind. +(** [] *) + +(** **** Exercise: 1 star, standard, optional (mytype) + + Find an inductive definition that gives rise to the + following induction principle: + + 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 +*) +(** [] *) + +(** **** Exercise: 1 star, standard, optional (foo) + + Find an inductive definition that gives rise to the + following induction principle: + + 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 +*) +(** [] *) + +(** **** Exercise: 1 star, standard, optional (foo') + + Consider the following inductive definition: *) + +Inductive foo' (X:Type) : Type := + | C1 (l : list X) (f : foo' X) + | C2. + +(** What induction principle will Rocq generate for [foo']? (Fill + in the blanks, then check your answer with Rocq.) + + foo'_ind : + forall (X : Type) (P : foo' X -> Prop), + (forall (l : list X) (f : foo' X), + _______________________ -> + _______________________ ) -> + ___________________________________________ -> + forall f : foo' X, ________________________ +*) + +(** [] *) + +(* ################################################################# *) +(** * Induction Hypotheses *) + +(** Where does the phrase "induction hypothesis" fit into this story? + + The induction principle for numbers + + forall P : nat -> Prop, + P 0 -> + (forall n : nat, P n -> P (S n)) -> + forall n : nat, P n + + is a generic statement that holds for all propositions + [P] (or rather, strictly speaking, for all families of + propositions [P] indexed by a number [n]). Each time we + use this principle, we are choosing [P] to be a particular + expression of type [nat -> Prop]. + + We can make proofs by induction more explicit by giving + this expression a name. For example, instead of stating + the theorem [mul_0_r] as "[forall n, n * 0 = 0]," we can + write it as "[forall n, P_m0r n]", where [P_m0r] is defined + as... *) + +Definition P_m0r (n:nat) : Prop := + n * 0 = 0. + +(** ... or equivalently: *) + +Definition P_m0r' : nat -> Prop := + fun n => n * 0 = 0. + +(** Now it is easier to see where [P_m0r] appears in the proof. *) + +Theorem mul_0_r'' : forall n:nat, + P_m0r n. +Proof. + apply nat_ind. + - (* n = O *) reflexivity. + - (* n = S n' *) + (* Note the proof state at this point! *) + intros n IHn. + unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed. + +(** This extra naming step isn't something that we do in + normal proofs, but it is useful to do it explicitly for an example + or two, because it allows us to see exactly what the induction + hypothesis is. If we prove [forall n, P_m0r n] by induction on + [n] (using either [induction] or [apply nat_ind]), we see that the + first subgoal requires us to prove [P_m0r 0] ("[P] holds for + zero"), while the second subgoal requires us to prove [forall n', + P_m0r n' -> P_m0r (S n')] (that is "[P] holds of [S n'] if it + holds of [n']" or, more elegantly, "[P] is preserved by [S]"). + The _induction hypothesis_ is the premise of this latter + implication -- the assumption that [P] holds of [n'], which we are + allowed to use in proving that [P] holds for [S n']. *) + +(* ################################################################# *) +(** * More on the [induction] Tactic *) + +(** The [induction] tactic actually does even more low-level + bookkeeping for us than we discussed above. + + Recall the informal statement of the induction principle for + natural numbers: + - If [P n] is some proposition involving a natural number n, and + we want to show that P holds for _all_ numbers n, we can + reason like this: + - show that [P O] holds + - show that, if [P n'] holds, then so does [P (S n')] + - conclude that [P n] holds for all n. + So, when we begin a proof with [intros n] and then [induction n], + we are first telling Rocq to consider a _particular_ [n] (by + introducing it into the context) and then telling it to prove + something about _all_ numbers (by using induction). +*) + +(** What Rocq actually does in this situation, internally, is it + "re-generalizes" the variable we perform induction on. For + example, in our original proof that [plus] is associative... *) + +Theorem add_assoc' : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. + (* ...we first introduce all 3 variables into the context, + which amounts to saying "Consider an arbitrary [n], [m], and + [p]..." *) + intros n m p. + (* ...We now use the [induction] tactic to prove [P n] (that + is, [n + (m + p) = (n + m) + p]) for _all_ [n], + and hence also for the particular [n] that is in the context + at the moment. *) + induction n as [| n']. + - (* n = O *) reflexivity. + - (* n = S n' *) + simpl. rewrite -> IHn'. reflexivity. Qed. + +(** It also works to apply [induction] to a variable that is + quantified in the goal. *) + +Theorem add_comm' : forall n m : nat, + n + m = m + n. +Proof. + induction n as [| n']. + - (* n = O *) intros m. rewrite -> add_0_r. reflexivity. + - (* n = S n' *) intros m. simpl. rewrite -> IHn'. + rewrite <- plus_n_Sm. reflexivity. Qed. + +(** Note that [induction n] leaves [m] still bound in the goal -- + i.e., what we are proving inductively is a statement beginning + with [forall m]. + + If we do [induction] on a variable that is quantified in the goal + _after_ some other quantifiers, the [induction] tactic will + automatically introduce the variables bound by these quantifiers + into the context. *) + +Theorem add_comm'' : forall n m : nat, + n + m = m + n. +Proof. + (* Let's do induction on [m] this time, instead of [n]... *) + induction m as [| m']. (* [n] is already introduced into the context *) + - (* m = O *) simpl. rewrite -> add_0_r. reflexivity. + - (* m = S m' *) simpl. rewrite <- IHm'. + rewrite <- plus_n_Sm. reflexivity. Qed. + +(** **** Exercise: 1 star, standard, optional (plus_explicit_prop) + + Rewrite both [add_assoc'] and [add_comm'] and their proofs in + the same style as [mul_0_r''] above -- that is, for each theorem, + give an explicit [Definition] of the proposition being proved by + induction, and state the theorem and proof in terms of this + defined proposition. *) + +(* FILL IN HERE + + [] *) + +(* ################################################################# *) +(** * Induction Principles for Propositions *) + +(** Inductive definitions of propositions also cause Rocq to generate + induction priniciples. For example, recall our proposition [ev] + from [IndProp]: *) + +Print ev. + +(* ===> + + Inductive ev : nat -> Prop := + | ev_0 : ev 0 + | ev_SS : forall n : nat, ev n -> ev (S (S n))) + +*) + +Check ev_ind : + forall P : nat -> Prop, + P 0 -> + (forall n : nat, ev n -> P n -> P (S (S n))) -> + forall n : nat, ev n -> P n. + +(** In English, [ev_ind] says: Suppose [P] is a property of natural + numbers. To show that [P n] holds whenever [n] is even, it suffices + to show: + + - [P] holds for [0], + + - for any [n], if [n] is even and [P] holds for [n], then [P] + holds for [S (S n)]. *) + +(** As expected, we can apply [ev_ind] directly instead of using + [induction]. For example, we can use it to show that [ev'] (the + slightly awkward alternate definition of evenness that we saw in + an exercise in the [IndProp] chapter) is equivalent to the + cleaner inductive definition [ev]: *) + +Inductive ev' : nat -> Prop := + | ev'_0 : ev' 0 + | ev'_2 : ev' 2 + | ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m). + +Theorem ev_ev' : forall n, ev n -> ev' n. +Proof. + apply ev_ind. + - (* ev_0 *) + apply ev'_0. + - (* ev_SS *) + intros m Hm IH. + apply (ev'_sum 2 m). + + apply ev'_2. + + apply IH. +Qed. + +(** The precise form of an [Inductive] definition can affect the + induction principle Rocq generates. *) + +Inductive le1 : nat -> nat -> Prop := + | le1_n : forall n, le1 n n + | le1_S : forall n m, (le1 n m) -> (le1 n (S m)). + +Notation "m <=1 n" := (le1 m n) (at level 70). + +(** This definition can be streamlined a little by observing that the + left-hand argument [n] is the same everywhere in the definition, + so we can actually make it a "general parameter" to the whole + definition, rather than an argument to each constructor. *) + +Inductive le2 (n:nat) : nat -> Prop := + | le2_n : le2 n n + | le2_S m (H : le2 n m) : le2 n (S m). + +Notation "m <=2 n" := (le2 m n) (at level 70). + +(** The second one is better, even though it looks less symmetric. + Why? Because it gives us a simpler induction principle. *) + +Check le1_ind : + forall P : nat -> nat -> Prop, + (forall n : nat, P n n) -> + (forall n m : nat, n <=1 m -> P n m -> P n (S m)) -> + forall n n0 : nat, n <=1 n0 -> P n n0. + +Check le2_ind : + forall (n : nat) (P : nat -> Prop), + P n -> + (forall m : nat, n <=2 m -> P m -> P (S m)) -> + forall n0 : nat, n <=2 n0 -> P n0. + +(* ################################################################# *) +(** * Another Form of Induction Principles on Propositions (Optional) *) + +(** The induction principle that Rocq generated for [ev] was parameterized + on a natural number [n]. It could have additionally been parameterized + on the evidence that [n] was even, which would have led to this + induction principle: + + forall P : (forall n : nat, ev'' n -> Prop), + P O ev_0 -> + (forall (m : nat) (E : ev'' m), + P m E -> P (S (S m)) (ev_SS m E)) -> + forall (n : nat) (E : ev'' n), P n E +*) + +(** ... because: + + - Since [ev] is indexed by a number [n] (every [ev] object [E] is + a piece of evidence that some particular number [n] is even), + the proposition [P] is parameterized by both [n] and [E] -- + that is, the induction principle can be used to prove + assertions involving both an even number and the evidence that + it is even. + + - Since there are two ways of giving evidence of evenness ([even] + has two constructors), applying the induction principle + generates two subgoals: + + - We must prove that [P] holds for [O] and [ev_0]. + + - We must prove that, whenever [m] is an even number and [E] + is an evidence of its evenness, if [P] holds of [m] and + [E], then it also holds of [S (S m)] and [ev_SS m E]. + + - If these subgoals can be proved, then the induction principle + tells us that [P] is true for _all_ even numbers [n] and + evidence [E] of their evenness. + + This is more flexibility than we normally need or want: it is + giving us a way to prove logical assertions where the assertion + involves properties of some piece of _evidence_ of evenness, while + all we really care about is proving properties of _numbers_ that + are even -- we are interested in assertions about numbers, not + about evidence. It would therefore be more convenient to have an + induction principle for proving propositions [P] that are + parameterized just by [n] and whose conclusion establishes [P] for + all even numbers [n]: + + forall P : nat -> Prop, + ... -> + forall n : nat, + even n -> P n + + That is why Rocq actually generates the induction principle + [ev_ind] that we saw before. *) + +(* ################################################################# *) +(** * Formal vs. Informal Proofs by Induction *) + +(** Question: What is the relation between a formal proof of a + proposition [P] and an informal proof of the same proposition [P]? + + Answer: The latter should _teach_ the reader everything they would + need to understand to be able to produce the former. + + Question: How much detail does that require? + + Unfortunately, there is no single right answer; rather, there is a + range of choices. + + At one end of the spectrum, we can essentially give the reader the + whole formal proof (i.e., the "informal" proof will amount to just + transcribing the formal one into words). This may give the reader + the ability to reproduce the formal one for themselves, but it + probably doesn't _teach_ them anything much. + + At the other end of the spectrum, we can say "The theorem is true + and you can figure out why for yourself if you think about it hard + enough." This is also not a good teaching strategy, because often + writing the proof requires one or more significant insights into + the thing we're proving, and most readers will give up before they + rediscover all the same insights as we did. + + In the middle is the golden mean -- a proof that includes all of + the essential insights (saving the reader the hard work that we + went through to find the proof in the first place) plus high-level + suggestions for the more routine parts to save the reader from + spending too much time reconstructing these (e.g., what the IH says + and what must be shown in each case of an inductive proof), but not + so much detail that the main ideas are obscured. + + Since we've spent much of this chapter looking "under the hood" at + formal proofs by induction, now is a good moment to talk a little + about _informal_ proofs by induction. + + In the real world of mathematical communication, written proofs + range from extremely longwinded and pedantic to extremely brief and + telegraphic. Although the ideal is somewhere in between, while one + is getting used to the style it is better to start out at the + pedantic end. Also, during the learning phase, it is probably + helpful to have a clear standard to compare against. With this in + mind, we offer two templates -- one for proofs by induction over + _data_ (i.e., where the thing we're doing induction on lives in + [Type]) and one for proofs by induction over _evidence_ (i.e., + where the inductively defined thing lives in [Prop]). *) + +(* ================================================================= *) +(** ** Induction Over an Inductively Defined Set *) + +(** _Template_: + + - _Theorem_: + + _Proof_: By induction on [n]. + + + + - Suppose [n = c a1 ... ak], where <...and here we state + the IH for each of the [a]'s that has type [S], if any>. + We must show <...and here we restate [P(c a1 ... ak)]>. + + + + - [] + + _Example_: + + - _Theorem_: For all sets [X], lists [l : list X], and numbers + [n], if [length l = n] then [index (S n) l = None]. + + _Proof_: By induction on [l]. + + - Suppose [l = []]. We must show, for all numbers [n], + that, if [length [] = n], then [index (S n) [] = + None]. + + This follows immediately from the definition of [index]. + + - Suppose [l = x :: l'] for some [x] and [l'], where + [length l' = n'] implies [index (S n') l' = None], for + any number [n']. We must show, for all [n], that, if + [length (x::l') = n] then [index (S n) (x::l') = + None]. + + Let [n] be a number with [length l = n]. Since + + length l = length (x::l') = S (length l'), + + it suffices to show that + + index (S (length l')) l' = None. + + But this follows directly from the induction hypothesis, + picking [n'] to be [length l']. [] *) + +(* ================================================================= *) +(** ** Induction Over an Inductively Defined Proposition *) + +(** Since inductively defined proof objects are often called + "derivation trees," this form of proof is also known as _induction + on derivations_. + + _Template_: + + - _Theorem_: P]," where [Q] is + some inductively defined proposition (more generally, + "For all [x] [y] [z], [Q x y z -> P x y z]")> + + _Proof_: By induction on a derivation of [Q]. + + + + - Suppose the final rule used to show [Q] is [c]. Then + <...and here we state the types of all of the [a]'s + together with any equalities that follow from the + definition of the constructor and the IH for each of + the [a]'s that has type [Q], if there are any>. We must + show <...and here we restate [P]>. + + + + - [] + + _Example_ + + - _Theorem_: The [<=] relation is transitive -- i.e., for all + numbers [n], [m], and [o], if [n <= m] and [m <= o], then + [n <= o]. + + _Proof_: By induction on a derivation of [m <= o]. + + - Suppose the final rule used to show [m <= o] is + [le_n]. Then [m = o] and we must show that [n <= m], + which is immediate by hypothesis. + + - Suppose the final rule used to show [m <= o] is + [le_S]. Then [o = S o'] for some [o'] with [m <= o']. + We must show that [n <= S o']. + By induction hypothesis, [n <= o']. + + But then, by [le_S], [n <= S o']. [] *) + +(* ################################################################# *) +(** * Explicit Proof Objects for Induction (Optional) *) + +(** Although tactic-based proofs are normally much easier to + work with, the ability to write a proof term directly is sometimes + very handy, particularly when we want Rocq to do something slightly + non-standard. *) + +(** Recall again the induction principle on naturals that Rocq generates for + us automatically from the Inductive declaration for [nat]. *) + +Check nat_ind : + forall P : nat -> Prop, + P 0 -> + (forall n : nat, P n -> P (S n)) -> + forall n : nat, P n. + +(** There's nothing magic about this induction lemma: it's just + another Rocq lemma that requires a proof. Rocq generates the proof + automatically too... *) + +Print nat_ind. + +(** We can rewrite that more tidily as follows: *) +Fixpoint build_proof + (P : nat -> Prop) + (evPO : P 0) + (evPS : forall n : nat, P n -> P (S n)) + (n : nat) : P n := + match n with + | 0 => evPO + | S k => evPS k (build_proof P evPO evPS k) + end. + +Definition nat_ind_tidy := build_proof. + +(** We can read [build_proof] as follows: Suppose we have + evidence [evPO] that [P] holds on 0, and evidence [evPS] that [forall + n:nat, P n -> P (S n)]. Then we can prove that [P] holds of an + arbitrary nat [n] using recursive function [build_proof], which + pattern matches on [n]: + + - If [n] is 0, [build_proof] returns [evPO] to show that [P n] + holds. + + - If [n] is [S k], [build_proof] applies itself recursively on + [k] to obtain evidence that [P k] holds; then it applies + [evPS] on that evidence to show that [P (S n)] holds. *) + +(** Recursive function [build_proof] thus pattern matches against + [n], recursing all the way down to 0, and building up a proof + as it returns. *) + +(** The actual [nat_ind] that Rocq generates uses a recursive + function [F] defined with [fix] instead of [Fixpoint]. *) + +(** We can adapt this approach to proving [nat_ind] to help prove + _non-standard_ induction principles too. As a motivating example, + suppose that we want to prove the following lemma, directly + relating the [ev] predicate we defined in [IndProp] + to the [even] function defined in [Basics]. *) + +Lemma even_ev : forall n: nat, even n = true -> ev n. +Proof. + induction n; intros. + - apply ev_0. + - destruct n. + + simpl in H. inversion H. + + simpl in H. + apply ev_SS. +Abort. + +(** Attempts to prove this by standard induction on [n] fail in the case for + [S (S n)], because the induction hypothesis only tells us something about + [S n], which is useless. There are various ways to hack around this problem; + for example, we _can_ use ordinary induction on [n] to prove this (try it!): + + [Lemma even_ev' : forall n : nat, + (even n = true -> ev n) /\ (even (S n) = true -> ev (S n))]. + + But we can make a much better proof by defining and proving a + non-standard induction principle that goes "by twos": + *) + +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 with + 0 => P0 + | 1 => P1 + | S (S n') => PSS n' (f n') + end. + + (** Once you get the hang of it, it is entirely straightforward to + give an explicit proof term for induction principles like this. + Proving this as a lemma using tactics is much less intuitive. + + The [induction ... using] tactic variant gives a convenient way to + utilize a non-standard induction principle like this. *) + +Lemma even_ev : forall n, even n = true -> ev n. +Proof. + intros. + induction n as [ | |n'] using nat_ind2. + - apply ev_0. + - simpl in H. + inversion H. + - simpl in H. + apply ev_SS. + apply IHn'. + apply H. +Qed. + + + +(** **** Exercise: 4 stars, standard, optional (t_tree) + + What if we wanted to define binary trees as follows, using a + constructor that bundles the children and value at a node into a + tuple? *) + +Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. + +Inductive t_tree (X : Type) : Type := +| t_leaf +| t_branch : (t_tree X * X * t_tree X) -> t_tree X. + +Arguments t_leaf {X}. +Arguments t_branch {X}. + +(** Unfortunately, the automatically-generated induction principle is + not as strong as we need. It doesn't introduce induction hypotheses + for the subtrees. *) + +Check t_tree_ind. + +(** That will get us in trouble if we want to prove something by + induction, such as that [reflect] is an involution. *) + +Fixpoint reflect {X : Type} (t : t_tree X) : t_tree X := + match t with + | t_leaf => t_leaf + | t_branch (l, v, r) => t_branch (reflect r, v, reflect l) + end. + +Theorem reflect_involution : forall (X : Type) (t : t_tree X), + reflect (reflect t) = t. +Proof. + intros X t. induction t. + - reflexivity. + - destruct p as [[l v] r]. simpl. Abort. + +(** We get stuck, because we have no inductive hypothesis for [l] or + [r]. So, we need to define our own custom induction principle, and + use it to complete the proof. + + First, define the type of the induction principle that you want to + use. There are many possible answers. Recall that you can use + [match] as part of the definition. *) + +Definition better_t_tree_ind_type : Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** Second, define the induction principle by giving a term of that + type. Use the examples about [nat], above, as models. *) + +Definition better_t_tree_ind : better_t_tree_ind_type + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** Finally, prove the theorem. If [induction...using] gives you an + error about "Cannot recognize an induction scheme", don't worry + about it. The [induction] tactic is picky about the shape of the + theorem you pass to it, but it doesn't give you much information + to debug what is wrong about that shape. You can use [apply] + instead, as we saw at the beginning of this file. *) + +Theorem reflect_involution : forall (X : Type) (t : t_tree X), + reflect (reflect t) = t. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(* 2026-01-07 13:18 *) diff --git a/IndPrinciplesTest.v b/IndPrinciplesTest.v new file mode 100644 index 0000000..762e930 --- /dev/null +++ b/IndPrinciplesTest.v @@ -0,0 +1,118 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import IndPrinciples. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import IndPrinciples. +Import Check. + +Goal True. + +idtac "------------------- plus_one_r' --------------------". +idtac " ". + +idtac "#> plus_one_r'". +idtac "Possible points: 2". +check_type @plus_one_r' ((forall n : nat, @eq nat (Nat.add n 1) (S n))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_one_r'. +Goal True. +idtac " ". + +idtac "------------------- booltree_ind --------------------". +idtac " ". + +idtac "#> booltree_ind_type_correct". +idtac "Possible points: 2". +check_type @booltree_ind_type_correct (booltree_ind_type). +idtac "Assumptions:". +Abort. +Print Assumptions booltree_ind_type_correct. +Goal True. +idtac " ". + +idtac "------------------- toy_ind --------------------". +idtac " ". + +idtac "#> Toy_correct". +idtac "Possible points: 2". +check_type @Toy_correct ( +(@ex (forall _ : bool, Toy) + (fun f : forall _ : bool, Toy => + @ex (forall (_ : nat) (_ : Toy), Toy) + (fun g : forall (_ : nat) (_ : Toy), Toy => + forall (P : forall _ : Toy, Prop) (_ : forall b : bool, P (f b)) + (_ : forall (n : nat) (t : Toy) (_ : P t), P (g n t)) + (t : Toy), + P t)))). +idtac "Assumptions:". +Abort. +Print Assumptions Toy_correct. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 6". +idtac "Max points - advanced: 6". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- plus_one_r' ---------". +Print Assumptions plus_one_r'. +idtac "---------- booltree_ind_type_correct ---------". +Print Assumptions booltree_ind_type_correct. +idtac "---------- Toy_correct ---------". +Print Assumptions Toy_correct. +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/IndProp.v b/IndProp.v new file mode 100644 index 0000000..4e0fd33 --- /dev/null +++ b/IndProp.v @@ -0,0 +1,2962 @@ +(** * IndProp: Inductively Defined Propositions *) + +Set Warnings "-notation-overridden". +From LF Require Export Logic. + +(* ################################################################# *) +(** * Inductively Defined Propositions *) + +(** In the [Logic] chapter, we looked at several ways of writing + propositions, including conjunction, disjunction, and existential + quantification. + + In this chapter, we bring yet another new tool into the mix: + _inductively defined propositions_. + + To begin, some examples... *) + +(* ================================================================= *) +(** ** Example: The Collatz Conjecture *) + +(** The _Collatz Conjecture_ is a famous open problem in number + theory. + + Its statement is quite simple. First, we define a function [csf] + on numbers, as follows (where [csf] stands for "Collatz step function"): *) + +Fixpoint div2 (n : nat) : nat := + match n with + 0 => 0 + | 1 => 0 + | S (S n) => S (div2 n) + end. + +Definition csf (n : nat) : nat := + if even n then div2 n + else (3 * n) + 1. + +(** Next, we look at what happens when we repeatedly apply [csf] to + some given starting number. For example, [csf 12] is [6], and + [csf 6] is [3], so by repeatedly applying [csf] we get the + sequence [12, 6, 3, 10, 5, 16, 8, 4, 2, 1]. + + Similarly, if we start with [19], we get the longer sequence [19, + 58, 29, 88, 44, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, + 4, 2, 1]. + + Both of these sequences eventually reach [1]. The question posed + by Collatz was: Is the sequence starting from _any_ positive + natural number guaranteed to reach [1] eventually? *) + +(** To formalize this question in Rocq, we might try to define a + recursive _function_ that calculates the total number of steps + that it takes for such a sequence to reach [1]. *) + +Fail Fixpoint reaches1_in (n : nat) : nat := + if n =? 1 then 0 + else 1 + reaches1_in (csf n). + +(** You can write this definition in a standard programming language. + This definition is, however, rejected by Rocq's termination + checker, since the argument to the recursive call, [csf n], is not + "obviously smaller" than [n]. + + Indeed, this isn't just a pointless limitation: functions in Rocq + are required to be total, to ensure logical consistency. + + Moreover, we can't fix it by devising a more clever termination + checker: deciding whether this particular function is total + would be equivalent to settling the Collatz conjecture! *) + +(** Another idea could be to express the concept of "eventually + reaches [1] in the Collatz sequence" as an _recursively defined + property_ of numbers [Collatz_holds_for : nat -> Prop]. *) + +Fail Fixpoint Collatz_holds_for (n : nat) : Prop := + match n with + | 0 => False + | 1 => True + | _ => if even n then Collatz_holds_for (div2 n) + else Collatz_holds_for ((3 * n) + 1) + end. + +(** This recursive function is also rejected by the termination + checker, since, while we could in principle convince Rocq that + [div2 n] is smaller than [n], we certainly can't convince it that + [(3 * n) + 1] is smaller than [n]! *) + +(** Fortunately, there is another way to do it: We can express the + concept "reaches [1] eventually in the Collatz sequence" as an + _inductively defined property_ of numbers. Intuitively, this + property is defined by a set of rules: + + ------------------- (Chf_one) + Collatz_holds_for 1 + + even n = true Collatz_holds_for (div2 n) + --------------------------------------------- (Chf_even) + Collatz_holds_for n + + even n = false Collatz_holds_for ((3 * n) + 1) + ------------------------------------------------- (Chf_odd) + Collatz_holds_for n + + So there are three ways to prove that a number [n] eventually + reaches 1 in the Collatz sequence: + - [n] is 1; + - [n] is even and [div2 n] eventually reaches 1; + - [n] is odd and [(3 * n) + 1] eventually reaches 1. +*) +(** We can prove that a number reaches 1 by constructing a (finite) + derivation using these rules. For instance, here is the derivation + proving that 12 reaches 1 (where we left out the evenness/oddness + premises): + + ———————————————————— (Chf_one) + Collatz_holds_for 1 + ———————————————————— (Chf_even) + Collatz_holds_for 2 + ———————————————————— (Chf_even) + Collatz_holds_for 4 + ———————————————————— (Chf_even) + Collatz_holds_for 8 + ———————————————————— (Chf_even) + Collatz_holds_for 16 + ———————————————————— (Chf_odd) + Collatz_holds_for 5 + ———————————————————— (Chf_even) + Collatz_holds_for 10 + ———————————————————— (Chf_odd) + Collatz_holds_for 3 + ———————————————————— (Chf_even) + Collatz_holds_for 6 + ———————————————————— (Chf_even) + Collatz_holds_for 12 +*) + +(** Formally in Rocq, the [Collatz_holds_for] property is + _inductively defined_: *) + +Inductive Collatz_holds_for : nat -> Prop := + | Chf_one : Collatz_holds_for 1 + | Chf_even (n : nat) : even n = true -> + Collatz_holds_for (div2 n) -> + Collatz_holds_for n + | Chf_odd (n : nat) : even n = false -> + Collatz_holds_for ((3 * n) + 1) -> + Collatz_holds_for n. + +(** What we've done here is to use Rocq's [Inductive] definition + mechanism to characterize the property "Collatz holds for..." by + stating three different ways in which it can hold: (1) Collatz + holds for [1], (2) if Collatz holds for [div2 n] and [n] is even + then Collatz holds for [n], and (3) if Collatz holds for [(3 * n) + + 1] and [n] is odd then Collatz holds for [n]. This Rocq definition + directly corresponds to the three rules we wrote informally above. *) + +(** For particular numbers, we can now prove that the Collatz sequence + reaches [1] (we'll look more closely at how it works a bit later + in the chapter): *) + +Example Collatz_holds_for_12 : Collatz_holds_for 12. +Proof. + apply Chf_even. reflexivity. simpl. + apply Chf_even. reflexivity. simpl. + apply Chf_odd. reflexivity. simpl. + apply Chf_even. reflexivity. simpl. + apply Chf_odd. reflexivity. simpl. + apply Chf_even. reflexivity. simpl. + apply Chf_even. reflexivity. simpl. + apply Chf_even. reflexivity. simpl. + apply Chf_even. reflexivity. simpl. + apply Chf_one. +Qed. + +(** The Collatz conjecture then states that the sequence beginning + from _any_ positive number reaches [1]: *) + +Conjecture collatz : forall n, n <> 0 -> Collatz_holds_for n. + +(** If you succeed in proving this conjecture, you've got a bright + future as a number theorist! But don't spend too long on it -- + it's been open since 1937. *) + +(* ================================================================= *) +(** ** Example: Binary relation for comparing numbers *) + +(** A binary _relation_ on a set [X] has Rocq type [X -> X -> Prop]. + This is a family of propositions parameterized by two elements of + [X] -- i.e., a proposition about pairs of elements of [X]. *) + +(** For example, one familiar binary relation on [nat] is [le : nat -> + nat -> Prop], the less-than-or-equal-to relation, which can be + inductively defined by the following two rules: *) + +(** + + ------ (le_n) + le n n + + le n m + ---------- (le_S) + le n (S m) +*) +(** These rules say that there are two ways to show that a + number is less than or equal to another: either observe that they + are the same number, or, if the second has the form [S m], give + evidence that the first is less than or equal to [m]. *) + +(** This corresponds to the following inductive definition in Rocq: *) + +Module LePlayground. + +Inductive le : nat -> nat -> Prop := + | le_n (n : nat) : le n n + | le_S (n m : nat) : le n m -> le n (S m). + +Notation "n <= m" := (le n m) (at level 70). + +(** This definition is a bit simpler and more elegant than the Boolean function + [leb] we defined in [Basics]. As usual, [le] and [leb] are + equivalent, and there is an exercise about that later. *) + +Example le_3_5 : 3 <= 5. +Proof. + apply le_S. apply le_S. apply le_n. Qed. + +End LePlayground. + +(* ================================================================= *) +(** ** Example: Transitive Closure *) + +(** Another example: The _reflexive and transitive closure_ of a + relation [R] is the smallest relation that contains [R] and that + is reflexive and transitive. This can be defined by the following + three rules (where we added a reflexivity rule to [clos_trans]): + + R x y + ---------------- (t_step) + clos_trans R x y + + clos_trans R x y clos_trans R y z + ------------------------------------ (t_trans) + clos_trans R x z + + In Rocq this looks as follows: +*) + +Inductive clos_trans {X: Type} (R: X->X->Prop) : X->X->Prop := + | t_step (x y : X) : + R x y -> + clos_trans R x y + | t_trans (x y z : X) : + clos_trans R x y -> + clos_trans R y z -> + clos_trans R x z. + +(** For example, suppose we define a "parent of" relation on a group + of people... *) + +Inductive Person : Type := Sage | Cleo | Ridley | Moss. + +Inductive parent_of : Person -> Person -> Prop := + po_SC : parent_of Sage Cleo +| po_SR : parent_of Sage Ridley +| po_CM : parent_of Cleo Moss. + +(** In this example, [Sage] is a parent of both [Cleo] and + [Ridley]; and [Cleo] is a parent of [Moss]. *) + +(** The [parent_of] relation is not transitive, but we can define + an "ancestor of" relation as its transitive closure: *) + +Definition ancestor_of : Person -> Person -> Prop := + clos_trans parent_of. + +(** Here is a derivation showing that Sage is an ancestor of Moss: + + ———————————————————(po_SC) ———————————————————(po_CM) + parent_of Sage Cleo parent_of Cleo Moss +—————————————————————(t_step) —————————————————————(t_step) +ancestor_of Sage Cleo ancestor_of Cleo Moss +————————————————————————————————————————————————————(t_trans) + ancestor_of Sage Moss +*) + +Example ancestor_of_ex : ancestor_of Sage Moss. +Proof. + unfold ancestor_of. apply t_trans with Cleo. + - apply t_step. apply po_SC. + - apply t_step. apply po_CM. Qed. + +(** Computing the transitive closure can be undecidable even for + a relation R that is decidable (e.g., the [cms] relation below), so in + general we can't expect to define transitive closure as a boolean + function. Fortunately, Rocq allows us to define transitive closure + as an inductive relation. + + The transitive closure of a binary relation cannot, in general, be + expressed in first-order logic. The logic of Rocq is, however, much + more powerful, and can easily define such inductive relations. *) + +(* ================================================================= *) +(** ** Example: Reflexive and Transitive Closure *) + +(** As another example, the _reflexive and transitive closure_ + of a relation [R] is the + smallest relation that contains [R] and that is reflexive and + transitive. This can be defined by the following three rules + (where we added a reflexivity rule to [clos_trans]): + + R x y + --------------------- (rt_step) + clos_refl_trans R x y + + --------------------- (rt_refl) + clos_refl_trans R x x + + clos_refl_trans R x y clos_refl_trans R y z + ---------------------------------------------- (rt_trans) + clos_refl_trans R x z +*) + +Inductive clos_refl_trans {X: Type} (R: X->X->Prop) : X->X->Prop := + | rt_step (x y : X) : + R x y -> + clos_refl_trans R x y + | rt_refl (x : X) : + clos_refl_trans R x x + | rt_trans (x y z : X) : + clos_refl_trans R x y -> + clos_refl_trans R y z -> + clos_refl_trans R x z. + +(** For instance, this enables an equivalent definition of the Collatz + conjecture. First we define a binary relation corresponding to + the "Collatz step function" [csf]: *) + +Definition cs (n m : nat) : Prop := csf n = m. + +(** This Collatz step relation can be used in conjunction with the + reflexive and transitive closure operation to define a _Collatz + multi-step_ ([cms]) relation, expressing that a number [n] + reaches another number [m] in zero or more Collatz steps: *) + +Definition cms n m := clos_refl_trans cs n m. +Conjecture collatz' : forall n, n <> 0 -> cms n 1. + +(** This [cms] relation defined in terms of + [clos_refl_trans] allows for more interesting derivations than the + linear ones of the directly-defined [Collatz_holds_for] relation: + +csf 16 = 8 csf 8 = 4 csf 4 = 2 csf 2 = 1 +————————(rt_step) ———————(rt_step) ———————(rt_step) ———————(rt_step) +cms 16 8 cms 8 4 cms 4 2 cms 2 1 +—————————————————————————(rt_trans) ————————————————————————(rt_trans) + cms 16 4 cms 4 1 + —————————————————————————————————————————————(rt_trans) + cms 16 1 +*) + +(** **** Exercise: 1 star, standard, optional (clos_refl_trans_sym) + + How would you modify the [clos_refl_trans] definition above so as + to define the reflexive, symmetric, and transitive closure? *) + +(* FILL IN HERE + + [] *) + +(* ================================================================= *) +(** ** Example: Permutations *) + +(** The familiar mathematical concept of _permutation_ also has an + elegant formulation as an inductive relation. For simplicity, + let's focus on permutations of lists with exactly three + elements. + + We can define such permulations by the following rules: + + --------------------- (perm3_swap12) + Perm3 [a;b;c] [b;a;c] + + --------------------- (perm3_swap23) + Perm3 [a;b;c] [a;c;b] + + Perm3 l1 l2 Perm3 l2 l3 + ----------------------------- (perm3_trans) + Perm3 l1 l3 + + For instance we can derive [Perm3 [1;2;3] [3;2;1]] as follows: + + ————————(perm_swap12) —————————————————————(perm_swap23) + Perm3 [1;2;3] [2;1;3] Perm3 [2;1;3] [2;3;1] + ——————————————————————————————(perm_trans) ————————————(perm_swap12) + Perm3 [1;2;3] [2;3;1] Perm [2;3;1] [3;2;1] + —————————————————————————————————————————————————————(perm_trans) + Perm3 [1;2;3] [3;2;1] +*) + +(** This definition says: + - If [l2] can be obtained from [l1] by swapping the first and + second elements, then [l2] is a permutation of [l1]. + - If [l2] can be obtained from [l1] by swapping the second and + third elements, then [l2] is a permutation of [l1]. + - If [l2] is a permutation of [l1] and [l3] is a permutation of + [l2], then [l3] is a permutation of [l1]. *) + +(** In Rocq [Perm3] is given the following inductive definition: *) + +Inductive Perm3 {X : Type} : list X -> list X -> Prop := + | perm3_swap12 (a b c : X) : + Perm3 [a;b;c] [b;a;c] + | perm3_swap23 (a b c : X) : + Perm3 [a;b;c] [a;c;b] + | perm3_trans (l1 l2 l3 : list X) : + Perm3 l1 l2 -> Perm3 l2 l3 -> Perm3 l1 l3. + +(** **** Exercise: 1 star, standard, optional (perm) + + According to this definition, is [[1;2;3]] a permutation of + itself? *) + +(* FILL IN HERE + + [] *) + +(* ================================================================= *) +(** ** Example: Evenness (yet again) *) + +(** We've already seen two ways of stating a proposition that a number + [n] is even: We can say + + (1) [even n = true] (using the recursive boolean function [even]), or + + (2) [exists k, n = double k] (using an existential quantifier). *) + +(** A third possibility, which we'll use as a simple running example + in this chapter, is to say that a number is even if we can + _establish_ its evenness from the following two rules: + + ---- (ev_0) + ev 0 + + ev n + ------------ (ev_SS) + ev (S (S n)) +*) + +(** Intuitively these rules say that: + - The number [0] is even. + - If [n] is even, then [S (S n)] is even. *) + +(** (Defining evenness in this way may seem a bit confusing, + since we have already seen two perfectly good ways of doing + it. It makes a convenient running example because it is + simple and compact, but we will soon return to the more compelling + examples above.) *) + +(** To illustrate how this new definition of evenness works, let's + imagine using it to show that [4] is even: + + ———— (ev_0) + ev 0 + ———————————— (ev_SS) + ev (S (S 0)) + ———————————————————— (ev_SS) + ev (S (S (S (S 0)))) +*) + +(** In words, to show that [4] is even, by rule [ev_SS], it + suffices to show that [2] is even. This, in turn, is again + guaranteed by rule [ev_SS], as long as we can show that [0] is + even. But this last fact follows directly from the [ev_0] rule. *) + +(** We can translate the informal definition of evenness from above + into a formal [Inductive] declaration, where each "way that a + number can be even" corresponds to a separate constructor: *) + +Inductive ev : nat -> Prop := + | ev_0 : ev 0 + | ev_SS (n : nat) (H : ev n) : ev (S (S n)). + +(** Such definitions are interestingly different from previous uses of + [Inductive] for defining inductive datatypes like [nat] or [list]. + For one thing, we are defining not a [Type] (like [nat]) or a + function yielding a [Type] (like [list]), but rather a function + from [nat] to [Prop] -- that is, a property of numbers. But what + is really new is that, because the [nat] argument of [ev] appears + to the _right_ of the colon on the first line, it is allowed to + take _different_ values in the types of different constructors: + [0] in the type of [ev_0] and [S (S n)] in the type of [ev_SS]. + Accordingly, the type of each constructor must be specified + explicitly (after a colon), and each constructor's type must have + the form [ev n] for some natural number [n]. + + In contrast, recall the definition of [list]: + + Inductive list (X:Type) : Type := + | nil + | cons (x : X) (l : list X). + + or (equivalently but more explicitly): + + Inductive list (X:Type) : Type := + | nil : list X + | cons (x : X) (l : list X) : list X. + + This definition introduces the [X] parameter _globally_, to the + _left_ of the colon, forcing the result of [nil] and [cons] to be + the same type (i.e., [list X]). But if we had tried to bring [nat] + to the left of the colon in defining [ev], we would have seen an + error: *) + +Fail Inductive wrong_ev (n : nat) : Prop := + | wrong_ev_0 : wrong_ev 0 + | wrong_ev_SS (H: wrong_ev n) : wrong_ev (S (S n)). +(* ===> Error: Last occurrence of "[wrong_ev]" must have "[n]" as 1st + argument in "[wrong_ev 0]". *) + +(** In an [Inductive] definition, an argument to the type constructor + on the left of the colon is called a "parameter", whereas an + argument on the right is called an "index" or "annotation." + + For example, in [Inductive list (X : Type) := ...], the [X] is a + parameter, while in [Inductive ev : nat -> Prop := ...], the + unnamed [nat] argument is an index. *) + +(** We can think of the inductive definition of [ev] as defining a + Rocq property [ev : nat -> Prop], together with two "evidence + constructors": *) + +Check ev_0 : ev 0. +Check ev_SS : forall (n : nat), ev n -> ev (S (S n)). + +(** Indeed, Rocq also accepts the following equivalent definition of [ev]: *) + +Module EvPlayground. + +Inductive ev : nat -> Prop := + | ev_0 : ev 0 + | ev_SS : forall (n : nat), ev n -> ev (S (S n)). + +End EvPlayground. + +(** These evidence constructors can be thought of as "primitive + evidence of evenness", and they can be used later on just like proven + theorems. In particular, we can use Rocq's [apply] tactic with the + constructor names to obtain evidence for [ev] of particular + numbers... *) + +Theorem ev_4 : ev 4. +Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed. + +(** ... or we can use function application syntax to combine several + constructors: *) + +Theorem ev_4' : ev 4. +Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed. + +(** In this way, we can also prove theorems that have hypotheses + involving [ev]. *) + +Theorem ev_plus4 : forall n, ev n -> ev (4 + n). +Proof. + intros n. simpl. intros Hn. apply ev_SS. apply ev_SS. apply Hn. +Qed. + +(** **** Exercise: 1 star, standard (ev_double) *) +Theorem ev_double : forall n, + ev (double n). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Constructing Evidence for Permutations *) + +(** Similarly we can apply the evidence constructors to obtain + evidence of [Perm3 [1;2;3] [3;2;1]]: *) + +Lemma Perm3_rev : Perm3 [1;2;3] [3;2;1]. +Proof. + apply perm3_trans with (l2:=[2;3;1]). + - apply perm3_trans with (l2:=[2;1;3]). + + apply perm3_swap12. + + apply perm3_swap23. + - apply perm3_swap12. +Qed. + +(** And again we can equivalently use function application syntax to + combine several constructors. (Note that the Rocq type checker can + infer not only types, but also nats and lists, when they are clear + from the context.) *) + +Lemma Perm3_rev' : Perm3 [1;2;3] [3;2;1]. +Proof. + apply (perm3_trans _ [2;3;1] _ + (perm3_trans _ [2;1;3] _ + (perm3_swap12 _ _ _) + (perm3_swap23 _ _ _)) + (perm3_swap12 _ _ _)). +Qed. + +(** So the informal derivation trees we drew above are not too far + from what's happening formally. Formally we're using the evidence + constructors to build _evidence trees_, similar to the finite trees we + built using the constructors of data types such as nat, list, + binary trees, etc. *) + +(** **** Exercise: 1 star, standard (Perm3) *) +Lemma Perm3_ex1 : Perm3 [1;2;3] [2;3;1]. +Proof. + (* FILL IN HERE *) Admitted. + +Lemma Perm3_refl : forall (X : Type) (a b c : X), + Perm3 [a;b;c] [a;b;c]. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Using Evidence in Proofs *) + +(** Besides _constructing_ evidence that numbers are even, we can also + _destruct_ such evidence, reasoning about how it could have been + built. + + Defining [ev] with an [Inductive] declaration tells Rocq not + only that the constructors [ev_0] and [ev_SS] are valid ways to + build evidence that some number is [ev], but also that these two + constructors are the _only_ ways to build evidence that numbers + are [ev]. *) + +(** In other words, if someone gives us evidence [E] for the proposition + [ev n], then we know that [E] must be one of two things: + + - [E = ev_0] and [n = O], or + - [E = ev_SS n' E'] and [n = S (S n')], where [E'] is + evidence for [ev n']. *) + +(** This suggests that it should be possible to analyze a + hypothesis of the form [ev n] much as we do inductively defined + data structures; in particular, it should be possible to argue either by + _case analysis_ or by _induction_ on such evidence. Let's look at a + few examples to see what this means in practice. *) + +(* ================================================================= *) +(** ** Destructing and Inverting Evidence *) + +(** Suppose we are proving some fact involving a number [n], and + we are given [ev n] as a hypothesis. We already know how to + perform case analysis on [n] using [destruct] or [induction], + generating separate subgoals for the case where [n = O] and the + case where [n = S n'] for some [n']. But for some proofs we may + instead want to analyze the evidence for [ev n] _directly_. + + As a tool for such proofs, we can formalize the intuitive + characterization that we gave above for evidence of [ev n], using + [destruct]. *) + +Lemma ev_inversion : forall (n : nat), + ev n -> + (n = 0) \/ (exists n', n = S (S n') /\ ev n'). +Proof. + intros n E. destruct E as [ | n' E'] eqn:EE. + - (* E = ev_0 : ev 0 *) + left. reflexivity. + - (* E = ev_SS n' E' : ev (S (S n')) *) + right. exists n'. split. reflexivity. apply E'. +Qed. + +(** Facts like this are often called "inversion lemmas" because they + allow us to "invert" some given information to reason about all + the different ways it could have been derived. + + Here there are two ways to prove [ev n], and the inversion + lemma makes this explicit. *) + +(** **** Exercise: 1 star, standard (le_inversion) + + Let's prove a similar inversion lemma for [le]. *) +Lemma le_inversion : forall (n m : nat), + le n m -> + (n = m) \/ (exists m', m = S m' /\ le n m'). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** We can use the inversion lemma that we proved above to help + structure proofs: *) + +Theorem evSS_ev : forall n, ev (S (S n)) -> ev n. +Proof. + intros n E. apply ev_inversion in E. destruct E as [H0|H1]. + - discriminate H0. + - destruct H1 as [n' [Hnn' E']]. injection Hnn' as Hnn'. + rewrite Hnn'. apply E'. +Qed. + +(** Note how the inversion lemma produces two subgoals, which + correspond to the two ways of proving [ev]. The first subgoal is + a contradiction that is discharged with [discriminate]. The + second subgoal makes use of [injection] and [rewrite]. + + Rocq provides a handy tactic called [inversion] that factors out + this common pattern, saving us the trouble of explicitly stating + and proving an inversion lemma for every [Inductive] definition we + make. + + Here, the [inversion] tactic can detect (1) that the first case, + where [n = 0], does not apply and (2) that the [n'] that appears + in the [ev_SS] case must be the same as [n]. It includes an + "[as]" annotation similar to [destruct], allowing us to assign + names rather than have Rocq choose them. *) + +Theorem evSS_ev' : forall n, + ev (S (S n)) -> ev n. +Proof. + intros n E. inversion E as [| n' E' Hnn']. + (* We are in the [E = ev_SS n' E'] case now. *) + apply E'. +Qed. + +(** The [inversion] tactic can apply the principle of explosion to + "obviously contradictory" hypotheses involving inductively defined + properties, something that takes a bit more work using our + inversion lemma. Compare: *) + +Theorem one_not_even : ~ ev 1. +Proof. + intros H. apply ev_inversion in H. destruct H as [ | [m [Hm _]]]. + - discriminate H. + - discriminate Hm. +Qed. + +Theorem one_not_even' : ~ ev 1. +Proof. intros H. inversion H. Qed. + +(** **** Exercise: 1 star, standard (inversion_practice) + + Prove the following result using [inversion]. (For extra + practice, you can also prove it using the inversion lemma.) *) + +Theorem SSSSev__even : forall n, + ev (S (S (S (S n)))) -> ev n. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard (ev5_nonsense) + + Prove the following result using [inversion]. *) + +Theorem ev5_nonsense : + ev 5 -> 2 + 2 = 9. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The [inversion] tactic does quite a bit of work. For + example, when applied to an equality assumption, it does the work + of both [discriminate] and [injection]. In addition, it carries + out the [intros] and [rewrite]s that are typically necessary in + the case of [injection]. It can also be applied to analyze + evidence for arbitrary inductively defined propositions, not just + equality. As examples, we'll use it to re-prove some theorems + from chapter [Tactics]. (Here we are being a bit lazy by + omitting the [as] clause from [inversion], thereby asking Rocq to + choose names for the variables and hypotheses that it introduces.) *) + +Theorem inversion_ex1 : forall (n m o : nat), + [n; m] = [o; o] -> [n] = [m]. +Proof. + intros n m o H. inversion H. reflexivity. Qed. + +Theorem inversion_ex2 : forall (n : nat), + S n = O -> 2 + 2 = 5. +Proof. + intros n contra. inversion contra. Qed. + +(** Here's how [inversion] works in general. + - Suppose the name [H] refers to an assumption [P] in the + current context, where [P] has been defined by an [Inductive] + declaration. + - Then, for each of the constructors of [P], [inversion H] + generates a subgoal in which [H] has been replaced by the + specific conditions under which this constructor could have + been used to prove [P]. + - Some of these subgoals will be self-contradictory; [inversion] + throws these away. + - The ones that are left represent the cases that must be proved + to establish the original goal. For those, [inversion] adds + to the proof context all equations that must hold of the + arguments given to [P] -- e.g., [n' = n] in the proof of + [evSS_ev]). *) + +(** The [ev_double] exercise above allows us to easily show that + our new notion of evenness is implied by the two earlier ones + (since, by [even_bool_prop] in chapter [Logic], we already + know that those are equivalent to each other). To show that all + three coincide, we just need the following lemma. *) + +Lemma ev_Even_firsttry : forall n, + ev n -> Even n. +Proof. + (* WORKED IN CLASS *) unfold Even. + +(** We could try to proceed by case analysis or induction on [n]. But + since [ev] is mentioned in a premise, this strategy seems + unpromising, because (as we've noted before) the induction + hypothesis will talk about [n-1] (which is _not_ even!). Thus, it + seems better to first try [inversion] on the evidence for [ev]. + Indeed, the first case can be solved trivially. *) + + intros n E. inversion E as [EQ' | n' E' EQ']. + - (* E = ev_0 *) exists 0. reflexivity. + - (* E = ev_SS n' E' + + Unfortunately, the second case is harder. We need to show [exists + n0, S (S n') = double n0], but the only available assumption is + [E'], which states that [ev n'] holds. Since this isn't directly + useful, it seems that we are stuck and that performing case + analysis on [E] was a waste of time. + + If we look more closely at our second goal, however, we can see + that something interesting happened: By performing case analysis + on [E], we were able to reduce the original result to a similar + one that involves a _different_ piece of evidence for [ev]: namely + [E']. More formally, we could finish our proof if we could show + that + + exists k', n' = double k', + + which is the same as the original statement, but with [n'] instead + of [n]. Indeed, it is not difficult to convince Rocq that this + intermediate result would suffice. *) + assert (H: (exists k', n' = double k') + -> (exists n0, S (S n') = double n0)). + { intros [k' EQ'']. exists (S k'). simpl. + rewrite <- EQ''. reflexivity. } + apply H. + + (** Unfortunately, now we are stuck. To see this clearly, let's + move [E'] back into the goal from the hypotheses. *) + + generalize dependent E'. + + (** Now it is obvious that we are trying to prove another instance + of the same theorem we set out to prove -- only here we are + talking about [n'] instead of [n]. *) +Abort. + +(* ================================================================= *) +(** ** Induction on Evidence *) + +(** If this story feels familiar, it is no coincidence: We + encountered similar problems in the [Induction] chapter, when + trying to use case analysis to prove results that required + induction. And once again the solution is... induction! *) + +(** The behavior of [induction] on evidence is the same as its + behavior on data: It causes Rocq to generate one subgoal for each + constructor that could have been used to build that evidence, while + providing an induction hypothesis for each recursive occurrence of + the property in question. + + To prove that a property of [n] holds for all even numbers (i.e., + those for which [ev n] holds), we can use induction on [ev + n]. This requires us to prove two things, corresponding to the two + ways in which [ev n] could have been constructed. If it was + constructed by [ev_0], then [n=0] and the property must hold of + [0]. If it was constructed by [ev_SS], then the evidence of [ev n] + is of the form [ev_SS n' E'], where [n = S (S n')] and [E'] is + evidence for [ev n']. In this case, the inductive hypothesis says + that the property we are trying to prove holds for [n']. *) + +(** Let's try proving that lemma again: *) + +Lemma ev_Even : forall n, + ev n -> Even n. +Proof. + unfold Even. intros n E. + induction E as [|n' E' IH]. + - (* E = ev_0 *) + exists 0. reflexivity. + - (* E = ev_SS n' E', with IH : Even n' *) + destruct IH as [k Hk]. rewrite Hk. + exists (S k). simpl. reflexivity. +Qed. + +(** Here, we can see that Rocq produced an [IH] that corresponds + to [E'], the single recursive occurrence of [ev] in its own + definition. Since [E'] mentions [n'], the induction hypothesis + talks about [n'], as opposed to [n] or some other number. *) + +(** The equivalence between the second and third definitions of + evenness now follows. *) + +Theorem ev_Even_iff : forall n, + ev n <-> Even n. +Proof. + intros n. split. + - (* -> *) apply ev_Even. + - (* <- *) unfold Even. intros [k Hk]. rewrite Hk. apply ev_double. +Qed. + +(** As we will see in later chapters, induction on evidence is a + recurring technique across many areas -- in particular for + formalizing the semantics of programming languages. *) + +(** The following exercises provide simpler examples of this + technique, to help you familiarize yourself with it. *) + +(** **** Exercise: 2 stars, standard (ev_sum) *) +Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced, especially useful (ev_ev__ev) *) +Theorem ev_ev__ev : forall n m, + ev (n+m) -> ev n -> ev m. + (* Hint: There are two pieces of evidence you could attempt to induct upon + here. If one doesn't work, try the other. *) +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (ev_plus_plus) + + This exercise can be completed without induction or case analysis. + But, you will need a clever assertion and some tedious rewriting. + Hint: Is [(n+m) + (n+p)] even? *) + +Theorem ev_plus_plus : forall n m p, + ev (n+m) -> ev (n+p) -> ev (m+p). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Multiple Induction Hypotheses *) + +(** Recall the definition of the reflexive, transitive, closure of a + relation: *) + +Module clos_refl_trans_remainder. +Inductive clos_refl_trans {X: Type} (R: X->X->Prop) : X->X->Prop := + | rt_step (x y : X) : + R x y -> + clos_refl_trans R x y + | rt_refl (x : X) : + clos_refl_trans R x x + | rt_trans (x y z : X) : + clos_refl_trans R x y -> + clos_refl_trans R y z -> + clos_refl_trans R x z. +End clos_refl_trans_remainder. + +(** Let's say that a relation on a type [X] is _diagonal_ if it + refines the identity relation -- i.e., if [R x y] implies [x = y]. *) + +Definition isDiagonal {X : Type} (R: X -> X -> Prop) := + forall x y, R x y -> x = y. + +(** Now consider the following lemma about diagonal relations: *) + +Lemma closure_of_diagonal_is_diagonal: forall X (R: X -> X -> Prop), + isDiagonal R -> + isDiagonal (clos_refl_trans R). +Proof. + intros X R IsDiag x y H. + induction H as [ x y H | x | x y z H IH H' IH' ]. + (* The two first cases go as you'd expect... *) + - specialize (IsDiag x y H). rewrite -> IsDiag. reflexivity. + - reflexivity. + - (* ... but something interesting happens here: there are two + induction hypotheses, [IH] and [IH']! If you think about it, it + is not that weird: we are in the case [srt_trans], which has + two recursive components, [H], relating [x] to [y] and [H'], + relating [y] to [z]. Hence we may want (and will actually need) + an induction hypothesis for [H] and one for [H'] -- they are + called [IH] and [IH'] here. In general, Rocq will always + generate one induction hypothesis per recursive constructor of + the type being inducted over. *) + rewrite -> IH, <- IH'. reflexivity. +Qed. + +(** **** Exercise: 4 stars, advanced, optional (ev'_ev) + + In general, there may be multiple ways of defining a + property inductively. For example, here's a (slightly contrived) + alternative definition for [ev]: *) + +Inductive ev' : nat -> Prop := + | ev'_0 : ev' 0 + | ev'_2 : ev' 2 + | ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m). + +(** Prove that this definition is logically equivalent to the old one. + To streamline the proof, use the technique (from the [Logic] + chapter) of applying theorems to arguments, and note that the same + technique works with constructors of inductively defined + propositions. *) + +Theorem ev'_ev : forall n, ev' n <-> ev n. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** We can do similar inductive proofs on the [Perm3] relation, + which we defined earlier as follows: *) + +Module Perm3Reminder. + +Inductive Perm3 {X : Type} : list X -> list X -> Prop := + | perm3_swap12 (a b c : X) : + Perm3 [a;b;c] [b;a;c] + | perm3_swap23 (a b c : X) : + Perm3 [a;b;c] [a;c;b] + | perm3_trans (l1 l2 l3 : list X) : + Perm3 l1 l2 -> Perm3 l2 l3 -> Perm3 l1 l3. + +End Perm3Reminder. + +Lemma Perm3_symm : forall (X : Type) (l1 l2 : list X), + Perm3 l1 l2 -> Perm3 l2 l1. +Proof. + intros X l1 l2 E. + induction E as [a b c | a b c | l1 l2 l3 E12 IH12 E23 IH23]. + - apply perm3_swap12. + - apply perm3_swap23. + - apply (perm3_trans _ l2 _). + * apply IH23. + * apply IH12. +Qed. + +(** **** Exercise: 2 stars, standard (Perm3_In) *) +Lemma Perm3_In : forall (X : Type) (x : X) (l1 l2 : list X), + Perm3 l1 l2 -> In x l1 -> In x l2. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard, optional (Perm3_NotIn) *) +Lemma Perm3_NotIn : forall (X : Type) (x : X) (l1 l2 : list X), + Perm3 l1 l2 -> ~In x l1 -> ~In x l2. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (NotPerm3) + + Proving that something is NOT a permutation is quite tricky. Some + of the lemmas above, like [Perm3_In] can be useful for this. *) +Example Perm3_example2 : ~ Perm3 [1;2;3] [1;2;4]. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Exercising with Inductive Relations *) + +(** A proposition parameterized by a number (such as [ev]) + can be thought of as a _property_ -- i.e., it defines + a subset of [nat], namely those numbers for which the proposition + is provable. In the same way, a two-argument proposition can be + thought of as a _relation_ -- i.e., it defines a set of pairs for + which the proposition is provable. *) + +Module Playground. + +(** Just like properties, relations can be defined inductively. One + useful example is the "less than or equal to" relation on numbers + that we briefly saw above. *) + +Inductive le : nat -> nat -> Prop := + | le_n (n : nat) : le n n + | le_S (n m : nat) (H : le n m) : le n (S m). + +Notation "n <= m" := (le n m). + +(** (We've written the definition a bit differently this time, + giving explicit names to the arguments to the constructors and + moving them to the left of the colons.) *) + +(** Proofs of facts about [<=] using the constructors [le_n] and + [le_S] follow the same patterns as proofs about properties, like + [ev] above. We can [apply] the constructors to prove [<=] + goals (e.g., to show that [3<=3] or [3<=6]), and we can use + tactics like [inversion] to extract information from [<=] + hypotheses in the context (e.g., to prove that [(2 <= 1) -> + 2+2=5].) *) + +(** Here are some sanity checks on the definition. (Notice that, + although these are the same kind of simple "unit tests" as we gave + for the testing functions we wrote in the first few lectures, we + must construct their proofs explicitly -- [simpl] and + [reflexivity] don't do the job, because the proofs aren't just a + matter of simplifying computations.) *) + +Theorem test_le1 : + 3 <= 3. +Proof. + (* WORKED IN CLASS *) + apply le_n. Qed. + +Theorem test_le2 : + 3 <= 6. +Proof. + (* WORKED IN CLASS *) + apply le_S. apply le_S. apply le_S. apply le_n. Qed. + +Theorem test_le3 : + (2 <= 1) -> 2 + 2 = 5. +Proof. + (* WORKED IN CLASS *) + intros H. inversion H. inversion H2. Qed. + +(** The "strictly less than" relation [n < m] can now be defined + in terms of [le]. *) + +Definition lt (n m : nat) := le (S n) m. + +Notation "n < m" := (lt n m). + +(** The [>=] operation is defined in terms of [<=]. *) + +Definition ge (m n : nat) : Prop := le n m. +Notation "m >= n" := (ge m n). + +End Playground. + +(** From the definition of [le], we can sketch the behaviors of + [destruct], [inversion], and [induction] on a hypothesis [H] + providing evidence of the form [le e1 e2]. Doing [destruct H] + will generate two cases. In the first case, [e1 = e2], and it + will replace instances of [e2] with [e1] in the goal and context. + In the second case, [e2 = S n'] for some [n'] for which [le e1 n'] + holds, and it will replace instances of [e2] with [S n']. + Doing [inversion H] will remove impossible cases and add generated + equalities to the context for further use. Doing [induction H] + will, in the second case, add the induction hypothesis that the + goal holds when [e2] is replaced with [n']. *) + +(** Here are a number of facts about the [<=] and [<] relations that + we are going to need later in the course. The proofs make good + practice exercises. *) + +(** **** Exercise: 3 stars, standard, especially useful (le_facts) *) +Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o. +Proof. + (* FILL IN HERE *) Admitted. + +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. + (* FILL IN HERE *) Admitted. + +Theorem le_plus_l : forall a b, + a <= a + b. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, especially useful (plus_le_facts1) *) + +Theorem plus_le : forall n1 n2 m, + n1 + n2 <= m -> + n1 <= m /\ n2 <= m. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem plus_le_cases : forall n m p q, + n + m <= p + q -> n <= p \/ m <= q. + (** Hint: May be easiest to prove by induction on [n]. *) +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, especially useful (plus_le_facts2) *) + +Theorem plus_le_compat_l : forall n m p, + n <= m -> + p + n <= p + m. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem plus_le_compat_r : forall n m p, + n <= m -> + n + p <= m + p. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem le_plus_trans : forall n m p, + n <= m -> + n <= m + p. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (lt_facts) *) +Theorem lt_ge_cases : forall n m, + n < m \/ n >= m. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem n_lt_m__n_le_m : forall n m, + n < m -> + n <= m. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem plus_lt : forall n1 n2 m, + n1 + n2 < m -> + n1 < m /\ n2 < m. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 4 stars, standard, optional (leb_le) *) +Theorem leb_complete : forall n m, + n <=? m = true -> n <= m. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem leb_correct : forall n m, + n <= m -> + n <=? m = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** Hint: The next two can easily be proved without using [induction]. *) + +Theorem leb_iff : forall n m, + n <=? m = true <-> n <= m. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem leb_true_trans : forall n m o, + n <=? m = true -> m <=? o = true -> n <=? o = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +Module R. + +(** **** Exercise: 3 stars, standard, especially useful (R_provability) + + We can define three-place relations, four-place relations, + etc., in just the same way as binary relations. For example, + consider the following three-place relation on numbers: *) + +Inductive R : nat -> nat -> nat -> Prop := + | c1 : R 0 0 0 + | c2 m n o (H : R m n o ) : R (S m) n (S o) + | c3 m n o (H : R m n o ) : R m (S n) (S o) + | c4 m n o (H : R (S m) (S n) (S (S o))) : R m n o + | c5 m n o (H : R m n o ) : R n m o. + +(** - Which of the following propositions are provable? + - [R 1 1 2] + - [R 2 2 6] + + - If we dropped constructor [c5] from the definition of [R], + would the set of provable propositions change? Briefly (1 + sentence) explain your answer. + + - If we dropped constructor [c4] from the definition of [R], + would the set of provable propositions change? Briefly (1 + sentence) explain your answer. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_R_provability : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (R_fact) + + The relation [R] above actually encodes a familiar function. + Figure out which function; then state and prove this equivalence + in Rocq. *) + +Definition fR : nat -> nat -> nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem R_equiv_fR : forall m n o, R m n o <-> fR m n = o. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +End R. + +(** **** Exercise: 4 stars, advanced (subsequence) + + A list is a _subsequence_ of another list if all of the elements + in the first list occur in the same order in the second list, + possibly with some extra elements in between. For example, + + [1;2;3] + + is a subsequence of each of the lists + + [1;2;3] + [1;1;1;2;2;3] + [1;2;7;3] + [5;6;1;9;9;2;7;3;8] + + but it is _not_ a subsequence of any of the lists + + [1;2] + [1;3] + [5;6;2;1;7;3;8]. + + - Define an inductive proposition [subseq] on [list nat] that + captures what it means to be a subsequence. There are a number + of correct ways to do this. You should make sure that your + definition behaves correctly on all the positive and negative + examples above, but you do not need to prove this formally. + + - Prove [subseq_refl] that subsequence is reflexive, that is, + any list is a subsequence of itself. + + - Prove [subseq_app] that for any lists [l1], [l2], and [l3], + if [l1] is a subsequence of [l2], then [l1] is also a subsequence + of [l2 ++ l3]. + + - (Harder) Prove [subseq_trans] that subsequence is transitive -- + that is, if [l1] is a subsequence of [l2] and [l2] is a + subsequence of [l3], then [l1] is a subsequence of [l3]. *) + +Inductive subseq : list nat -> list nat -> Prop := +(* FILL IN HERE *) +. + +Theorem subseq_refl : forall (l : list nat), subseq l l. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem subseq_app : forall (l1 l2 l3 : list nat), + subseq l1 l2 -> + subseq l1 (l2 ++ l3). +Proof. + (* FILL IN HERE *) Admitted. + +Theorem subseq_trans : forall (l1 l2 l3 : list nat), + subseq l1 l2 -> + subseq l2 l3 -> + subseq l1 l3. +Proof. + (* Hint: be careful about what you are doing induction on and which + other things need to be generalized... *) + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (R_provability2) + + Suppose we give Rocq the following definition: + + Inductive R : nat -> list nat -> Prop := + | c1 : R 0 [] + | c2 n l (H: R n l) : R (S n) (n :: l) + | c3 n l (H: R (S n) l) : R n l. + + Which of the following propositions are provable? + + - [R 2 [1;0]] + - [R 1 [1;2;1;0]] + - [R 6 [3;2;1;0]] *) + +(* FILL IN HERE + + [] *) + +(** **** Exercise: 2 stars, standard, optional (total_relation) + + Define an inductive binary relation [total_relation] that holds + between every pair of natural numbers. *) + +Inductive total_relation : nat -> nat -> Prop := + (* FILL IN HERE *) +. + +Theorem total_relation_is_total : forall n m, total_relation n m. + Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (empty_relation) + + Define an inductive binary relation [empty_relation] (on numbers) + that never holds. *) + +Inductive empty_relation : nat -> nat -> Prop := + (* FILL IN HERE *) +. + +Theorem empty_relation_is_empty : forall n m, ~ empty_relation n m. + Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Case Study: Regular Expressions *) + +(** Many of the examples above were simple and -- in the case of + the [ev] property -- even a bit artificial. To give a better sense + of the power of inductively defined propositions, we now show how + to use them to model a classic concept in computer science: + _regular expressions_. *) + +(* ================================================================= *) +(** ** Definitions *) + +(** Regular expressions are a natural language for describing sets of + strings. Their syntax is defined as follows: *) + +Inductive reg_exp (T : Type) : Type := + | EmptySet + | EmptyStr + | Char (t : T) + | App (r1 r2 : reg_exp T) + | Union (r1 r2 : reg_exp T) + | Star (r : reg_exp T). + +Arguments EmptySet {T}. +Arguments EmptyStr {T}. +Arguments Char {T} _. +Arguments App {T} _ _. +Arguments Union {T} _ _. +Arguments Star {T} _. + +(** Note that this definition is _polymorphic_: Regular + expressions in [reg_exp T] describe strings with characters drawn + from [T] -- which in this exercise we represent as _lists_ with + elements from [T]. *) + +(** (Technical aside: We depart slightly from standard practice in + that we do not require the type [T] to be finite. This results in + a somewhat different theory of regular expressions, but the + difference is not significant for present purposes.) *) + +(** We connect regular expressions and strings by defining when a + regular expression _matches_ some string. + + Informally this looks as follows: + + - The regular expression [EmptySet] does not match any string. + + - [EmptyStr] matches the empty string [[]]. + + - [Char x] matches the one-character string [[x]]. + + - If [re1] matches [s1], and [re2] matches [s2], + then [App re1 re2] matches [s1 ++ s2]. + + - If at least one of [re1] and [re2] matches [s], + then [Union re1 re2] matches [s]. + + - Finally, if we can write some string [s] as the concatenation + of a sequence of strings [s = s_1 ++ ... ++ s_k], and the + expression [re] matches each one of the strings [s_i], + then [Star re] matches [s]. + + In particular, the sequence of strings may be empty, so + [Star re] always matches the empty string [[]] no matter what + [re] is. *) + +(** We can easily translate this intuition into a set of rules, + where we write [s =~ re] to say that [re] matches [s]: + + -------------- (MEmpty) + [] =~ EmptyStr + + --------------- (MChar) + [x] =~ (Char x) + + s1 =~ re1 s2 =~ re2 + --------------------------- (MApp) + (s1 ++ s2) =~ (App re1 re2) + + s1 =~ re1 + --------------------- (MUnionL) + s1 =~ (Union re1 re2) + + s2 =~ re2 + --------------------- (MUnionR) + s2 =~ (Union re1 re2) + + --------------- (MStar0) + [] =~ (Star re) + + s1 =~ re + s2 =~ (Star re) + ----------------------- (MStarApp) + (s1 ++ s2) =~ (Star re) +*) + +(** This directly corresponds to the following [Inductive] definition. + We use the notation [s =~ re] in place of [exp_match s re]. + (By "reserving" the notation before defining the [Inductive], + we can use it in the definition.) *) + +Reserved Notation "s =~ re" (at level 80). + +Inductive exp_match {T} : list T -> reg_exp T -> Prop := + | MEmpty : [] =~ EmptyStr + | MChar x : [x] =~ (Char x) + | MApp s1 re1 s2 re2 + (H1 : s1 =~ re1) + (H2 : s2 =~ re2) + : (s1 ++ s2) =~ (App re1 re2) + | MUnionL s1 re1 re2 + (H1 : s1 =~ re1) + : s1 =~ (Union re1 re2) + | MUnionR s2 re1 re2 + (H2 : s2 =~ re2) + : s2 =~ (Union re1 re2) + | MStar0 re : [] =~ (Star re) + | MStarApp s1 s2 re + (H1 : s1 =~ re) + (H2 : s2 =~ (Star re)) + : (s1 ++ s2) =~ (Star re) + + where "s =~ re" := (exp_match s re). + +(** Notice that these rules are not _quite_ the same as the + intuition that we gave at the beginning of the section. First, we + don't need to include a rule explicitly stating that no string is + matched by [EmptySet]; indeed, the syntax of inductive definitions + doesn't even _allow_ us to give such a "negative rule." We just + don't happen to include any rule that would have the effect of + [EmptySet] matching some string. + + Second, the intuition we gave for [Union] and [Star] correspond + to two constructors each: [MUnionL] / [MUnionR], and [MStar0] / + [MStarApp]. The result is logically equivalent to the original + intuition but more convenient to use in Rocq, since the recursive + occurrences of [exp_match] are given as direct arguments to the + constructors, making it easier to perform induction on evidence. + (The [exp_match_ex1] and [exp_match_ex2] exercises below ask you + to prove that the constructors given in the inductive declaration + and the ones that would arise from a more literal transcription of + the intuition is indeed equivalent.) + + Let's illustrate these rules with a few examples. *) + +(* ================================================================= *) +(** ** Examples *) + +Example reg_exp_ex1 : [1] =~ Char 1. +Proof. + apply MChar. +Qed. + +Example reg_exp_ex2 : [1; 2] =~ App (Char 1) (Char 2). +Proof. + apply (MApp [1]). + - apply MChar. + - apply MChar. +Qed. + +(** (Notice how the last example applies [MApp] to the string + [[1]] directly. Since the goal mentions [[1; 2]] instead of + [[1] ++ [2]], Rocq wouldn't be able to figure out how to split + the string on its own.) + + Using [inversion], we can also show that certain strings do _not_ + match a regular expression: *) + +Example reg_exp_ex3 : ~ ([1; 2] =~ Char 1). +Proof. + intros H. inversion H. +Qed. + +(** We can define helper functions for writing down regular + expressions. The [reg_exp_of_list] function constructs a regular + expression that matches exactly the string that it receives as an + argument: *) + +Fixpoint reg_exp_of_list {T} (l : list T) := + match l with + | [] => EmptyStr + | x :: l' => App (Char x) (reg_exp_of_list l') + end. + +Example reg_exp_ex4 : [1; 2; 3] =~ reg_exp_of_list [1; 2; 3]. +Proof. + simpl. apply (MApp [1]). + { apply MChar. } + apply (MApp [2]). + { apply MChar. } + apply (MApp [3]). + { apply MChar. } + apply MEmpty. +Qed. + +(** We can also prove general facts about [exp_match]. For instance, + the following lemma shows that every string [s] matched by [re] + is also matched by [Star re]. *) + +Lemma MStar1 : + forall T s (re : reg_exp T) , + s =~ re -> + s =~ Star re. +Proof. + intros T s re H. + rewrite <- (app_nil_r _ s). + apply MStarApp. + - apply H. + - apply MStar0. +Qed. + +(** (Note the use of [app_nil_r] to change the goal of the theorem to + exactly the shape expected by [MStarApp].) *) + +(** **** Exercise: 3 stars, standard (exp_match_ex1) + + The following lemmas show that the intuition about matching given + at the beginning of the chapter can be obtained from the formal + inductive definition. *) + +Lemma EmptySet_is_empty : forall T (s : list T), + ~ (s =~ EmptySet). +Proof. + (* FILL IN HERE *) Admitted. + +Lemma MUnion' : forall T (s : list T) (re1 re2 : reg_exp T), + s =~ re1 \/ s =~ re2 -> + s =~ Union re1 re2. +Proof. + (* FILL IN HERE *) Admitted. + +(** The next lemma is stated in terms of the [fold] function from the + [Poly] chapter: If [ss : list (list T)] represents a sequence of + strings [s1, ..., sn], then [fold app ss []] is the result of + concatenating them all together. *) + +Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp T), + (forall s, In s ss -> s =~ re) -> + fold app ss [] =~ Star re. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (EmptyStr_not_needed) + + It turns out that the [EmptyStr] constructor is actually not + needed, since the regular expression matching the empty string can + also be defined from [Star] and [EmptySet]: *) +Definition EmptyStr' {T:Type} := @Star T (EmptySet). + +(** State and prove that this [EmptyStr'] definition matches exactly + the same strings as the [EmptyStr] constructor. *) + +(* FILL IN HERE + + [] *) + +(** Since the definition of [exp_match] has a recursive + structure, we might expect that proofs involving regular + expressions will often require induction on evidence. *) + +(** For example, suppose we want to prove the following intuitive + fact: If a string [s] is matched by a regular expression [re], + then all elements of [s] must occur as character literals + somewhere in [re]. + + To state this as a theorem, we first define a function [re_chars] + that lists all characters that occur in a regular expression: *) + +Fixpoint re_chars {T} (re : reg_exp T) : list T := + match re with + | EmptySet => [] + | EmptyStr => [] + | Char x => [x] + | App re1 re2 => re_chars re1 ++ re_chars re2 + | Union re1 re2 => re_chars re1 ++ re_chars re2 + | Star re => re_chars re + end. + +(** Now, the main theorem: *) + +Theorem in_re_match : forall T (s : list T) (re : reg_exp T) (x : T), + s =~ re -> + In x s -> + In x (re_chars re). +Proof. + intros T s re x Hmatch Hin. + induction Hmatch + as [| x' + | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2]. + (* WORKED IN CLASS *) + - (* MEmpty *) + simpl in Hin. destruct Hin. + - (* MChar *) + simpl. simpl in Hin. + apply Hin. + - (* MApp *) + simpl. + +(** Something interesting happens in the [MApp] case. We obtain + _two_ induction hypotheses: One that applies when [x] occurs in + [s1] (which is matched by [re1]), and a second one that applies when [x] + occurs in [s2] (matched by [re2]). *) + + rewrite In_app_iff in *. + destruct Hin as [Hin | Hin]. + + (* In x s1 *) + left. apply (IH1 Hin). + + (* In x s2 *) + right. apply (IH2 Hin). + - (* MUnionL *) + simpl. rewrite In_app_iff. + left. apply (IH Hin). + - (* MUnionR *) + simpl. rewrite In_app_iff. + right. apply (IH Hin). + - (* MStar0 *) + destruct Hin. + - (* MStarApp *) + simpl. + +(** Here again we get two induction hypotheses, and they illustrate + why we need induction on evidence for [exp_match], rather than + induction on the regular expression [re]: The latter would only + provide an induction hypothesis for strings that match [re], which + would not allow us to reason about the case [In x s2]. *) + + rewrite In_app_iff in Hin. + destruct Hin as [Hin | Hin]. + + (* In x s1 *) + apply (IH1 Hin). + + (* In x s2 *) + apply (IH2 Hin). +Qed. + +(** **** Exercise: 4 stars, standard (re_not_empty) + + Write a recursive function [re_not_empty] that tests whether a + regular expression matches some string. Prove that your function + is correct. *) + +Fixpoint re_not_empty {T : Type} (re : reg_exp T) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Lemma re_not_empty_correct : forall T (re : reg_exp T), + (exists s, s =~ re) <-> re_not_empty re = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** The [remember] Tactic *) + +(** One potentially confusing feature of the [induction] tactic is + that it will let you try to perform an induction over a term that + isn't sufficiently general. The effect of this is to lose + information (much as [destruct] without an [eqn:] clause can do), + and leave you unable to complete the proof. Here's an example: *) + +Lemma star_app: forall T (s1 s2 : list T) (re : reg_exp T), + s1 =~ Star re -> + s2 =~ Star re -> + s1 ++ s2 =~ Star re. +Proof. + intros T s1 s2 re H1. + +(** Now, just doing an [inversion] on [H1] won't get us very far in + the recursive cases. (Try it!). So we need induction (on + evidence). Here is a naive first attempt. *) + + induction H1 + as [|x'|s1 re1 s2' re2 Hmatch1 IH1 Hmatch2 IH2 + |s1 re1 re2 Hmatch IH|re1 s2' re2 Hmatch IH + |re''|s1 s2' re'' Hmatch1 IH1 Hmatch2 IH2]. + +(** But now, although we get seven cases (as we would expect + from the definition of [exp_match]), we have lost a very important + bit of information from [H1]: the fact that [s1] matched something + of the form [Star re]. This means that we have to give proofs for + _all_ seven constructors of this definition, even though all but + two of them ([MStar0] and [MStarApp]) are contradictory. We can + still get the proof to go through for a few constructors, such as + [MEmpty]... *) + + - (* MEmpty *) + simpl. intros H. apply H. + +(** ... but most cases get stuck. For [MChar], for instance, we + must show + + s2 =~ Char x' -> + x'::s2 =~ Char x' + + which is clearly impossible. *) + + - (* MChar. *) intros H. simpl. (* Stuck... *) +Abort. + +(** The problem here is that [induction] over a Prop hypothesis only + works properly with hypotheses that are "fully general," i.e., + ones in which all the arguments are just variables, as opposed to more + specific expressions like [Star re]. + + (In this respect, [induction] on evidence behaves more like + [destruct]-without-[eqn:] than like [inversion].) + + A possible, but awkward, way to solve this problem is "manually + generalizing" over the problematic expressions by adding + explicit equality hypotheses to the lemma: *) + +Lemma star_app: forall T (s1 s2 : list T) (re re' : reg_exp T), + re' = Star re -> + s1 =~ re' -> + s2 =~ Star re -> + s1 ++ s2 =~ Star re. + +(** We can now proceed by performing induction over evidence + directly, because the argument to the first hypothesis is + sufficiently general, which means that we can discharge most cases + by inverting the [re' = Star re] equality in the context. + + This works, but it makes the statement of the lemma a bit ugly. + Fortunately, there is a better way... *) +Abort. + +(** The tactic [remember e as x eqn:Eq] causes Rocq to (1) replace all + occurrences of the expression [e] by the variable [x], and (2) add + an equation [Eq : x = e] to the context. Here's how we can use it + to show the above result: *) + +Lemma star_app: forall T (s1 s2 : list T) (re : reg_exp T), + s1 =~ Star re -> + s2 =~ Star re -> + s1 ++ s2 =~ Star re. +Proof. + intros T s1 s2 re H1. + remember (Star re) as re' eqn:Eq. + +(** We now have [Eq : re' = Star re]. *) + + induction H1 + as [|x'|s1 re1 s2' re2 Hmatch1 IH1 Hmatch2 IH2 + |s1 re1 re2 Hmatch IH|re1 s2' re2 Hmatch IH + |re''|s1 s2' re'' Hmatch1 IH1 Hmatch2 IH2]. + +(** The [Eq] is contradictory in most cases, allowing us to + conclude immediately. *) + + - (* MEmpty *) discriminate. + - (* MChar *) discriminate. + - (* MApp *) discriminate. + - (* MUnionL *) discriminate. + - (* MUnionR *) discriminate. + +(** The interesting cases are those that correspond to [Star]. *) + + - (* MStar0 *) + intros H. apply H. + + - (* MStarApp *) + intros H1. rewrite <- app_assoc. + apply MStarApp. + + apply Hmatch1. + + apply IH2. + * apply Eq. + * apply H1. + +(** Note that the induction hypothesis [IH2] on the [MStarApp] case + mentions an additional premise [Star re'' = Star re], which + results from the equality generated by [remember]. *) +Qed. + +(** **** Exercise: 4 stars, standard, optional (exp_match_ex2) *) + +(** The [MStar''] lemma below (combined with its converse, the + [MStar'] exercise above), shows that our definition of [exp_match] + for [Star] is equivalent to the informal one given previously. *) + +Lemma MStar'' : forall T (s : list T) (re : reg_exp T), + s =~ Star re -> + exists ss : list (list T), + s = fold app ss [] + /\ forall s', In s' ss -> s' =~ re. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** The "Weak" Pumping Lemma *) + +(** One of the first really interesting theorems in the theory of + regular expressions is the so-called _pumping lemma_, which + states, informally, that any sufficiently long string [s] matching + a regular expression [re] can be "pumped" by repeating some middle + section of [s] an arbitrary number of times to produce a new + string also matching [re]. For the sake of simplicity, this + exercise considers a slightly weaker theorem than is usually + stated in courses on automata theory -- hence the name + [weak_pumping]. The stronger one can be found below. + + To get started, we need to define "sufficiently long." Since we + are working in a constructive logic, we actually need to be able + to _calculate_, for each regular expression [re], a minimum length + for strings [s] to guarantee "pumpability." *) + +Module Pumping. + +Fixpoint pumping_constant {T} (re : reg_exp T) : nat := + match re with + | EmptySet => 1 + | EmptyStr => 1 + | Char _ => 2 + | App re1 re2 => + pumping_constant re1 + pumping_constant re2 + | Union re1 re2 => + pumping_constant re1 + pumping_constant re2 + | Star r => pumping_constant r + end. + +(** You may find these lemmas about the pumping constant useful when + proving the pumping lemma below. *) + +Lemma pumping_constant_ge_1 : + forall T (re : reg_exp T), + pumping_constant re >= 1. +Proof. + intros T re. induction re. + - (* EmptySet *) + apply le_n. + - (* EmptyStr *) + apply le_n. + - (* Char *) + apply le_S. apply le_n. + - (* App *) + simpl. + apply le_trans with (n:=pumping_constant re1). + apply IHre1. apply le_plus_l. + - (* Union *) + simpl. + apply le_trans with (n:=pumping_constant re1). + apply IHre1. apply le_plus_l. + - (* Star *) + simpl. apply IHre. +Qed. + +Lemma pumping_constant_0_false : + forall T (re : reg_exp T), + pumping_constant re = 0 -> False. +Proof. + intros T re H. + assert (Hp1 : pumping_constant re >= 1). + { apply pumping_constant_ge_1. } + rewrite H in Hp1. inversion Hp1. +Qed. + +(** Next, it is useful to define an auxiliary function that repeats a + string (appends it to itself) some number of times. *) + +Fixpoint napp {T} (n : nat) (l : list T) : list T := + match n with + | 0 => [] + | S n' => l ++ napp n' l + end. + +(** This auxiliary lemma might also be useful in your proof of the + pumping lemma. *) + +Lemma napp_plus: forall T (n m : nat) (l : list T), + napp (n + m) l = napp n l ++ napp m l. +Proof. + intros T n m l. + induction n as [|n IHn]. + - reflexivity. + - simpl. rewrite IHn, app_assoc. reflexivity. +Qed. + +Lemma napp_star : + forall T m s1 s2 (re : reg_exp T), + s1 =~ re -> s2 =~ Star re -> + napp m s1 ++ s2 =~ Star re. +Proof. + intros T m s1 s2 re Hs1 Hs2. + induction m. + - simpl. apply Hs2. + - simpl. rewrite <- app_assoc. + apply MStarApp. + + apply Hs1. + + apply IHm. +Qed. + +(** The (weak) pumping lemma itself says that, if [s =~ re] and if the + length of [s] is at least the pumping constant of [re], then [s] + can be split into three substrings [s1 ++ s2 ++ s3] in such a way + that [s2] can be repeated any number of times and the result, when + combined with [s1] and [s3], will still match [re]. Since [s2] is + also guaranteed not to be the empty string, this gives us + a (constructive!) way to generate strings matching [re] that are + as long as we like. *) + +(** This proof is quite long, so to make it more tractable we've + broken it up into a number of sub-proofs, which we then assemble + to prove the main lemma. + + Your job is to complete the proofs of the helper lemmas; the main + lemma relies on these. Several of the lemmas about [le] that were + in an optional exercise earlier in this chapter may be useful here + -- in particular, [lt_ge_cases] and [plus_le]. *) + +(** **** Exercise: 2 stars, standard (weak_pumping_char) *) +Lemma weak_pumping_char : forall (T : Type) (x : T), + pumping_constant (Char x) <= length [x] -> + exists s1 s2 s3 : list T, + [x] = s1 ++ s2 ++ s3 /\ + s2 <> [ ] /\ + (forall m : nat, s1 ++ napp m s2 ++ s3 =~ Char x). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (weak_pumping_app) *) +Lemma weak_pumping_app : forall (T : Type) + (s1 s2 : list T) (re1 re2 : reg_exp T), + s1 =~ re1 -> + s2 =~ re2 -> + (pumping_constant re1 <= length s1 -> + exists s2 s3 s4 : list T, + s1 = s2 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s2 ++ napp m s3 ++ s4 =~ re1)) -> + (pumping_constant re2 <= length s2 -> + exists s1 s3 s4 : list T, + s2 = s1 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s1 ++ napp m s3 ++ s4 =~ re2)) -> + pumping_constant (App re1 re2) <= length (s1 ++ s2) -> + exists s0 s3 s4 : list T, + s1 ++ s2 = s0 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s0 ++ napp m s3 ++ s4 =~ App re1 re2). +Proof. + simpl. intros T s1 s2 re1 re2 Hmatch1 Hmatch2 IH1 IH2 Hlen. + assert (H : pumping_constant re1 <= length s1 \/ + pumping_constant re2 <= length s2). + { + (* FILL IN HERE *) admit. + } + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (weak_pumping_union_l) *) +Lemma weak_pumping_union_l : forall T (s1 : list T) (re1 re2 : reg_exp T), + s1 =~ re1 -> + (pumping_constant re1 <= length s1 -> + exists s2 s3 s4 : list T, + s1 = s2 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s2 ++ napp m s3 ++ s4 =~ re1)) -> + pumping_constant (Union re1 re2) <= length s1 -> + exists s0 s2 s3 : list T, + s1 = s0 ++ s2 ++ s3 /\ + s2 <> [ ] /\ + (forall m : nat, s0 ++ napp m s2 ++ s3 =~ Union re1 re2). +Proof. + simpl. intros T s1 re1 re2 Hmatch IH Hlen. + assert (H : pumping_constant re1 <= length s1). + { + (* FILL IN HERE *) admit. + } + (* FILL IN HERE *) Admitted. +(** [] *) + +Lemma weak_pumping_union_r : forall T (s2 : list T) (re1 re2 : reg_exp T), + s2 =~ re2 -> + (pumping_constant re2 <= length s2 -> + exists s1 s3 s4 : list T, + s2 = s1 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s1 ++ napp m s3 ++ s4 =~ re2)) -> + pumping_constant (Union re1 re2) <= length s2 -> + exists s1 s0 s3 : list T, + s2 = s1 ++ s0 ++ s3 /\ + s0 <> [ ] /\ + (forall m : nat, s1 ++ napp m s0 ++ s3 =~ Union re1 re2). +Proof. + (* Symmetric to the previous... *) + (* FILL IN HERE *) Admitted. + +(** **** Exercise: 2 stars, standard, optional (weak_pumping_star_zero) *) +Lemma weak_pumping_star_zero : forall T (re : reg_exp T), + pumping_constant (Star re) <= @length T [] -> + exists s1 s2 s3 : list T, + [ ] = s1 ++ s2 ++ s3 /\ + s2 <> [ ] /\ + (forall m : nat, s1 ++ napp m s2 ++ s3 =~ Star re). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 4 stars, standard, optional (weak_pumping_star_app) + + (You may also want the [plus_le_cases] lemma here.) *) + +Lemma weak_pumping_star_app : forall T (s1 s2 : list T) (re : reg_exp T), + s1 =~ re -> + s2 =~ Star re -> + (pumping_constant re <= length s1 -> + exists s2 s3 s4 : list T, + s1 = s2 ++ s3 ++ s4 + /\ s3 <> [ ] /\ + (forall m : nat, s2 ++ napp m s3 ++ s4 =~ re)) -> + (pumping_constant (Star re) <= length s2 -> + exists s1 s3 s4 : list T, + s2 = s1 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s1 ++ napp m s3 ++ s4 =~ Star re)) -> + pumping_constant (Star re) <= length (s1 ++ s2) -> + exists s0 s3 s4 : list T, + s1 ++ s2 = s0 ++ s3 ++ s4 /\ + s3 <> [ ] /\ + (forall m : nat, s0 ++ napp m s3 ++ s4 =~ Star re). +Proof. + simpl. intros T s1 s2 re Hmatch1 Hmatch2 IH1 IH2 Hlen. + rewrite app_length in *. + assert (Hs1re1 : length s1 = 0 + \/ (length s1 <> 0 /\ length s1 < pumping_constant re) + \/ pumping_constant re <= length s1). + { + induction s1 as [| h s1' IHs1]. + - (* FILL IN HERE *) admit. + - (* FILL IN HERE *) admit. + } + (* FILL IN HERE *) Admitted. +(** [] *) + +Lemma weak_pumping : forall T (re : reg_exp T) s, + s =~ re -> + pumping_constant re <= length s -> + exists s1 s2 s3, + s = s1 ++ s2 ++ s3 /\ + s2 <> [] /\ + forall m, s1 ++ napp m s2 ++ s3 =~ re. +Proof. + intros T re s Hmatch. + induction Hmatch + as [ | x | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2 ]. + - (* MEmpty *) + simpl. intros contra. inversion contra. + - apply weak_pumping_char. + - apply weak_pumping_app; assumption. + - apply weak_pumping_union_l; assumption. + - apply weak_pumping_union_r; assumption. + - apply weak_pumping_star_zero. + - apply weak_pumping_star_app; assumption. +Qed. + +(* ================================================================= *) +(** ** The (Strong) Pumping Lemma *) + +(** **** Exercise: 5 stars, advanced, optional (pumping) + + Now here is the usual version of the pumping lemma. In addition to + requiring that [s2 <> []], it also strengthens the result to + include the claim that [length s1 + length s2 <= pumping_constant + re]. *) + +Lemma pumping : forall T (re : reg_exp T) s, + s =~ re -> + pumping_constant re <= length s -> + exists s1 s2 s3, + s = s1 ++ s2 ++ s3 /\ + s2 <> [] /\ + length s1 + length s2 <= pumping_constant re /\ + forall m, s1 ++ napp m s2 ++ s3 =~ re. + +(** You may want to copy your proof of weak_pumping below. *) +Proof. + intros T re s Hmatch. + induction Hmatch + as [ | x | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2 + | s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH + | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2 ]. + - (* MEmpty *) + simpl. intros contra. inversion contra. + (* FILL IN HERE *) Admitted. + +End Pumping. +(** [] *) + +(* ################################################################# *) +(** * Case Study: Improving Reflection *) + +(** We've seen in the [Logic] chapter that we sometimes + need to relate boolean computations to statements in [Prop]. But + performing this conversion as we did there can result in tedious + proof scripts. Consider the proof of the following theorem: *) + +Theorem filter_not_empty_In : forall n l, + filter (fun x => n =? x) l <> [] -> In n l. +Proof. + intros n l. induction l as [|m l' IHl']. + - (* l = nil *) + simpl. intros H. apply H. reflexivity. + - (* l = m :: l' *) + simpl. destruct (n =? m) eqn:H. + + (* n =? m = true *) + intros _. rewrite eqb_eq in H. rewrite H. + left. reflexivity. + + (* n =? m = false *) + intros H'. right. apply IHl'. apply H'. +Qed. + +(** In the first branch after [destruct], we explicitly apply the [eqb_eq] + lemma to the equation generated by destructing [n =? m], to convert the + assumption [n =? m + = true] into the assumption [n = m]; then we had to + [rewrite] using this assumption to complete the case. *) + +(** We can streamline this sort of reasoning by defining an inductive + proposition that yields a better case-analysis principle for [n =? + m]. Instead of generating the assumption [(n =? m) = true], which + usually requires some massaging before we can use it, this + principle gives us right away the assumption we really need: [n = + m]. + + Following the terminology introduced in [Logic], we call this + the "reflection principle for equality on numbers," and we say + that the boolean [n =? m] is _reflected in_ the proposition + [n = m]. *) + +Inductive reflect (P : Prop) : bool -> Prop := + | ReflectT (H : P) : reflect P true + | ReflectF (H : ~ P) : reflect P false. + +(** The [reflect] property takes two arguments: a proposition + [P] and a boolean [b]. It states that the property [P] + _reflects_ (intuitively, is equivalent to) the boolean [b]: that + is, [P] holds if and only if [b = true]. + + To see this, notice that, by definition, the only way we can + produce evidence for [reflect P true] is by showing [P] and then + using the [ReflectT] constructor. If we invert this statement, + this means that we can extract evidence for [P] from a proof of + [reflect P true]. + + Similarly, the only way to show [reflect P false] is by tagging + evidence for [~ P] with the [ReflectF] constructor. *) + +(** To put this observation to work, we first prove that the + statements [P <-> b = true] and [reflect P b] are indeed + equivalent. First, the left-to-right implication: *) + +Theorem iff_reflect : forall P b, (P <-> b = true) -> reflect P b. +Proof. + (* WORKED IN CLASS *) + intros P b H. destruct b eqn:Eb. + - apply ReflectT. rewrite H. reflexivity. + - apply ReflectF. rewrite H. intros H'. discriminate. +Qed. + +(** Now you prove the right-to-left implication: *) + +(** **** Exercise: 2 stars, standard, especially useful (reflect_iff) *) +Theorem reflect_iff : forall P b, reflect P b -> (P <-> b = true). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** We can think of [reflect] as a variant of the usual "if and only + if" connective; the advantage of [reflect] is that, by destructing + a hypothesis or lemma of the form [reflect P b], we can perform + case analysis on [b] while _at the same time_ generating + appropriate hypothesis in the two branches ([P] in the first + subgoal and [~ P] in the second). *) + +(** Let's use [reflect] to produce a smoother proof of + [filter_not_empty_In]. + + We begin by recasting the [eqb_eq] lemma in terms of [reflect]: *) + +Lemma eqbP : forall n m, reflect (n = m) (n =? m). +Proof. + intros n m. apply iff_reflect. rewrite eqb_eq. reflexivity. +Qed. + +(** The proof of [filter_not_empty_In] now goes as follows. Notice + how the calls to [destruct] and [rewrite] in the earlier proof of + this theorem are combined here into a single call to + [destruct]. *) + +(** (To see this clearly, execute the two proofs of + [filter_not_empty_In] with Rocq and observe the differences in + proof state at the beginning of the first case of the + [destruct].) *) + +Theorem filter_not_empty_In' : forall n l, + filter (fun x => n =? x) l <> [] -> + In n l. +Proof. + intros n l. induction l as [|m l' IHl']. + - (* l = [] *) + simpl. intros H. apply H. reflexivity. + - (* l = m :: l' *) + simpl. destruct (eqbP n m) as [EQnm | NEQnm]. + + (* n = m *) + intros _. rewrite EQnm. left. reflexivity. + + (* n <> m *) + intros H'. right. apply IHl'. apply H'. +Qed. + +(** **** Exercise: 3 stars, standard, especially useful (eqbP_practice) + + Use [eqbP] as above to prove the following: *) + +Fixpoint count n l := + match l with + | [] => 0 + | m :: l' => (if n =? m then 1 else 0) + count n l' + end. + +Theorem eqbP_practice : forall n l, + count n l = 0 -> ~(In n l). +Proof. + intros n l Hcount. induction l as [| m l' IHl']. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** This small example shows reflection giving us a small gain in + convenience; in larger developments, using [reflect] consistently + can often lead to noticeably shorter and clearer proof scripts. + We'll see many more examples in later chapters and in _Programming + Language Foundations_. + + This way of using [reflect] was popularized by _SSReflect_, a Rocq + library that has been used to formalize important results in + mathematics, including the 4-color theorem and the Feit-Thompson + theorem. The name SSReflect stands for _small-scale reflection_, + i.e., the pervasive use of reflection to streamline small proof + steps by turning them into boolean computations. *) + +(* ################################################################# *) +(** * Additional Exercises *) + +(** **** Exercise: 3 stars, standard, especially useful (nostutter_defn) + + Formulating inductive definitions of properties is an important + skill you'll need in this course. Try to solve this exercise + without any help. + + We say that a list "stutters" if it repeats the same element + consecutively. (This is different from not containing duplicates: + the sequence [[1;4;1]] has two occurrences of the element [1] but + does not stutter.) The property "[nostutter mylist]" means that + [mylist] does not stutter. Formulate an inductive definition for + [nostutter]. *) + +Inductive nostutter {X:Type} : list X -> Prop := + (* FILL IN HERE *) +. +(** Make sure each of these tests succeeds, but feel free to change + the suggested proof (in comments) if the given one doesn't work + for you. Your definition might be different from ours and still + be correct, in which case the examples might need a different + proof. (You'll notice that the suggested proofs use a number of + tactics we haven't talked about, to make them more robust to + different possible ways of defining [nostutter]. You can probably + just uncomment and use them as-is, but you can also prove each + example with more basic tactics.) *) + +Example test_nostutter_1: nostutter [3;1;4;1;5;6]. +(* FILL IN HERE *) Admitted. +(* + Proof. repeat constructor; apply eqb_neq; auto. + Qed. +*) + +Example test_nostutter_2: nostutter (@nil nat). +(* FILL IN HERE *) Admitted. +(* + Proof. repeat constructor; apply eqb_neq; auto. + Qed. +*) + +Example test_nostutter_3: nostutter [5]. +(* FILL IN HERE *) Admitted. +(* + Proof. repeat constructor; auto. Qed. +*) + +Example test_nostutter_4: not (nostutter [3;1;1;4]). +(* FILL IN HERE *) Admitted. +(* + Proof. intro. + repeat match goal with + h: nostutter _ |- _ => inversion h; clear h; subst + end. + contradiction; auto. Qed. +*) + +(* Do not modify the following line: *) +Definition manual_grade_for_nostutter : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 4 stars, advanced (filter_challenge) + + Let's prove that our definition of [filter] from the [Poly] + chapter matches an abstract specification. Here is the + specification, written out informally in English: + + A list [l] is an "in-order merge" of [l1] and [l2] if it contains + all the same elements as [l1] and [l2], in the same order as [l1] + and [l2], but possibly interleaved. For example, + + [1;4;6;2;3] + + is an in-order merge of + + [1;6;2] + + and + + [4;3]. + + Now, suppose we have a set [X], a function [test: X->bool], and a + list [l] of type [list X]. Suppose further that [l] is an + in-order merge of two lists, [l1] and [l2], such that every item + in [l1] satisfies [test] and no item in [l2] satisfies test. Then + [filter test l = l1]. + + First define what it means for one list to be a merge of two + others. Do this with an inductive relation, not a [Fixpoint]. *) + +Inductive merge {X:Type} : list X -> list X -> list X -> Prop := +(* FILL IN HERE *) +. + +Theorem merge_filter : forall (X : Set) (test: X->bool) (l l1 l2 : list X), + merge l1 l2 l -> + All (fun n => test n = true) l1 -> + All (fun n => test n = false) l2 -> + filter test l = l1. +Proof. + (* FILL IN HERE *) Admitted. + +(* FILL IN HERE *) + +(** [] *) + +(** **** Exercise: 5 stars, advanced, optional (filter_challenge_2) + + A different way to characterize the behavior of [filter] goes like + this: Among all subsequences of [l] with the property that [test] + evaluates to [true] on all their members, [filter test l] is the + longest. Formalize this claim and prove it. *) + +(* FILL IN HERE + + [] *) + +(** **** Exercise: 4 stars, standard, optional (palindromes) + + A palindrome is a sequence that reads the same backwards as + forwards. + + - Define an inductive proposition [pal] on [list X] that + captures what it means to be a palindrome. (Hint: You'll need + three cases. + + - Prove ([pal_app_rev]) that + + forall l, pal (l ++ rev l). + + - Prove ([pal_rev] that) + + forall l, pal l -> l = rev l. + + For extra credit, try proving the same theorems with an alternate + definition with a _single_ constructor of this type: + + forall l, l = rev l -> pal l +*) + +Inductive pal {X:Type} : list X -> Prop := +(* FILL IN HERE *) +. + +Theorem pal_app_rev : forall (X:Type) (l : list X), + pal (l ++ (rev l)). +Proof. + (* FILL IN HERE *) Admitted. + +Theorem pal_rev : forall (X:Type) (l: list X) , pal l -> l = rev l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 5 stars, standard, optional (palindrome_converse) + + Again, the converse direction is significantly more difficult, due + to the lack of evidence. Using your definition of [pal] from the + previous exercise, prove that + + forall l, l = rev l -> pal l. +*) + +Theorem palindrome_converse: forall {X: Type} (l: list X), + l = rev l -> pal l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 4 stars, advanced, optional (NoDup) + + Recall the definition of the [In] property from the [Logic] + chapter, which asserts that a value [x] appears at least once in a + list [l]: *) + +Module RecallIn. + Fixpoint In (A : Type) (x : A) (l : list A) : Prop := + match l with + | [] => False + | x' :: l' => x' = x \/ In A x l' + end. +End RecallIn. + +(** Your first task is to use [In] to define a proposition [disjoint X + l1 l2], which should be provable exactly when [l1] and [l2] are + lists (with elements of type X) that have no elements in + common. *) + +(* FILL IN HERE *) + +(** Next, use [In] to define an inductive proposition [NoDup X + l], which should be provable exactly when [l] is a list (with + elements of type [X]) where every member is different from every + other. For example, [NoDup nat [1;2;3;4]] and [NoDup + bool []] should be provable, while [NoDup nat [1;2;1]] and + [NoDup bool [true;true]] should not be. *) + +(* FILL IN HERE *) + +(** Finally, state and prove one or more interesting theorems relating + [disjoint], [NoDup] and [++] (list append). *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_NoDup_disjoint_etc : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 5 stars, advanced, optional (pigeonhole_principle) + + The _pigeonhole principle_ states a basic fact about counting: if + we distribute more than [n] items into [n] pigeonholes, some + pigeonhole must contain at least two items. As often happens, this + apparently trivial fact about numbers requires non-trivial + machinery to prove, but we now have enough... *) + +(** First prove an easy and useful lemma. *) + +Lemma in_split : forall (X:Type) (x:X) (l:list X), + In x l -> + exists l1 l2, l = l1 ++ x :: l2. +Proof. + (* FILL IN HERE *) Admitted. + +(** Now define a property [repeats] such that [repeats X l] asserts + that [l] contains at least one repeated element (of type [X]). *) + +Inductive repeats {X:Type} : list X -> Prop := + (* FILL IN HERE *) +. + +(* Do not modify the following line: *) +Definition manual_grade_for_check_repeats : option (nat*string) := None. + +(** Now, here's a way to formalize the pigeonhole principle. Suppose + list [l2] represents a list of pigeonhole labels, and list [l1] + represents the labels assigned to a list of items. If there are + more items than labels, at least two items must have the same + label -- i.e., list [l1] must contain repeats. + + This proof is much easier if you use the [excluded_middle] + hypothesis to show that [In] is decidable, i.e., [forall x l, (In x + l) \/ ~ (In x l)]. However, it is also possible to make the proof + go through _without_ assuming that [In] is decidable; if you + manage to do this, you will not need the [excluded_middle] + hypothesis. *) +Theorem pigeonhole_principle: excluded_middle -> + forall (X:Type) (l1 l2:list X), + (forall x, In x l1 -> In x l2) -> + length l2 < length l1 -> + repeats l1. +Proof. + intros EM X l1. induction l1 as [|x l1' IHl1']. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Extended Exercise: A Verified Regular-Expression Matcher *) + +(** We have now defined a match relation over regular expressions and + polymorphic lists. We can use such a definition to manually prove that + a given regex matches a given string, but it does not give us a + program that we can run to determine a match automatically. + + It would be reasonable to hope that we can translate the definitions + of the inductive rules for constructing evidence of the match relation + into cases of a recursive function that reflects the relation by recursing + on a given regex. However, it does not seem straightforward to define + such a function in which the given regex is a recursion variable + recognized by Rocq. As a result, Rocq will not accept that the function + always terminates. + + Heavily-optimized regex matchers match a regex by translating a given + regex into a state machine and determining if the state machine + accepts a given string. However, regex matching can also be + implemented using an algorithm that operates purely on strings and + regexes without defining and maintaining additional datatypes, such as + state machines. We'll implement such an algorithm, and verify that + its value reflects the match relation. *) + +(** We will implement a regex matcher that matches strings represented + as lists of ASCII characters: *) +From Stdlib Require Import Strings.Ascii. + +Definition string := list ascii. + +(** The Rocq standard library contains a distinct inductive definition + of strings of ASCII characters. However, we will use the above + definition of strings as lists as ASCII characters in order to apply + the existing definition of the match relation. + + We could also define a regex matcher over polymorphic lists, not lists + of ASCII characters specifically. The matching algorithm that we will + implement needs to be able to test equality of elements in a given + list, and thus needs to be given an equality-testing + function. Generalizing the definitions, theorems, and proofs that we + define for such a setting is a bit tedious, but workable. *) + +(** The proof of correctness of the regex matcher will combine + properties of the regex-matching function with properties of the + [match] relation that do not depend on the matching function. We'll go + ahead and prove the latter class of properties now. Most of them have + straightforward proofs, which have been given to you, although there + are a few key lemmas that are left for you to prove. *) + +(** Each provable [Prop] is equivalent to [True]. *) +Lemma provable_equiv_true : forall (P : Prop), P -> (P <-> True). +Proof. + intros. + split. + - intros. constructor. + - intros _. apply H. +Qed. + +(** Each [Prop] whose negation is provable is equivalent to [False]. *) +Lemma not_equiv_false : forall (P : Prop), ~P -> (P <-> False). +Proof. + intros. + split. + - apply H. + - intros. destruct H0. +Qed. + +(** [EmptySet] matches no string. *) +Lemma null_matches_none : forall (s : string), (s =~ EmptySet) <-> False. +Proof. + intros. + apply not_equiv_false. + unfold not. intros. inversion H. +Qed. + +(** [EmptyStr] only matches the empty string. *) +Lemma empty_matches_eps : forall (s : string), s =~ EmptyStr <-> s = [ ]. +Proof. + split. + - intros. inversion H. reflexivity. + - intros. rewrite H. apply MEmpty. +Qed. + +(** [EmptyStr] matches no non-empty string. *) +Lemma empty_nomatch_ne : forall (a : ascii) s, (a :: s =~ EmptyStr) <-> False. +Proof. + intros. + apply not_equiv_false. + unfold not. intros. inversion H. +Qed. + +(** [Char a] matches no string that starts with a non-[a] character. *) +Lemma char_nomatch_char : + forall (a b : ascii) s, b <> a -> (b :: s =~ Char a <-> False). +Proof. + intros. + apply not_equiv_false. + unfold not. + intros. + apply H. + inversion H0. + reflexivity. +Qed. + +(** If [Char a] matches a non-empty string, then the string's tail is empty. *) +Lemma char_eps_suffix : forall (a : ascii) s, a :: s =~ Char a <-> s = [ ]. +Proof. + split. + - intros. inversion H. reflexivity. + - intros. rewrite H. apply MChar. +Qed. + +(** [App re0 re1] matches string [s] iff [s = s0 ++ s1], where [s0] + matches [re0] and [s1] matches [re1]. *) +Lemma app_exists : forall (s : string) re0 re1, + s =~ App re0 re1 <-> + exists s0 s1, s = s0 ++ s1 /\ s0 =~ re0 /\ s1 =~ re1. +Proof. + intros. + split. + - intros. inversion H. exists s1, s2. split. + * reflexivity. + * split. apply H3. apply H4. + - intros [ s0 [ s1 [ Happ [ Hmat0 Hmat1 ] ] ] ]. + rewrite Happ. apply (MApp s0 _ s1 _ Hmat0 Hmat1). +Qed. + +(** **** Exercise: 3 stars, standard, optional (app_ne) + + [App re0 re1] matches [a::s] iff [re0] matches the empty string + and [a::s] matches [re1] or [s=s0++s1], where [a::s0] matches [re0] + and [s1] matches [re1]. + + Even though this is a property of purely the match relation, it is a + critical observation behind the design of our regex matcher. So (1) + take time to understand it, (2) prove it, and (3) look for how you'll + use it later. *) +Lemma app_ne : forall (a : ascii) s re0 re1, + a :: s =~ (App re0 re1) <-> + ([ ] =~ re0 /\ a :: s =~ re1) \/ + exists s0 s1, s = s0 ++ s1 /\ a :: s0 =~ re0 /\ s1 =~ re1. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** [s] is matched by [Union re0 re1] iff [s] matched by + [re0] or [s] matched by [re1]. *) +Lemma union_disj : forall (s : string) re0 re1, + s =~ Union re0 re1 <-> s =~ re0 \/ s =~ re1. +Proof. + intros. split. + - intros. inversion H. + + left. apply H2. + + right. apply H1. + - intros [ H | H ]. + + apply MUnionL. apply H. + + apply MUnionR. apply H. +Qed. + +(** **** Exercise: 3 stars, standard, optional (star_ne) + + [a::s] is matched by [Star re] iff [s = s0 ++ s1], where [a::s0] is matched by + [re] and [s1] is matched by [Star re]. Like [app_ne], this observation is + critical, so understand it, prove it, and keep it in mind. + + Hint: you'll need to perform induction. There are quite a few + reasonable candidates for [Prop]'s to prove by induction. The only one + that will work is splitting the [iff] into two implications and + proving one by induction on the evidence for [a :: s =~ Star re]. The + other implication can be proved without induction. + + In order to prove the right property by induction, you'll need to + rephrase [a :: s =~ Star re] to be a [Prop] over general variables, + using the [remember] tactic. *) + +Lemma star_ne : forall (a : ascii) s re, + a :: s =~ Star re <-> + exists s0 s1, s = s0 ++ s1 /\ a :: s0 =~ re /\ s1 =~ Star re. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The definition of our regex matcher will include two fixpoint + functions. The first function, given regex [re], will evaluate to a + value that reflects whether [re] matches the empty string. The + function will satisfy the following property: *) +Definition refl_matches_eps m := + forall re : reg_exp ascii, reflect ([ ] =~ re) (m re). + +(** **** Exercise: 2 stars, standard, optional (match_eps) + + Complete the definition of [match_eps] so that it tests if a given + regex matches the empty string: *) +Fixpoint match_eps (re: reg_exp ascii) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (match_eps_refl) + + Now, prove that [match_eps] indeed tests if a given regex matches + the empty string. (Hint: You'll want to use the reflection lemmas + [ReflectT] and [ReflectF].) *) +Lemma match_eps_refl : refl_matches_eps match_eps. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** We'll define other functions that use [match_eps]. However, the + only property of [match_eps] that you'll need to use in all proofs + over these functions is [match_eps_refl]. *) + +(** The key operation that will be performed by our regex matcher will + be to iteratively construct a sequence of regex derivatives. For each + character [a] and regex [re], the derivative of [re] on [a] is a regex + that matches all suffixes of strings matched by [re] that start with + [a]. I.e., [re'] is a derivative of [re] on [a] if they satisfy the + following relation: *) + +Definition is_der re (a : ascii) re' := + forall s, a :: s =~ re <-> s =~ re'. + +(** A function [d] derives strings if, given character [a] and regex + [re], it evaluates to the derivative of [re] on [a]. I.e., [d] + satisfies the following property: *) +Definition derives d := forall a re, is_der re a (d a re). + +(** **** Exercise: 3 stars, standard, optional (derive) + + Define [derive] so that it derives strings. One natural + implementation uses [match_eps] in some cases to determine if key + regex's match the empty string. *) +Fixpoint derive (a : ascii) (re : reg_exp ascii) : reg_exp ascii + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** The [derive] function should pass the following tests. Each test + establishes an equality between an expression that will be + evaluated by our regex matcher and the final value that must be + returned by the regex matcher. Each test is annotated with the + match fact that it reflects. *) +Example c := ascii_of_nat 99. +Example d := ascii_of_nat 100. + +(** "c" =~ EmptySet: *) +Example test_der0 : match_eps (derive c (EmptySet)) = false. +Proof. + (* FILL IN HERE *) Admitted. + +(** "c" =~ Char c: *) +Example test_der1 : match_eps (derive c (Char c)) = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** "c" =~ Char d: *) +Example test_der2 : match_eps (derive c (Char d)) = false. +Proof. + (* FILL IN HERE *) Admitted. + +(** "c" =~ App (Char c) EmptyStr: *) +Example test_der3 : match_eps (derive c (App (Char c) EmptyStr)) = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** "c" =~ App EmptyStr (Char c): *) +Example test_der4 : match_eps (derive c (App EmptyStr (Char c))) = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** "c" =~ Star c: *) +Example test_der5 : match_eps (derive c (Star (Char c))) = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** "cd" =~ App (Char c) (Char d): *) +Example test_der6 : + match_eps (derive d (derive c (App (Char c) (Char d)))) = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** "cd" =~ App (Char d) (Char c): *) +Example test_der7 : + match_eps (derive d (derive c (App (Char d) (Char c)))) = false. +Proof. + (* FILL IN HERE *) Admitted. + +(** **** Exercise: 4 stars, standard, optional (derive_corr) + + Prove that [derive] in fact always derives strings. + + Hint: one proof performs induction on [re], although you'll need + to carefully choose the property that you prove by induction by + generalizing the appropriate terms. + + Hint: if your definition of [derive] applies [match_eps] to a + particular regex [re], then a natural proof will apply + [match_eps_refl] to [re] and destruct the result to generate cases + with assumptions that the [re] does or does not match the empty + string. + + Hint: You can save quite a bit of work by using lemmas proved + above. In particular, to prove many cases of the induction, you + can rewrite a [Prop] over a complicated regex (e.g., [s =~ Union + re0 re1]) to a Boolean combination of [Prop]'s over simple + regex's (e.g., [s =~ re0 \/ s =~ re1]) using lemmas given above + that are logical equivalences. You can then reason about these + [Prop]'s naturally using [intro] and [destruct]. *) +Lemma derive_corr : derives derive. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** We'll define the regex matcher using [derive]. However, the only + property of [derive] that you'll need to use in all proofs of + properties of the matcher is [derive_corr]. *) + +(** A function [m] _matches regexes_ if, given string [s] and regex [re], + it evaluates to a value that reflects whether [re] matches + [s]. I.e., [m] holds the following property: *) +Definition matches_regex m : Prop := + forall (s : string) re, reflect (s =~ re) (m s re). + +(** **** Exercise: 2 stars, standard, optional (regex_match) + + Complete the definition of [regex_match] so that it matches + regexes. *) +Fixpoint regex_match (s : string) (re : reg_exp ascii) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (regex_match_correct) + + Finally, prove that [regex_match] in fact matches regexes. + + Hint: if your definition of [regex_match] applies [match_eps] to + regex [re], then a natural proof applies [match_eps_refl] to [re] + and destructs the result to generate cases in which you may assume + that [re] does or does not match the empty string. + + Hint: if your definition of [regex_match] applies [derive] to + character [x] and regex [re], then a natural proof applies + [derive_corr] to [x] and [re] to prove that [x :: s =~ re] given + [s =~ derive x re], and vice versa. *) +Theorem regex_match_correct : matches_regex regex_match. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* 2026-01-07 13:17 *) diff --git a/IndPropTest.v b/IndPropTest.v new file mode 100644 index 0000000..728af7b --- /dev/null +++ b/IndPropTest.v @@ -0,0 +1,632 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import IndProp. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import IndProp. +Import Check. + +Goal True. + +idtac "------------------- ev_double --------------------". +idtac " ". + +idtac "#> ev_double". +idtac "Possible points: 1". +check_type @ev_double ((forall n : nat, ev (double n))). +idtac "Assumptions:". +Abort. +Print Assumptions ev_double. +Goal True. +idtac " ". + +idtac "------------------- Perm3 --------------------". +idtac " ". + +idtac "#> Perm3_ex1". +idtac "Possible points: 0.5". +check_type @Perm3_ex1 ( +(@Perm3 nat (@cons nat 1 (@cons nat 2 (@cons nat 3 (@nil nat)))) + (@cons nat 2 (@cons nat 3 (@cons nat 1 (@nil nat)))))). +idtac "Assumptions:". +Abort. +Print Assumptions Perm3_ex1. +Goal True. +idtac " ". + +idtac "#> Perm3_refl". +idtac "Possible points: 0.5". +check_type @Perm3_refl ( +(forall (X : Type) (a b c : X), + @Perm3 X (@cons X a (@cons X b (@cons X c (@nil X)))) + (@cons X a (@cons X b (@cons X c (@nil X)))))). +idtac "Assumptions:". +Abort. +Print Assumptions Perm3_refl. +Goal True. +idtac " ". + +idtac "------------------- le_inversion --------------------". +idtac " ". + +idtac "#> le_inversion". +idtac "Possible points: 1". +check_type @le_inversion ( +(forall (n m : nat) (_ : le n m), + or (@eq nat n m) + (@ex nat (fun m' : nat => and (@eq nat m (S m')) (le n m'))))). +idtac "Assumptions:". +Abort. +Print Assumptions le_inversion. +Goal True. +idtac " ". + +idtac "------------------- inversion_practice --------------------". +idtac " ". + +idtac "#> SSSSev__even". +idtac "Possible points: 1". +check_type @SSSSev__even ((forall (n : nat) (_ : ev (S (S (S (S n))))), ev n)). +idtac "Assumptions:". +Abort. +Print Assumptions SSSSev__even. +Goal True. +idtac " ". + +idtac "------------------- ev5_nonsense --------------------". +idtac " ". + +idtac "#> ev5_nonsense". +idtac "Possible points: 1". +check_type @ev5_nonsense ((forall _ : ev 5, @eq nat (Nat.add 2 2) 9)). +idtac "Assumptions:". +Abort. +Print Assumptions ev5_nonsense. +Goal True. +idtac " ". + +idtac "------------------- ev_sum --------------------". +idtac " ". + +idtac "#> ev_sum". +idtac "Possible points: 2". +check_type @ev_sum ((forall (n m : nat) (_ : ev n) (_ : ev m), ev (Nat.add n m))). +idtac "Assumptions:". +Abort. +Print Assumptions ev_sum. +Goal True. +idtac " ". + +idtac "------------------- ev_ev__ev --------------------". +idtac " ". + +idtac "#> ev_ev__ev". +idtac "Advanced". +idtac "Possible points: 3". +check_type @ev_ev__ev ((forall (n m : nat) (_ : ev (Nat.add n m)) (_ : ev n), ev m)). +idtac "Assumptions:". +Abort. +Print Assumptions ev_ev__ev. +Goal True. +idtac " ". + +idtac "------------------- Perm3_In --------------------". +idtac " ". + +idtac "#> Perm3_In". +idtac "Possible points: 2". +check_type @Perm3_In ( +(forall (X : Type) (x : X) (l1 l2 : list X) (_ : @Perm3 X l1 l2) + (_ : @In X x l1), + @In X x l2)). +idtac "Assumptions:". +Abort. +Print Assumptions Perm3_In. +Goal True. +idtac " ". + +idtac "------------------- le_facts --------------------". +idtac " ". + +idtac "#> le_trans". +idtac "Possible points: 0.5". +check_type @le_trans ((forall (m n o : nat) (_ : le m n) (_ : le n o), le m o)). +idtac "Assumptions:". +Abort. +Print Assumptions le_trans. +Goal True. +idtac " ". + +idtac "#> O_le_n". +idtac "Possible points: 0.5". +check_type @O_le_n ((forall n : nat, le 0 n)). +idtac "Assumptions:". +Abort. +Print Assumptions O_le_n. +Goal True. +idtac " ". + +idtac "#> n_le_m__Sn_le_Sm". +idtac "Possible points: 0.5". +check_type @n_le_m__Sn_le_Sm ((forall (n m : nat) (_ : le n m), le (S n) (S m))). +idtac "Assumptions:". +Abort. +Print Assumptions n_le_m__Sn_le_Sm. +Goal True. +idtac " ". + +idtac "#> Sn_le_Sm__n_le_m". +idtac "Possible points: 1". +check_type @Sn_le_Sm__n_le_m ((forall (n m : nat) (_ : le (S n) (S m)), le n m)). +idtac "Assumptions:". +Abort. +Print Assumptions Sn_le_Sm__n_le_m. +Goal True. +idtac " ". + +idtac "#> le_plus_l". +idtac "Possible points: 0.5". +check_type @le_plus_l ((forall a b : nat, le a (Nat.add a b))). +idtac "Assumptions:". +Abort. +Print Assumptions le_plus_l. +Goal True. +idtac " ". + +idtac "------------------- plus_le_facts1 --------------------". +idtac " ". + +idtac "#> plus_le". +idtac "Possible points: 1". +check_type @plus_le ( +(forall (n1 n2 m : nat) (_ : le (Nat.add n1 n2) m), and (le n1 m) (le n2 m))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_le. +Goal True. +idtac " ". + +idtac "#> plus_le_cases". +idtac "Possible points: 1". +check_type @plus_le_cases ( +(forall (n m p q : nat) (_ : le (Nat.add n m) (Nat.add p q)), + or (le n p) (le m q))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_le_cases. +Goal True. +idtac " ". + +idtac "------------------- plus_le_facts2 --------------------". +idtac " ". + +idtac "#> plus_le_compat_l". +idtac "Possible points: 0.5". +check_type @plus_le_compat_l ( +(forall (n m p : nat) (_ : le n m), le (Nat.add p n) (Nat.add p m))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_le_compat_l. +Goal True. +idtac " ". + +idtac "#> plus_le_compat_r". +idtac "Possible points: 0.5". +check_type @plus_le_compat_r ( +(forall (n m p : nat) (_ : le n m), le (Nat.add n p) (Nat.add m p))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_le_compat_r. +Goal True. +idtac " ". + +idtac "#> le_plus_trans". +idtac "Possible points: 1". +check_type @le_plus_trans ((forall (n m p : nat) (_ : le n m), le n (Nat.add m p))). +idtac "Assumptions:". +Abort. +Print Assumptions le_plus_trans. +Goal True. +idtac " ". + +idtac "------------------- R_provability --------------------". +idtac " ". + +idtac "#> Manually graded: R.R_provability". +idtac "Possible points: 3". +print_manual_grade R.manual_grade_for_R_provability. +idtac " ". + +idtac "------------------- subsequence --------------------". +idtac " ". + +idtac "#> subseq_refl". +idtac "Advanced". +idtac "Possible points: 1". +check_type @subseq_refl ((forall l : list nat, subseq l l)). +idtac "Assumptions:". +Abort. +Print Assumptions subseq_refl. +Goal True. +idtac " ". + +idtac "#> subseq_app". +idtac "Advanced". +idtac "Possible points: 2". +check_type @subseq_app ( +(forall (l1 l2 l3 : list nat) (_ : subseq l1 l2), subseq l1 (@app nat l2 l3))). +idtac "Assumptions:". +Abort. +Print Assumptions subseq_app. +Goal True. +idtac " ". + +idtac "#> subseq_trans". +idtac "Advanced". +idtac "Possible points: 3". +check_type @subseq_trans ( +(forall (l1 l2 l3 : list nat) (_ : subseq l1 l2) (_ : subseq l2 l3), + subseq l1 l3)). +idtac "Assumptions:". +Abort. +Print Assumptions subseq_trans. +Goal True. +idtac " ". + +idtac "------------------- exp_match_ex1 --------------------". +idtac " ". + +idtac "#> EmptySet_is_empty". +idtac "Possible points: 0.5". +check_type @EmptySet_is_empty ( +(forall (T : Type) (s : list T), not (@exp_match T s (@EmptySet T)))). +idtac "Assumptions:". +Abort. +Print Assumptions EmptySet_is_empty. +Goal True. +idtac " ". + +idtac "#> MUnion'". +idtac "Possible points: 0.5". +check_type @MUnion' ( +(forall (T : Type) (s : list T) (re1 re2 : reg_exp T) + (_ : or (@exp_match T s re1) (@exp_match T s re2)), + @exp_match T s (@Union T re1 re2))). +idtac "Assumptions:". +Abort. +Print Assumptions MUnion'. +Goal True. +idtac " ". + +idtac "#> MStar'". +idtac "Possible points: 2". +check_type @MStar' ( +(forall (T : Type) (ss : list (list T)) (re : reg_exp T) + (_ : forall (s : list T) (_ : @In (list T) s ss), @exp_match T s re), + @exp_match T (@fold (list T) (list T) (@app T) ss (@nil T)) (@Star T re))). +idtac "Assumptions:". +Abort. +Print Assumptions MStar'. +Goal True. +idtac " ". + +idtac "------------------- re_not_empty --------------------". +idtac " ". + +idtac "#> re_not_empty". +idtac "Possible points: 3". +check_type @re_not_empty ((forall (T : Type) (_ : reg_exp T), bool)). +idtac "Assumptions:". +Abort. +Print Assumptions re_not_empty. +Goal True. +idtac " ". + +idtac "#> re_not_empty_correct". +idtac "Possible points: 3". +check_type @re_not_empty_correct ( +(forall (T : Type) (re : reg_exp T), + iff (@ex (list T) (fun s : list T => @exp_match T s re)) + (@eq bool (@re_not_empty T re) true))). +idtac "Assumptions:". +Abort. +Print Assumptions re_not_empty_correct. +Goal True. +idtac " ". + +idtac "------------------- weak_pumping_char --------------------". +idtac " ". + +idtac "#> Pumping.weak_pumping_char". +idtac "Possible points: 2". +check_type @Pumping.weak_pumping_char ( +(forall (T : Type) (x : T) + (_ : le (@Pumping.pumping_constant T (@Char T x)) + (@length T (@cons T x (@nil T)))), + @ex (list T) + (fun s1 : list T => + @ex (list T) + (fun s2 : list T => + @ex (list T) + (fun s3 : list T => + and (@eq (list T) (@cons T x (@nil T)) (@app T s1 (@app T s2 s3))) + (and (not (@eq (list T) s2 (@nil T))) + (forall m : nat, + @exp_match T (@app T s1 (@app T (@Pumping.napp T m s2) s3)) + (@Char T x)))))))). +idtac "Assumptions:". +Abort. +Print Assumptions Pumping.weak_pumping_char. +Goal True. +idtac " ". + +idtac "------------------- weak_pumping_app --------------------". +idtac " ". + +idtac "#> Pumping.weak_pumping_app". +idtac "Possible points: 3". +check_type @Pumping.weak_pumping_app ( +(forall (T : Type) (s1 s2 : list T) (re1 re2 : reg_exp T) + (_ : @exp_match T s1 re1) (_ : @exp_match T s2 re2) + (_ : forall _ : le (@Pumping.pumping_constant T re1) (@length T s1), + @ex (list T) + (fun s3 : list T => + @ex (list T) + (fun s4 : list T => + @ex (list T) + (fun s5 : list T => + and (@eq (list T) s1 (@app T s3 (@app T s4 s5))) + (and (not (@eq (list T) s4 (@nil T))) + (forall m : nat, + @exp_match T + (@app T s3 (@app T (@Pumping.napp T m s4) s5)) re1)))))) + (_ : forall _ : le (@Pumping.pumping_constant T re2) (@length T s2), + @ex (list T) + (fun s3 : list T => + @ex (list T) + (fun s4 : list T => + @ex (list T) + (fun s5 : list T => + and (@eq (list T) s2 (@app T s3 (@app T s4 s5))) + (and (not (@eq (list T) s4 (@nil T))) + (forall m : nat, + @exp_match T + (@app T s3 (@app T (@Pumping.napp T m s4) s5)) re2)))))) + (_ : le (@Pumping.pumping_constant T (@App T re1 re2)) + (@length T (@app T s1 s2))), + @ex (list T) + (fun s0 : list T => + @ex (list T) + (fun s3 : list T => + @ex (list T) + (fun s4 : list T => + and (@eq (list T) (@app T s1 s2) (@app T s0 (@app T s3 s4))) + (and (not (@eq (list T) s3 (@nil T))) + (forall m : nat, + @exp_match T (@app T s0 (@app T (@Pumping.napp T m s3) s4)) + (@App T re1 re2)))))))). +idtac "Assumptions:". +Abort. +Print Assumptions Pumping.weak_pumping_app. +Goal True. +idtac " ". + +idtac "------------------- weak_pumping_union_l --------------------". +idtac " ". + +idtac "#> Pumping.weak_pumping_union_l". +idtac "Possible points: 3". +check_type @Pumping.weak_pumping_union_l ( +(forall (T : Type) (s1 : list T) (re1 re2 : reg_exp T) + (_ : @exp_match T s1 re1) + (_ : forall _ : le (@Pumping.pumping_constant T re1) (@length T s1), + @ex (list T) + (fun s2 : list T => + @ex (list T) + (fun s3 : list T => + @ex (list T) + (fun s4 : list T => + and (@eq (list T) s1 (@app T s2 (@app T s3 s4))) + (and (not (@eq (list T) s3 (@nil T))) + (forall m : nat, + @exp_match T + (@app T s2 (@app T (@Pumping.napp T m s3) s4)) re1)))))) + (_ : le (@Pumping.pumping_constant T (@Union T re1 re2)) (@length T s1)), + @ex (list T) + (fun s0 : list T => + @ex (list T) + (fun s2 : list T => + @ex (list T) + (fun s3 : list T => + and (@eq (list T) s1 (@app T s0 (@app T s2 s3))) + (and (not (@eq (list T) s2 (@nil T))) + (forall m : nat, + @exp_match T (@app T s0 (@app T (@Pumping.napp T m s2) s3)) + (@Union T re1 re2)))))))). +idtac "Assumptions:". +Abort. +Print Assumptions Pumping.weak_pumping_union_l. +Goal True. +idtac " ". + +idtac "------------------- reflect_iff --------------------". +idtac " ". + +idtac "#> reflect_iff". +idtac "Possible points: 2". +check_type @reflect_iff ( +(forall (P : Prop) (b : bool) (_ : reflect P b), iff P (@eq bool b true))). +idtac "Assumptions:". +Abort. +Print Assumptions reflect_iff. +Goal True. +idtac " ". + +idtac "------------------- eqbP_practice --------------------". +idtac " ". + +idtac "#> eqbP_practice". +idtac "Possible points: 3". +check_type @eqbP_practice ( +(forall (n : nat) (l : list nat) (_ : @eq nat (count n l) 0), + not (@In nat n l))). +idtac "Assumptions:". +Abort. +Print Assumptions eqbP_practice. +Goal True. +idtac " ". + +idtac "------------------- nostutter_defn --------------------". +idtac " ". + +idtac "#> Manually graded: nostutter". +idtac "Possible points: 3". +print_manual_grade manual_grade_for_nostutter. +idtac " ". + +idtac "------------------- filter_challenge --------------------". +idtac " ". + +idtac "#> merge_filter". +idtac "Advanced". +idtac "Possible points: 6". +check_type @merge_filter ( +(forall (X : Set) (test : forall _ : X, bool) (l l1 l2 : list X) + (_ : @merge X l1 l2 l) + (_ : @All X (fun n : X => @eq bool (test n) true) l1) + (_ : @All X (fun n : X => @eq bool (test n) false) l2), + @eq (list X) (@filter X test l) l1)). +idtac "Assumptions:". +Abort. +Print Assumptions merge_filter. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 44". +idtac "Max points - advanced: 59". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- ev_double ---------". +Print Assumptions ev_double. +idtac "---------- Perm3_ex1 ---------". +Print Assumptions Perm3_ex1. +idtac "---------- Perm3_refl ---------". +Print Assumptions Perm3_refl. +idtac "---------- le_inversion ---------". +Print Assumptions le_inversion. +idtac "---------- SSSSev__even ---------". +Print Assumptions SSSSev__even. +idtac "---------- ev5_nonsense ---------". +Print Assumptions ev5_nonsense. +idtac "---------- ev_sum ---------". +Print Assumptions ev_sum. +idtac "---------- Perm3_In ---------". +Print Assumptions Perm3_In. +idtac "---------- le_trans ---------". +Print Assumptions le_trans. +idtac "---------- O_le_n ---------". +Print Assumptions O_le_n. +idtac "---------- n_le_m__Sn_le_Sm ---------". +Print Assumptions n_le_m__Sn_le_Sm. +idtac "---------- Sn_le_Sm__n_le_m ---------". +Print Assumptions Sn_le_Sm__n_le_m. +idtac "---------- le_plus_l ---------". +Print Assumptions le_plus_l. +idtac "---------- plus_le ---------". +Print Assumptions plus_le. +idtac "---------- plus_le_cases ---------". +Print Assumptions plus_le_cases. +idtac "---------- plus_le_compat_l ---------". +Print Assumptions plus_le_compat_l. +idtac "---------- plus_le_compat_r ---------". +Print Assumptions plus_le_compat_r. +idtac "---------- le_plus_trans ---------". +Print Assumptions le_plus_trans. +idtac "---------- R_provability ---------". +idtac "MANUAL". +idtac "---------- EmptySet_is_empty ---------". +Print Assumptions EmptySet_is_empty. +idtac "---------- MUnion' ---------". +Print Assumptions MUnion'. +idtac "---------- MStar' ---------". +Print Assumptions MStar'. +idtac "---------- re_not_empty ---------". +Print Assumptions re_not_empty. +idtac "---------- re_not_empty_correct ---------". +Print Assumptions re_not_empty_correct. +idtac "---------- Pumping.weak_pumping_char ---------". +Print Assumptions Pumping.weak_pumping_char. +idtac "---------- Pumping.weak_pumping_app ---------". +Print Assumptions Pumping.weak_pumping_app. +idtac "---------- Pumping.weak_pumping_union_l ---------". +Print Assumptions Pumping.weak_pumping_union_l. +idtac "---------- reflect_iff ---------". +Print Assumptions reflect_iff. +idtac "---------- eqbP_practice ---------". +Print Assumptions eqbP_practice. +idtac "---------- nostutter ---------". +idtac "MANUAL". +idtac "". +idtac "********** Advanced **********". +idtac "---------- ev_ev__ev ---------". +Print Assumptions ev_ev__ev. +idtac "---------- subseq_refl ---------". +Print Assumptions subseq_refl. +idtac "---------- subseq_app ---------". +Print Assumptions subseq_app. +idtac "---------- subseq_trans ---------". +Print Assumptions subseq_trans. +idtac "---------- merge_filter ---------". +Print Assumptions merge_filter. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Induction.v b/Induction.v new file mode 100644 index 0000000..2dd62ce --- /dev/null +++ b/Induction.v @@ -0,0 +1,764 @@ +(** * Induction: Proof by Induction *) + +(* ################################################################# *) +(** * Separate Compilation *) + +(** Before getting started on this chapter, we need to import + all of our definitions from the previous chapter: *) + +From LF Require Export Basics. + +(** For this [Require] command to work, Rocq needs to be able to + find a compiled version of the previous chapter ([Basics.v]). + This compiled version, called [Basics.vo], is analogous to the + [.class] files compiled from [.java] source files and the [.o] + files compiled from [.c] files. + + To compile [Basics.v] and obtain [Basics.vo], first make sure that + the files [Basics.v], [Induction.v], and [_CoqProject] are in + the current directory. + + The [_CoqProject] file should contain just the following line: + + -Q . LF + + This maps the current directory ("[.]", which contains [Basics.v], + [Induction.v], etc.) to the prefix (or "logical directory") + "[LF]". Proof General, CoqIDE, and VSCoq read [_CoqProject] + automatically, to find out to where to look for the file + [Basics.vo] corresponding to the library [LF.Basics]. + + Once the files are in place, there are various ways to build + [Basics.vo] from an IDE, or you can build it from the command + line. From an IDE... + + - In Proof General: The compilation can be made to happen + automatically when you submit the [Require] line above to PG, by + setting the emacs variable [coq-compile-before-require] to [t]. + This can also be found in the menu: "Coq" > "Auto Compilation" > + "Compile Before Require". + + - In CoqIDE: One thing you can do on all platforms is open + [Basics.v]; then, in the "Compile" menu, click on "Compile Buffer". + + - For VSCode users, open the terminal pane at the bottom and then + follow the command line instructions below. (If you downloaded + the project setup .tgz file, just doing `make` should build all + the code.) + + To compile [Basics.v] from the command line... + + - First, generate a [Makefile] using the [rocq makefile] utility, + which comes installed with Rocq. (If you obtained the whole volume as + a single archive, a [Makefile] should already exist and you can + skip this step.) + + rocq makefile -f _CoqProject *.v -o Makefile + + You should rerun that command whenever you add or remove + Rocq files in this directory. + + - Now you can compile [Basics.v] by running [make] with the + corresponding [.vo] file as a target: + + make Basics.vo + + All files in the directory can be compiled by giving no + arguments: + + make + + - Under the hood, [make] uses the Rocq compiler, [rocq compile]. You can + also run [rocq compile] directly: + + rocq compile -Q . LF Basics.v + + - Since [make] also calculates dependencies between source files + to compile them in the right order, [make] should generally be + preferred over running [rocq compile] explicitly. But as a last (but + not terrible) resort, you can simply compile each file manually + as you go. For example, before starting work on the present + chapter, you would need to run the following command: + + rocq compile -Q . LF Basics.v + + Then, once you've finished this chapter, you'd do + + rocq compile -Q . LF Induction.v + + to get ready to work on the next one. If you ever remove the + .vo files, you'd need to give both commands again (in that + order). + + Troubleshooting: + + - For many of the alternatives above you need to make sure that + the [rocq] executable is in your [PATH]. + + - If you get complaints about missing identifiers, it may be + because the "load path" for Rocq is not set up correctly. The + [Print LoadPath.] command may be helpful in sorting out such + issues. + + - When trying to compile a later chapter, if you see a message like + + Compiled library Induction makes inconsistent assumptions over + library Basics + + a common reason is that the library [Basics] was modified and + recompiled without also recompiling [Induction] which depends + on it. Recompile [Induction], or everything if too many files + are affected (for instance by running [make] and if even this + doesn't work then [make clean; make]). + + - If you get complaints about missing identifiers later in this + file it may be because the "load path" for Rocq is not set up + correctly. The [Print LoadPath.] command may be helpful in + sorting out such issues. + + In particular, if you see a message like + + Compiled library Foo makes inconsistent assumptions over + library Bar + + check whether you have multiple installations of Rocq on your + machine. It may be that commands (like [rocq compile]) that you execute + in a terminal window are getting a different version of Rocq than + commands executed by Proof General or CoqIDE. + + - One more tip for CoqIDE users: If you see messages like [Error: + Unable to locate library Basics], a likely reason is + inconsistencies between compiling things _within CoqIDE_ vs _using + [rocq] from the command line_. This typically happens when there + are two incompatible versions of Rocq installed on your + system (one associated with CoqIDE, and one associated with [rocq] + from the terminal). The workaround for this situation is + compiling using CoqIDE only (i.e. choosing "make" from the menu), + and avoiding using [rocq] directly at all. *) + +(* ################################################################# *) +(** * Proof by Induction *) + +(** We can prove that [0] is a neutral element for [+] on the _left_ + using just [reflexivity]. But the proof that it is also a neutral + element on the _right_ ... *) + +Theorem add_0_r_firsttry : forall n:nat, + n + 0 = n. + +(** ... can't be done in the same simple way. Just applying + [reflexivity] doesn't work, since the [n] in [n + 0] is an arbitrary + unknown number, so the [match] in the definition of [+] can't be + simplified. *) + +Proof. + intros n. + simpl. (* Does nothing! *) +Abort. + +(** And reasoning by cases using [destruct n] doesn't get us much + further: the branch of the case analysis where we assume [n = 0] + goes through just fine, but in the branch where [n = S n'] for + some [n'] we get stuck in exactly the same way. *) + +Theorem add_0_r_secondtry : forall n:nat, + n + 0 = n. +Proof. + intros n. destruct n as [| n'] eqn:E. + - (* n = 0 *) + reflexivity. (* so far so good... *) + - (* n = S n' *) + simpl. (* ...but here we are stuck again *) +Abort. + +(** We could use [destruct n'] to get a bit further, but, + since [n] can be arbitrarily large, we'll never get all the way + there if we just go on like this. *) + +(** To prove interesting facts about numbers, lists, and other + inductively defined sets, we often need a more powerful reasoning + principle: _induction_. + + Recall (from a discrete math course, probably) the _principle of + induction over natural numbers_: If [P(n)] is some proposition + involving a natural number [n] and we want to show that [P] holds for + all numbers [n], we can reason like this: + - show that [P(O)] holds; + - show that, for any [n'], if [P(n')] holds, then so does + [P(S n')]; + - conclude that [P(n)] holds for all [n]. + + In Rocq, the steps are the same, except we typically encounter them + in reverse order: we begin with the goal of proving [P(n)] for all + [n] and apply the [induction] tactic to break it down into two + separate subgoals: one where we must show [P(O)] and another where + we must show [P(n') -> P(S n')]. Here's how this works for the + theorem at hand... *) + +Theorem add_0_r : forall n:nat, n + 0 = n. +Proof. + intros n. induction n as [| n' IHn']. + - (* n = 0 *) reflexivity. + - (* n = S n' *) simpl. rewrite -> IHn'. reflexivity. Qed. + +(** Like [destruct], the [induction] tactic takes an [as...] + clause that specifies the names of the variables to be introduced + in the subgoals. Since there are two subgoals, the [as...] clause + has two parts, separated by a vertical bar, [|]. (Strictly + speaking, we can omit the [as...] clause and Rocq will choose names + for us. In practice, this is a bad practice, as Rocq's automatic + choices tend to be confusing.) + + In the first subgoal, [n] is replaced by [0]. No new variables + are introduced (so the first part of the [as...] is empty), and + the goal becomes [0 = 0 + 0], which follows easily by simplification. + + In the second subgoal, [n] is replaced by [S n'], and the + assumption [n' + 0 = n'] is added to the context with the name + [IHn'] (i.e., the Induction Hypothesis for [n']). These two names + are specified in the second part of the [as...] clause. The goal + in this case becomes [S n' = (S n') + 0], which simplifies to + [S n' = S (n' + 0)], which in turn follows from [IHn']. *) + +Theorem minus_n_n : forall n, + minus n n = 0. +Proof. + (* WORKED IN CLASS *) + intros n. induction n as [| n' IHn']. + - (* n = 0 *) + simpl. reflexivity. + - (* n = S n' *) + simpl. rewrite -> IHn'. reflexivity. Qed. + +(** (The use of the [intros] tactic in these proofs is actually + redundant. When applied to a goal that contains quantified + variables, the [induction] tactic will automatically move them + into the context as needed.) *) + +(** **** Exercise: 2 stars, standard, especially useful (basic_induction) + + Prove the following using induction. You might need previously + proven results. *) + +Theorem mul_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 add_comm : forall n m : nat, + n + m = m + n. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem add_assoc : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (double_plus) + + Consider the following function, which doubles its argument: *) + +Fixpoint double (n:nat) := + match n with + | O => O + | S n' => S (S (double n')) + end. + +(** Use induction to prove this simple fact about [double]: *) + +Lemma double_plus : forall n, double n = n + n . +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (eqb_refl) + + The following theorem relates the computational equality [=?] on + [nat] with the definitional equality [=] on [bool]. *) + +Theorem eqb_refl : forall n : nat, + (n =? n) = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (even_S) + + One inconvenient aspect of our definition of [even n] is the + recursive call on [n - 2]. This makes proofs about [even n] + harder when done by induction on [n], since we may need an + induction hypothesis about [n - 2]. The following lemma gives an + alternative characterization of [even (S n)] that works better + with induction: *) + +Theorem even_S : forall n : nat, + even (S n) = negb (even n). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Proofs Within Proofs *) + +(** In Rocq, as in informal mathematics, large proofs are often + broken into a sequence of theorems, with later proofs referring to + earlier theorems. But sometimes a proof will involve some + miscellaneous fact that is too trivial and of too little general + interest to bother giving it its own top-level name. In such + cases, it is convenient to be able to simply use the required fact + "in place" and then prove it as a separate step. The [replace] + tactic allows us to do this. *) + +Theorem mult_0_plus' : forall n m : nat, + (n + 0 + 0) * m = n * m. +Proof. + intros n m. + replace (n + 0 + 0) with n. + - reflexivity. + - rewrite add_comm. simpl. rewrite add_comm. reflexivity. +Qed. + +(** The tactic [replace e1 with e2] tactic introduces two subgoals. + + The first subgoal is the same as the one at the point where we + invoke [replace], except that [e1] is replaced by [e2]. The + second subgoal is the equality [e1 = e2] itself. *) + +(** As another example, suppose we want to prove that [(n + m) + + (p + q) = (m + n) + (p + q)]. The only difference between the + two sides of the [=] is that the arguments [m] and [n] to the + first inner [+] are swapped, so it seems we should be able to use + the commutativity of addition ([add_comm]) to rewrite one into the + other. However, the [rewrite] tactic is not very smart about + _where_ it applies the rewrite. There are three uses of [+] here, + and it turns out that doing [rewrite -> add_comm] will affect only + the _outer_ one... *) + +Theorem plus_rearrange_firsttry : forall n m p q : nat, + (n + m) + (p + q) = (m + n) + (p + q). +Proof. + intros n m p q. + (* We just need to swap (n + m) for (m + n)... seems + like add_comm should do the trick! *) + rewrite add_comm. + (* Doesn't work... Rocq rewrites the wrong plus! :-( *) +Abort. + +(** To use [add_comm] at the point where we need it, we can rewrite + [n + m] to [m + n] using [replace] and then prove [n + m = m + n] + using [add_comm]. *) + +Theorem plus_rearrange : forall n m p q : nat, + (n + m) + (p + q) = (m + n) + (p + q). +Proof. + intros n m p q. + replace (n + m) with (m + n). + - reflexivity. + - rewrite add_comm. reflexivity. +Qed. + +(* ################################################################# *) +(** * Formal vs. Informal Proof *) + +(** "Informal proofs are algorithms; formal proofs are code." *) + +(** What constitutes a successful proof of a mathematical claim? + + The question has challenged philosophers for millennia, but a + rough and ready answer could be this: A proof of a mathematical + proposition [P] is a written (or spoken) text that instills in the + reader or hearer the certainty that [P] is true -- an unassailable + argument for the truth of [P]. That is, a proof is an act of + communication. + + Acts of communication may involve different sorts of readers. On + one hand, the "reader" can be a program like Rocq, in which case + the "belief" that is instilled is that [P] can be mechanically + derived from a certain set of formal logical rules, and the proof + is a recipe that guides the program in checking this fact. Such + recipes are _formal_ proofs. + + Alternatively, the reader can be a human being, in which case the + proof will probably be written in English or some other natural + language and will thus necessarily be _informal_. Here, the + criteria for success are less clearly specified. A "valid" proof + is one that makes the reader believe [P]. But the same proof may + be read by many different readers, some of whom may be convinced + by a particular way of phrasing the argument, while others may not + be. Some readers may be particularly pedantic, inexperienced, or + just plain thick-headed; the only way to convince them will be to + make the argument in painstaking detail. Other readers, more + familiar in the area, may find all this detail so overwhelming + that they lose the overall thread; all they want is to be told the + main ideas, since it is easier for them to fill in the details for + themselves than to wade through a written presentation of them. + Ultimately, there is no universal standard, because there is no + single way of writing an informal proof that will convince every + conceivable reader. + + In practice, however, mathematicians have developed a rich set of + conventions and idioms for writing about complex mathematical + objects that -- at least within a certain community -- make + communication fairly reliable. The conventions of this stylized + form of communication give a reasonably clear standard for judging + proofs good or bad. + + Because we are using Rocq in this course, we will be working + heavily with formal proofs. But this doesn't mean we can + completely forget about informal ones! Formal proofs are useful + in many ways, but they are _not_ very efficient ways of + communicating ideas between human beings. *) + +(** For example, here is a proof that addition is associative: *) + +Theorem add_assoc' : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. intros n m p. induction n as [| n' IHn']. reflexivity. + simpl. rewrite IHn'. reflexivity. Qed. + +(** Rocq is perfectly happy with this. For a human, however, it + is difficult to make much sense of it. We can use comments and + bullets to show the structure a little more clearly... *) + +Theorem add_assoc'' : forall n m p : nat, + n + (m + p) = (n + m) + p. +Proof. + intros n m p. induction n as [| n' IHn']. + - (* n = 0 *) + reflexivity. + - (* n = S n' *) + simpl. rewrite IHn'. reflexivity. Qed. + +(** ... and if you're used to Rocq you might be able to step + through the tactics one after the other in your mind and imagine + the state of the context and goal stack at each point, but if the + proof were even a little bit more complicated this would be next + to impossible. + + A (pedantic) mathematician might write the proof something like + this: *) + +(** - _Theorem_: For any [n], [m] and [p], + + n + (m + p) = (n + m) + p. + + _Proof_: By induction on [n]. + + - First, suppose [n = 0]. We must show that + + 0 + (m + p) = (0 + m) + p. + + This follows directly from the definition of [+]. + + - Next, suppose [n = S n'], where + + n' + (m + p) = (n' + m) + p. + + We must now show that + + (S n') + (m + p) = ((S n') + m) + p. + + By the definition of [+], this follows from + + S (n' + (m + p)) = S ((n' + m) + p), + + which is immediate from the induction hypothesis. _Qed_. *) + +(** The overall form of the proof is basically similar, and of + course this is no accident: Rocq has been designed so that its + [induction] tactic generates the same sub-goals, in the same + order, as the bullet points that a mathematician would usually + write. But there are significant differences of detail: the + formal proof is much more explicit in some ways (e.g., the use of + [reflexivity]) but much less explicit in others (in particular, + the "proof state" at any given point in the Rocq proof is + completely implicit, whereas the informal proof reminds the reader + several times where things stand). *) + +(** **** Exercise: 2 stars, advanced, optional (add_comm_informal) + + Translate your solution for [add_comm] into an informal proof: + + Theorem: Addition is commutative. + + Proof: (* FILL IN HERE *) +*) + +(* Do not modify the following line: *) +Definition manual_grade_for_add_comm_informal : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (eqb_refl_informal) + + Write an informal proof of the following theorem, using the + informal proof of [add_assoc] as a model. Don't just + paraphrase the Rocq tactics into English! + + Theorem: [(n =? n) = true] for any [n]. + + Proof: (* FILL IN HERE *) +*) + +(* Do not modify the following line: *) +Definition manual_grade_for_eqb_refl_informal : option (nat*string) := None. +(** [] *) + +(* ################################################################# *) +(** * More Exercises *) + +(** **** Exercise: 3 stars, standard, especially useful (mul_comm) + + Use [replace] to help prove [add_shuffle3]. You don't need to + use induction yet. *) + +Theorem add_shuffle3 : forall n m p : nat, + n + (m + p) = m + (n + p). +Proof. + (* FILL IN HERE *) Admitted. + +(** Now prove commutativity of multiplication. You will probably want + to look for (or define and prove) a "helper" theorem to be used in + the proof of this one. Hint: what is [n * (1 + k)]? *) + +Theorem mul_comm : forall m n : nat, + m * n = n * m. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (more_exercises) + + Take a piece of paper. For each of the following theorems, first + _think_ about whether (a) it can be proved using only + simplification and rewriting, (b) it also requires case + analysis ([destruct]), or (c) it also requires induction. Write + down your prediction. Then fill in the proof. (There is no need + to turn in your piece of paper; this is just to encourage you to + reflect before you hack!) *) + +Theorem leb_refl : forall n:nat, + (n <=? n) = true. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem zero_neqb_S : forall n: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 S_neqb_0 : forall n: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. +(** [] *) + +(* ################################################################# *) +(** * Nat to Bin and Back to Nat *) + +(** Recall the [bin] type we defined in [Basics]: *) + +Inductive bin : Type := + | Z + | B0 (n : bin) + | B1 (n : bin) +. +(** Before you start working on the next exercise, replace the stub + definitions of [incr] and [bin_to_nat], below, with your solution + from [Basics]. That will make it possible for this file to + be graded on its own. *) + +Fixpoint incr (m:bin) : bin + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Fixpoint bin_to_nat (m:bin) : nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** In [Basics], we did some unit testing of [bin_to_nat], but we + didn't prove its correctness. Now we'll do so. *) + +(** **** Exercise: 3 stars, standard, especially useful (binary_commute) + + Prove that the following diagram commutes: + + incr + bin ----------------------> bin + | | + bin_to_nat | | bin_to_nat + | | + v v + nat ----------------------> nat + S + + That is, incrementing a binary number and then converting it to + a (unary) natural number yields the same result as first converting + it to a natural number and then incrementing. + + If you want to change your previous definitions of [incr] or [bin_to_nat] + to make the property easier to prove, feel free to do so! *) + +Theorem bin_to_nat_pres_incr : forall b : bin, + bin_to_nat (incr b) = 1 + bin_to_nat b. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 3 stars, standard (nat_bin_nat) *) + +(** Write a function to convert natural numbers to binary numbers. *) + +Fixpoint nat_to_bin (n:nat) : bin + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** Prove that, if we start with any [nat], convert it to [bin], and + convert it back, we get the same [nat] which we started with. + + Hint: This proof should go through smoothly using the previous + exercise about [incr] as a lemma. If not, revisit your definitions + of the functions involved and consider whether they are more + complicated than necessary: the shape of a proof by induction will + match the recursive structure of the program being verified, so + make the recursions as simple as possible. *) + +Theorem nat_bin_nat : forall n, bin_to_nat (nat_to_bin n) = n. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ################################################################# *) +(** * Bin to Nat and Back to Bin (Advanced) *) + +(** The opposite direction -- starting with a [bin], converting to [nat], + then converting back to [bin] -- turns out to be problematic. That + is, the following theorem does not hold. *) + +Theorem bin_nat_bin_fails : forall b, nat_to_bin (bin_to_nat b) = b. +Abort. + +(** Let's explore why that theorem fails, and how to prove a modified + version of it. We'll start with some lemmas that might seem + unrelated, but will turn out to be relevant. *) + +(** **** Exercise: 2 stars, advanced (double_bin) *) + +(** Prove this lemma about [double], which we defined earlier in the + chapter. *) + +Lemma double_incr : forall n : nat, double (S n) = S (S (double n)). +Proof. + (* FILL IN HERE *) Admitted. + +(** Now define a similar doubling function for [bin]. *) + +Definition double_bin (b:bin) : bin + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** Check that your function correctly doubles zero. *) + +Example double_bin_zero : double_bin Z = Z. +(* FILL IN HERE *) Admitted. + +(** Prove this lemma, which corresponds to [double_incr]. *) + +Lemma double_incr_bin : forall b, + double_bin (incr b) = incr (incr (double_bin b)). +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** Let's return to our desired theorem: *) + +Theorem bin_nat_bin_fails : forall b, nat_to_bin (bin_to_nat b) = b. +Abort. + +(** The theorem fails because there are some [bin] such that we won't + necessarily get back to the _original_ [bin], but instead to an + "equivalent" [bin]. (We deliberately leave that notion undefined + here for you to think about.) + + Explain in a comment, below, why this failure occurs. Your + explanation will not be graded, but it's important that you get it + clear in your mind before going on to the next part. If you're + stuck on this, think about alternative implementations of + [double_bin] that might have failed to satisfy [double_bin_zero] + yet otherwise seem correct. *) + +(* FILL IN HERE *) + +(** To solve that problem, we can introduce a _normalization_ function + that selects the simplest [bin] out of all the equivalent + [bin]. Then we can prove that the conversion from [bin] to [nat] and + back again produces that normalized, simplest [bin]. *) + +(** **** Exercise: 4 stars, advanced (bin_nat_bin) *) + +(** Define [normalize]. You will need to keep its definition as simple + as possible for later proofs to go smoothly. Do not use + [bin_to_nat] or [nat_to_bin], but do use [double_bin]. + + Hint: Structure the recursion such that it _always_ reaches the + end of the [bin] and _only_ processes each bit only once. Do not + try to "look ahead" at future bits. *) + +Fixpoint normalize (b:bin) : bin + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** It would be wise to do some [Example] proofs to check that your definition of + [normalize] works the way you intend before you proceed. They won't be graded, + but fill them in below. *) + +(* FILL IN HERE *) + +(** Finally, prove the main theorem. The inductive cases could be a + bit tricky. + + Hint: Start by trying to prove the main statement, see where you + get stuck, and see if you can find a lemma -- perhaps requiring + its own inductive proof -- that will allow the main proof to make + progress. We have one lemma for the [B0] case (which also makes + use of [double_incr_bin]) and another for the [B1] case. *) + +Theorem bin_nat_bin : forall b, nat_to_bin (bin_to_nat b) = normalize b. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(* 2026-01-07 13:17 *) diff --git a/InductionTest.v b/InductionTest.v new file mode 100644 index 0000000..2f171dc --- /dev/null +++ b/InductionTest.v @@ -0,0 +1,257 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Induction. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Induction. +Import Check. + +Goal True. + +idtac "------------------- basic_induction --------------------". +idtac " ". + +idtac "#> mul_0_r". +idtac "Possible points: 0.5". +check_type @mul_0_r ((forall n : nat, @eq nat (Nat.mul n 0) 0)). +idtac "Assumptions:". +Abort. +Print Assumptions mul_0_r. +Goal True. +idtac " ". + +idtac "#> plus_n_Sm". +idtac "Possible points: 0.5". +check_type @plus_n_Sm ((forall n m : nat, @eq nat (S (Nat.add n m)) (Nat.add n (S m)))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_n_Sm. +Goal True. +idtac " ". + +idtac "#> add_comm". +idtac "Possible points: 0.5". +check_type @add_comm ((forall n m : nat, @eq nat (Nat.add n m) (Nat.add m n))). +idtac "Assumptions:". +Abort. +Print Assumptions add_comm. +Goal True. +idtac " ". + +idtac "#> add_assoc". +idtac "Possible points: 0.5". +check_type @add_assoc ( +(forall n m p : nat, + @eq nat (Nat.add n (Nat.add m p)) (Nat.add (Nat.add n m) p))). +idtac "Assumptions:". +Abort. +Print Assumptions add_assoc. +Goal True. +idtac " ". + +idtac "------------------- double_plus --------------------". +idtac " ". + +idtac "#> double_plus". +idtac "Possible points: 2". +check_type @double_plus ((forall n : nat, @eq nat (double n) (Nat.add n n))). +idtac "Assumptions:". +Abort. +Print Assumptions double_plus. +Goal True. +idtac " ". + +idtac "------------------- eqb_refl --------------------". +idtac " ". + +idtac "#> eqb_refl". +idtac "Possible points: 2". +check_type @eqb_refl ((forall n : nat, @eq bool (eqb n n) true)). +idtac "Assumptions:". +Abort. +Print Assumptions eqb_refl. +Goal True. +idtac " ". + +idtac "------------------- mul_comm --------------------". +idtac " ". + +idtac "#> add_shuffle3". +idtac "Possible points: 1". +check_type @add_shuffle3 ( +(forall n m p : nat, + @eq nat (Nat.add n (Nat.add m p)) (Nat.add m (Nat.add n p)))). +idtac "Assumptions:". +Abort. +Print Assumptions add_shuffle3. +Goal True. +idtac " ". + +idtac "#> mul_comm". +idtac "Possible points: 2". +check_type @mul_comm ((forall m n : nat, @eq nat (Nat.mul m n) (Nat.mul n m))). +idtac "Assumptions:". +Abort. +Print Assumptions mul_comm. +Goal True. +idtac " ". + +idtac "------------------- binary_commute --------------------". +idtac " ". + +idtac "#> bin_to_nat_pres_incr". +idtac "Possible points: 3". +check_type @bin_to_nat_pres_incr ( +(forall b : bin, @eq nat (bin_to_nat (incr b)) (Nat.add 1 (bin_to_nat b)))). +idtac "Assumptions:". +Abort. +Print Assumptions bin_to_nat_pres_incr. +Goal True. +idtac " ". + +idtac "------------------- nat_bin_nat --------------------". +idtac " ". + +idtac "#> nat_bin_nat". +idtac "Possible points: 3". +check_type @nat_bin_nat ((forall n : nat, @eq nat (bin_to_nat (nat_to_bin n)) n)). +idtac "Assumptions:". +Abort. +Print Assumptions nat_bin_nat. +Goal True. +idtac " ". + +idtac "------------------- double_bin --------------------". +idtac " ". + +idtac "#> double_incr". +idtac "Advanced". +idtac "Possible points: 0.5". +check_type @double_incr ((forall n : nat, @eq nat (double (S n)) (S (S (double n))))). +idtac "Assumptions:". +Abort. +Print Assumptions double_incr. +Goal True. +idtac " ". + +idtac "#> double_bin_zero". +idtac "Advanced". +idtac "Possible points: 0.5". +check_type @double_bin_zero ((@eq bin (double_bin Z) Z)). +idtac "Assumptions:". +Abort. +Print Assumptions double_bin_zero. +Goal True. +idtac " ". + +idtac "#> double_incr_bin". +idtac "Advanced". +idtac "Possible points: 1". +check_type @double_incr_bin ( +(forall b : bin, @eq bin (double_bin (incr b)) (incr (incr (double_bin b))))). +idtac "Assumptions:". +Abort. +Print Assumptions double_incr_bin. +Goal True. +idtac " ". + +idtac "------------------- bin_nat_bin --------------------". +idtac " ". + +idtac "#> bin_nat_bin". +idtac "Advanced". +idtac "Possible points: 6". +check_type @bin_nat_bin ( +(forall b : bin, @eq bin (nat_to_bin (bin_to_nat b)) (normalize b))). +idtac "Assumptions:". +Abort. +Print Assumptions bin_nat_bin. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 15". +idtac "Max points - advanced: 23". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- mul_0_r ---------". +Print Assumptions mul_0_r. +idtac "---------- plus_n_Sm ---------". +Print Assumptions plus_n_Sm. +idtac "---------- add_comm ---------". +Print Assumptions add_comm. +idtac "---------- add_assoc ---------". +Print Assumptions add_assoc. +idtac "---------- double_plus ---------". +Print Assumptions double_plus. +idtac "---------- eqb_refl ---------". +Print Assumptions eqb_refl. +idtac "---------- add_shuffle3 ---------". +Print Assumptions add_shuffle3. +idtac "---------- mul_comm ---------". +Print Assumptions mul_comm. +idtac "---------- bin_to_nat_pres_incr ---------". +Print Assumptions bin_to_nat_pres_incr. +idtac "---------- nat_bin_nat ---------". +Print Assumptions nat_bin_nat. +idtac "". +idtac "********** Advanced **********". +idtac "---------- double_incr ---------". +Print Assumptions double_incr. +idtac "---------- double_bin_zero ---------". +Print Assumptions double_bin_zero. +idtac "---------- double_incr_bin ---------". +Print Assumptions double_incr_bin. +idtac "---------- bin_nat_bin ---------". +Print Assumptions bin_nat_bin. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..733806a --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2026 + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Lists.v b/Lists.v new file mode 100644 index 0000000..771c92a --- /dev/null +++ b/Lists.v @@ -0,0 +1,1207 @@ +(** * Lists: Working with Structured Data *) + +From LF Require Export Induction. +Module NatList. + +(* ################################################################# *) +(** * Pairs of Numbers *) + +(** In an [Inductive] type definition, each constructor can take + any number of arguments -- none (as with [true] and [O]), one (as + with [S]), or more than one (as with [nybble] and the following): *) + +Inductive natprod : Type := + | pair (n1 n2 : nat). + +(** This declaration can be read: "The one and only way to + construct a pair of numbers is by applying the constructor [pair] + to two arguments of type [nat]." *) + +Check (pair 3 5) : natprod. + +(** Functions for extracting the first and second components of a pair + can then be defined by pattern matching. *) + +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. + +Compute (fst (pair 3 5)). +(* ===> 3 *) + +(** Since pairs will be used heavily in what follows, it will be + convenient to write them with the standard mathematical notation + [(x,y)] instead of [pair x y]. We can tell Rocq to allow this with + a [Notation] declaration. *) + +Notation "( x , y )" := (pair x y). + +(** The new notation can be used both in expressions and in pattern + matches. *) + +Compute (fst (3,5)). + +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. + +(** Note that pattern-matching on a pair (with parentheses: [(x, y)]) + is not to be confused with the "multiple pattern" syntax (with no + parentheses: [x, y]) that we have seen previously. The above + examples illustrate pattern matching on a pair with elements [x] + and [y], whereas, for example, the definition of [minus] in + [Basics] performs pattern matching on the values [n] and [m]: + + Fixpoint minus (n m : nat) : nat := + match n, m with + | O , _ => O + | S _ , O => n + | S n', S m' => minus n' m' + end. + + The distinction is minor, but it is worth understanding that they + are not the same. For instance, the following definitions are + ill-formed: + + (* Can't match on a pair with multiple patterns: *) + Definition bad_fst (p : natprod) : nat := + match p with + | x, y => x + end. + + (* Can't match on multiple values with pair patterns: *) + Definition bad_minus (n m : nat) : nat := + match n, m with + | (O , _ ) => O + | (S _ , O ) => n + | (S n', S m') => bad_minus n' m' + end. +*) + +(** If we state properties of pairs in a slightly peculiar way, we can + sometimes complete their proofs with just reflexivity and its + built-in simplification: *) + +Theorem surjective_pairing' : forall (n m : nat), + (n,m) = (fst (n,m), snd (n,m)). +Proof. + reflexivity. Qed. + +(** But just [reflexivity] is not enough if we state the lemma in a more + natural way: *) + +Theorem surjective_pairing_stuck : forall (p : natprod), + p = (fst p, snd p). +Proof. + simpl. (* Doesn't reduce anything! *) +Abort. + +(** Instead, we need to expose the structure of [p] so that + [simpl] can perform the pattern match in [fst] and [snd]. We can + do this with [destruct]. *) + +Theorem surjective_pairing : forall (p : natprod), + p = (fst p, snd p). +Proof. + intros p. destruct p as [n m]. simpl. reflexivity. Qed. + +(** Notice that, by contrast with the behavior of [destruct] on + [nat]s, where it generates two subgoals, [destruct] generates just + one subgoal here. That's because [natprod]s can only be + constructed in one way. *) + +(** **** Exercise: 1 star, standard (snd_fst_is_swap) *) +Theorem snd_fst_is_swap : forall (p : natprod), + (snd p, fst p) = swap_pair p. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard, optional (fst_swap_is_snd) *) +Theorem fst_swap_is_snd : forall (p : natprod), + fst (swap_pair p) = snd p. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Lists of Numbers *) + +(** Generalizing the definition of pairs, we can describe the + type of _lists_ of numbers like this: "A list is either the empty + list or else a pair of a number and another list." *) + +Inductive natlist : Type := + | nil + | cons (n : nat) (l : natlist). + +(** For example, here is a three-element list: *) + +Definition mylist := cons 1 (cons 2 (cons 3 nil)). + +(** As with pairs, it is convenient to write lists in familiar + notation. The following declarations allow us to use [::] as an + infix [cons] operator and square brackets as an "outfix" notation + for constructing lists. *) + +Notation "x :: l" := (cons x l) + (at level 60, right associativity). +Notation "[ ]" := nil. +Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..). + +(** It is not necessary to understand the details of these + declarations, but here is roughly what's going on in case you are + interested. The "[right associativity]" annotation tells Rocq how to + parenthesize expressions involving multiple uses of [::] so that, + for example, the next three declarations mean exactly the same + thing: *) + +Definition mylist1 := 1 :: (2 :: (3 :: nil)). +Definition mylist2 := 1 :: 2 :: 3 :: nil. +Definition mylist3 := [1;2;3]. + +(** The "[at level 60]" part tells Rocq how to parenthesize + expressions that involve both [::] and some other infix operator. + For example, since we defined [+] as infix notation for the [plus] + function at level 50, + + Notation "x + y" := (plus x y) (at level 50, left associativity). + + the [+] operator will bind tighter than [::], so [1 + 2 :: [3]] + will be parsed, as we'd expect, as [(1 + 2) :: [3]] rather than [1 + + (2 :: [3])]. + + (Expressions like "[1 + 2 :: [3]]" can be a little confusing when + you read them in a [.v] file. The inner brackets, around 3, + indicate a list, but the outer brackets, which are invisible in + the HTML rendering, are there to instruct the "rocq doc" tool that + the bracketed part should be displayed as Rocq code rather than + running text.) + + The second and third [Notation] declarations above introduce the + standard square-bracket notation for lists; the right-hand side of + the third one illustrates Rocq's syntax for declaring n-ary + notations and translating them to nested sequences of binary + constructors. + + Again, don't worry if some of these parsing details are puzzling: + all the notations you'll need in this course will be defined for + you. *) + +(* ----------------------------------------------------------------- *) +(** *** Repeat *) + +(** Next let's look at several functions for constructing and + manipulating lists. First is the [repeat] function, which takes a + number [n] and a [count] and returns a list of length [count] in + which every element is [n]. *) + +Fixpoint repeat (n count : nat) : natlist := + match count with + | O => nil + | S count' => n :: (repeat n count') + end. + +(* ----------------------------------------------------------------- *) +(** *** Length *) + +(** The [length] function calculates the length of a list. *) + +Fixpoint length (l:natlist) : nat := + match l with + | nil => O + | h :: t => S (length t) + end. + +(* ----------------------------------------------------------------- *) +(** *** Append *) + +(** The [app] function appends (concatenates) two lists. *) + +Fixpoint app (l1 l2 : natlist) : natlist := + match l1 with + | nil => l2 + | h :: t => h :: (app t l2) + end. + +(** Since [app] will be used extensively, it is again convenient + to have an infix operator for it. *) + +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. + +(* ----------------------------------------------------------------- *) +(** *** Head and Tail *) + +(** Here are two more handy functions for working with lists. + The [hd] function returns the first element (the "head") of the + list, while [tl] returns everything but the first element (the + "tail"). Since the empty list has no first element, we pass + a default value to be returned in that case. *) + +Definition hd (default : nat) (l : natlist) : nat := + match l with + | nil => default + | h :: t => h + end. + +Definition tl (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_tl: tl [1;2;3] = [2;3]. +Proof. reflexivity. Qed. + +(* ----------------------------------------------------------------- *) +(** *** Exercises *) + +(** **** Exercise: 2 stars, standard, especially useful (list_funs) + + Complete the definitions of [nonzeros], [oddmembers], and + [countoddmembers] below. Have a look at the tests to understand + what these functions should do. *) + +Fixpoint nonzeros (l:natlist) : natlist + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_nonzeros: + nonzeros [0;1;0;2;3;0;0] = [1;2;3]. + (* FILL IN HERE *) Admitted. + +Fixpoint oddmembers (l:natlist) : natlist + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_oddmembers: + oddmembers [0;1;0;2;3;0;0] = [1;3]. + (* FILL IN HERE *) Admitted. + +(** For the next problem, [countoddmembers], we're giving you a header + that uses the keyword [Definition] instead of [Fixpoint]. The + point of stating the question this way is to encourage you to + implement the function by using already-defined functions, rather + than writing your own recursive definition. *) + +Definition countoddmembers (l:natlist) : nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(** **** Exercise: 3 stars, advanced (alternate) + + Complete the following definition of [alternate], which + interleaves two lists into one, alternating between elements taken + from the first list and elements from the second. See the tests + below for more specific examples. + + Hint: there are natural ways of writing [alternate] that fail to + satisfy Rocq's requirement that all [Fixpoint] definitions be + _structurally recursive_, as mentioned in [Basics]. If you + encounter this difficulty, consider pattern matching against both + lists at the same time with the "multiple pattern" syntax we've + seen before. *) + +Fixpoint alternate (l1 l2 : natlist) : natlist + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(* ----------------------------------------------------------------- *) +(** *** Bags via Lists *) + +(** A [bag] (or [multiset]) is like a set, except that each element + can appear multiple times rather than just once. One way of + representating a bag of numbers is as a list. *) + +Definition bag := natlist. + +(** **** Exercise: 3 stars, standard, especially useful (bag_functions) + + Complete the following definitions for the functions [count], + [sum], [add], and [member] for bags. *) + +Fixpoint count (v : nat) (s : bag) : nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** All these proofs can be completed with [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. + +(** Multiset [sum] is similar to set [union]: [sum a b] contains all + the elements of [a] and those of [b]. (Mathematicians usually + define [union] on multisets a little bit differently -- using max + instead of sum -- which is why we don't call this operation + [union].) + + We've deliberately given you a header that does not give explicit + names to the arguments. Implement [sum] in terms of an + already-defined function, without changing the header. *) + +Definition sum : bag -> bag -> bag + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3. + (* FILL IN HERE *) Admitted. + +Definition add (v : nat) (s : bag) : bag + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. + +Fixpoint member (v : nat) (s : bag) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (bag_more_functions) + + Here are some more [bag] functions for you to practice with. *) + +(** When [remove_one] is applied to a bag without the number to + remove, it should return the same bag unchanged. (This exercise + is optional, but students following the advanced track will need + to fill in the definition of [remove_one] for a later + exercise.) *) + +Fixpoint remove_one (v : nat) (s : bag) : bag + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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 + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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 included (s1 : bag) (s2 : bag) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_included1: included [1;2] [2;1;4;1] = true. + (* FILL IN HERE *) Admitted. +Example test_included2: included [1;2;2] [2;1;4;1] = false. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (add_inc_count) + + Adding a value to a bag should increase the value's count by one. + State this as a theorem and prove it in Rocq. *) +(* +Theorem add_inc_count : ... +Proof. + ... +Qed. +*) + +(* Do not modify the following line: *) +Definition manual_grade_for_add_inc_count : option (nat*string) := None. +(** [] *) + +(* ################################################################# *) +(** * Reasoning About Lists *) + +(** As with numbers, simple facts about list-processing + functions can sometimes be proved entirely by simplification. For + example, just [reflexivity] is enough for this theorem... *) + +Theorem nil_app : forall l : natlist, + [] ++ l = l. +Proof. reflexivity. Qed. + +(** ...because the [[]] is substituted into the "scrutinee" (the + expression whose value is being "scrutinized" by the match) in the + definition of [app], allowing the match itself to be simplified. *) + +(** Also, as with numbers, it is sometimes helpful to perform case + analysis on the possible shapes -- empty or non-empty -- of an unknown + list. *) + +Theorem tl_length_pred : forall l:natlist, + pred (length l) = length (tl l). +Proof. + intros l. destruct l as [| n l']. + - (* l = nil *) + reflexivity. + - (* l = cons n l' *) + reflexivity. Qed. + +(** Here, the [nil] case works because we've chosen to define + [tl nil = nil]. Notice that the [as] annotation on the [destruct] + tactic here introduces two names, [n] and [l'], corresponding to + the fact that the [cons] constructor for lists takes two + arguments (the head and tail of the list it is constructing). *) + +(** Usually, though, interesting theorems about lists require + induction for their proofs. We'll see how to do this next. *) + +(** (Micro-Sermon: As we get deeper into this material, simply + _reading_ proof scripts will not help you very much. Rather, it + is important to step through the details of each one using Rocq and + think about what each step achieves. Otherwise it is more or less + guaranteed that the exercises will make no sense when you get to + them. 'Nuff said.) *) + +(* ================================================================= *) +(** ** Induction on Lists *) + +(** Proofs by induction over datatypes like [natlist] are a + little less familiar than standard natural number induction, but + the idea is equally simple. Each [Inductive] declaration defines + a set of data values that can be built up using the declared + constructors. For example, a boolean can be either [true] or + [false]; a number can be either [O] or else [S] applied to another + number; and a list can be either [nil] or else [cons] applied to a + number and a list. Moreover, applications of the declared + constructors to one another are the _only_ possible shapes that + elements of an inductively defined set can have. + + This last fact directly gives rise to a way of reasoning about + inductively defined sets: a number is either [O] or else it is [S] + applied to some _smaller_ number; a list is either [nil] or else + it is [cons] applied to some number and some _smaller_ list; + etc. Thus, if we have in mind some proposition [P] that mentions a + list [l] and we want to argue that [P] holds for _all_ lists, we + can reason as follows: + + - First, show that [P] is true of [l] when [l] is [nil]. + + - Then show that [P] is true of [l] when [l] is [cons n l'] for + some number [n] and some smaller list [l'], assuming that [P] + is true for [l']. + + Since larger lists can always be broken down into smaller ones, + eventually reaching [nil], these two arguments together establish + the truth of [P] for all lists [l]. + + Here's a concrete example: *) + +Theorem app_assoc : forall l1 l2 l3 : natlist, + (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3). +Proof. + intros l1 l2 l3. induction l1 as [| n l1' IHl1']. + - (* l1 = nil *) + reflexivity. + - (* l1 = cons n l1' *) + simpl. rewrite -> IHl1'. reflexivity. Qed. + +(** Notice that, as we saw with induction on natural numbers, + the [as...] clause provided to the [induction] tactic gives a name + to the induction hypothesis corresponding to the smaller list + [l1'] in the [cons] case. + + Once again, this Rocq proof is not especially illuminating as a + static document -- it is easy to see what's going on if you are + reading the proof in an interactive Rocq session and you can see + the current goal and context at each point, but this state is not + visible in the written-down parts of the Rocq proof. So a + natural-language proof -- one written for human readers -- would + include more explicit signposts; in particular, it helps the + reader stay oriented to remind them exactly what the induction + hypothesis is in the second case. *) + +(** For comparison, here is an informal proof of the same theorem. *) + +(** _Theorem_: For all lists [l1], [l2], and [l3], + [(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3)]. + + _Proof_: By induction on [l1]. + + - First, suppose [l1 = []]. We must show + + ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3), + + which follows directly from the definition of [++]. + + - Next, suppose [l1 = n::l1'], with + + (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3) + + (the induction hypothesis). We must show + + ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3). + + By the definition of [++], this follows from + + n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)), + + which is immediate from the induction hypothesis. [] *) + +(* ----------------------------------------------------------------- *) +(** *** Generalizing Statements *) + +(** In some situations, it is necessary to generalize a + statement in order to prove it by induction. Intuitively, the + reason is that a more general statement also yields a more general + (stronger) inductive hypothesis. If you find yourself stuck in a + proof, it may help to step back and see whether you can prove a + stronger statement. *) + +Theorem repeat_double_firsttry : forall c n: nat, + repeat n c ++ repeat n c = repeat n (c + c). +Proof. + intros c. induction c as [| c' IHc']. + - (* c = 0 *) + intros n. simpl. reflexivity. + - (* c = S c' *) + intros n. simpl. + (* Now we seem to be stuck. The IH cannot be used to + rewrite [repeat n (c' + S c')]: it only works + for [repeat n (c' + c')]. If the IH were more liberal here + (e.g., if it worked for an arbitrary second summand), + the proof would go through. *) +Abort. + +(** To get a more general inductive hypothesis, we can generalize + the statement as follows: *) + +Theorem repeat_plus: forall c1 c2 n: nat, + repeat n c1 ++ repeat n c2 = repeat n (c1 + c2). +Proof. + intros c1 c2 n. + induction c1 as [| c1' IHc1']. + - simpl. reflexivity. + - simpl. + rewrite <- IHc1'. + reflexivity. + Qed. + +(* ----------------------------------------------------------------- *) +(** *** Reversing a List *) + +(** For a slightly more involved example of inductive proof over + lists, suppose we use [app] to define a list-reversing function + [rev]: *) + +Fixpoint rev (l:natlist) : natlist := + match l with + | nil => nil + | h :: t => 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. + +(** For something a bit more challenging, let's prove that + reversing a list does not change its length. Our first attempt + gets stuck in the successor case... *) + +Theorem rev_length_firsttry : forall l : natlist, + length (rev l) = length l. +Proof. + intros l. induction l as [| n l' IHl']. + - (* l = nil *) + reflexivity. + - (* l = n :: l' *) + (* This is the tricky case. Let's begin as usual + by simplifying. *) + simpl. + (* Now we seem to be stuck: the goal is an equality + involving [++], but we don't have any useful equations + in either the immediate context or in the global + environment! We can make a little progress by using + the IH to rewrite the goal... *) + rewrite <- IHl'. + (* ... but now we can't go any further. *) +Abort. + +(** A first attempt to make progress would be to prove exactly + the statement that we are missing at this point. But this attempt + will fail because the inductive hypothesis is not general enough. *) +Theorem app_rev_length_S_firsttry: forall l n, + length (rev l ++ [n]) = S (length (rev l)). +Proof. + intros l. induction l as [| m l' IHl']. + - (* l = [] *) + intros n. simpl. reflexivity. + - (* l = m:: l' *) + intros n. simpl. + (* IHl' not applicable. *) +Abort. + +(** It turns out that the above lemma is more specific than it + needs to be. We can strengthen the lemma to work not only on reversed + lists but on general lists. *) +Theorem app_length_S: forall l n, + length (l ++ [n]) = S (length l). +Proof. + intros l n. induction l as [| m l' IHl']. + - (* l = [] *) + simpl. reflexivity. + - (* l = m:: l' *) + simpl. + rewrite IHl'. + reflexivity. +Qed. + +(** Now we can complete the original proof. *) + +Theorem rev_length : forall l : natlist, + length (rev l) = length l. +Proof. + intros l. induction l as [| n l' IHl']. + - (* l = nil *) + reflexivity. + - (* l = cons *) + simpl. + rewrite -> app_length_S. + rewrite -> IHl'. + reflexivity. +Qed. + +(** Note that the [app_length_S] lemma we proved above is pretty + narrow, requiring that the second list contains only a single element. + We can prove a more general version for any two lists. *) +Theorem app_length : forall l1 l2 : natlist, + length (l1 ++ l2) = (length l1) + (length l2). +Proof. + (* WORKED IN CLASS *) + intros l1 l2. induction l1 as [| n l1' IHl1']. + - (* l1 = nil *) + reflexivity. + - (* l1 = cons *) + simpl. rewrite -> IHl1'. reflexivity. Qed. + +(** For comparison, here are informal proofs of these two theorems: + + _Theorem_: For all lists [l1] and [l2], + [length (l1 ++ l2) = length l1 + length l2]. + + _Proof_: By induction on [l1]. + + - First, suppose [l1 = []]. We must show + + length ([] ++ l2) = length [] + length l2, + + which follows directly from the definitions of [length], + [++], and [plus]. + + - Next, suppose [l1 = n::l1'], with + + length (l1' ++ l2) = length l1' + length l2. + + We must show + + length ((n::l1') ++ l2) = length (n::l1') + length l2. + + This follows directly from the definitions of [length] and [++] + together with the induction hypothesis. [] *) + +(** _Theorem_: For all lists [l], [length (rev l) = length l]. + + _Proof_: By induction on [l]. + + - First, suppose [l = []]. We must show + + length (rev []) = length [], + + which follows directly from the definitions of [length] + and [rev]. + + - Next, suppose [l = n::l'], with + + length (rev l') = length l'. + + We must show + + length (rev (n :: l')) = length (n :: l'). + + By the definition of [rev], this follows from + + length ((rev l') ++ [n]) = S (length l') + + which, by the previous lemma, is the same as + + length (rev l') + length [n] = S (length l'). + + This follows directly from the induction hypothesis and the + definition of [length]. [] *) + +(** The style of these proofs is rather longwinded and pedantic. + After reading a couple like this, we might find it easier to + follow proofs that give fewer details (which we can easily work + out in our own minds or on scratch paper if necessary) and just + highlight the non-obvious steps. In this more compressed style, + the above proof might look like this: *) + +(** _Theorem_: For all lists [l], [length (rev l) = length l]. + + _Proof_: First observe, by a straightforward induction on [l], + that [length (l ++ [n]) = S (length l)] for any [l]. The main + property then follows by another induction on [l], using the + observation together with the induction hypothesis in the case + where [l = n'::l']. [] *) + +(** Which style is preferable in a given situation depends on + the sophistication of the expected audience and how similar the + proof at hand is to ones that they will already be familiar with. + The more pedantic style is a good default for our present purposes + because we're trying to be ultra-clear about the details. *) + +(* ================================================================= *) +(** ** [Search] *) + +(** We've seen that proofs can make use of other theorems we've + already proved, e.g., using [rewrite]. But in order to refer to a + theorem, we need to know its name! Indeed, it is often hard even + to remember what theorems have been proven, much less what they + are called. + + Rocq's [Search] command is quite helpful with this. + + Let's say you've forgotten the name of a theorem about [rev]. The + command [Search rev] will cause Rocq to display a list of all + theorems involving [rev]. *) + +Search rev. + +(** Or say you've forgotten the name of the theorem showing that plus + is commutative. You can use a pattern to search for all theorems + involving the equality of two additions. *) + +Search (_ + _ = _ + _). + +(** You'll see a lot of results there, nearly all of them from the + standard library. To restrict the results, you can search inside + a particular module: *) + +Search (_ + _ = _ + _) inside Induction. + +(** You can also make the search more precise by using variables in + the search pattern instead of wildcards: *) + +Search (?x + ?y = ?y + ?x). + +(** (The question mark in front of the variable is needed to indicate + that it is a variable in the search pattern, rather than a defined + identifier that is expected to be in scope currently.) *) + +(** Keep [Search] in mind as you do the following exercises and + throughout the rest of the book; it can save you a lot of time! + + Your IDE likely has its own functionality to help with searching. + For example, in VSRocq, you can open a tab for performing searches + with [Command-Control-K]. *) + +(* ================================================================= *) +(** ** List Exercises, Part 1 *) + +(** **** Exercise: 3 stars, standard (list_exercises) + + More practice with lists: *) + +Theorem app_nil_r : forall l : natlist, + l ++ [] = l. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem rev_app_distr: forall l1 l2 : natlist, + rev (l1 ++ l2) = rev l2 ++ rev l1. +Proof. + (* FILL IN HERE *) Admitted. + +(** An _involution_ is a function that is its own inverse. That is, + applying the function twice yield the original input. *) +Theorem rev_involutive : forall l : natlist, + rev (rev l) = l. +Proof. + (* FILL IN HERE *) Admitted. + +(** There is a short solution to the next one. If you find yourself + getting tangled up, step back and try to look for a simpler + way. *) + +Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist, + l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4. +Proof. + (* FILL IN HERE *) Admitted. + +(** An exercise about your implementation of [nonzeros]: *) + +Lemma nonzeros_app : forall l1 l2 : natlist, + nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (eqblist) + + Fill in the definition of [eqblist], which compares + lists of numbers for equality. Prove that [eqblist l l] + yields [true] for every list [l]. *) + +Fixpoint eqblist (l1 l2 : natlist) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_eqblist1 : + (eqblist nil nil = true). + (* FILL IN HERE *) Admitted. + +Example test_eqblist2 : + eqblist [1;2;3] [1;2;3] = true. +(* FILL IN HERE *) Admitted. + +Example test_eqblist3 : + eqblist [1;2;3] [1;2;4] = false. + (* FILL IN HERE *) Admitted. + +Theorem eqblist_refl : forall l:natlist, + true = eqblist l l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** List Exercises, Part 2 *) + +(** Here are a couple of little theorems to prove about your + definitions about bags above. *) + +(** **** Exercise: 1 star, standard (count_member_nonzero) *) +Theorem count_member_nonzero : forall (s : bag), + 1 <=? (count 1 (1 :: s)) = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The following lemma about [leb] might help you in the next + exercise (it will also be useful in later chapters). *) + +Theorem leb_n_Sn : forall n, + n <=? (S n) = true. +Proof. + intros n. induction n as [| n' IHn']. + - (* 0 *) + simpl. reflexivity. + - (* S n' *) + simpl. rewrite IHn'. reflexivity. Qed. + +(** Before doing the next exercise, make sure you've filled in the + definition of [remove_one] above. *) +(** **** Exercise: 3 stars, advanced (remove_does_not_increase_count) *) +Theorem remove_does_not_increase_count: forall (s : bag), + (count 0 (remove_one 0 s)) <=? (count 0 s) = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (bag_count_sum) + + Write down an interesting theorem [bag_count_sum] about bags + involving the functions [count] and [sum], and prove it using + Rocq. (You may find that the difficulty of the proof depends on + how you defined [count]! + + Hint: If you defined [count] using [=?] you may find it useful + to know that [destruct] works on arbitrary expressions, not just + simple identifiers.) +*) +(* FILL IN HERE + + [] *) + +(** **** Exercise: 3 stars, advanced (involution_injective) *) + +(** Prove that every involution is injective. + + Involutions were defined above in [rev_involutive]. An _injective_ + function is one-to-one: it maps distinct inputs to distinct + outputs, without any collisions. *) + +Theorem involution_injective : forall (f : nat -> nat), + (forall n : nat, n = f (f n)) -> (forall n1 n2 : nat, f n1 = f n2 -> n1 = n2). +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 2 stars, advanced (rev_injective) + + Prove that [rev] is injective. Do not prove this by induction -- + that would be hard. Instead, re-use the same proof technique that + you used for [involution_injective]. (But: Don't try to use that + exercise directly as a lemma: the types are not the same!) *) + +Theorem rev_injective : forall (l1 l2 : natlist), + rev l1 = rev l2 -> l1 = l2. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Options *) + +(** Suppose we want to write a function that returns the [n]th + element of some list. If we give it type [nat -> natlist -> nat], + then we'll have to choose some number to return when the list is + too short... *) + +Fixpoint nth_bad (l:natlist) (n:nat) : nat := + match l with + | nil => 42 + | a :: l' => match n with + | 0 => a + | S n' => nth_bad l' n' + end + end. + +(** This solution is not so good: If [nth_bad] returns [42], we + don't know whether that value actually appears in the input + or whether we gave bad arguments. A better alternative is to change the + return type of [nth_bad] to include an error value as a possible + outcome. We call this new type [natoption]. *) + +Inductive natoption : Type := + | Some (n : nat) + | None. + +(* Note that we've capitalized the constructor names [None] and + [Some], following their definition in Rocq's standard library. In + general, constructor (and variable) names can begin with either + capital or lowercase letters. *) + +(** We can then change the above definition of [nth_bad] to + return [None] when the list is too short and [Some a] when the + list has enough members and [a] appears at position [n]. We call + this new function [nth_error] to indicate that it may result in an + error. + + (As we see here, constructors of inductive definitions are allowed + to be be capitalized.) *) + +Fixpoint nth_error (l:natlist) (n:nat) : natoption := + match l with + | nil => None + | a :: l' => match n with + | O => Some a + | S n' => nth_error l' n' + end + end. + +Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4. +Proof. reflexivity. Qed. +Example test_nth_error2 : nth_error [4;5;6;7] 3 = Some 7. +Proof. reflexivity. Qed. +Example test_nth_error3 : nth_error [4;5;6;7] 9 = None. +Proof. reflexivity. Qed. + +(** (In the HTML version, the boilerplate proofs of these + examples are elided. Click on a box if you want to see the + details.) *) + +(** The function below pulls the [nat] out of a [natoption], returning + a supplied default in the [None] case. *) + +Definition option_elim (d : nat) (o : natoption) : nat := + match o with + | Some n' => n' + | None => d + end. + +(** **** Exercise: 2 stars, standard (hd_error) + + Using the same idea, fix the [hd] function from earlier so we don't + have to pass a default element for the [nil] case. *) + +Definition hd_error (l : natlist) : natoption + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_hd_error1 : hd_error [] = None. + (* FILL IN HERE *) Admitted. + +Example test_hd_error2 : hd_error [1] = Some 1. + (* FILL IN HERE *) Admitted. + +Example test_hd_error3 : hd_error [5;6] = Some 5. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 1 star, standard, optional (option_elim_hd) + + This exercise relates your new [hd_error] to the old [hd]. *) + +Theorem option_elim_hd : forall (l:natlist) (default:nat), + hd default l = option_elim default (hd_error l). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +End NatList. + +(* ################################################################# *) +(** * Partial Maps *) + +(** As a final illustration of how data structures can be defined in + Rocq, here is a simple _partial map_ data type, analogous to the + map or dictionary data structures found in most programming + languages. *) + +(** First, we define a new inductive datatype [id] to serve as the + "keys" of our partial maps. *) + +Inductive id : Type := + | Id (n : nat). + +(** Internally, an [id] is just a number. Introducing a separate type + by wrapping each nat with the tag [Id] makes definitions more + readable and gives us flexibility to change representations later + if we want to. *) + +(** We'll also need an equality test for [id]s: *) + +Definition eqb_id (x1 x2 : id) := + match x1, x2 with + | Id n1, Id n2 => n1 =? n2 + end. + +(** **** Exercise: 1 star, standard (eqb_id_refl) *) +Theorem eqb_id_refl : forall x, eqb_id x x = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Now we define the type of partial maps: *) + +Module PartialMap. +Export NatList. (* make the definitions from NatList available here *) + +Inductive partial_map : Type := + | empty + | record (i : id) (v : nat) (m : partial_map). + +(** This declaration can be read: "There are two ways to construct a + [partial_map]: either using the constructor [empty] to represent an + empty partial map, or applying the constructor [record] to + a key, a value, and an existing [partial_map] to construct a + [partial_map] with an additional key-to-value mapping." *) + +(** The [update] function overrides the entry for a given key in a + partial map by shadowing it with a new one (or simply adds a new + entry if the given key is not already present). *) + +Definition update (d : partial_map) + (x : id) (value : nat) + : partial_map := + record x value d. + +(** Last, the [find] function searches a [partial_map] for a given + key. It returns [None] if the key was not found and [Some val] if + the key was associated with [val]. If the same key is mapped to + multiple values, [find] will return the first one it + encounters. *) + +Fixpoint find (x : id) (d : partial_map) : natoption := + match d with + | empty => None + | record y v d' => if eqb_id x y + then Some v + else find x d' + end. + +(** **** Exercise: 1 star, standard (update_eq) *) +Theorem update_eq : + forall (d : partial_map) (x : id) (v: nat), + find x (update d x v) = Some v. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard (update_neq) *) +Theorem update_neq : + forall (d : partial_map) (x y : id) (o: nat), + eqb_id x y = false -> find x (update d y o) = find x d. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) +End PartialMap. + +(* 2026-01-07 13:17 *) diff --git a/ListsTest.v b/ListsTest.v new file mode 100644 index 0000000..508cdf8 --- /dev/null +++ b/ListsTest.v @@ -0,0 +1,544 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Lists. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Lists. +Import Check. + +Goal True. + +idtac "------------------- snd_fst_is_swap --------------------". +idtac " ". + +idtac "#> NatList.snd_fst_is_swap". +idtac "Possible points: 1". +check_type @NatList.snd_fst_is_swap ( +(forall p : NatList.natprod, + @eq NatList.natprod (NatList.pair (NatList.snd p) (NatList.fst p)) + (NatList.swap_pair p))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.snd_fst_is_swap. +Goal True. +idtac " ". + +idtac "------------------- list_funs --------------------". +idtac " ". + +idtac "#> NatList.test_nonzeros". +idtac "Possible points: 0.5". +check_type @NatList.test_nonzeros ( +(@eq NatList.natlist + (NatList.nonzeros + (NatList.cons 0 + (NatList.cons 1 + (NatList.cons 0 + (NatList.cons 2 + (NatList.cons 3 + (NatList.cons 0 (NatList.cons 0 NatList.nil)))))))) + (NatList.cons 1 (NatList.cons 2 (NatList.cons 3 NatList.nil))))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_nonzeros. +Goal True. +idtac " ". + +idtac "#> NatList.test_oddmembers". +idtac "Possible points: 0.5". +check_type @NatList.test_oddmembers ( +(@eq NatList.natlist + (NatList.oddmembers + (NatList.cons 0 + (NatList.cons 1 + (NatList.cons 0 + (NatList.cons 2 + (NatList.cons 3 + (NatList.cons 0 (NatList.cons 0 NatList.nil)))))))) + (NatList.cons 1 (NatList.cons 3 NatList.nil)))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_oddmembers. +Goal True. +idtac " ". + +idtac "#> NatList.test_countoddmembers2". +idtac "Possible points: 0.5". +check_type @NatList.test_countoddmembers2 ( +(@eq nat + (NatList.countoddmembers + (NatList.cons 0 (NatList.cons 2 (NatList.cons 4 NatList.nil)))) + 0)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_countoddmembers2. +Goal True. +idtac " ". + +idtac "#> NatList.test_countoddmembers3". +idtac "Possible points: 0.5". +check_type @NatList.test_countoddmembers3 ( +(@eq nat (NatList.countoddmembers NatList.nil) 0)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_countoddmembers3. +Goal True. +idtac " ". + +idtac "------------------- alternate --------------------". +idtac " ". + +idtac "#> NatList.test_alternate1". +idtac "Advanced". +idtac "Possible points: 1". +check_type @NatList.test_alternate1 ( +(@eq NatList.natlist + (NatList.alternate + (NatList.cons 1 (NatList.cons 2 (NatList.cons 3 NatList.nil))) + (NatList.cons 4 (NatList.cons 5 (NatList.cons 6 NatList.nil)))) + (NatList.cons 1 + (NatList.cons 4 + (NatList.cons 2 + (NatList.cons 5 (NatList.cons 3 (NatList.cons 6 NatList.nil)))))))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_alternate1. +Goal True. +idtac " ". + +idtac "#> NatList.test_alternate2". +idtac "Advanced". +idtac "Possible points: 1". +check_type @NatList.test_alternate2 ( +(@eq NatList.natlist + (NatList.alternate (NatList.cons 1 NatList.nil) + (NatList.cons 4 (NatList.cons 5 (NatList.cons 6 NatList.nil)))) + (NatList.cons 1 + (NatList.cons 4 (NatList.cons 5 (NatList.cons 6 NatList.nil)))))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_alternate2. +Goal True. +idtac " ". + +idtac "#> NatList.test_alternate4". +idtac "Advanced". +idtac "Possible points: 1". +check_type @NatList.test_alternate4 ( +(@eq NatList.natlist + (NatList.alternate NatList.nil + (NatList.cons 20 (NatList.cons 30 NatList.nil))) + (NatList.cons 20 (NatList.cons 30 NatList.nil)))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_alternate4. +Goal True. +idtac " ". + +idtac "------------------- bag_functions --------------------". +idtac " ". + +idtac "#> NatList.test_count2". +idtac "Possible points: 0.5". +check_type @NatList.test_count2 ( +(@eq nat + (NatList.count 6 + (NatList.cons 1 + (NatList.cons 2 + (NatList.cons 3 + (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil))))))) + 0)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_count2. +Goal True. +idtac " ". + +idtac "#> NatList.test_sum1". +idtac "Possible points: 0.5". +check_type @NatList.test_sum1 ( +(@eq nat + (NatList.count 1 + (NatList.sum + (NatList.cons 1 (NatList.cons 2 (NatList.cons 3 NatList.nil))) + (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil))))) + 3)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_sum1. +Goal True. +idtac " ". + +idtac "#> NatList.test_add1". +idtac "Possible points: 0.5". +check_type @NatList.test_add1 ( +(@eq nat + (NatList.count 1 + (NatList.add 1 + (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil))))) + 3)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_add1. +Goal True. +idtac " ". + +idtac "#> NatList.test_add2". +idtac "Possible points: 0.5". +check_type @NatList.test_add2 ( +(@eq nat + (NatList.count 5 + (NatList.add 1 + (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil))))) + 0)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_add2. +Goal True. +idtac " ". + +idtac "#> NatList.test_member1". +idtac "Possible points: 0.5". +check_type @NatList.test_member1 ( +(@eq bool + (NatList.member 1 + (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil)))) + true)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_member1. +Goal True. +idtac " ". + +idtac "#> NatList.test_member2". +idtac "Possible points: 0.5". +check_type @NatList.test_member2 ( +(@eq bool + (NatList.member 2 + (NatList.cons 1 (NatList.cons 4 (NatList.cons 1 NatList.nil)))) + false)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_member2. +Goal True. +idtac " ". + +idtac "------------------- list_exercises --------------------". +idtac " ". + +idtac "#> NatList.app_nil_r". +idtac "Possible points: 0.5". +check_type @NatList.app_nil_r ( +(forall l : NatList.natlist, + @eq NatList.natlist (NatList.app l NatList.nil) l)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.app_nil_r. +Goal True. +idtac " ". + +idtac "#> NatList.rev_app_distr". +idtac "Possible points: 0.5". +check_type @NatList.rev_app_distr ( +(forall l1 l2 : NatList.natlist, + @eq NatList.natlist (NatList.rev (NatList.app l1 l2)) + (NatList.app (NatList.rev l2) (NatList.rev l1)))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.rev_app_distr. +Goal True. +idtac " ". + +idtac "#> NatList.rev_involutive". +idtac "Possible points: 0.5". +check_type @NatList.rev_involutive ( +(forall l : NatList.natlist, + @eq NatList.natlist (NatList.rev (NatList.rev l)) l)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.rev_involutive. +Goal True. +idtac " ". + +idtac "#> NatList.app_assoc4". +idtac "Possible points: 0.5". +check_type @NatList.app_assoc4 ( +(forall l1 l2 l3 l4 : NatList.natlist, + @eq NatList.natlist (NatList.app l1 (NatList.app l2 (NatList.app l3 l4))) + (NatList.app (NatList.app (NatList.app l1 l2) l3) l4))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.app_assoc4. +Goal True. +idtac " ". + +idtac "#> NatList.nonzeros_app". +idtac "Possible points: 1". +check_type @NatList.nonzeros_app ( +(forall l1 l2 : NatList.natlist, + @eq NatList.natlist (NatList.nonzeros (NatList.app l1 l2)) + (NatList.app (NatList.nonzeros l1) (NatList.nonzeros l2)))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.nonzeros_app. +Goal True. +idtac " ". + +idtac "------------------- eqblist --------------------". +idtac " ". + +idtac "#> NatList.eqblist_refl". +idtac "Possible points: 2". +check_type @NatList.eqblist_refl ( +(forall l : NatList.natlist, @eq bool true (NatList.eqblist l l))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.eqblist_refl. +Goal True. +idtac " ". + +idtac "------------------- count_member_nonzero --------------------". +idtac " ". + +idtac "#> NatList.count_member_nonzero". +idtac "Possible points: 1". +check_type @NatList.count_member_nonzero ( +(forall s : NatList.bag, + @eq bool (leb 1 (NatList.count 1 (NatList.cons 1 s))) true)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.count_member_nonzero. +Goal True. +idtac " ". + +idtac "------------------- remove_does_not_increase_count --------------------". +idtac " ". + +idtac "#> NatList.remove_does_not_increase_count". +idtac "Advanced". +idtac "Possible points: 3". +check_type @NatList.remove_does_not_increase_count ( +(forall s : NatList.bag, + @eq bool + (leb (NatList.count 0 (NatList.remove_one 0 s)) (NatList.count 0 s)) true)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.remove_does_not_increase_count. +Goal True. +idtac " ". + +idtac "------------------- involution_injective --------------------". +idtac " ". + +idtac "#> NatList.involution_injective". +idtac "Advanced". +idtac "Possible points: 3". +check_type @NatList.involution_injective ( +(forall (f : forall _ : nat, nat) (_ : forall n : nat, @eq nat n (f (f n))) + (n1 n2 : nat) (_ : @eq nat (f n1) (f n2)), + @eq nat n1 n2)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.involution_injective. +Goal True. +idtac " ". + +idtac "------------------- rev_injective --------------------". +idtac " ". + +idtac "#> NatList.rev_injective". +idtac "Advanced". +idtac "Possible points: 2". +check_type @NatList.rev_injective ( +(forall (l1 l2 : NatList.natlist) + (_ : @eq NatList.natlist (NatList.rev l1) (NatList.rev l2)), + @eq NatList.natlist l1 l2)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.rev_injective. +Goal True. +idtac " ". + +idtac "------------------- hd_error --------------------". +idtac " ". + +idtac "#> NatList.test_hd_error1". +idtac "Possible points: 1". +check_type @NatList.test_hd_error1 ( +(@eq NatList.natoption (NatList.hd_error NatList.nil) NatList.None)). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_hd_error1. +Goal True. +idtac " ". + +idtac "#> NatList.test_hd_error2". +idtac "Possible points: 1". +check_type @NatList.test_hd_error2 ( +(@eq NatList.natoption (NatList.hd_error (NatList.cons 1 NatList.nil)) + (NatList.Some 1))). +idtac "Assumptions:". +Abort. +Print Assumptions NatList.test_hd_error2. +Goal True. +idtac " ". + +idtac "------------------- eqb_id_refl --------------------". +idtac " ". + +idtac "#> eqb_id_refl". +idtac "Possible points: 1". +check_type @eqb_id_refl ((forall x : id, @eq bool (eqb_id x x) true)). +idtac "Assumptions:". +Abort. +Print Assumptions eqb_id_refl. +Goal True. +idtac " ". + +idtac "------------------- update_eq --------------------". +idtac " ". + +idtac "#> PartialMap.update_eq". +idtac "Possible points: 1". +check_type @PartialMap.update_eq ( +(forall (d : PartialMap.partial_map) (x : id) (v : nat), + @eq NatList.natoption (PartialMap.find x (PartialMap.update d x v)) + (NatList.Some v))). +idtac "Assumptions:". +Abort. +Print Assumptions PartialMap.update_eq. +Goal True. +idtac " ". + +idtac "------------------- update_neq --------------------". +idtac " ". + +idtac "#> PartialMap.update_neq". +idtac "Possible points: 1". +check_type @PartialMap.update_neq ( +(forall (d : PartialMap.partial_map) (x y : id) (o : nat) + (_ : @eq bool (eqb_id x y) false), + @eq NatList.natoption (PartialMap.find x (PartialMap.update d y o)) + (PartialMap.find x d))). +idtac "Assumptions:". +Abort. +Print Assumptions PartialMap.update_neq. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 17". +idtac "Max points - advanced: 28". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- NatList.snd_fst_is_swap ---------". +Print Assumptions NatList.snd_fst_is_swap. +idtac "---------- NatList.test_nonzeros ---------". +Print Assumptions NatList.test_nonzeros. +idtac "---------- NatList.test_oddmembers ---------". +Print Assumptions NatList.test_oddmembers. +idtac "---------- NatList.test_countoddmembers2 ---------". +Print Assumptions NatList.test_countoddmembers2. +idtac "---------- NatList.test_countoddmembers3 ---------". +Print Assumptions NatList.test_countoddmembers3. +idtac "---------- NatList.test_count2 ---------". +Print Assumptions NatList.test_count2. +idtac "---------- NatList.test_sum1 ---------". +Print Assumptions NatList.test_sum1. +idtac "---------- NatList.test_add1 ---------". +Print Assumptions NatList.test_add1. +idtac "---------- NatList.test_add2 ---------". +Print Assumptions NatList.test_add2. +idtac "---------- NatList.test_member1 ---------". +Print Assumptions NatList.test_member1. +idtac "---------- NatList.test_member2 ---------". +Print Assumptions NatList.test_member2. +idtac "---------- NatList.app_nil_r ---------". +Print Assumptions NatList.app_nil_r. +idtac "---------- NatList.rev_app_distr ---------". +Print Assumptions NatList.rev_app_distr. +idtac "---------- NatList.rev_involutive ---------". +Print Assumptions NatList.rev_involutive. +idtac "---------- NatList.app_assoc4 ---------". +Print Assumptions NatList.app_assoc4. +idtac "---------- NatList.nonzeros_app ---------". +Print Assumptions NatList.nonzeros_app. +idtac "---------- NatList.eqblist_refl ---------". +Print Assumptions NatList.eqblist_refl. +idtac "---------- NatList.count_member_nonzero ---------". +Print Assumptions NatList.count_member_nonzero. +idtac "---------- NatList.test_hd_error1 ---------". +Print Assumptions NatList.test_hd_error1. +idtac "---------- NatList.test_hd_error2 ---------". +Print Assumptions NatList.test_hd_error2. +idtac "---------- eqb_id_refl ---------". +Print Assumptions eqb_id_refl. +idtac "---------- PartialMap.update_eq ---------". +Print Assumptions PartialMap.update_eq. +idtac "---------- PartialMap.update_neq ---------". +Print Assumptions PartialMap.update_neq. +idtac "". +idtac "********** Advanced **********". +idtac "---------- NatList.test_alternate1 ---------". +Print Assumptions NatList.test_alternate1. +idtac "---------- NatList.test_alternate2 ---------". +Print Assumptions NatList.test_alternate2. +idtac "---------- NatList.test_alternate4 ---------". +Print Assumptions NatList.test_alternate4. +idtac "---------- NatList.remove_does_not_increase_count ---------". +Print Assumptions NatList.remove_does_not_increase_count. +idtac "---------- NatList.involution_injective ---------". +Print Assumptions NatList.involution_injective. +idtac "---------- NatList.rev_injective ---------". +Print Assumptions NatList.rev_injective. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Logic.v b/Logic.v new file mode 100644 index 0000000..c083dcc --- /dev/null +++ b/Logic.v @@ -0,0 +1,1805 @@ +(** * Logic: Logic in Rocq *) + +Set Warnings "-notation-overridden". +Require Nat. +From LF Require Export Tactics. + +(** We have now seen many examples of factual claims (i.e., + _propositions_) and ways of presenting evidence of their truth + (_proofs_). In particular, we have worked extensively with + equality propositions ([e1 = e2]), implications ([P -> Q]), and + quantified propositions ([forall x, P]). In this chapter, we will + see how Rocq can be used to carry out other familiar forms of + logical reasoning. + + Before diving into details, we should talk a bit about the status + of mathematical statements in Rocq. Rocq is a _typed_ language, + which means that every sensible expression has an associated type. + Logical claims are no exception: any statement we might try to + prove in Rocq has a type, namely [Prop], the type of + _propositions_. We can see this with the [Check] command: *) + +Check (forall n m : nat, n + m = m + n) : Prop. + +(** Note that _all_ syntactically well-formed propositions have type + [Prop] in Rocq, regardless of whether they are true or not. + + Simply _being_ a proposition is one thing; being _provable_ is + a different thing! *) + +Check 2 = 2 : Prop. + +Check 3 = 2 : Prop. + +Check forall n : nat, n = 2 : Prop. + +(** Indeed, propositions don't just have types -- they are + _first-class_ entities that can be manipulated in all the same ways as + any of the other things in Rocq's world. *) + +(** So far, we've seen one primary place where propositions can appear: + in [Theorem] (and [Lemma] and [Example]) declarations. *) + +Theorem plus_2_2_is_4 : + 2 + 2 = 4. +Proof. reflexivity. Qed. + +(** But propositions can be used in other ways. For example, we + can give a name to a proposition using a [Definition], just as we + give names to other kinds of expressions. *) + +Definition plus_claim : Prop := 2 + 2 = 4. +Check plus_claim : Prop. + +(** We can later use this name in any situation where a proposition is + expected -- for example, as the claim in a [Theorem] declaration. *) + +Theorem plus_claim_is_true : + plus_claim. +Proof. reflexivity. Qed. + +(** We can also write _parameterized_ propositions -- that is, + functions that take arguments of some type and return a + proposition. *) + +(** For instance, the following function takes a number + and returns a proposition asserting that this number is equal to + three: *) + +Definition is_three (n : nat) : Prop := + n = 3. +Check is_three : nat -> Prop. + +(** In Rocq, functions that return propositions are said to define + _properties_ of their arguments. + + For instance, here's a (polymorphic) property defining the + familiar notion of an _injective function_. *) + +Definition injective {A B} (f : A -> B) : Prop := + forall x y : A, f x = f y -> x = y. + +Lemma succ_inj : injective S. +Proof. + intros x y H. injection H as H1. apply H1. +Qed. + +(** The familiar equality operator [=] is a (binary) function that returns + a [Prop]. + + The expression [n = m] is syntactic sugar for [eq n m] (defined in + Rocq's standard library using the [Notation] mechanism). + + Because [eq] can be used with elements of any type, it is also + polymorphic: *) + +Check @eq : forall A : Type, A -> A -> Prop. + +(** (Notice that we wrote [@eq] instead of [eq]: The type + argument [A] to [eq] is declared as implicit, and we need to turn + off the inference of this implicit argument to see the full type + of [eq].) *) + +(* ################################################################# *) +(** * Logical Connectives *) + +(* ================================================================= *) +(** ** Conjunction *) + +(** The _conjunction_, or _logical and_, of propositions [A] and [B] is + written [A /\ B]; it represents the claim that both [A] and [B] are + true. *) + +Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4. + +(** To prove a conjunction, start with the [split] tactic. This will + generate two subgoals, one for each part of the statement: *) + +Proof. + split. + - (* 3 + 4 = 7 *) reflexivity. + - (* 2 * 2 = 4 *) reflexivity. +Qed. + +(** For any propositions [A] and [B], if we assume that [A] and [B] + are each true individually, we can conclude that [A /\ B] is also + true. The Rocq library provides a function [conj] that does this. *) + +Check @conj : forall A B : Prop, A -> B -> A /\ B. + +(** Since applying a theorem with hypotheses to some goal has the + effect of generating as many subgoals as there are hypotheses for + that theorem, we can apply [conj] to achieve the same effect as + [split]. *) + +Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4. +Proof. + apply conj. + - (* 3 + 4 = 7 *) reflexivity. + - (* 2 + 2 = 4 *) reflexivity. +Qed. + +(** **** Exercise: 2 stars, standard (plus_is_O) *) + +Example plus_is_O : + forall n m : nat, n + m = 0 -> n = 0 /\ m = 0. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** So much for proving conjunctive statements. To go in the other + direction -- i.e., to _use_ a conjunctive hypothesis to help prove + something else -- we can use our good old [destruct] tactic. *) + +(** When the current proof context contains a hypothesis [H] of the + form [A /\ B], writing [destruct H as [HA HB]] will remove [H] + from the context and replace it with two new hypotheses: [HA], + stating that [A] is true, and [HB], stating that [B] is true. *) + +Lemma and_example2 : + forall n m : nat, n = 0 /\ m = 0 -> n + m = 0. +Proof. + (* WORKED IN CLASS *) + intros n m H. + destruct H as [Hn Hm]. + rewrite Hn. rewrite Hm. + reflexivity. +Qed. + +(** As usual, we can also destruct [H] right at the point where we + introduce it, instead of introducing and then destructing it: *) + +Lemma and_example2' : + forall n m : nat, n = 0 /\ m = 0 -> n + m = 0. +Proof. + intros n m [Hn Hm]. + rewrite Hn. rewrite Hm. + reflexivity. +Qed. + +(** You may wonder why we bothered packing the two hypotheses [n = 0] and + [m = 0] into a single conjunction, since we could also have stated the + theorem with two separate premises: *) + +Lemma and_example2'' : + forall n m : nat, n = 0 -> m = 0 -> n + m = 0. +Proof. + intros n m Hn Hm. + rewrite Hn. rewrite Hm. + reflexivity. +Qed. + +(** For this specific theorem, both formulations are fine. But + it's important to understand how to work with conjunctive + hypotheses because conjunctions often arise from intermediate + steps in proofs, especially in larger developments. Here's a + simple example: *) + +Lemma and_example3 : + forall n m : nat, n + m = 0 -> n * m = 0. +Proof. + (* WORKED IN CLASS *) + intros n m H. + apply plus_is_O in H. + destruct H as [Hn Hm]. + rewrite Hn. reflexivity. +Qed. + +(** Another common situation is that we know [A /\ B] but in some + context we need just [A] or just [B]. In such cases we can do a + [destruct] (possibly implicitly, as part of an [intros]) and use + an underscore pattern [_] to indicate that the unneeded conjunct + should just be thrown away. *) + +Lemma proj1 : forall P Q : Prop, + P /\ Q -> P. +Proof. + intros P Q HPQ. + destruct HPQ as [HP _]. + apply HP. Qed. + +(** **** Exercise: 1 star, standard, optional (proj2) *) +Lemma proj2 : forall P Q : Prop, + P /\ Q -> Q. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Finally, we sometimes need to rearrange the order of conjunctions + and/or the grouping of multi-way conjunctions. We can see this + at work in the proofs of the following commutativity and + associativity theorems *) + +Theorem and_commut : forall P Q : Prop, + P /\ Q -> Q /\ P. +Proof. + intros P Q [HP HQ]. + split. + - (* left *) apply HQ. + - (* right *) apply HP. Qed. + +(** **** Exercise: 1 star, standard (and_assoc) + + In the following proof of associativity, notice how the _nested_ + [intros] pattern breaks the hypothesis [H : P /\ (Q /\ R)] down into + [HP : P], [HQ : Q], and [HR : R]. Finish the proof. *) + +Theorem and_assoc : forall P Q R : Prop, + P /\ (Q /\ R) -> (P /\ Q) /\ R. +Proof. + intros P Q R [HP [HQ HR]]. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The infix notation [/\] is actually just syntactic sugar for + [and A B]. That is, [and] is a Rocq operator that takes two + propositions as arguments and yields a proposition. *) + +Check and : Prop -> Prop -> Prop. + +(* ================================================================= *) +(** ** Disjunction *) + +(** Another important connective is the _disjunction_, or _logical or_, + of two propositions: [A \/ B] is true when either [A] or [B] is. + This infix notation stands for [or A B], where + [or : Prop -> Prop -> Prop]. *) + +(** To use a disjunctive hypothesis in a proof, we proceed by case + analysis -- which, as with other data types like [nat], can be done + explicitly with [destruct] or implicitly with an [intros] + pattern: *) + +Lemma factor_is_O: + forall n m : nat, n = 0 \/ m = 0 -> n * m = 0. +Proof. + (* This intro pattern implicitly does case analysis on + [n = 0 \/ m = 0]... *) + intros n m [Hn | Hm]. + - (* Here, [n = 0] *) + rewrite Hn. reflexivity. + - (* Here, [m = 0] *) + rewrite Hm. rewrite <- mult_n_O. + reflexivity. +Qed. + +(** We can see in this example that, when we perform case + analysis on a disjunction [A \/ B], we must separately discharge + two proof obligations, each showing that the conclusion holds + under a different assumption -- [A] in the first subgoal and [B] + in the second. + + The case analysis pattern [[Hn | Hm]] allows us to name the + hypotheses that are generated for the subgoals. *) + +(** Conversely, to show that a disjunction holds, it suffices to show + that one of its sides holds. This can be done via the tactics + [left] and [right]. As their names imply, the first one requires + proving the left side of the disjunction, while the second + requires proving the right side. Here is a trivial use... *) + +Lemma or_intro_l : forall A B : Prop, A -> A \/ B. +Proof. + intros A B HA. + left. + apply HA. +Qed. + +(** ... and here is a slightly more interesting example requiring both + [left] and [right]: *) + +Lemma zero_or_succ : + forall n : nat, n = 0 \/ n = S (pred n). +Proof. + (* WORKED IN CLASS *) + intros [|n']. + - left. reflexivity. + - right. reflexivity. +Qed. + +(** **** Exercise: 2 stars, standard (mult_is_O) *) +Lemma mult_is_O : + forall n m, n * m = 0 -> n = 0 \/ m = 0. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard (or_commut) *) +Theorem or_commut : forall P Q : Prop, + P \/ Q -> Q \/ P. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Falsehood and Negation *) + +(** Up to this point, we have mostly been concerned with proving + "positive" statements -- addition is commutative, appending lists + is associative, etc. We are sometimes also interested in negative + results, demonstrating that some proposition is _not_ true. Such + statements are expressed with the logical negation operator [~]. *) + +(** To see how negation works, recall the _principle of explosion_ + from the [Tactics] chapter, which asserts that, if we assume a + contradiction, then any other proposition can be derived. + + Following this intuition, we could define [~ P] ("not [P]") as + [forall Q, P -> Q]. *) + +(** Rocq actually makes an equivalent but slightly different choice, + defining [~ P] as [P -> False], where [False] is a specific + un-provable proposition defined in the standard library. *) + +Module NotPlayground. + +Definition not (P:Prop) := P -> False. + +Check not : Prop -> Prop. + +Notation "~ x" := (not x) : type_scope. + +End NotPlayground. + +(** Since [False] is a contradictory proposition, the principle of + explosion also applies to it. If we can get [False] into the context, + we can use [destruct] on it to complete any goal: *) + +Theorem ex_falso_quodlibet : forall (P:Prop), + False -> P. +Proof. + intros P contra. + destruct contra. Qed. + +(** The Latin _ex falso quodlibet_ means, literally, "from falsehood + follows whatever you like"; this is another common name for the + principle of explosion. *) + +(** **** Exercise: 2 stars, standard, optional (not_implies_our_not) + + Show that Rocq's definition of negation implies the intuitive one + mentioned above. + + Hint: While getting accustomed to Rocq's definition of [not], you might + find it helpful to [unfold not] near the beginning of proofs. *) + +Theorem not_implies_our_not : forall (P:Prop), + ~ P -> (forall (Q:Prop), P -> Q). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Inequality is a very common form of negated statement, so there is a + special notation for it: *) + +Notation "x <> y" := (~(x = y)) : type_scope. + +(** For example: *) + +Theorem zero_not_one : 0 <> 1. +Proof. + (** The proposition [0 <> 1] is exactly the same as + [~(0 = 1)] -- that is, [not (0 = 1)] -- which unfolds to + [(0 = 1) -> False]. (We use [unfold not] explicitly here, + to illustrate that point, but generally it can be omitted.) *) + unfold not. + (** To prove an inequality, we may assume the opposite + equality... *) + intros contra. + (** ... and deduce a contradiction from it. Here, the + equality [O = S O] contradicts the disjointness of + constructors [O] and [S], so [discriminate] takes care + of it. *) + discriminate contra. +Qed. + +(** It takes a little practice to get used to working with negation in Rocq. + Even though _you_ may see perfectly well why a claim involving + negation holds, it can be a little tricky at first to see how to make + Rocq understand it! + + Here are proofs of a few familiar facts to help get you warmed up. *) + +Theorem not_False : + ~ False. +Proof. + unfold not. intros H. destruct H. Qed. + +Theorem contradiction_implies_anything : forall P Q : Prop, + (P /\ ~P) -> Q. +Proof. + (* WORKED IN CLASS *) + intros P Q [HP HNP]. unfold not in HNP. + apply HNP in HP. destruct HP. Qed. + +Theorem double_neg : forall P : Prop, + P -> ~~P. +Proof. + (* WORKED IN CLASS *) + intros P H. unfold not. intros G. apply G. apply H. Qed. + +(** **** Exercise: 2 stars, advanced, optional (double_neg_informal) + + Write an _informal_ proof of [double_neg]: + + _Theorem_: [P] implies [~~P], for any proposition [P]. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_double_neg_informal : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 1 star, standard, especially useful (contrapositive) *) +Theorem contrapositive : forall (P Q : Prop), + (P -> Q) -> (~Q -> ~P). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard (not_both_true_and_false) *) +Theorem not_both_true_and_false : forall P : Prop, + ~ (P /\ ~P). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, advanced (not_PNP_informal) + + Write an informal proof (in English) of the proposition [forall P + : Prop, ~(P /\ ~P)]. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_not_PNP_informal : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 2 stars, standard (de_morgan_not_or) + + _De Morgan's Laws_, named for Augustus De Morgan, describe how + negation interacts with conjunction and disjunction. The + following law says that "the negation of a disjunction is the + conjunction of the negations." There is a dual law + [de_morgan_not_and_not] to which we will return at the end of this + chapter. *) +Theorem de_morgan_not_or : forall (P Q : Prop), + ~ (P \/ Q) -> ~P /\ ~Q. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard, optional (not_S_inverse_pred) + + Since we are working with natural numbers, we can disprove that + [S] and [pred] are inverses of each other: *) +Lemma not_S_pred_n : ~(forall n : nat, S (pred n) = n). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Since inequality involves a negation, it also requires a little + practice to be able to work with it fluently. Here is one useful + trick. + + If you are trying to prove a goal that is nonsensical (e.g., the + goal state is [false = true]), apply [ex_falso_quodlibet] to + change the goal to [False]. + + This makes it easier to use assumptions of the form [~P] that may + be available in the context -- in particular, assumptions of the + form [x<>y]. *) + +Theorem not_true_is_false : forall b : bool, + b <> true -> b = false. +Proof. + intros b H. destruct b eqn:HE. + - (* b = true *) + unfold not in H. + apply ex_falso_quodlibet. + apply H. reflexivity. + - (* b = false *) + reflexivity. +Qed. + +(** Since reasoning with [ex_falso_quodlibet] is quite common, Rocq + provides a built-in tactic, [exfalso], for applying it. *) + +Theorem not_true_is_false' : forall b : bool, + b <> true -> b = false. +Proof. + intros [] H. (* note implicit [destruct b] here! *) + - (* b = true *) + unfold not in H. + exfalso. (* <=== *) + apply H. reflexivity. + - (* b = false *) reflexivity. +Qed. + +(* ================================================================= *) +(** ** Truth *) + +(** Besides [False], Rocq's standard library also defines [True], a + proposition that is trivially true. To prove it, we use the + constant [I : True], which is also defined in the standard + library: *) + +Lemma True_is_true : True. +Proof. apply I. Qed. + +(** Unlike [False], which is used extensively, [True] is used + relatively rarely: it is trivial (and therefore uninteresting) to + prove as a goal, and it provides no useful information when it + appears as a hypothesis. *) + +(** However, [True] can be quite useful when defining complex [Prop]s using + conditionals or as a parameter to higher-order [Prop]s. We'll come back + to this later. + + For now, let's take a look at how we can use [True] and [False] to + achieve an effect similar to that of the [discriminate] tactic, without + literally using [discriminate]. *) + +(** Pattern-matching lets us do different things for different + constructors. If the result of applying two different + constructors were hypothetically equal, then we could use [match] + to convert an unprovable statement (like [False]) to one that is + provable (like [True]). *) + +Definition disc_fn (n: nat) : Prop := + match n with + | O => True + | S _ => False + end. + +Theorem disc_example : forall n, ~ (O = S n). +Proof. + intros n contra. + assert (H : disc_fn O). { simpl. apply I. } + rewrite contra in H. simpl in H. apply H. +Qed. + +(** To generalize this to other constructors, we simply have to provide an + appropriate variant of [disc_fn]. To generalize it to other + conclusions, we can use [exfalso] to replace them with [False]. + + The built-in [discriminate] tactic takes care of all this for us. *) + +(** **** Exercise: 2 stars, advanced, optional (nil_is_not_cons) *) + +(** Use the same technique as above to show that [nil <> x :: xs]. + Do not use the [discriminate] tactic. *) + +Theorem nil_is_not_cons : forall X (x : X) (xs : list X), ~ (nil = x :: xs). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Logical Equivalence *) +Print "<->". +(** The handy "if and only if" connective, which asserts that two + propositions have the same truth value, is simply the conjunction + of two implications. + + Print "<->". +*) +(* ===> + Notation "A <-> B" := (iff A B) + + iff = fun A B : Prop => (A -> B) /\ (B -> A) + : Prop -> Prop -> Prop + + Argumments iff (A B)%type_scope *) + +Theorem iff_sym : forall P Q : Prop, + (P <-> Q) -> (Q <-> P). +Proof. + (* WORKED IN CLASS *) + intros P Q [HAB HBA]. + split. + - (* -> *) apply HBA. + - (* <- *) apply HAB. Qed. + +Lemma not_true_iff_false : forall b, + b <> true <-> b = false. +Proof. + intros b. split. + - (* -> *) apply not_true_is_false. + - (* <- *) + intros H. rewrite H. intros H'. discriminate H'. +Qed. + +(** We can also use [apply] with an [<->] in either direction, + without explicitly thinking about the fact that it is really an + [and] underneath. *) + +Lemma apply_iff_example1: + forall P Q R : Prop, (P <-> Q) -> (Q -> R) -> (P -> R). +Proof. + intros P Q R Hiff H HP. apply H. apply Hiff. apply HP. +Qed. + +Lemma apply_iff_example2: + forall P Q R : Prop, (P <-> Q) -> (P -> R) -> (Q -> R). +Proof. + intros P Q R Hiff H HQ. apply H. apply Hiff. apply HQ. +Qed. + +(** **** Exercise: 1 star, standard, optional (iff_properties) + + Using the above proof that [<->] is symmetric ([iff_sym]) as + a guide, prove that it is also reflexive and transitive. *) + +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. +(** [] *) + +(** **** Exercise: 3 stars, standard (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. +(** [] *) + +(* ================================================================= *) +(** ** Setoids and Logical Equivalence *) + +(** Some of Rocq's tactics treat [iff] statements specially, avoiding some + low-level proof-state manipulation. In particular, [rewrite] and + [reflexivity] can be used with [iff] statements, not just equalities. + To enable this behavior, we have to import the Rocq library that + supports it: *) +From Stdlib Require Import Setoids.Setoid. + +(** A "setoid" is a set equipped with an equivalence relation -- that + is, a relation that is reflexive, symmetric, and transitive. When two + elements of a set are equivalent according to the relation, [rewrite] + can be used to replace one by the other. + + We've seen this already with the equality relation [=] in Rocq: when + [x = y], we can use [rewrite] to replace [x] with [y] or vice-versa. + + Similarly, the logical equivalence relation [<->] is reflexive, + symmetric, and transitive, so we can use it to replace one part of a + proposition with another: if [P <-> Q], then we can use [rewrite] to + replace [P] with [Q], or vice-versa. *) + +(** Here is a simple example demonstrating how these tactics work with + [iff]. + + First, let's prove a couple of basic iff equivalences. (For these + proofs we are not using setoids yet.) *) + +Lemma mul_eq_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0. +Proof. + split. + - apply mult_is_O. + - apply factor_is_O. +Qed. + +Theorem or_assoc : + forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R. +Proof. + intros P Q R. split. + - intros [H | [H | H]]. + + left. left. apply H. + + left. right. apply H. + + right. apply H. + - intros [[H | H] | H]. + + left. apply H. + + right. left. apply H. + + right. right. apply H. +Qed. + +(** We can now use these facts with [rewrite] and [reflexivity] to + prove a ternary version of the [mult_eq_0] fact above _without_ + splitting the top-level iff: *) + +Lemma mul_eq_0_ternary : + forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0. +Proof. + intros n m p. + rewrite mul_eq_0. rewrite mul_eq_0. rewrite or_assoc. + reflexivity. +Qed. + +(* ================================================================= *) +(** ** Existential Quantification *) + +(** Another fundamental logical connective is _existential + quantification_. To say that there is some [x] of type [T] such + that some property [P] holds of [x], we write [exists x : T, P]. + As with [forall], the type annotation [: T] can be omitted if Rocq + is able to infer from the context what the type of [x] should be. *) + +(** To prove a statement of the form [exists x, P], we must show that [P] + holds for some specific choice for [x], known as the _witness_ of the + existential. This is done in two steps: First, we explicitly tell Rocq + which witness [t] we have in mind by invoking the tactic [exists t]. + Then we prove that [P] holds after all occurrences of [x] are replaced + by [t]. *) + +Definition Even x := exists n : nat, x = double n. +Check Even : nat -> Prop. + +Lemma four_is_Even : Even 4. +Proof. + unfold Even. exists 2. reflexivity. +Qed. + +(** Conversely, if we have an existential hypothesis [exists x, P] in + the context, we can destruct it to obtain a witness [x] and a + hypothesis stating that [P] holds of [x]. *) + +Theorem exists_example_2 : forall n, + (exists m, n = 4 + m) -> + (exists o, n = 2 + o). +Proof. + (* WORKED IN CLASS *) + intros n [m Hm]. (* note the implicit [destruct] here *) + exists (2 + m). + apply Hm. Qed. + +(** **** Exercise: 1 star, standard, especially useful (dist_not_exists) + + Prove that "[P] holds for all [x]" implies "there is no [x] for + which [P] does not hold." (Hint: [destruct H as [x E]] works on + existential assumptions!) *) + +Theorem dist_not_exists : forall (X:Type) (P : X -> Prop), + (forall x, P x) -> ~ (exists x, ~ P x). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (dist_exists_or) + + Prove that existential quantification distributes over + disjunction. *) + +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. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (leb_plus_exists) *) +Theorem leb_plus_exists : forall n m, n <=? m = true -> exists x, m = n+x. +Proof. +(* FILL IN HERE *) Admitted. + +Theorem plus_exists_leb : forall n m, (exists x, m = n+x) -> n <=? m = true. +Proof. + (* FILL IN HERE *) Admitted. + +(** [] *) + +(* ################################################################# *) +(** * Programming with Propositions *) + +(** The logical connectives that we have seen provide a rich + vocabulary for defining complex propositions from simpler ones. + To illustrate, let's look at how to express the claim that an + element [x] occurs in a list [l]. Notice that this property has a + simple recursive structure: + + - If [l] is the empty list, then [x] cannot occur in it, so the + property "[x] appears in [l]" is simply false. + + - Otherwise, [l] has the form [x' :: l']. In this case, [x] + occurs in [l] if it is equal to [x'] or it occurs in [l']. *) + +(** We can translate this directly into a straightforward recursive + function taking an element and a list and returning... a proposition! *) + +Fixpoint In {A : Type} (x : A) (l : list A) : Prop := + match l with + | [] => False + | x' :: l' => x' = x \/ In x l' + end. + +(** When [In] is applied to a concrete list, it expands into a + concrete sequence of nested disjunctions. *) + +Example In_example_1 : In 4 [1; 2; 3; 4; 5]. +Proof. + (* WORKED IN CLASS *) + simpl. right. right. right. left. reflexivity. +Qed. + +Example In_example_2 : + forall n, In n [2; 4] -> + exists n', n = 2 * n'. +Proof. + (* WORKED IN CLASS *) + simpl. + intros n [H | [H | []]]. + - exists 1. rewrite <- H. reflexivity. + - exists 2. rewrite <- H. reflexivity. +Qed. +(** (Notice the use of the empty pattern to discharge the last case + _en passant_.) *) + +(** We can also reason about more generic statements involving [In]. *) + +Theorem In_map : + forall (A B : Type) (f : A -> B) (l : list A) (x : A), + In x l -> + In (f x) (map f l). +Proof. + intros A B f l x. + induction l as [|x' l' IHl']. + - (* l = nil, contradiction *) + simpl. intros []. + - (* l = x' :: l' *) + simpl. intros [H | H]. + + rewrite H. left. reflexivity. + + right. apply IHl'. apply H. +Qed. + +(** (Note here how [In] starts out applied to a variable and only + gets expanded when we do case analysis on this variable.) *) + +(** This way of defining propositions recursively is very convenient in + some cases, less so in others. In particular, it is subject to Rocq's + usual restrictions regarding definitions of recursive functions, + e.g., the requirement that they be "obviously terminating." + + In the next chapter, we will see how to define propositions + _inductively_ -- a different technique with its own strengths and + limitations. *) + +(** **** Exercise: 2 stars, standard (In_map_iff) *) +Theorem In_map_iff : + forall (A B : Type) (f : A -> B) (l : list A) (y : B), + In y (map f l) <-> + exists x, f x = y /\ In x l. +Proof. + intros A B f l y. split. + - induction l as [|x l' IHl']. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (In_app_iff) *) +Theorem In_app_iff : forall A l l' (a:A), + In a (l++l') <-> In a l \/ In a l'. +Proof. + intros A l. induction l as [|a' l' IH]. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, especially useful (All) + + We noted above that functions returning propositions can be seen as + _properties_ of their arguments. For instance, if [P] has type + [nat -> Prop], then [P n] says that property [P] holds of [n]. + + Drawing inspiration from [In], write a recursive function [All] + stating that some property [P] holds of all elements of a list + [l]. To make sure your definition is correct, prove the [All_In] + lemma below. (Of course, your definition should _not_ just + restate the left-hand side of [All_In].) *) + +Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem All_In : + forall T (P : T -> Prop) (l : list T), + (forall x, In x l -> P x) <-> + All P l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (combine_odd_even) + + Complete the definition of [combine_odd_even] below. It takes as + arguments two properties of numbers, [Podd] and [Peven], and it should + return a property [P] such that [P n] is equivalent to [Podd n] when + [n] is [odd] and equivalent to [Peven n] otherwise. *) + +Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** To test your definition, prove the following facts: *) + +Theorem combine_odd_even_intro : + forall (Podd Peven : nat -> Prop) (n : nat), + (odd n = true -> Podd n) -> + (odd n = false -> Peven n) -> + combine_odd_even Podd Peven n. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem combine_odd_even_elim_odd : + forall (Podd Peven : nat -> Prop) (n : nat), + combine_odd_even Podd Peven n -> + odd n = true -> + Podd n. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem combine_odd_even_elim_even : + forall (Podd Peven : nat -> Prop) (n : nat), + combine_odd_even Podd Peven n -> + odd n = false -> + Peven n. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Applying Theorems to Arguments *) + +(** One feature that distinguishes Rocq from some other popular proof + assistants (e.g., ACL2 and Isabelle) is that it treats _proofs_ as + first-class objects. + + There is a great deal to be said about this, but it is not necessary to + understand it all in order to use Rocq. This section gives just a + taste, leaving a deeper exploration for the optional chapters + [ProofObjects] and [IndPrinciples]. *) + +(** We have seen that we can use [Check] to ask Rocq to check whether + an expression has a given type: *) + +Check plus : nat -> nat -> nat. +Check @rev : forall X, list X -> list X. + +(** We can also use it to check what theorem a particular identifier + refers to: *) + +Check add_comm : forall n m : nat, n + m = m + n. +Check plus_id_example : forall n m : nat, n = m -> n + n = m + m. + +(** Rocq checks the _statements_ of the [add_comm] and + [plus_id_example] theorems in the same way that it checks the + _type_ of any term (e.g., plus). If we leave off the colon and + type, Rocq will print these types for us. + + Why? *) + +(** The reason is that the identifier [add_comm] actually refers to a + _proof object_ -- a logical derivation establishing the truth of the + statement [forall n m : nat, n + m = m + n]. The type of this object + is the proposition that it is a proof of. + + The type of an ordinary function tells us what we can do with it. + - If we have a term of type [nat -> nat -> nat], we can give it two + [nat]s as arguments and get a [nat] back. + + Similarly, the statement of a theorem tells us what we can use that + theorem for. + - If we have a term of type [forall n m, n = m -> n + n = m + m] and we + provide it two numbers [n] and [m] and a third "argument" of type + [n = m], we get back a proof object of type [n + n = m + m]. *) + +(** Operationally, this analogy goes even further: by applying a + theorem as if it were a function, i.e., applying it to values and + hypotheses with matching types, we can specialize its result + without having to resort to intermediate assertions. For example, + suppose we wanted to prove the following result: *) + +Lemma add_comm3 : + forall x y z, x + (y + z) = (z + y) + x. + +(** It appears at first sight that we ought to be able to prove this by + rewriting with [add_comm] twice to make the two sides match. The + problem is that the second [rewrite] will undo the effect of the + first. *) + +Proof. + intros x y z. + rewrite add_comm. + rewrite add_comm. + (* We are back where we started... *) +Abort. + +(** We encountered similar issues back in [Induction], and we saw + one way to work around them by using [assert] to derive a specialized + version of [add_comm] that can be used to rewrite exactly where we + want. *) + +Lemma add_comm3_take2 : + forall x y z, x + (y + z) = (z + y) + x. +Proof. + intros x y z. + rewrite add_comm. + assert (H : y + z = z + y). + { rewrite add_comm. reflexivity. } + rewrite H. + reflexivity. +Qed. + +(** A more elegant alternative is to apply [add_comm] directly + to the arguments we want to instantiate it with, in much the same + way as we apply a polymorphic function to a type argument. *) + +Lemma add_comm3_take3 : + forall x y z, x + (y + z) = (z + y) + x. +Proof. + intros x y z. + rewrite add_comm. + rewrite (add_comm y z). + reflexivity. +Qed. + +(** If we really wanted, we could in fact do it for both rewrites. *) + +Lemma add_comm3_take4 : + forall x y z, x + (y + z) = (z + y) + x. +Proof. + intros x y z. + rewrite (add_comm x (y + z)). + rewrite (add_comm y z). + reflexivity. +Qed. + +(** Here's another example of using a theorem about lists like + a function. Suppose we have proved the following simple fact + about lists... *) + +Theorem in_not_nil : + forall A (x : A) (l : list A), In x l -> l <> []. +Proof. + intros A x l H. unfold not. intro Hl. + rewrite Hl in H. + simpl in H. + apply H. +Qed. + +(** (I.e., if a list [l] contains some element [x], then [l] + must be nonempty.) *) + +(** Note that one quantified variable ([x]) does not appear in + the conclusion ([l <> []]). *) + +(** Intuitively, we should be able to use this theorem to prove the special + case where [x] is [42]. However, simply invoking the tactic [apply + in_not_nil] will fail because it cannot infer the value of [x]. *) + +Lemma in_not_nil_42 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + Fail apply in_not_nil. +Abort. + +(** There are several ways to work around this: *) + +(** We can use [apply ... with ...]: *) +Lemma in_not_nil_42_take2 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply in_not_nil with (x := 42). + apply H. +Qed. + +(** Or we can use [apply ... in ...]: *) +Lemma in_not_nil_42_take3 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply in_not_nil in H. + apply H. +Qed. + +(** Or -- this is the new one -- we can explicitly + apply the lemma to the value [42] for [x]: *) +Lemma in_not_nil_42_take4 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply (in_not_nil nat 42). + apply H. +Qed. + +(** We can also explicitly apply the lemma to a hypothesis, + causing the values of the other parameters to be inferred: *) +Lemma in_not_nil_42_take5 : + forall l : list nat, In 42 l -> l <> []. +Proof. + intros l H. + apply (in_not_nil _ _ _ H). +Qed. + +(** You can "use a theorem as a function" in this way with almost any + tactic that can take a theorem's name as an argument. + + Note, also, that theorem application uses the same inference + mechanisms as function application; thus, it is possible, for + example, to supply wildcards as arguments to be inferred, or to + declare some hypotheses to a theorem as implicit by default. + These features are illustrated in the proof below. (The details of + how this proof works are not critical -- the goal here is just to + illustrate applying theorems to arguments.) *) + +Example lemma_application_ex : + forall {n : nat} {ns : list nat}, + In n (map (fun m => m * 0) ns) -> + n = 0. +Proof. + intros n ns H. + destruct (proj1 _ _ (In_map_iff _ _ _ _ _) H) + as [m [Hm _]]. + rewrite mul_0_r in Hm. rewrite <- Hm. reflexivity. +Qed. + +(** We will see many more examples in later chapters. *) + +(* ################################################################# *) +(** * Working with Decidable Properties *) + +(** We've seen two different ways of expressing logical claims in Rocq: + with _booleans_ (of type [bool]), and with _propositions_ (of type + [Prop]). + + Here are the key differences between [bool] and [Prop]: + + bool Prop + ==== ==== + decidable? yes no + useable with match? yes no + works with rewrite tactic? no yes +*) + +(** The crucial difference between the two worlds is _decidability_. + Every (closed) Rocq expression of type [bool] can be simplified in a + finite number of steps to either [true] or [false] -- i.e., there is a + terminating mechanical procedure for deciding whether or not it is + [true]. + + This means that, for example, the type [nat -> bool] is inhabited only + by functions that, given a [nat], always yield either [true] or [false] + in finite time; and this, in turn, means (by a standard computability + argument) that there is _no_ function in [nat -> bool] that checks + whether a given number is the code of a terminating Turing machine. + + By contrast, the type [Prop] includes both decidable and undecidable + mathematical propositions; in particular, the type [nat -> Prop] does + contain functions representing properties like "the nth Turing machine + halts." + + The second row in the table follows directly from this essential + difference. To evaluate a pattern match (or conditional) on a boolean, + we need to know whether the scrutinee evaluates to [true] or [false]; + this only works for [bool], not [Prop]. + + The third row highlights an important practical difference: + equality functions like [eqb_nat] that return a boolean cannot be + used directly to justify rewriting with the [rewrite] tactic; + propositional equality is required for this. *) + + +(** Since [Prop] includes _both_ decidable and undecidable properties, we + have two options when we want to formalize a property that happens to + be decidable: we can express it either as a boolean computation or as a + function into [Prop]. *) + +Example even_42_bool : even 42 = true. +Proof. reflexivity. Qed. + +(** ... or that there exists some [k] such that [n = double k]. *) +Example even_42_prop : Even 42. +Proof. unfold Even. exists 21. reflexivity. Qed. + +(** Of course, it would be deeply strange if these two + characterizations of evenness did not describe the same set of + natural numbers! + + Fortunately, they do! *) + +(** To prove this, we first need two helper lemmas. *) + +Lemma even_double : forall k, even (double k) = true. +Proof. + intros k. induction k as [|k' IHk']. + - reflexivity. + - simpl. apply IHk'. +Qed. + +(** **** Exercise: 3 stars, standard (even_double_conv) *) +Lemma even_double_conv : forall n, exists k, + n = if even n then double k else S (double k). +Proof. + (* Hint: Use the [even_S] lemma from [Induction.v]. *) + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Now the main theorem: *) + +Theorem even_bool_prop : forall n, + even n = true <-> Even n. +Proof. + intros n. split. + - intros H. destruct (even_double_conv n) as [k Hk]. + rewrite Hk. rewrite H. exists k. reflexivity. + - intros [k Hk]. rewrite Hk. apply even_double. +Qed. + +(** In view of this theorem, we can say that the boolean computation + [even n] is _reflected_ in the truth of the proposition + [exists k, n = double k]. *) + +(** Similarly, to state that two numbers [n] and [m] are equal, we can + say either + - (1) that [n =? m] returns [true], or + - (2) that [n = m]. + Again, these two notions are equivalent: *) + +Theorem eqb_eq : forall n1 n2 : nat, + n1 =? n2 = true <-> n1 = n2. +Proof. + intros n1 n2. split. + - apply eqb_true. + - intros H. rewrite H. rewrite eqb_refl. reflexivity. +Qed. + +(** So what should we do in situations where some claim could be + formalized as either a proposition or a boolean computation? Which + should we choose? + + In general, _both_ can be useful. *) + +(** For example, booleans are more useful for defining functions. + There is no effective way to _test_ whether or not a [Prop] is + true, so we cannot use [Prop]s in conditional expressions. The + following definition is rejected: *) + +Fail +Definition is_even_prime n := + if n = 2 then true + else false. + +(** Rocq complains that [n = 2] has type [Prop], while it expects an + element of [bool] (or some other inductive type with two constructors). + This has to do with the _computational_ nature of Rocq's core language, + which is designed so that every function it can express is computable + and total. (One reason for this is to allow the extraction of + executable programs from Rocq developments.) As a consequence, [Prop] in + Rocq does _not_ have a universal case analysis operation telling whether + any given proposition is true or false, since such an operation would + allow us to write non-computable functions. *) + +(** Rather, we have to state this definition using a boolean equality + test. *) + +Definition is_even_prime n := + if n =? 2 then true + else false. + +(** Beyond the fact that non-computable properties are impossible in + general to phrase as boolean computations, even many _computable_ + properties are easier to express using [Prop] than [bool], since + recursive function definitions in Rocq are subject to significant + restrictions. For instance, the next chapter shows how to define the + property that a regular expression matches a given string using [Prop]. + Doing the same with [bool] would amount to writing a regular expression + matching algorithm, which would be more complicated, harder to + understand, and harder to reason about than a simple (non-algorithmic) + definition of this property. + + Conversely, an important side benefit of stating facts using booleans + is enabling some proof automation through computation with Rocq terms, a + technique known as _proof by reflection_. + + Consider the following statement: *) + +Example even_1000 : Even 1000. + +(** The most direct way to prove this is to give the value of [k] + explicitly. *) + +Proof. unfold Even. exists 500. reflexivity. Qed. + +(** The proof of the corresponding boolean statement is simpler, because we + don't have to invent the witness [500]: Rocq's computation mechanism + does it for us! *) + +Example even_1000' : even 1000 = true. +Proof. reflexivity. Qed. + +(** Now, the useful observation is that, since the two notions are + equivalent, we can use the boolean formulation to prove the other one + without mentioning the value 500 explicitly: *) + +Example even_1000'' : Even 1000. +Proof. apply even_bool_prop. reflexivity. Qed. + +(** Although we haven't gained much in terms of proof-script + line count in this case, larger proofs can often be made considerably + simpler by the use of reflection. As an extreme example, a famous + Rocq proof of the even more famous _4-color theorem_ uses + reflection to reduce the analysis of hundreds of different cases + to a boolean computation. *) + +(** Another advantage of booleans is that the _negation_ of a claim + about booleans is straightforward to state and (when true) prove: + simply flip the expected boolean result. *) + +Example not_even_1001 : even 1001 = false. +Proof. + reflexivity. +Qed. + +(** In contrast, propositional negation can be difficult to work with + directly. + + For example, suppose we state the non-evenness of [1001] + propositionally: *) + +Example not_even_1001' : ~(Even 1001). + +(** Proving this directly -- by assuming that there is some [n] such that + [1001 = double n] and then somehow reasoning to a contradiction -- + would be rather complicated. + + But if we convert it to a claim about the boolean [even] function, we + can let Rocq do the work for us. *) + +Proof. + (* WORKED IN CLASS *) + rewrite <- even_bool_prop. + unfold not. + simpl. + intro H. + discriminate H. +Qed. + +(** Conversely, there are situations where it can be easier to work + with propositions rather than booleans. + + In particular, knowing that [(n =? m) = true] is generally of + little direct help in the middle of a proof involving [n] and [m]. + But if we convert the statement to the equivalent form [n = m], + then we can easily [rewrite] with it. *) + +Lemma plus_eqb_example : forall n m p : nat, + n =? m = true -> n + p =? m + p = true. +Proof. + (* WORKED IN CLASS *) + intros n m p H. + rewrite eqb_eq in H. + rewrite H. + rewrite eqb_eq. + reflexivity. +Qed. + +(** We won't discuss reflection any further for the moment, but + it serves as a good example showing the different strengths of + booleans and general propositions. *) + +(** Being able to cross back and forth between the boolean and + propositional worlds will often be convenient in later chapters. *) + +(** **** Exercise: 2 stars, standard (logical_connectives) + + The following theorems relate the propositional connectives studied + in this chapter to the corresponding boolean operations. *) + +Theorem andb_true_iff : forall b1 b2:bool, + b1 && b2 = true <-> b1 = true /\ b2 = true. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem orb_true_iff : forall b1 b2, + b1 || b2 = true <-> b1 = true \/ b2 = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard (eqb_neq) + + The following theorem is an alternate "negative" formulation of + [eqb_eq] that is more convenient in certain situations. (We'll see + examples in later chapters.) Hint: [not_true_iff_false]. *) + +Theorem eqb_neq : forall x y : nat, + x =? y = false <-> x <> y. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (eqb_list) + + Given a boolean operator [eqb] for testing equality of elements of + some type [A], we can define a function [eqb_list] for testing + equality of lists with elements in [A]. Complete the definition + of the [eqb_list] function below. To make sure that your + definition is correct, prove the lemma [eqb_list_true_iff]. *) + +Fixpoint eqb_list {A : Type} (eqb : A -> A -> bool) + (l1 l2 : list A) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem eqb_list_true_iff : + forall A (eqb : A -> A -> bool), + (forall a1 a2, eqb a1 a2 = true <-> a1 = a2) -> + forall l1 l2, eqb_list eqb l1 l2 = true <-> l1 = l2. +Proof. +(* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 2 stars, standard, especially useful (All_forallb) + + Prove the theorem below, which relates [forallb], from the + exercise [forall_exists_challenge] in chapter [Tactics], to + the [All] property defined above. *) + +(** Copy the definition of [forallb] from your [Tactics] here + so that this file can be graded on its own. *) +Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem forallb_true_iff : forall X test (l : list X), + forallb test l = true <-> All (fun x => test x = true) l. +Proof. + (* FILL IN HERE *) Admitted. + +(** (Ungraded thought question) Are there any important properties of + the function [forallb] which are not captured by this + specification? *) + +(* FILL IN HERE + + [] *) + +(* ################################################################# *) +(** * The Logic of Rocq *) + +(** Rocq's logical core, the _Calculus of Inductive + Constructions_, differs in some important ways from other formal + systems that are used by mathematicians to write down precise and + rigorous definitions and proofs -- in particular from + Zermelo-Fraenkel Set Theory (ZFC), the most popular foundation for + paper-and-pencil mathematics. + + We conclude this chapter with a brief discussion of some of the + most significant differences between these two worlds. *) + +(* ================================================================= *) +(** ** Functional Extensionality *) + +(** Rocq's logic is quite minimalistic. This means that one occasionally + encounters cases where translating standard mathematical reasoning into + Rocq is cumbersome -- or even impossible -- unless we enrich its core + logic with additional axioms. *) + +(** For example, the equality assertions that we have seen so far + mostly have concerned elements of inductive types ([nat], [bool], + etc.). But, since Rocq's equality operator is polymorphic, we can use + it at _any_ type -- in particular, we can write propositions claiming + that two _functions_ are equal to each other: + + In certain cases Rocq can successfully prove equality propositions stating + that two _functions_ are equal to each other: **) + +Example function_equality_ex1 : + (fun x => 3 + x) = (fun x => (pred 4) + x). +Proof. reflexivity. Qed. + +(** This works when Rocq can simplify the functions to the same expression, + but this doesn't always happen. **) + +(** These two functions are equal just by simplification, but in general + functions can be equal for more interesting reasons. + + In common mathematical practice, two functions [f] and [g] are + considered equal if they produce the same output on every input: + + (forall x, f x = g x) -> f = g + + This is known as the principle of _functional extensionality_. *) + +(** (Informally, an "extensional" property is one that pertains to an + object's observable behavior. Thus, functional extensionality + simply means that a function's identity is completely determined + by what we can observe from it -- i.e., the results we obtain + after applying it.) *) + +(** However, functional extensionality is not part of Rocq's built-in logic. + This means that some intuitively obvious propositions are not + provable. *) + +Example function_equality_ex2 : + (fun x => plus x 1) = (fun x => plus 1 x). +Proof. + Fail reflexivity. Fail rewrite add_comm. + (* Stuck *) +Abort. + +(** However, if we like, we can add functional extensionality to Rocq + using the [Axiom] command. *) + +Axiom functional_extensionality : forall {X Y: Type} + {f g : X -> Y}, + (forall (x:X), f x = g x) -> f = g. + +(** Defining something as an [Axiom] has the same effect as stating a + theorem and skipping its proof using [Admitted], but it alerts the + reader that this isn't just something we're going to come back and + fill in later! *) + +(** We can now invoke functional extensionality in proofs: *) + +Example function_equality_ex2 : + (fun x => plus x 1) = (fun x => plus 1 x). +Proof. + apply functional_extensionality. intros x. + apply add_comm. +Qed. + +(** Naturally, we need to be quite careful when adding new axioms into + Rocq's logic, as this can render it _inconsistent_ -- that is, it may + become possible to prove every proposition, including [False], [2+2=5], + etc.! + + In general, there is no simple way of telling whether an axiom is safe + to add: hard work by highly trained mathematicians is often required to + establish the consistency of any particular combination of axioms. + + Fortunately, it is known that adding functional extensionality, in + particular, _is_ consistent. *) + +(** To check whether a particular proof relies on any additional + axioms, use the [Print Assumptions] command: + + Print Assumptions function_equality_ex2. +*) +(* ===> + Axioms: + functional_extensionality : + forall (X Y : Type) (f g : X -> Y), + (forall x : X, f x = g x) -> f = g + + (If you try this yourself, you may also see [add_comm] listed as + an assumption, depending on whether the copy of [Tactics.v] in the + local directory has the proof of [add_comm] filled in.) *) + +(** **** Exercise: 4 stars, standard (tr_rev_correct) + + One problem with the definition of the list-reversing function [rev] + that we have is that it performs a call to [app] on each step. Running + [app] takes time asymptotically linear in the size of the list, which + means that [rev] is asymptotically quadratic. + + We can improve this with the following two-argument definition: *) + +Fixpoint rev_append {X} (l1 l2 : list X) : list X := + match l1 with + | [] => l2 + | x :: l1' => rev_append l1' (x :: l2) + end. + +Definition tr_rev {X} (l : list X) : list X := + rev_append l []. + +(** This version of [rev] is said to be _tail recursive_, because the + recursive call to the function is the last operation that needs to be + performed (i.e., we don't have to execute [++] after the recursive + call); a decent compiler will generate very efficient code in this + case. + + Prove that the two definitions are indeed equivalent. *) + +Theorem tr_rev_correct : forall X, @tr_rev X = @rev X. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Classical vs. Constructive Logic *) + +(** We have seen that it is not possible to test whether or not a + proposition [P] holds while defining a Rocq function. You may be + surprised to learn that a similar restriction applies in _proofs_! + In other words, the following intuitive reasoning principle is not + derivable in Rocq: *) + +Definition excluded_middle := forall P : Prop, + P \/ ~ P. + +(** To understand operationally why this is the case, recall + that, to prove a statement of the form [P \/ Q], we use the [left] + and [right] tactics, which effectively require knowing which side + of the disjunction holds. But the universally quantified [P] in + [excluded_middle] is an _arbitrary_ proposition, which we know + nothing about. We don't have enough information to choose which + of [left] or [right] to apply. *) + +(** However, in the special case where we happen to know that [P] is + reflected in some boolean term [b], knowing whether it holds or + not is trivial: we just have to check the value of [b]. *) + +Theorem restricted_excluded_middle : forall P b, + (P <-> b = true) -> P \/ ~ P. +Proof. + intros P [] H. + - left. rewrite H. reflexivity. + - right. rewrite H. intros contra. discriminate contra. +Qed. + +(** In particular, the excluded middle is valid for equations [n = m], + between natural numbers [n] and [m]. *) + +Theorem restricted_excluded_middle_eq : forall (n m : nat), + n = m \/ n <> m. +Proof. + intros n m. + apply (restricted_excluded_middle (n = m) (n =? m)). + symmetry. + apply eqb_eq. +Qed. + +(** Sadly, this trick only works for decidable propositions. *) + +(** It may seem strange that the general excluded middle is not + available by default in Rocq, since it is a standard feature of familiar + logics like ZFC. But there is a distinct advantage in _not_ assuming + the excluded middle: statements in Rocq make stronger claims than the + analogous statements in standard mathematics. Notably, a Rocq proof of + [exists x, P x] always includes a particular value of [x] for which we + can prove [P x] -- in other words, every proof of existence is + _constructive_. *) + +(** Logics like Rocq's, which do not assume the excluded middle, are + referred to as _constructive logics_. + + Logical systems such as ZFC, in which the excluded middle does + hold for arbitrary propositions, are referred to as _classical_. *) + +(** The following example illustrates why assuming the excluded middle may + lead to non-constructive proofs: + + _Claim_: There exist irrational numbers [a] and [b] such that [a ^ + b] ([a] to the power [b]) is rational. + + _Proof_: It is not difficult to show that [sqrt 2] is irrational. So if + [sqrt 2 ^ sqrt 2] is rational, it suffices to take [a = b = sqrt 2] and + we are done. Otherwise, [sqrt 2 ^ sqrt 2] is irrational. In this + case, we can take [a = sqrt 2 ^ sqrt 2] and [b = sqrt 2], since [a ^ b + = sqrt 2 ^ (sqrt 2 * sqrt 2) = sqrt 2 ^ 2 = 2]. [] + + Do you see what happened here? We used the excluded middle to + consider separately the cases where [sqrt 2 ^ sqrt 2] is rational + and where it is not, without knowing which one actually holds! + Because of this, we finish the proof knowing that such [a] and [b] + exist, but not being sure of their actual values. + + As useful as constructive logic is, it does have its limitations: + There are many statements that can easily be proven in classical + logic but that have only much more complicated constructive + proofs, and there are some that are known to have no constructive + proof at all! Fortunately, like functional extensionality, the + excluded middle is known to be compatible with Rocq's logic, + allowing us to add it safely as an axiom. However, we will not + need to do so here: the results that we cover in Software + Foundations can be developed entirely within constructive logic at + negligible extra cost. + + It takes some practice to understand which proof techniques must + be avoided in constructive reasoning, but arguments by + contradiction, in particular, are infamous for leading to + non-constructive proofs. Here's a typical example: suppose that we + want to show that there exists [x] with some property [P], i.e., + such that [P x]. We start by assuming that our conclusion is + false; that is, [~ exists x, P x]. From this premise, it is not + hard to derive [forall x, ~ P x]. If we manage to show that this + results in a contradiction, we arrive at an existence proof + without ever exhibiting a value of [x] for which [P x] holds! + + The technical flaw here, from a constructive standpoint, is that we + claimed to prove [exists x, P x] using a proof of [~ ~ (exists x, P x)]. + Allowing ourselves to remove double negations from arbitrary + statements is equivalent to assuming the excluded middle law, as shown + in one of the exercises below. Thus, this line of reasoning cannot be + encoded in Rocq without assuming additional axioms. *) + +(** **** Exercise: 3 stars, standard (excluded_middle_irrefutable) + + Proving the consistency of Rocq with the general excluded middle + axiom requires complicated reasoning that cannot be carried out + within Rocq itself. However, the following theorem implies that it + is always safe to assume a decidability axiom (i.e., an instance + of excluded middle) for any _particular_ Prop [P]. Why? Because + the negation of such an axiom leads to a contradiction. If [~ (P + \/ ~P)] were provable, then by [de_morgan_not_or] as proved above, + [P /\ ~P] would be provable, which would be a contradiction. So, it + is safe to add [P \/ ~P] as an axiom for any particular [P]. + + Succinctly: for any proposition P, + [Rocq is consistent ==> Rocq + (P \/ ~P) is consistent]. *) + +Theorem excluded_middle_irrefutable: forall (P : Prop), + ~ ~ (P \/ ~ P). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced (not_exists_dist) + + It is a theorem of classical logic that the following two + assertions are equivalent: + + ~ (exists x, ~ P x) + forall x, P x + + The [dist_not_exists] theorem above proves one side of this + equivalence. Interestingly, the other direction cannot be proved + in constructive logic. Your job is to show that it is implied by + 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. +(** [] *) + +(** **** Exercise: 5 stars, standard, optional (classical_axioms) + + For those who like a challenge, here is an exercise adapted from the + Coq'Art book by Bertot and Casteran (p. 123). Each of the + following five statements, together with [excluded_middle], can be + considered as characterizing classical logic. We can't prove any + of them in Rocq, but we can consistently add any _one_ of them as an + axiom if we wish to work in classical logic. + + To see this, prove that all six propositions (these five plus + [excluded_middle]) are equivalent. + + Hint: Rather than considering all pairs of statements pairwise, + prove a single circular chain of implications that connects them + all. *) + +Definition peirce := forall P Q: Prop, + ((P -> Q) -> P) -> P. + +Definition double_negation_elimination := 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). + +Definition consequentia_mirabilis := forall P:Prop, + (~P -> P) -> P. + +(* FILL IN HERE + + [] *) + +(* 2026-01-07 13:17 *) diff --git a/LogicTest.v b/LogicTest.v new file mode 100644 index 0000000..b2bb2ba --- /dev/null +++ b/LogicTest.v @@ -0,0 +1,423 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Logic. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Logic. +Import Check. + +Goal True. + +idtac "------------------- plus_is_O --------------------". +idtac " ". + +idtac "#> plus_is_O". +idtac "Possible points: 2". +check_type @plus_is_O ( +(forall (n m : nat) (_ : @eq nat (Nat.add n m) 0), + and (@eq nat n 0) (@eq nat m 0))). +idtac "Assumptions:". +Abort. +Print Assumptions plus_is_O. +Goal True. +idtac " ". + +idtac "------------------- and_assoc --------------------". +idtac " ". + +idtac "#> and_assoc". +idtac "Possible points: 1". +check_type @and_assoc ((forall (P Q R : Prop) (_ : and P (and Q R)), and (and P Q) R)). +idtac "Assumptions:". +Abort. +Print Assumptions and_assoc. +Goal True. +idtac " ". + +idtac "------------------- mult_is_O --------------------". +idtac " ". + +idtac "#> mult_is_O". +idtac "Possible points: 2". +check_type @mult_is_O ( +(forall (n m : nat) (_ : @eq nat (Nat.mul n m) 0), + or (@eq nat n 0) (@eq nat m 0))). +idtac "Assumptions:". +Abort. +Print Assumptions mult_is_O. +Goal True. +idtac " ". + +idtac "------------------- or_commut --------------------". +idtac " ". + +idtac "#> or_commut". +idtac "Possible points: 1". +check_type @or_commut ((forall (P Q : Prop) (_ : or P Q), or Q P)). +idtac "Assumptions:". +Abort. +Print Assumptions or_commut. +Goal True. +idtac " ". + +idtac "------------------- contrapositive --------------------". +idtac " ". + +idtac "#> contrapositive". +idtac "Possible points: 1". +check_type @contrapositive ( +(forall (P Q : Prop) (_ : forall _ : P, Q) (_ : not Q), not P)). +idtac "Assumptions:". +Abort. +Print Assumptions contrapositive. +Goal True. +idtac " ". + +idtac "------------------- not_both_true_and_false --------------------". +idtac " ". + +idtac "#> not_both_true_and_false". +idtac "Possible points: 1". +check_type @not_both_true_and_false ((forall P : Prop, not (and P (not P)))). +idtac "Assumptions:". +Abort. +Print Assumptions not_both_true_and_false. +Goal True. +idtac " ". + +idtac "------------------- not_PNP_informal --------------------". +idtac " ". + +idtac "#> Manually graded: not_PNP_informal". +idtac "Advanced". +idtac "Possible points: 1". +print_manual_grade manual_grade_for_not_PNP_informal. +idtac " ". + +idtac "------------------- de_morgan_not_or --------------------". +idtac " ". + +idtac "#> de_morgan_not_or". +idtac "Possible points: 2". +check_type @de_morgan_not_or ( +(forall (P Q : Prop) (_ : not (or P Q)), and (not P) (not Q))). +idtac "Assumptions:". +Abort. +Print Assumptions de_morgan_not_or. +Goal True. +idtac " ". + +idtac "------------------- or_distributes_over_and --------------------". +idtac " ". + +idtac "#> or_distributes_over_and". +idtac "Possible points: 3". +check_type @or_distributes_over_and ( +(forall P Q R : Prop, iff (or P (and Q R)) (and (or P Q) (or P R)))). +idtac "Assumptions:". +Abort. +Print Assumptions or_distributes_over_and. +Goal True. +idtac " ". + +idtac "------------------- dist_not_exists --------------------". +idtac " ". + +idtac "#> dist_not_exists". +idtac "Possible points: 1". +check_type @dist_not_exists ( +(forall (X : Type) (P : forall _ : X, Prop) (_ : forall x : X, P x), + not (@ex X (fun x : X => not (P x))))). +idtac "Assumptions:". +Abort. +Print Assumptions dist_not_exists. +Goal True. +idtac " ". + +idtac "------------------- dist_exists_or --------------------". +idtac " ". + +idtac "#> dist_exists_or". +idtac "Possible points: 2". +check_type @dist_exists_or ( +(forall (X : Type) (P Q : forall _ : X, Prop), + iff (@ex X (fun x : X => or (P x) (Q x))) + (or (@ex X (fun x : X => P x)) (@ex X (fun x : X => Q x))))). +idtac "Assumptions:". +Abort. +Print Assumptions dist_exists_or. +Goal True. +idtac " ". + +idtac "------------------- In_map_iff --------------------". +idtac " ". + +idtac "#> In_map_iff". +idtac "Possible points: 2". +check_type @In_map_iff ( +(forall (A B : Type) (f : forall _ : A, B) (l : list A) (y : B), + iff (@In B y (@map A B f l)) + (@ex A (fun x : A => and (@eq B (f x) y) (@In A x l))))). +idtac "Assumptions:". +Abort. +Print Assumptions In_map_iff. +Goal True. +idtac " ". + +idtac "------------------- In_app_iff --------------------". +idtac " ". + +idtac "#> In_app_iff". +idtac "Possible points: 2". +check_type @In_app_iff ( +(forall (A : Type) (l l' : list A) (a : A), + iff (@In A a (@app A l l')) (or (@In A a l) (@In A a l')))). +idtac "Assumptions:". +Abort. +Print Assumptions In_app_iff. +Goal True. +idtac " ". + +idtac "------------------- All --------------------". +idtac " ". + +idtac "#> All_In". +idtac "Possible points: 3". +check_type @All_In ( +(forall (T : Type) (P : forall _ : T, Prop) (l : list T), + iff (forall (x : T) (_ : @In T x l), P x) (@All T P l))). +idtac "Assumptions:". +Abort. +Print Assumptions All_In. +Goal True. +idtac " ". + +idtac "------------------- even_double_conv --------------------". +idtac " ". + +idtac "#> even_double_conv". +idtac "Possible points: 3". +check_type @even_double_conv ( +(forall n : nat, + @ex nat + (fun k : nat => @eq nat n (if even n then double k else S (double k))))). +idtac "Assumptions:". +Abort. +Print Assumptions even_double_conv. +Goal True. +idtac " ". + +idtac "------------------- logical_connectives --------------------". +idtac " ". + +idtac "#> andb_true_iff". +idtac "Possible points: 1". +check_type @andb_true_iff ( +(forall b1 b2 : bool, + iff (@eq bool (andb b1 b2) true) (and (@eq bool b1 true) (@eq bool b2 true)))). +idtac "Assumptions:". +Abort. +Print Assumptions andb_true_iff. +Goal True. +idtac " ". + +idtac "#> orb_true_iff". +idtac "Possible points: 1". +check_type @orb_true_iff ( +(forall b1 b2 : bool, + iff (@eq bool (orb b1 b2) true) (or (@eq bool b1 true) (@eq bool b2 true)))). +idtac "Assumptions:". +Abort. +Print Assumptions orb_true_iff. +Goal True. +idtac " ". + +idtac "------------------- eqb_neq --------------------". +idtac " ". + +idtac "#> eqb_neq". +idtac "Possible points: 1". +check_type @eqb_neq ( +(forall x y : nat, iff (@eq bool (eqb x y) false) (not (@eq nat x y)))). +idtac "Assumptions:". +Abort. +Print Assumptions eqb_neq. +Goal True. +idtac " ". + +idtac "------------------- eqb_list --------------------". +idtac " ". + +idtac "#> eqb_list_true_iff". +idtac "Possible points: 3". +check_type @eqb_list_true_iff ( +(forall (A : Type) (eqb : forall (_ : A) (_ : A), bool) + (_ : forall a1 a2 : A, iff (@eq bool (eqb a1 a2) true) (@eq A a1 a2)) + (l1 l2 : list A), + iff (@eq bool (@eqb_list A eqb l1 l2) true) (@eq (list A) l1 l2))). +idtac "Assumptions:". +Abort. +Print Assumptions eqb_list_true_iff. +Goal True. +idtac " ". + +idtac "------------------- All_forallb --------------------". +idtac " ". + +idtac "#> forallb_true_iff". +idtac "Possible points: 2". +check_type @forallb_true_iff ( +(forall (X : Type) (test : forall _ : X, bool) (l : list X), + iff (@eq bool (@forallb X test l) true) + (@All X (fun x : X => @eq bool (test x) true) l))). +idtac "Assumptions:". +Abort. +Print Assumptions forallb_true_iff. +Goal True. +idtac " ". + +idtac "------------------- tr_rev_correct --------------------". +idtac " ". + +idtac "#> tr_rev_correct". +idtac "Possible points: 6". +check_type @tr_rev_correct ( +(forall X : Type, @eq (forall _ : list X, list X) (@tr_rev X) (@rev X))). +idtac "Assumptions:". +Abort. +Print Assumptions tr_rev_correct. +Goal True. +idtac " ". + +idtac "------------------- excluded_middle_irrefutable --------------------". +idtac " ". + +idtac "#> excluded_middle_irrefutable". +idtac "Possible points: 3". +check_type @excluded_middle_irrefutable ((forall P : Prop, not (not (or P (not P))))). +idtac "Assumptions:". +Abort. +Print Assumptions excluded_middle_irrefutable. +Goal True. +idtac " ". + +idtac "------------------- not_exists_dist --------------------". +idtac " ". + +idtac "#> not_exists_dist". +idtac "Advanced". +idtac "Possible points: 3". +check_type @not_exists_dist ( +(forall (_ : excluded_middle) (X : Type) (P : forall _ : X, Prop) + (_ : not (@ex X (fun x : X => not (P x)))) (x : X), + P x)). +idtac "Assumptions:". +Abort. +Print Assumptions not_exists_dist. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 43". +idtac "Max points - advanced: 47". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- plus_is_O ---------". +Print Assumptions plus_is_O. +idtac "---------- and_assoc ---------". +Print Assumptions and_assoc. +idtac "---------- mult_is_O ---------". +Print Assumptions mult_is_O. +idtac "---------- or_commut ---------". +Print Assumptions or_commut. +idtac "---------- contrapositive ---------". +Print Assumptions contrapositive. +idtac "---------- not_both_true_and_false ---------". +Print Assumptions not_both_true_and_false. +idtac "---------- de_morgan_not_or ---------". +Print Assumptions de_morgan_not_or. +idtac "---------- or_distributes_over_and ---------". +Print Assumptions or_distributes_over_and. +idtac "---------- dist_not_exists ---------". +Print Assumptions dist_not_exists. +idtac "---------- dist_exists_or ---------". +Print Assumptions dist_exists_or. +idtac "---------- In_map_iff ---------". +Print Assumptions In_map_iff. +idtac "---------- In_app_iff ---------". +Print Assumptions In_app_iff. +idtac "---------- All_In ---------". +Print Assumptions All_In. +idtac "---------- even_double_conv ---------". +Print Assumptions even_double_conv. +idtac "---------- andb_true_iff ---------". +Print Assumptions andb_true_iff. +idtac "---------- orb_true_iff ---------". +Print Assumptions orb_true_iff. +idtac "---------- eqb_neq ---------". +Print Assumptions eqb_neq. +idtac "---------- eqb_list_true_iff ---------". +Print Assumptions eqb_list_true_iff. +idtac "---------- forallb_true_iff ---------". +Print Assumptions forallb_true_iff. +idtac "---------- tr_rev_correct ---------". +Print Assumptions tr_rev_correct. +idtac "---------- excluded_middle_irrefutable ---------". +Print Assumptions excluded_middle_irrefutable. +idtac "". +idtac "********** Advanced **********". +idtac "---------- not_PNP_informal ---------". +idtac "MANUAL". +idtac "---------- not_exists_dist ---------". +Print Assumptions not_exists_dist. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f969b9c --- /dev/null +++ b/Makefile @@ -0,0 +1,17 @@ +COQMFFLAGS := -Q . LF + +ALLVFILES := Preface.v Basics.v Induction.v Lists.v Poly.v Tactics.v Logic.v IndProp.v Maps.v ProofObjects.v IndPrinciples.v Rel.v Imp.v ImpParser.v ImpCEvalFun.v Extraction.v Auto.v AltAuto.v Postscript.v Bib.v PrefaceTest.v BasicsTest.v InductionTest.v ListsTest.v PolyTest.v TacticsTest.v LogicTest.v IndPropTest.v MapsTest.v ProofObjectsTest.v IndPrinciplesTest.v RelTest.v ImpTest.v ImpParserTest.v ImpCEvalFunTest.v ExtractionTest.v AutoTest.v AltAutoTest.v PostscriptTest.v BibTest.v + +build: Makefile.coq + $(MAKE) -f Makefile.coq + +clean:: + if [ -e Makefile.coq ]; then $(MAKE) -f Makefile.coq cleanall; fi + $(RM) $(wildcard Makefile.coq Makefile.coq.conf) imp.ml imp.mli imp1.ml imp1.mli imp2.ml imp2.mli + +Makefile.coq: + rocq makefile $(COQMFFLAGS) -o Makefile.coq $(ALLVFILES) + +-include Makefile.coq + +.PHONY: build clean diff --git a/Maps.v b/Maps.v new file mode 100644 index 0000000..4ae5f4e --- /dev/null +++ b/Maps.v @@ -0,0 +1,380 @@ +(** * Maps: Total and Partial Maps *) + +(** _Maps_ (or _dictionaries_) are ubiquitous data structures both in + ordinary programming and in the theory of programming languages; + we're going to need them in many places in the coming chapters. + + They also make a nice case study using ideas we've seen in + previous chapters, including building data structures out of + higher-order functions (from [Basics] and [Poly]) and the use of + reflection to streamline proofs (from [IndProp]). + + We'll define two flavors of maps: _total_ maps, which include a + "default" element to be returned when a key being looked up + doesn't exist, and _partial_ maps, which instead return an + [option] to indicate success or failure. Partial maps are defined + in terms of total maps, using [None] as the default element. *) + +(* ################################################################# *) +(** * The Standard Library *) + +(** One small digression before we begin... + + Unlike the chapters we have seen so far, this one does not + [Require Import] the chapter before it (or, transitively, all the + earlier chapters). Instead, in this chapter and from now on, + we're going to import the definitions and theorems we need + directly from Rocq's standard library. You should not notice much + difference, though, because we've been careful to name our own + definitions and theorems the same as their counterparts in the + standard library, wherever they overlap. *) + +From Stdlib Require Import Arith. +From Stdlib Require Import Bool. +From Stdlib Require Export Strings.String. +From Stdlib Require Import FunctionalExtensionality. +From Stdlib Require Import List. +Import ListNotations. + +(** Documentation for the standard library can be found at + https://rocq-prover.org/doc/V9.0.0/stdlib/index.html. + + The [Search] command is a good way to look for theorems involving + objects of specific types. See [Lists] for a reminder of how + to use it. *) + +(** If you want to find out how or where a notation is defined, the + [Locate] command is useful. For example, where is the natural + addition operation defined in the standard library? *) + +Locate "+". + +(** (There are several uses of the [+] notation, but only one for + naturals.) *) + +Print Init.Nat.add. + +(** We'll see some more uses of [Locate] in the [Imp] chapter. *) + +(* ################################################################# *) +(** * Identifiers *) + +(** To define maps, we first need a type for the keys that we will use + to index into our maps. In [Lists.v] we introduced a fresh type + [id] for a similar purpose; here and for the rest of _Software + Foundations_ we will use the [string] type from Rocq's standard + library. *) + +(** To compare strings, we use the function [eqb_refl] from the [String] + module in the standard library. *) + +Check String.eqb_refl : + forall x : string, (x =? x)%string = true. + +(** We will often use a few basic properties of string equality... *) +Check String.eqb_eq : + forall n m : string, (n =? m)%string = true <-> n = m. +Check String.eqb_neq : + forall n m : string, (n =? m)%string = false <-> n <> m. +Check String.eqb_spec : + forall x y : string, reflect (x = y) (String.eqb x y). + +(* ################################################################# *) +(** * Total Maps *) + +(** Our main job in this chapter will be to build a definition of + partial maps that is similar in behavior to the one we saw in the + [Lists] chapter, plus accompanying lemmas about its behavior. + + This time around, though, we're going to use _functions_, rather + than lists of key-value pairs, to build maps. The advantage of + this representation is that it offers a more "extensional" view of + maps: two maps that respond to queries in the same way will be + represented as exactly the same function, rather than just as + "equivalent" list structures. This simplifies proofs that use + maps. *) + +(** We build up to partial maps in two steps. First, we define a type + of _total maps_ that return a default value when we look up a key + that is not present in the map. *) + +Definition total_map (A : Type) := string -> A. + +(** Intuitively, a total map over an element type [A] is just a + function that can be used to look up [string]s, yielding [A]s. *) + +(** The function [t_empty] yields an empty total map, given a default + element; this map always returns the default element when applied + to any string. *) + +Definition t_empty {A : Type} (v : A) : total_map A := + (fun _ => v). + +(** More interesting is the map-updating function, which (as always) + takes a map [m], a key [x], and a value [v] and returns a new map + that takes [x] to [v] and takes every other key to whatever [m] + does. The novelty here is that we achieve this effect by wrapping + a new function around the old one. *) + +Definition t_update {A : Type} (m : total_map A) + (x : string) (v : A) := + fun x' => if String.eqb x x' then v else m x'. + +(** This definition is a nice example of higher-order programming: + [t_update] takes a _function_ [m] and yields a new function + [fun x' => ...] that behaves like the desired map. *) + +(** For example, we can build a map taking [string]s to [bool]s, where + ["foo"] and ["bar"] are mapped to [true] and every other key is + mapped to [false], like this: *) + +Definition examplemap := + t_update (t_update (t_empty false) "foo" true) + "bar" true. + +(** Next, let's introduce some notations to facilitate working with + maps. *) + +(** First, we use the following notation to represent an empty total + map with a default value. *) +Notation "'__' '!->' v" := (t_empty v) + (at level 100, right associativity). + +Example example_empty := ( false). + +(** We next introduce a symbolic notation for extending an existing + map with a new binding. *) +Notation "x '!->' v ';' m" := (t_update m x v) + (at level 100, v constr at level 100, right associativity). + +(** The [examplemap] above can now be defined as follows: *) + +Definition examplemap' := + ( "bar" !-> true; + "foo" !-> true; + __ !-> false + ). + +(** This completes the definition of total maps. Note that we + don't need to define a [find] operation on this representation of + maps because it is just function application! *) + +Example update_example1 : examplemap' "baz" = false. +Proof. reflexivity. Qed. + +Example update_example2 : examplemap' "foo" = true. +Proof. reflexivity. Qed. + +Example update_example3 : examplemap' "quux" = false. +Proof. reflexivity. Qed. + +Example update_example4 : examplemap' "bar" = true. +Proof. reflexivity. Qed. + +(** When we use maps in later chapters, we'll need several fundamental + facts about how they behave. *) + +(** Even if you don't work the following exercises, make sure + you thoroughly understand the statements of the lemmas! *) + +(** (Some of the proofs require the functional extensionality axiom, + which was discussed in the [Logic] chapter.) *) + +(** **** Exercise: 1 star, standard, optional (t_apply_empty) + + First, the empty map returns its default element for all keys: *) + +Lemma t_apply_empty : forall (A : Type) (x : string) (v : A), + (__ !-> v) x = v. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (t_update_eq) + + Next, if we update a map [m] at a key [x] with a new value [v] + and then look up [x] in the map resulting from the [update], we + get back [v]: *) + +Lemma t_update_eq : forall (A : Type) (m : total_map A) x v, + (x !-> v ; m) x = v. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (t_update_neq) + + On the other hand, if we update a map [m] at a key [x1] and then + look up a _different_ key [x2] in the resulting map, we get the + same result that [m] would have given: *) + +Theorem t_update_neq : forall (A : Type) (m : total_map A) x1 x2 v, + x1 <> x2 -> + (x1 !-> v ; m) x2 = m x2. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (t_update_shadow) + + If we update a map [m] at a key [x] with a value [v1] and then + update again with the same key [x] and another value [v2], the + resulting map behaves the same (gives the same result when applied + to any key) as the simpler map obtained by performing just + the second [update] on [m]: *) + +Lemma t_update_shadow : forall (A : Type) (m : total_map A) x v1 v2, + (x !-> v2 ; x !-> v1 ; m) = (x !-> v2 ; m). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (t_update_same) + + Given [string]s [x1] and [x2], we can use the tactic + [destruct (eqb_spec x1 x2)] to simultaneously perform case + analysis on the result of [String.eqb x1 x2] and generate + hypotheses about the equality (in the sense of [=]) of [x1] and + [x2]. With the example in chapter [IndProp] as a template, + use [String.eqb_spec] to prove the following theorem, which states + that if we update a map to assign key [x] the same value as it + already has in [m], then the result is equal to [m]: *) + +Theorem t_update_same : forall (A : Type) (m : total_map A) x, + (x !-> m x ; m) = m. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, especially useful (t_update_permute) + + Similarly, use [String.eqb_spec] to prove one final property of + the [update] function: If we update a map [m] at two distinct + keys, it doesn't matter in which order we do the updates. *) + +Theorem t_update_permute : forall (A : Type) (m : total_map A) + v1 v2 x1 x2, + x2 <> x1 -> + (x1 !-> v1 ; x2 !-> v2 ; m) + = + (x2 !-> v2 ; x1 !-> v1 ; m). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Partial maps *) + +(** Lastly, we define _partial maps_ on top of total maps. A partial + map with elements of type [A] is simply a total map with elements + of type [option A] and default element [None]. *) + +Definition partial_map (A : Type) := total_map (option A). + +Definition empty {A : Type} : partial_map A := + t_empty None. + +Definition update {A : Type} (m : partial_map A) + (x : string) (v : A) := + (x !-> Some v ; m). +(** We introduce a similar notation for partial maps: *) +Notation "x '|->' v ';' m" := (update m x v) + (at level 0, x constr, v at level 200, right associativity). + +(** We can also hide the last case when it is empty. *) +Notation "x '|->' v" := (update empty x v) + (at level 0, x constr, v at level 200). + +Definition examplepmap := + ("Church" |-> true ; "Turing" |-> false). + +(** We now straightforwardly lift all of the basic lemmas about total + maps to partial maps. *) + +Lemma apply_empty : forall (A : Type) (x : string), + @empty A x = None. +Proof. + intros. unfold empty. rewrite t_apply_empty. + reflexivity. +Qed. + +Lemma update_eq : forall (A : Type) (m : partial_map A) x v, + (x |-> v ; m) x = Some v. +Proof. + intros. unfold update. rewrite t_update_eq. + reflexivity. +Qed. + +(** The [update_eq] lemma is used very often in proofs. Adding it to + Rocq's global "hint database" allows proof-automation tactics such + as [auto] to find it. *) +#[global] Hint Resolve update_eq : core. + +Theorem update_neq : forall (A : Type) (m : partial_map A) x1 x2 v, + x2 <> x1 -> + (x2 |-> v ; m) x1 = m x1. +Proof. + intros A m x1 x2 v H. + unfold update. rewrite t_update_neq. + - reflexivity. + - apply H. +Qed. + +Lemma update_shadow : forall (A : Type) (m : partial_map A) x v1 v2, + (x |-> v2 ; x |-> v1 ; m) = (x |-> v2 ; m). +Proof. + intros A m x v1 v2. unfold update. rewrite t_update_shadow. + reflexivity. +Qed. + +Theorem update_same : forall (A : Type) (m : partial_map A) x v, + m x = Some v -> + (x |-> v ; m) = m. +Proof. + intros A m x v H. unfold update. rewrite <- H. + apply t_update_same. +Qed. + +Theorem update_permute : forall (A : Type) (m : partial_map A) + x1 x2 v1 v2, + x2 <> x1 -> + (x1 |-> v1 ; x2 |-> v2 ; m) = (x2 |-> v2 ; x1 |-> v1 ; m). +Proof. + intros A m x1 x2 v1 v2. unfold update. + apply t_update_permute. +Qed. + +(** One last thing: For partial maps, it's convenient to introduce a + notion of map inclusion, stating that all the entries in one map + are also present in another: *) + +Definition includedin {A : Type} (m m' : partial_map A) := + forall x v, m x = Some v -> m' x = Some v. + +(** We can then show that map update preserves map inclusion, that is: *) + +Lemma includedin_update : forall (A : Type) (m m' : partial_map A) + (x : string) (vx : A), + includedin m m' -> + includedin (x |-> vx ; m) (x |-> vx ; m'). +Proof. + unfold includedin. + intros A m m' x vx H. + intros y vy. + destruct (eqb_spec x y) as [Hxy | Hxy]. + - rewrite Hxy. + rewrite update_eq. rewrite update_eq. intro H1. apply H1. + - rewrite update_neq. + + rewrite update_neq. + * apply H. + * apply Hxy. + + apply Hxy. +Qed. + +(** This property is quite useful for reasoning about languages with + variable binding -- e.g., the Simply Typed Lambda Calculus, which + we will see in _Programming Language Foundations_, where maps are + used to keep track of which program variables are defined in a + given scope. *) + +(* 2026-01-07 13:18 *) diff --git a/MapsTest.v b/MapsTest.v new file mode 100644 index 0000000..93c92c8 --- /dev/null +++ b/MapsTest.v @@ -0,0 +1,102 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Maps. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Maps. +Import Check. + +Goal True. + +idtac "------------------- t_update_same --------------------". +idtac " ". + +idtac "#> t_update_same". +idtac "Possible points: 2". +check_type @t_update_same ( +(forall (A : Type) (m : total_map A) (x : string), + @eq (forall _ : string, A) (@t_update A m x (m x)) m)). +idtac "Assumptions:". +Abort. +Print Assumptions t_update_same. +Goal True. +idtac " ". + +idtac "------------------- t_update_permute --------------------". +idtac " ". + +idtac "#> t_update_permute". +idtac "Possible points: 3". +check_type @t_update_permute ( +(forall (A : Type) (m : total_map A) (v1 v2 : A) (x1 x2 : string) + (_ : not (@eq string x2 x1)), + @eq (forall _ : string, A) (@t_update A (@t_update A m x2 v2) x1 v1) + (@t_update A (@t_update A m x1 v1) x2 v2))). +idtac "Assumptions:". +Abort. +Print Assumptions t_update_permute. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 5". +idtac "Max points - advanced: 5". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- t_update_same ---------". +Print Assumptions t_update_same. +idtac "---------- t_update_permute ---------". +Print Assumptions t_update_permute. +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Poly.v b/Poly.v new file mode 100644 index 0000000..ddb63dc --- /dev/null +++ b/Poly.v @@ -0,0 +1,1246 @@ +(** * Poly: Polymorphism and Higher-Order Functions *) + +(* Final reminder: Please do not put solutions to the exercises in + publicly accessible places. Thank you!! *) + +(* Suppress some annoying warnings from Rocq: *) +Set Warnings "-notation-overridden". +From LF Require Export Lists. + +(* ################################################################# *) +(** * Polymorphism *) + +(** In this chapter we continue our development of basic + concepts of functional programming. The critical new ideas are + _polymorphism_ (abstracting functions over the types of the data + they manipulate) and _higher-order functions_ (treating functions + as data). We begin with polymorphism. *) + +(* ================================================================= *) +(** ** Polymorphic Lists *) + +(** In the last chapter, we worked with lists containing just + numbers. Obviously, interesting programs also need to be able to + manipulate lists with elements from other types -- lists of + booleans, lists of lists, etc. We _could_ just define a new + inductive datatype for each of these, for example... *) + +Inductive boollist : Type := + | bool_nil + | bool_cons (b : bool) (l : boollist). + +(** ... but this would quickly become tedious: not only would we + have to make up different constructor names for each datatype, but -- + even worse -- we would also need to define new versions of all + the list manipulating functions ([length], [app], [rev], etc.) and all + their properties ([rev_length], [app_assoc], etc.) for each + new definition. *) + +(** To avoid all this repetition, Rocq supports _polymorphic_ + inductive type definitions. For example, here is a _polymorphic + list_ datatype. *) + +Inductive list (X:Type) : Type := + | nil + | cons (x : X) (l : list X). + +(** This is exactly like the definition of [natlist] from the + previous chapter, except that the [nat] argument to the [cons] + constructor has been replaced by an arbitrary type [X], a binding + for [X] has been added to the function header on the first line, + and the occurrences of [natlist] in the types of the constructors + have been replaced by [list X]. We can now write [list nat] instead + of [natlist]. + + What sort of thing is [list] itself? A good way to think about it + is that the definition of [list] is a _function_ from [Type]s to + [Inductive] definitions; or, to put it more concisely, [list] is a + function from [Type]s to [Type]s. For any particular type [X], + the type [list X] is the [Inductive]ly defined set of lists whose + elements are of type [X]. *) + + +Check list : Type -> Type. + +(** The [X] in the definition of [list] automatically becomes a + parameter to the constructors [nil] and [cons] -- that is, [nil] + and [cons] are now polymorphic constructors; when we use them, we + must provide, as a first argument, the type of the list they are + building. For example, [nil nat] is the empty list of type [nat]. *) + +Check (nil nat) : list nat. + +(** Similarly, [cons nat] adds an element of type [nat] to a list of + type [list nat]. Here is an example of forming a list containing + just the natural number 3. *) + +Check (cons nat 3 (nil nat)) : list nat. + +(** What might the type of [nil] be? We can read off the type + [list X] from the definition, but this omits the binding for [X] + which is the parameter to [list]. [Type -> list X] does not + explain the meaning of [X]. [(X : Type) -> list X] comes + closer. Rocq's notation for this situation is [forall X : Type, + list X]. *) + +Check nil : forall X : Type, list X. + +(** Similarly, the type of [cons] from the definition looks like + [X -> list X -> list X], but using this convention to explain the + meaning of [X] results in the type [forall X, X -> list X -> list + X]. *) + +Check cons : forall X : Type, X -> list X -> list X. + +(** (A side note on notations: In .v files, the "forall" + quantifier is spelled out in letters. In the corresponding HTML + files (and in the way some IDEs show .v files, depending on the + settings of their display controls), [forall] is usually typeset + as the standard mathematical "upside down A," though you'll still + see the spelled-out "forall" in a few places. This is just a + quirk of typesetting -- there is no difference in meaning.) *) + +(** Having to supply a type argument for every single use of a + list constructor would be rather burdensome; we will soon see ways + of reducing this annotation burden. *) + +Check (cons nat 2 (cons nat 1 (nil nat))) + : list nat. + +(** We can now go back and make polymorphic versions of all the + list-processing functions that we wrote before. Here is [repeat], + for example: *) + +Fixpoint repeat (X : Type) (x : X) (count : nat) : list X := + match count with + | 0 => nil X + | S count' => cons X x (repeat X x count') + end. + +(** As with [nil] and [cons], we can use [repeat] by applying it + first to a type and then to an element of this type (and a number): *) + +Example test_repeat1 : + repeat nat 4 2 = cons nat 4 (cons nat 4 (nil nat)). +Proof. reflexivity. Qed. + +(** To use [repeat] to build other kinds of lists, we simply + instantiate it with an appropriate type parameter: *) + +Example test_repeat2 : + repeat bool false 1 = cons bool false (nil bool). +Proof. reflexivity. Qed. + +(** **** Exercise: 2 stars, standard, optional (mumble_grumble) + + Consider the following two inductively defined types. *) + +Module MumbleGrumble. + +Inductive mumble : Type := + | a + | b (x : mumble) (y : nat) + | c. + +Inductive grumble (X:Type) : Type := + | d (m : mumble) + | e (x : X). + +(** Which of the following are well-typed elements of [grumble X] for + some type [X]? (Add YES or NO to each line.) + - [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 *) +End MumbleGrumble. +(** [] *) + +(* ----------------------------------------------------------------- *) +(** *** Type Annotation Inference *) + +(** Let's write the definition of [repeat] again, but this time we + won't specify the types of any of the arguments. Will Rocq still + accept it? *) + +Fixpoint repeat' X x count : list X := + match count with + | 0 => nil X + | S count' => cons X x (repeat' X x count') + end. + +(** Indeed it will. Let's see what type Rocq has assigned to [repeat']... *) + +Check repeat' + : forall X : Type, X -> nat -> list X. +Check repeat + : forall X : Type, X -> nat -> list X. + +(** It has exactly the same type as [repeat]. Rocq was able to + use _type inference_ to deduce what the types of [X], [x], and + [count] must be, based on how they are used. For example, since + [X] is used as an argument to [cons], it must be a [Type], since + [cons] expects a [Type] as its first argument; matching [count] + with [0] and [S] means it must be a [nat]; and so on. + + This powerful facility means we don't always have to write + explicit type annotations everywhere, although explicit type + annotations can still be quite useful as documentation and sanity + checks, so we will continue to use them much of the time. *) + +(* ----------------------------------------------------------------- *) +(** *** Type Argument Synthesis *) + +(** To use a polymorphic function, we need to pass it one or + more types in addition to its other arguments. For example, the + recursive call in the body of the [repeat] function above must + pass along the type [X]. But since the second argument to + [repeat] is an element of [X], it seems entirely obvious that the + first argument can only be [X] -- why should we have to write it + explicitly? + + Fortunately, Rocq permits us to avoid this kind of redundancy. In + place of any type argument we can write a "hole" [_], which can be + read as "Please try to figure out for yourself what belongs here." + More precisely, when Rocq encounters a [_], it will attempt to + _unify_ all locally available information -- the type of the + function being applied, the types of the other arguments, and the + type expected by the context in which the application appears -- + to determine what concrete type should replace the [_]. + + This may sound similar to type annotation inference -- and, indeed, + the two procedures rely on the same underlying mechanisms. Instead + of simply omitting the types of some arguments to a function, like + + repeat' X x count : list X := + + we can also replace the types with holes + + repeat' (X : _) (x : _) (count : _) : list X := + + to tell Rocq to attempt to infer the missing information. + + Using holes, the [repeat] function can be written like this: *) + +Fixpoint repeat'' X x count : list X := + match count with + | 0 => nil _ + | S count' => cons _ x (repeat'' _ x count') + end. + +(** In this instance, we don't save much by writing [_] instead of + [X]. But in many cases the difference in both keystrokes and + readability is nontrivial. For example, suppose we want to write + down a list containing the numbers [1], [2], and [3]. Instead of + this... *) + +Definition list123 := + cons nat 1 (cons nat 2 (cons nat 3 (nil nat))). + +(** ...we can use holes to write this: *) + +Definition list123' := + cons _ 1 (cons _ 2 (cons _ 3 (nil _))). + +(* ----------------------------------------------------------------- *) +(** *** Implicit Arguments *) + +(** In fact, we can go further and even avoid writing [_]'s in most + cases by telling Rocq _always_ to infer the type argument(s) of a + given function. + + The [Arguments] directive specifies the name of the function (or + constructor) and then lists the (leading) argument names to be + treated as implicit, each surrounded by curly braces. *) + +Arguments nil {X}. +Arguments cons {X}. +Arguments repeat {X}. + +(** Now we don't have to supply any type arguments at all in the example: *) + +Definition list123'' := cons 1 (cons 2 (cons 3 nil)). + +(** Alternatively, we can declare an argument to be implicit + when defining the function itself, by surrounding it in curly + braces instead of parens. For example: *) + +Fixpoint repeat''' {X : Type} (x : X) (count : nat) : list X := + match count with + | 0 => nil + | S count' => cons x (repeat''' x count') + end. + +(** (Note that we didn't even have to provide a type argument to the + recursive call to [repeat''']. Indeed, it would be invalid to + provide one, because Rocq is not expecting it.) *) + +(** We will use the latter style whenever possible, but we will + continue to use explicit [Argument] declarations for [Inductive] + constructors. The reason for this is that marking the parameter + of an inductive type as implicit causes it to become implicit for + the type itself, not just for its constructors. For instance, + consider the following alternative definition of the [list] + type: *) + +Inductive list' {X:Type} : Type := + | nil' + | cons' (x : X) (l : list'). + +(** Because [X] is declared as implicit for the _entire_ inductive + definition including [list'] itself, we now have to write just + [list'] whether we are talking about lists of numbers or booleans + or anything else, rather than [list' nat] or [list' bool] or + whatever; this is a step too far. *) + +(** Let's finish by re-implementing a few other standard list + functions on our new polymorphic lists... *) + +Fixpoint app {X : Type} (l1 l2 : list X) : list X := + match l1 with + | nil => l2 + | cons h t => cons h (app t l2) + end. + +Fixpoint rev {X:Type} (l:list X) : list X := + match l with + | nil => nil + | cons h t => app (rev t) (cons h nil) + end. + +Fixpoint length {X : Type} (l : list X) : nat := + match l with + | nil => 0 + | cons _ l' => S (length l') + end. + +Example test_rev1 : + rev (cons 1 (cons 2 nil)) = (cons 2 (cons 1 nil)). +Proof. reflexivity. Qed. + +Example test_rev2: + rev (cons true nil) = cons true nil. +Proof. reflexivity. Qed. + +Example test_length1: length (cons 1 (cons 2 (cons 3 nil))) = 3. +Proof. reflexivity. Qed. + +(* ----------------------------------------------------------------- *) +(** *** Supplying Type Arguments Explicitly *) + +(** One small problem with declaring arguments to be implicit is + that, once in a while, Rocq does not have enough local information + to determine a type argument; in such cases, we need to tell Rocq + that we want to give the argument explicitly just this time. For + example, suppose we write this: *) + +Fail Definition mynil := nil. + +(** (The [Fail] qualifier that appears before [Definition] can be + used with _any_ command, and is used to ensure that that command + indeed fails when executed. If the command does fail, Rocq prints + the corresponding error message, but continues processing the rest + of the file.) + + Here, Rocq gives us an error because it doesn't know what type + argument to supply to [nil]. We can help it by providing an + explicit type declaration (so that Rocq has more information + available when it gets to the "application" of [nil]): *) + +Definition mynil : list nat := nil. + +(** Alternatively, we can disable the implicit argument to [nil] by + prefixing the function name with [@]. This allows us to apply [@nil] + _explicitly_ to an appropriate type. *) + +Check @nil : forall X : Type, list X. + +Definition mynil' := @nil nat. + +(** (Note that we cannot just write [nil nat] here, without the + [@]: the [Implicit Arguments] declaration above means that [nil + nat] is now interpreted by Rocq as [@nil ?X nat], where [?X] is + some unknown type that should be filled in by implicit argument + synthesis.) *) +Fail Check (nil nat). + +(** Using argument synthesis and implicit arguments, we can + define convenient notation for lists, as before. Since we have + made the constructor type arguments implicit, Rocq will know to + automatically infer these when we use the notations. *) + +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). + +(** Now lists can be written just the way we'd hope: *) + +Definition list123''' := [1; 2; 3]. + +(* ----------------------------------------------------------------- *) +(** *** Exercises *) + +(** **** Exercise: 2 stars, standard (poly_exercises) + + Here are a few simple exercises, just like ones in the [Lists] + chapter, for practice with polymorphism. Complete the proofs + below. *) + +Theorem app_nil_r : forall (X : Type), forall l : list X, + l ++ [] = l. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem app_assoc : forall A (l m n : list A), + l ++ m ++ n = (l ++ m) ++ n. +Proof. + (* FILL IN HERE *) Admitted. + +Lemma app_length : forall (X : Type) (l1 l2 : list X), + length (l1 ++ l2) = length l1 + length l2. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (more_poly_exercises) + + Here are some slightly more interesting ones... *) + +Theorem rev_app_distr: forall X (l1 l2 : list X), + rev (l1 ++ l2) = rev l2 ++ rev l1. +Proof. + (* FILL IN HERE *) Admitted. + +Theorem rev_involutive : forall X : Type, forall l : list X, + rev (rev l) = l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Polymorphic Pairs *) + +(** Following the same pattern, the definition for pairs of + numbers that we gave in the last chapter can be generalized to + _polymorphic pairs_, often called _products_: *) + +Inductive prod (X Y : Type) : Type := +| pair (x : X) (y : Y). + +Arguments pair {X} {Y}. + +(** As with lists, we make the type arguments implicit and define the + familiar concrete notation. *) + +Notation "( x , y )" := (pair x y). + +(** We can also use the [Notation] mechanism to define the standard + notation for _product types_ (i.e., the types of pairs): *) + +Notation "X * Y" := (prod X Y) : type_scope. + +(** (The annotation [: type_scope] tells Rocq that this abbreviation + should only be used when parsing types, not when parsing + expressions. This avoids a clash with the multiplication + symbol.) *) + +(** It is easy at first to get [(x,y)] and [X*Y] confused. + Remember that [(x,y)] is a _value_ built from two other values, + while [X*Y] is a _type_ built from two other types. If [x] has + type [X] and [y] has type [Y], then [(x,y)] has type [X*Y]. *) + +(** The first and second projection functions now look pretty + much as they would in any functional programming language. *) + +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. + +(** The following function takes two lists and combines them + into a list of pairs. In other functional languages, it is often + called [zip]; we call it [combine] for consistency with Rocq's + standard library. *) + +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. + +(** **** Exercise: 1 star, standard, optional (combine_checks) + + Try answering the following questions on paper and + checking your answers in Rocq: + - What is the type of [combine] (i.e., what does [Check + @combine] print?) + - What does + + Compute (combine [1;2] [false;false;true;true]). + + print? + + [] *) + +(** **** Exercise: 2 stars, standard, especially useful (split) + + The function [split] is the right inverse of [combine]: it takes a + list of pairs and returns a pair of lists. In many functional + languages, it is called [unzip]. + + Fill in the definition of [split] below. Make sure it passes the + given unit test. *) + +Fixpoint split {X Y : Type} (l : list (X*Y)) : (list X) * (list Y) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_split: + split [(1,false);(2,false)] = ([1;2],[false;false]). +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Polymorphic Options *) + +(** Our last polymorphic type for now is _polymorphic options_, + which generalize [natoption] from the previous chapter. (We put + the definition inside a module because the standard library + already defines [option] and it's this one that we want to use + below.) *) + +Module OptionPlayground. + +Inductive option (X:Type) : Type := + | Some (x : X) + | None. + +Arguments Some {X}. +Arguments None {X}. + +End OptionPlayground. + +(** We can now rewrite the [nth_error] function so that it works + with any type of lists. *) + +Fixpoint nth_error {X : Type} (l : list X) (n : nat) + : option X := + match l with + | nil => None + | a :: l' => match n with + | O => Some a + | S n' => nth_error l' n' + end + end. + +Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4. +Proof. reflexivity. Qed. +Example test_nth_error2 : nth_error [[1];[2]] 1 = Some [2]. +Proof. reflexivity. Qed. +Example test_nth_error3 : nth_error [true] 2 = None. +Proof. reflexivity. Qed. + +(** **** Exercise: 1 star, standard, optional (hd_error_poly) + + Complete the definition of a polymorphic version of the + [hd_error] function from the last chapter. Be sure that it + passes the unit tests below. *) + +Definition hd_error {X : Type} (l : list X) : option X + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** Once again, to force the implicit arguments to be explicit, + we can use [@] before the name of the function. *) + +Check @hd_error : forall X : Type, list X -> option X. + +Example test_hd_error1 : hd_error [1;2] = Some 1. + (* FILL IN HERE *) Admitted. +Example test_hd_error2 : hd_error [[1];[2]] = Some [1]. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Functions as Data *) + +(** Like most modern programming languages -- especially other + "functional" languages, including OCaml, Haskell, Racket, Scala, + Clojure, etc. -- Rocq treats functions as first-class citizens, + allowing them to be passed as arguments to other functions, + returned as results, stored in data structures, etc. *) + +(* ================================================================= *) +(** ** Higher-Order Functions *) + +(** Functions that manipulate other functions are often called + _higher-order_ functions. Here's a simple one: *) + +Definition doit3times {X : Type} (f : X -> X) (n : X) : X := + f (f (f n)). + +(** The argument [f] here is itself a function (from [X] to + [X]); the body of [doit3times] applies [f] three times to some + value [n]. *) + +Check @doit3times : forall X : Type, (X -> X) -> X -> X. + +Example test_doit3times: doit3times minustwo 9 = 3. +Proof. reflexivity. Qed. + +Example test_doit3times': doit3times negb true = false. +Proof. reflexivity. Qed. + +(* ================================================================= *) +(** ** Filter *) + +(** Here is a more useful higher-order function, taking a list + of [X]s and a _predicate_ on [X] (a function from [X] to [bool]) + and "filtering" the list to yield a new list containing just + those elements for which the predicate returns [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. + +(** For example, if we apply [filter] to the predicate [even] + and a list of numbers [l], it returns a list containing just the + even members of [l]. *) + +Example test_filter1: filter even [1;2;3;4] = [2;4]. +Proof. reflexivity. Qed. + +Definition length_is_1 {X : Type} (l : list X) : bool := + (length l) =? 1. + +Example test_filter2: + filter length_is_1 + [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] + = [ [3]; [4]; [8] ]. +Proof. reflexivity. Qed. + +(** We can use [filter] to give a concise version of the + [countoddmembers] function from the [Lists] chapter. *) + +Definition countoddmembers' (l : list nat) : nat := + length (filter odd 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. + +(* ================================================================= *) +(** ** Anonymous Functions *) + +(** It is arguably a little sad, in the example just above, to + be forced to define the function [length_is_1] and give it a name + just to be able to pass it as an argument to [filter], since we + will probably never use it again. Indeed, when using higher-order + functions, we _often_ want to pass as arguments "one-off" + functions that we will never use again; having to give each of + these functions a name would be tedious. + + Fortunately, there is a better way. We can construct a function + "on the fly" without declaring it at the top level or giving it a + name. *) + +Example test_anon_fun': + doit3times (fun n => n * n) 2 = 256. +Proof. reflexivity. Qed. + +(** The expression [(fun n => n * n)] can be read as "the function + that, given a number [n], yields [n * n]." *) + +(** Here is the [filter] example, rewritten to use an anonymous + function. *) + +Example test_filter2': + filter (fun l => (length l) =? 1) + [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] + = [ [3]; [4]; [8] ]. +Proof. reflexivity. Qed. + +(** **** Exercise: 2 stars, standard (filter_even_gt7) + + Use [filter] (instead of [Fixpoint]) to write a Rocq function + [filter_even_gt7] that takes a list of natural numbers as input + and returns a list of just those that are even and greater than + 7. *) + +Definition filter_even_gt7 (l : list nat) : list nat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(** **** Exercise: 3 stars, standard (partition) + + Use [filter] to write a Rocq function [partition] that, + given a set [X], a predicate of type [X -> bool] and a [list X], + should return a pair of lists. The first member of the pair is + the sublist of the original list containing the elements + that satisfy the test, and the second is the sublist containing + those that fail the test. The order of elements in the two + sublists should be the same as their order in the original list. *) + +Definition partition {X : Type} + (test : X -> bool) + (l : list X) + : list X * list X + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_partition1: partition odd [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 *) + +(** Another handy higher-order function is called [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. + +(** It takes a function [f] and a list [ l = [n1, n2, n3, ...] ] + and returns the list [ [f n1, f n2, f n3,...] ], where [f] has + been applied to each element of [l] in turn. For example: *) + +Example test_map1: map (fun x => plus 3 x) [2;0;2] = [5;3;5]. +Proof. reflexivity. Qed. + +(** The element types of the input and output lists need not be + the same, since [map] takes _two_ type arguments, [X] and [Y]; it + can thus be applied to a list of numbers and a function from + numbers to booleans to yield a list of booleans: *) + +Example test_map2: + map odd [2;1;2;5] = [false;true;false;true]. +Proof. reflexivity. Qed. + +(** It can even be applied to a list of numbers and + a function from numbers to _lists_ of booleans to + yield a _list of lists_ of booleans: *) + +Example test_map3: + map (fun n => [even n;odd n]) [2;1;2;5] + = [[true;false];[false;true];[true;false];[false;true]]. +Proof. reflexivity. Qed. + +(* ----------------------------------------------------------------- *) +(** *** Exercises *) + +(** **** Exercise: 3 stars, standard (map_rev) + + Show that [map] and [rev] commute. (Hint: You may need to define an + auxiliary lemma.) *) + +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. +(** [] *) + +(** **** Exercise: 2 stars, standard, especially useful (flat_map) + + The function [map] maps a [list X] to a [list Y] using a function + of type [X -> Y]. We can define a similar function, [flat_map], + which maps a [list X] to a [list Y] using a function [f] of type + [X -> list Y]. Your definition should work by 'flattening' the + results of [f], like so: + + 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 + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +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. +(** [] *) + +(** Lists are not the only inductive type for which [map] makes sense. + Here is a [map] for the [option] type: *) + +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. + +(** **** Exercise: 2 stars, standard, optional (implicit_args) + + The definitions and uses of [filter] and [map] use implicit + arguments in many places. Replace the curly braces around the + implicit arguments with parentheses, and then fill in explicit + type parameters where necessary and use Rocq to check that you've + done so correctly. (This exercise is not to be turned in; it is + probably easiest to do it on a _copy_ of this file that you can + throw away afterwards.) +*) +(** [] *) + +(* ================================================================= *) +(** ** Fold *) + +(** An even more powerful higher-order function is called + [fold]. This function is the inspiration for the "[reduce]" + operation that lies at the heart of Google's map/reduce + distributed programming framework. *) + +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. + +(** Intuitively, the behavior of the [fold] operation is to + insert a given binary operator [f] between every pair of elements + in a given list. For example, [ fold plus [1;2;3;4] ] intuitively + means [1+2+3+4]. To make this precise, we also need a "starting + element" that serves as the initial second input to [f]. So, for + example, + + fold plus [1;2;3;4] 0 + + yields + + 1 + (2 + (3 + (4 + 0))). +]] *) + +Example fold_example1 : + fold andb [true;true;false;true] true = false. +Proof. reflexivity. Qed. + +Example fold_example2 : + fold mult [1;2;3;4] 1 = 24. +Proof. reflexivity. Qed. + +Example fold_example3 : + fold app [[1];[];[2;3];[4]] [] = [1;2;3;4]. +Proof. reflexivity. Qed. + +Example foldexample4 : + fold (fun l n => length l + n) [[1];[];[2;3;2];[4]] 0 = 5. +Proof. reflexivity. Qed. + +(** **** Exercise: 1 star, standard, optional (fold_types_different) + + Observe that the type of [fold] is parameterized by _two_ type + variables, [X] and [Y], and the parameter [f] is a binary operator + that takes an [X] and a [Y] and returns a [Y]. Example + [foldexample4] above shows one instance where it is useful for [X] + and [Y] to be different. Can you think of any others? *) + +(* FILL IN HERE + + [] *) + +(* ================================================================= *) +(** ** Functions That Construct Functions *) + +(** Most of the higher-order functions we have talked about so + far take functions as arguments. Let's look at some examples that + involve _returning_ functions as the results of other functions. + To begin, here is a function that takes a value [x] (drawn from + some type [X]) and returns a function from [nat] to [X] that + yields [x] whenever it is called, ignoring its [nat] argument. *) + +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. + +(** In fact, the multiple-argument functions we have already + seen are also examples of passing functions as data. To see why, + recall the type of [plus]. *) + +Check plus : nat -> nat -> nat. + +Definition plus3 := plus 3. +Check plus3 : nat -> nat. + +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. + +(** Similarly, we can write: *) +Definition fold_plus := + fold plus. + +Check fold_plus : list nat -> nat -> nat. + +(** What's happening here is called *partial application*. In + Rocq, the type constructor [->] is right-associative, meaning a + function type like [A -> B -> C] is parsed like [A -> (B -> C)], + or "a function from A to a function from B to C." + + We can think of [fold] not as a three-argument function, but as a + one-argument function that: + + 1. Takes an argument [f] of type [X -> Y -> Y] + 2. Returns a function of type [list X -> Y -> Y] that "remembers" + [f]] + + When we write [fold plus], we're giving [fold] its first argument, + [plus], and getting back a specialized function that can sum up + the elements of any list of numbers. This new function still expects + two more arguments: a list and a starting value. *) + +(* ################################################################# *) +(** * Additional Exercises *) + +Module Exercises. + +(** **** Exercise: 2 stars, standard (fold_length) + + Many common functions on lists can be implemented in terms of + [fold]. For example, here is an alternative definition of [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. + +(** Prove the correctness of [fold_length]. + + Hint: You may end up in a situation where you feel like [simpl] should + be able to simplify [fold_length], but does not do anything. In such + cases, you can use the [unfold] tactic to inline the definition of a + function prior to simplification, e.g., [unfold fold_length. simpl.]. + This tactic will be discussed further in the following chapter. *) + +Theorem fold_length_correct : forall X (l : list X), + fold_length l = length l. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (fold_map) + + We can also define [map] in terms of [fold]. Finish [fold_map] + below. *) + +Definition fold_map {X Y: Type} (f: X -> Y) (l: list X) : list Y + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** Write down a theorem [fold_map_correct] stating that [fold_map] is + correct, and prove it in Rocq. (Hint: again, remember that + [unfold]ing before [simpl]ifying may help.) *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_fold_map : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 2 stars, advanced (currying) + + The type [X -> Y -> Z] can be read as describing functions that + take two arguments, one of type [X] and another of type [Y], and + return an output of type [Z]. Recall from our discussion + of partial application that this type is written [X -> (Y -> Z)] + when fully parenthesized. That is, if we have [f : X -> Y -> Z], + and we give [f] an input of type [X], it will give us as output + a function of type [Y -> Z]. If we then give that function an + input of type [Y], it will return an output of type [Z]. That + is, every function in Rocq takes only one input, but some + functions return a function as output. This is precisely + what enables partial application, as we saw above with [plus3]. + + By contrast, functions of type [X * Y -> Z] -- which when fully + parenthesized is written [(X * Y) -> Z] -- require their single + input to be a pair. Both arguments must be given at once; there + is no possibility of partial application. + + It is possible to convert a function between these two types. + Converting from [X * Y -> Z] to [X -> Y -> Z] is called + _currying_, in honor of the logician Haskell Curry. Converting + from [X -> Y -> Z] to [X * Y -> Z] is called _uncurrying_. *) + +(** We can define currying as follows: *) + +Definition prod_curry {X Y Z : Type} + (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y). + +(** As an exercise, define its inverse, [prod_uncurry]. Then prove + the theorems below to show that the two are really inverses. *) + +Definition prod_uncurry {X Y Z : Type} + (f : X -> Y -> Z) (p : X * Y) : Z + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +(** As a (trivial) example of the usefulness of currying, we can use it + to shorten one of the examples that we saw above: *) + +Example test_map1': map (plus 3) [2;0;2] = [5;3;5]. +Proof. reflexivity. Qed. + +(** Thought exercise: before running the following commands, can you + calculate the types of [prod_curry] and [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. +(** [] *) + +(** **** Exercise: 2 stars, advanced, optional (nth_error_informal) + + Recall the definition of the [nth_error] function: + + Fixpoint nth_error {X : Type} (l : list X) (n : nat) : option X := + match l with + | [] => None + | a :: l' => if n =? O then Some a else nth_error l' (pred n) + end. + + Write a careful informal proof of the following theorem: + + forall X l n, length l = n -> @nth_error X l n = None + + Make sure to state the induction hypothesis _explicitly_. +*) +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_informal_proof : option (nat*string) := None. +(** [] *) + +(* ================================================================= *) +(** ** Church Numerals (Advanced) *) + +(** The following exercises explore an alternative way of defining + natural numbers using the _Church numerals_, which are named after + their inventor, the mathematician Alonzo Church. We can represent + a natural number [n] as a function that takes a function [f] as a + parameter and returns [f] iterated [n] times. *) + +Module Church. +Definition cnat := forall X : Type, (X -> X) -> X -> X. + +(** Let's see how to write some numbers with this notation. Iterating + a function once should be the same as just applying it. Thus: *) + +Definition one : cnat := + fun (X : Type) (f : X -> X) (x : X) => f x. + +(** Similarly, [two] should apply [f] twice to its argument: *) + +Definition two : cnat := + fun (X : Type) (f : X -> X) (x : X) => f (f x). + +(** Defining [zero] is somewhat trickier: how can we "apply a function + zero times"? The answer is actually simple: just return the + argument untouched. *) + +Definition zero : cnat := + fun (X : Type) (f : X -> X) (x : X) => x. + +(** More generally, a number [n] can be written as [fun X f x => f (f + ... (f x) ...)], with [n] occurrences of [f]. Let's informally + notate that as [fun X f x => f^n x], with the convention that [f^0 x] + is just [x]. Note how the [doit3times] function we've defined + previously is actually just the Church representation of [3]. *) + +Definition three : cnat := @doit3times. + +(** So [n X f x] represents "do it [n] times", where [n] is a Church + numerals and "it" means applying [f] starting with [x]. + + Another way to think about the Church representation is that + function [f] represents the successor operation on [X], and value + [x] represents the zero element of [X]. We could even rewrite + with those names to make it clearer: *) + +Definition zero' : cnat := + fun (X : Type) (succ : X -> X) (zero : X) => zero. +Definition one' : cnat := + fun (X : Type) (succ : X -> X) (zero : X) => succ zero. +Definition two' : cnat := + fun (X : Type) (succ : X -> X) (zero : X) => succ (succ zero). + +(** If we passed in [S] as [succ] and [O] as [zero], we'd even get the Peano + naturals as a result: *) + +Example zero_church_peano : zero nat S O = 0. +Proof. reflexivity. Qed. + +Example one_church_peano : one nat S O = 1. +Proof. reflexivity. Qed. + +Example two_church_peano : two nat S O = 2. +Proof. reflexivity. Qed. + +(** One very interesting implication of the Church numerals is that we + don't strictly need the natural numbers to be built-in to a + functional programming language, or even to be definable with an + inductive data type. It's possible to represent them purely (if + not efficiently) with functions. + + Of course, it's not enough just to "represent" numerals; we need + to be able to do arithmetic with the representation. Show that we + can by completing the definitions of the following functions. Make + sure that the corresponding unit tests pass by proving them with + [reflexivity]. *) + +(** **** Exercise: 2 stars, advanced (church_scc) *) + +(** Define a function that computes the successor of a Church numeral. + Given a Church numeral [n], its successor [scc n] should iterate + its function argument once more than [n]. That is, given [fun X f x + => f^n x] as input, [scc] should produce [fun X f x => f^(n+1) x] as + output. In other words, do it [n] times, then do it once more. *) + +Definition scc (n : cnat) : cnat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example scc_1 : scc zero = one. +Proof. (* FILL IN HERE *) Admitted. + +Example scc_2 : scc one = two. +Proof. (* FILL IN HERE *) Admitted. + +Example scc_3 : scc two = three. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 3 stars, advanced (church_plus) *) + +(** Define a function that computes the addition of two Church + numerals. Given [fun X f x => f^n x] and [fun X f x => f^m x] as + input, [plus] should produce [fun X f x => f^(n + m) x] as output. + In other words, do it [n] times, then do it [m] more times. + + Hint: the "zero" argument to a Church numeral need not be just + [x]. *) + +Definition plus (n m : cnat) : cnat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example plus_1 : plus zero one = one. +Proof. (* FILL IN HERE *) Admitted. + +Example plus_2 : plus two three = plus three two. +Proof. (* FILL IN HERE *) Admitted. + +Example plus_3 : + plus (plus two two) three = plus one (plus three three). +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 3 stars, advanced (church_mult) *) + +(** Define a function that computes the multiplication of two Church + numerals. + + Hint: the "successor" argument to a Church numeral need not be + just [f]. + + Warning: Rocq will not let you pass [cnat] itself as the type [X] + argument to a Church numeral; you will get a "Universe + inconsistency" error. That is Rocq's way of preventing a paradox in + which a type contains itself. So leave the type argument + unchanged. *) + +Definition mult (n m : cnat) : cnat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example mult_1 : mult one one = one. +Proof. (* FILL IN HERE *) Admitted. + +Example mult_2 : mult zero (plus three three) = zero. +Proof. (* FILL IN HERE *) Admitted. + +Example mult_3 : mult two three = plus three three. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(** **** Exercise: 3 stars, advanced (church_exp) *) + +(** Exponentiation: *) + +(** Define a function that computes the exponentiation of two Church + numerals. + + Hint: the type argument to a Church numeral need not just be [X]. + But again, you cannot pass [cnat] itself as the type argument. + Finding the right type can be tricky. *) + +Definition exp (n m : cnat) : cnat + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example exp_1 : exp two two = plus two two. +Proof. (* FILL IN HERE *) Admitted. + +Example exp_2 : exp three zero = one. +Proof. (* FILL IN HERE *) Admitted. + +Example exp_3 : exp three two = plus (mult two (mult two two)) one. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +End Church. +End Exercises. + +(* 2026-01-07 13:17 *) diff --git a/PolyTest.v b/PolyTest.v new file mode 100644 index 0000000..5850022 --- /dev/null +++ b/PolyTest.v @@ -0,0 +1,552 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Poly. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Poly. +Import Check. + +Goal True. + +idtac "------------------- poly_exercises --------------------". +idtac " ". + +idtac "#> app_nil_r". +idtac "Possible points: 0.5". +check_type @app_nil_r ( +(forall (X : Type) (l : list X), @eq (list X) (@app X l (@nil X)) l)). +idtac "Assumptions:". +Abort. +Print Assumptions app_nil_r. +Goal True. +idtac " ". + +idtac "#> app_assoc". +idtac "Possible points: 1". +check_type @app_assoc ( +(forall (A : Type) (l m n : list A), + @eq (list A) (@app A l (@app A m n)) (@app A (@app A l m) n))). +idtac "Assumptions:". +Abort. +Print Assumptions app_assoc. +Goal True. +idtac " ". + +idtac "#> app_length". +idtac "Possible points: 0.5". +check_type @app_length ( +(forall (X : Type) (l1 l2 : list X), + @eq nat (@length X (@app X l1 l2)) (Nat.add (@length X l1) (@length X l2)))). +idtac "Assumptions:". +Abort. +Print Assumptions app_length. +Goal True. +idtac " ". + +idtac "------------------- more_poly_exercises --------------------". +idtac " ". + +idtac "#> rev_app_distr". +idtac "Possible points: 1". +check_type @rev_app_distr ( +(forall (X : Type) (l1 l2 : list X), + @eq (list X) (@rev X (@app X l1 l2)) (@app X (@rev X l2) (@rev X l1)))). +idtac "Assumptions:". +Abort. +Print Assumptions rev_app_distr. +Goal True. +idtac " ". + +idtac "#> rev_involutive". +idtac "Possible points: 1". +check_type @rev_involutive ( +(forall (X : Type) (l : list X), @eq (list X) (@rev X (@rev X l)) l)). +idtac "Assumptions:". +Abort. +Print Assumptions rev_involutive. +Goal True. +idtac " ". + +idtac "------------------- split --------------------". +idtac " ". + +idtac "#> split". +idtac "Possible points: 1". +check_type @split ((forall (X Y : Type) (_ : list (prod X Y)), prod (list X) (list Y))). +idtac "Assumptions:". +Abort. +Print Assumptions split. +Goal True. +idtac " ". + +idtac "#> test_split". +idtac "Possible points: 1". +check_type @test_split ( +(@eq (prod (list nat) (list bool)) + (@split nat bool + (@cons (prod nat bool) (@pair nat bool 1 false) + (@cons (prod nat bool) (@pair nat bool 2 false) + (@nil (prod nat bool))))) + (@pair (list nat) (list bool) (@cons nat 1 (@cons nat 2 (@nil nat))) + (@cons bool false (@cons bool false (@nil bool)))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_split. +Goal True. +idtac " ". + +idtac "------------------- filter_even_gt7 --------------------". +idtac " ". + +idtac "#> test_filter_even_gt7_1". +idtac "Possible points: 1". +check_type @test_filter_even_gt7_1 ( +(@eq (list nat) + (filter_even_gt7 + (@cons nat 1 + (@cons nat 2 + (@cons nat 6 + (@cons nat 9 + (@cons nat 10 + (@cons nat 3 (@cons nat 12 (@cons nat 8 (@nil nat)))))))))) + (@cons nat 10 (@cons nat 12 (@cons nat 8 (@nil nat)))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_filter_even_gt7_1. +Goal True. +idtac " ". + +idtac "#> test_filter_even_gt7_2". +idtac "Possible points: 1". +check_type @test_filter_even_gt7_2 ( +(@eq (list nat) + (filter_even_gt7 + (@cons nat 5 + (@cons nat 2 (@cons nat 6 (@cons nat 19 (@cons nat 129 (@nil nat))))))) + (@nil nat))). +idtac "Assumptions:". +Abort. +Print Assumptions test_filter_even_gt7_2. +Goal True. +idtac " ". + +idtac "------------------- partition --------------------". +idtac " ". + +idtac "#> partition". +idtac "Possible points: 1". +check_type @partition ( +(forall (X : Type) (_ : forall _ : X, bool) (_ : list X), + prod (list X) (list X))). +idtac "Assumptions:". +Abort. +Print Assumptions partition. +Goal True. +idtac " ". + +idtac "#> test_partition1". +idtac "Possible points: 1". +check_type @test_partition1 ( +(@eq (prod (list nat) (list nat)) + (@partition nat odd + (@cons nat 1 + (@cons nat 2 (@cons nat 3 (@cons nat 4 (@cons nat 5 (@nil nat))))))) + (@pair (list nat) (list nat) + (@cons nat 1 (@cons nat 3 (@cons nat 5 (@nil nat)))) + (@cons nat 2 (@cons nat 4 (@nil nat)))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_partition1. +Goal True. +idtac " ". + +idtac "#> test_partition2". +idtac "Possible points: 1". +check_type @test_partition2 ( +(@eq (prod (list nat) (list nat)) + (@partition nat (fun _ : nat => false) + (@cons nat 5 (@cons nat 9 (@cons nat 0 (@nil nat))))) + (@pair (list nat) (list nat) (@nil nat) + (@cons nat 5 (@cons nat 9 (@cons nat 0 (@nil nat))))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_partition2. +Goal True. +idtac " ". + +idtac "------------------- map_rev --------------------". +idtac " ". + +idtac "#> map_rev". +idtac "Possible points: 3". +check_type @map_rev ( +(forall (X Y : Type) (f : forall _ : X, Y) (l : list X), + @eq (list Y) (@map X Y f (@rev X l)) (@rev Y (@map X Y f l)))). +idtac "Assumptions:". +Abort. +Print Assumptions map_rev. +Goal True. +idtac " ". + +idtac "------------------- flat_map --------------------". +idtac " ". + +idtac "#> flat_map". +idtac "Possible points: 1". +check_type @flat_map ( +(forall (X Y : Type) (_ : forall _ : X, list Y) (_ : list X), list Y)). +idtac "Assumptions:". +Abort. +Print Assumptions flat_map. +Goal True. +idtac " ". + +idtac "#> test_flat_map1". +idtac "Possible points: 1". +check_type @test_flat_map1 ( +(@eq (list nat) + (@flat_map nat nat + (fun n : nat => @cons nat n (@cons nat n (@cons nat n (@nil nat)))) + (@cons nat 1 (@cons nat 5 (@cons nat 4 (@nil nat))))) + (@cons nat 1 + (@cons nat 1 + (@cons nat 1 + (@cons nat 5 + (@cons nat 5 + (@cons nat 5 + (@cons nat 4 (@cons nat 4 (@cons nat 4 (@nil nat)))))))))))). +idtac "Assumptions:". +Abort. +Print Assumptions test_flat_map1. +Goal True. +idtac " ". + +idtac "------------------- fold_length --------------------". +idtac " ". + +idtac "#> Exercises.fold_length_correct". +idtac "Possible points: 2". +check_type @Exercises.fold_length_correct ( +(forall (X : Type) (l : list X), + @eq nat (@Exercises.fold_length X l) (@length X l))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.fold_length_correct. +Goal True. +idtac " ". + +idtac "------------------- fold_map --------------------". +idtac " ". + +idtac "#> Manually graded: Exercises.fold_map". +idtac "Possible points: 3". +print_manual_grade Exercises.manual_grade_for_fold_map. +idtac " ". + +idtac "------------------- currying --------------------". +idtac " ". + +idtac "#> Exercises.uncurry_curry". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.uncurry_curry ( +(forall (X Y Z : Type) (f : forall (_ : X) (_ : Y), Z) (x : X) (y : Y), + @eq Z (@Exercises.prod_curry X Y Z (@Exercises.prod_uncurry X Y Z f) x y) + (f x y))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.uncurry_curry. +Goal True. +idtac " ". + +idtac "#> Exercises.curry_uncurry". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.curry_uncurry ( +(forall (X Y Z : Type) (f : forall _ : prod X Y, Z) (p : prod X Y), + @eq Z (@Exercises.prod_uncurry X Y Z (@Exercises.prod_curry X Y Z f) p) + (f p))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.curry_uncurry. +Goal True. +idtac " ". + +idtac "------------------- church_scc --------------------". +idtac " ". + +idtac "#> Exercises.Church.scc_2". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.scc_2 ( +(@eq Exercises.Church.cnat (Exercises.Church.scc Exercises.Church.one) + Exercises.Church.two)). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.scc_2. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.scc_3". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.scc_3 ( +(@eq Exercises.Church.cnat (Exercises.Church.scc Exercises.Church.two) + Exercises.Church.three)). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.scc_3. +Goal True. +idtac " ". + +idtac "------------------- church_plus --------------------". +idtac " ". + +idtac "#> Exercises.Church.plus_1". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.plus_1 ( +(@eq Exercises.Church.cnat + (Exercises.Church.plus Exercises.Church.zero Exercises.Church.one) + Exercises.Church.one)). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.plus_1. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.plus_2". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.plus_2 ( +(@eq Exercises.Church.cnat + (Exercises.Church.plus Exercises.Church.two Exercises.Church.three) + (Exercises.Church.plus Exercises.Church.three Exercises.Church.two))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.plus_2. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.plus_3". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.plus_3 ( +(@eq Exercises.Church.cnat + (Exercises.Church.plus + (Exercises.Church.plus Exercises.Church.two Exercises.Church.two) + Exercises.Church.three) + (Exercises.Church.plus Exercises.Church.one + (Exercises.Church.plus Exercises.Church.three Exercises.Church.three)))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.plus_3. +Goal True. +idtac " ". + +idtac "------------------- church_mult --------------------". +idtac " ". + +idtac "#> Exercises.Church.mult_1". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.mult_1 ( +(@eq Exercises.Church.cnat + (Exercises.Church.mult Exercises.Church.one Exercises.Church.one) + Exercises.Church.one)). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.mult_1. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.mult_2". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.mult_2 ( +(@eq Exercises.Church.cnat + (Exercises.Church.mult Exercises.Church.zero + (Exercises.Church.plus Exercises.Church.three Exercises.Church.three)) + Exercises.Church.zero)). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.mult_2. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.mult_3". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.mult_3 ( +(@eq Exercises.Church.cnat + (Exercises.Church.mult Exercises.Church.two Exercises.Church.three) + (Exercises.Church.plus Exercises.Church.three Exercises.Church.three))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.mult_3. +Goal True. +idtac " ". + +idtac "------------------- church_exp --------------------". +idtac " ". + +idtac "#> Exercises.Church.exp_1". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.exp_1 ( +(@eq Exercises.Church.cnat + (Exercises.Church.exp Exercises.Church.two Exercises.Church.two) + (Exercises.Church.plus Exercises.Church.two Exercises.Church.two))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.exp_1. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.exp_2". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.exp_2 ( +(@eq Exercises.Church.cnat + (Exercises.Church.exp Exercises.Church.three Exercises.Church.zero) + Exercises.Church.one)). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.exp_2. +Goal True. +idtac " ". + +idtac "#> Exercises.Church.exp_3". +idtac "Advanced". +idtac "Possible points: 1". +check_type @Exercises.Church.exp_3 ( +(@eq Exercises.Church.cnat + (Exercises.Church.exp Exercises.Church.three Exercises.Church.two) + (Exercises.Church.plus + (Exercises.Church.mult Exercises.Church.two + (Exercises.Church.mult Exercises.Church.two Exercises.Church.two)) + Exercises.Church.one))). +idtac "Assumptions:". +Abort. +Print Assumptions Exercises.Church.exp_3. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 21". +idtac "Max points - advanced: 34". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- app_nil_r ---------". +Print Assumptions app_nil_r. +idtac "---------- app_assoc ---------". +Print Assumptions app_assoc. +idtac "---------- app_length ---------". +Print Assumptions app_length. +idtac "---------- rev_app_distr ---------". +Print Assumptions rev_app_distr. +idtac "---------- rev_involutive ---------". +Print Assumptions rev_involutive. +idtac "---------- split ---------". +Print Assumptions split. +idtac "---------- test_split ---------". +Print Assumptions test_split. +idtac "---------- test_filter_even_gt7_1 ---------". +Print Assumptions test_filter_even_gt7_1. +idtac "---------- test_filter_even_gt7_2 ---------". +Print Assumptions test_filter_even_gt7_2. +idtac "---------- partition ---------". +Print Assumptions partition. +idtac "---------- test_partition1 ---------". +Print Assumptions test_partition1. +idtac "---------- test_partition2 ---------". +Print Assumptions test_partition2. +idtac "---------- map_rev ---------". +Print Assumptions map_rev. +idtac "---------- flat_map ---------". +Print Assumptions flat_map. +idtac "---------- test_flat_map1 ---------". +Print Assumptions test_flat_map1. +idtac "---------- Exercises.fold_length_correct ---------". +Print Assumptions Exercises.fold_length_correct. +idtac "---------- fold_map ---------". +idtac "MANUAL". +idtac "". +idtac "********** Advanced **********". +idtac "---------- Exercises.uncurry_curry ---------". +Print Assumptions Exercises.uncurry_curry. +idtac "---------- Exercises.curry_uncurry ---------". +Print Assumptions Exercises.curry_uncurry. +idtac "---------- Exercises.Church.scc_2 ---------". +Print Assumptions Exercises.Church.scc_2. +idtac "---------- Exercises.Church.scc_3 ---------". +Print Assumptions Exercises.Church.scc_3. +idtac "---------- Exercises.Church.plus_1 ---------". +Print Assumptions Exercises.Church.plus_1. +idtac "---------- Exercises.Church.plus_2 ---------". +Print Assumptions Exercises.Church.plus_2. +idtac "---------- Exercises.Church.plus_3 ---------". +Print Assumptions Exercises.Church.plus_3. +idtac "---------- Exercises.Church.mult_1 ---------". +Print Assumptions Exercises.Church.mult_1. +idtac "---------- Exercises.Church.mult_2 ---------". +Print Assumptions Exercises.Church.mult_2. +idtac "---------- Exercises.Church.mult_3 ---------". +Print Assumptions Exercises.Church.mult_3. +idtac "---------- Exercises.Church.exp_1 ---------". +Print Assumptions Exercises.Church.exp_1. +idtac "---------- Exercises.Church.exp_2 ---------". +Print Assumptions Exercises.Church.exp_2. +idtac "---------- Exercises.Church.exp_3 ---------". +Print Assumptions Exercises.Church.exp_3. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Postscript.v b/Postscript.v new file mode 100644 index 0000000..2e98554 --- /dev/null +++ b/Postscript.v @@ -0,0 +1,85 @@ +(** * Postscript *) + +(** Congratulations: We've made it to the end of _Logical + Foundations_! *) + +(* ################################################################# *) +(** * Looking Back *) + +(** We've covered quite a bit of ground so far. Here's a quick review... + + - _Functional programming_: + - "declarative" programming style (recursion over immutable + data structures, rather than looping over mutable arrays + or pointer structures) + - higher-order functions + - polymorphism *) + +(** + - _Logic_, the mathematical basis for software engineering: + + logic calculus + -------------------- ~ ---------------------------- + software engineering mechanical/civil engineering + + - inductively defined sets and relations + - inductive proofs + - proof objects *) + +(** + - _Rocq_, an industrial-strength proof assistant + - functional core language + - core tactics + - automation +*) + +(* ################################################################# *) +(** * Looking Forward *) + +(** If what you've seen so far has whetted your interest, you have + several choices for further reading in later volumes of the + _Software Foundations_ series. Some of these are intended to be + accessible to readers immediately after finishing _Logical + Foundations_; others require a few chapters from Volume 2, + _Programming Language Foundations_. The Preface chapter in each + volume gives details about prerequisites. *) + +(* ################################################################# *) +(** * Resources *) + +(** Here are some other good places to learn more... + + - This book includes some optional chapters covering topics + that you may find useful. Take a look at the table of contents and the chapter dependency diagram to find + them. + + - For questions about Rocq, the [#coq] area of Stack + Overflow ({https://stackoverflow.com/questions/tagged/coq}) + is an excellent community resource. + + - Here are some great books on functional programming + - Learn You a Haskell for Great Good, by Miran Lipovaca + [Lipovaca 2011] (in Bib.v). + - Real World Haskell, by Bryan O'Sullivan, John Goerzen, + and Don Stewart [O'Sullivan 2008] (in Bib.v) + - ...and many other excellent books on Haskell, OCaml, + Scheme, Racket, Scala, F sharp, etc., etc. + + - And some further resources for Rocq: + - Certified Programming with Dependent Types, by Adam + Chlipala [Chlipala 2013] (in Bib.v). + - Interactive Theorem Proving and Program Development: + Coq'Art: The Calculus of Inductive Constructions, by Yves + Bertot and Pierre Casteran [Bertot 2004] (in Bib.v). + + - If you're interested in real-world applications of formal + verification to critical software, see the Postscript chapter + of _Programming Language Foundations_. + + - For applications of Rocq in building verified systems, the + lectures and course materials for the 2017 DeepSpec Summer + School are a great resource. + {https://deepspec.org/event/dsss17/index.html} +*) + +(* 2026-01-07 13:18 *) diff --git a/PostscriptTest.v b/PostscriptTest.v new file mode 100644 index 0000000..708abf3 --- /dev/null +++ b/PostscriptTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Postscript. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Postscript. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Preface.v b/Preface.v new file mode 100644 index 0000000..5cddecc --- /dev/null +++ b/Preface.v @@ -0,0 +1,549 @@ +(** * Preface *) + +(* ################################################################# *) +(** * Welcome *) + +(** This is the entry point to a series of electronic textbooks on + various aspects of _Software Foundations_, the mathematical + underpinnings of reliable software. Topics in the series include + basic concepts of logic, computer-assisted theorem proving, the + Rocq prover, functional programming, operational semantics, logics + and techniques for reasoning about programs, static type systems, + property-based random testing, and verification of practical C + code. The exposition is intended for a broad range of readers, + from advanced undergraduates to PhD students and researchers. No + specific background in logic or programming languages is assumed, + though a degree of mathematical maturity will be helpful. + + The principal novelty of the series is that it is one hundred + percent formalized and machine-checked: each text is literally a + script for Rocq. The books are intended to be read alongside (or + inside) an interactive session with Rocq. All the details in the + text are fully formalized in Rocq, and most of the exercises are + designed to be worked using Rocq. + + The files in each book are organized into a sequence of core + chapters, covering about one semester's worth of material and + organized into a coherent linear narrative, plus a number of + "offshoot" chapters covering additional topics. All the core + chapters are suitable for both upper-level undergraduate and + graduate students. + + This book, _Logical Foundations_, lays groundwork for the others, + introducing the reader to the basic ideas of functional + programming, constructive logic, and the Rocq prover. *) + +(* ################################################################# *) +(** * Overview *) + +(** Building reliable software is hard -- really hard. The scale and + complexity of modern systems, the number of people involved, and + the range of demands placed on them make it challenging to build + software that is even more-or-less correct, much less 100%% + correct. At the same time, the increasing degree to which + information processing is woven into every aspect of society + greatly amplifies the cost of bugs and insecurities. + + Computer scientists and software engineers have responded to these + challenges by developing a host of techniques for improving + software reliability, ranging from recommendations about managing + software projects teams (e.g., extreme programming) to design + philosophies for libraries (e.g., model-view-controller, + publish-subscribe, etc.) and programming languages (e.g., + object-oriented programming, functional programming, ...) + to mathematical techniques for + specifying and reasoning about properties of software and tools + for helping validate these properties. The _Software Foundations_ + series is focused on this last set of tools. + + This volume weaves together three conceptual threads: + + (A) basic tools from _logic_ for making and justifying precise + claims about programs; + + (B) the use of _proof assistants_ (or _provers_) to construct + rigorous logical arguments; + + (C) _functional programming_, both as a method of programming that + simplifies reasoning about programs and as a bridge between + programming and logic. *) + +(* ================================================================= *) +(** ** Logic *) + +(** Logic is the field of study whose subject matter is _proofs_ -- + unassailable arguments for the truth of particular propositions. + Volumes have been written about the central role of logic in + computer science. Manna and Waldinger called it "the calculus of + computer science," while Halpern et al.'s paper _On the Unusual + Effectiveness of Logic in Computer Science_ catalogs scores of + ways in which logic offers critical tools and insights. Indeed, + they observe that, "As a matter of fact, logic has turned out to + be significantly more effective in computer science than it has + been in mathematics. This is quite remarkable, especially since + much of the impetus for the development of logic during the past + one hundred years came from mathematics." + + In particular, the fundamental tools of _inductive proof_ are + ubiquitous in all of computer science. You have surely seen them + before, perhaps in a course on discrete math or analysis of + algorithms, but in this course we will examine them more deeply + than you have probably done so far. *) + +(* ================================================================= *) +(** ** Proof Assistants *) + +(** The flow of ideas between logic and computer science has not been + unidirectional: CS has also made important contributions to logic. + One of these has been the development of software tools for + helping construct proofs of logical propositions. These tools + fall into two broad categories: + + - _Automated theorem provers_ provide "push-button" operation: + you give them a proposition and they return either _true_ or + _false_ (or, sometimes, _don't know: ran out of time_). + Although their reasoning capabilities are still limited, + they have matured tremendously in recent decades and + are used now in a multitude of settings. Examples of such + tools include SAT solvers, SMT solvers, and model checkers. + + - _Proof assistants_ are hybrid tools that automate the more + routine aspects of building proofs while depending on human + guidance for more difficult aspects. Widely used proof + assistants include Isabelle, Agda, Twelf, ACL2, PVS, F*, + HOL4, Lean, and Rocq, among many others. + + This course is based around Rocq, a proof assistant that has been + under development since 1983 and has attracted a large community + of users in both research and industry. Rocq provides a rich + environment for interactive development of machine-checked formal + reasoning. The kernel of the Rocq system is a simple + proof-checker, which guarantees that only correct deduction steps + are ever performed. On top of this kernel, the Rocq environment + provides high-level facilities for proof development, including a + large library of common definitions and lemmas, powerful tactics + for constructing complex proofs semi-automatically, and a + special-purpose programming language for defining new + proof-automation tactics for specific situations. + + Rocq has been a critical enabler for a huge variety of work across + computer science and mathematics: + + - As a _platform for modeling programming languages_, it has + become a standard tool for researchers who need to describe and + reason about complex language definitions. It has been used, + for example, to check the security of the JavaCard platform, + obtaining the highest level of common criteria certification, + and for formal specifications of the x86 and LLVM instruction + sets and programming languages such as C. + + - As an _environment for developing formally certified software + and hardware_, Rocq has been used, for example, to build + CompCert, a fully-verified optimizing compiler for C, and + CertiKOS, a fully verified hypervisor, for proving the + correctness of subtle algorithms involving floating point + numbers, and as the basis for CertiCrypt, FCF, and SSProve, + which are frameworks for proving cryptographic algorithms secure. + It is also being used to build verified implementations of the + open-source RISC-V processor architecture. + + - As a _realistic environment for functional programming with + dependent types_, it has inspired numerous innovations. For + example, Hoare Type Theory embeds reasoning about + "pre-conditions" and "post-conditions" (an extension of the + _Hoare Logic_ we will see later in this course) in Rocq. + + - As a _proof assistant for higher-order logic_, it has been used + to validate a number of important results in mathematics. For + example, its ability to include complex computations inside + proofs made it possible to develop the first formally verified + proof of the 4-color theorem. This proof had previously been + controversial among mathematicians because it required checking + a large number of configurations using a program. In the Rocq + formalization, everything is checked, including the correctness + of the computational part. More recently, an even more massive + effort led to a Rocq formalization of the Feit-Thompson Theorem, + the first major step in the classification of finite simple + groups. *) + +(* ================================================================= *) +(** ** Functional Programming *) + +(** The term _functional programming_ refers both to a collection of + programming idioms that can be used in almost any programming + language and to a family of programming languages designed to + emphasize these idioms, including Haskell, OCaml, Standard ML, + F##, Scala, Scheme, Racket, Common Lisp, Clojure, Erlang, F*, + and Rocq. + + Functional programming has been developed over many decades -- + indeed, its roots go back to Church's lambda-calculus, which was + invented in the 1930s, well _before_ the first electronic + computers! But since the early '90s it has enjoyed a surge of + interest among industrial engineers and language designers, + playing a key role in high-value systems at companies like Jane + Street Capital, Microsoft, Facebook, Twitter, and Ericsson. + + The most basic tenet of functional programming is that, as much as + possible, computation should be _pure_, in the sense that the only + effect of execution should be to produce a result: it should be + free from _side effects_ such as I/O, assignments to mutable + variables, redirecting pointers, etc. For example, whereas an + _imperative_ sorting function might take a list of numbers and + rearrange its pointers to put the list in order, a pure sorting + function would take the original list and return a _new_ list + containing the same numbers in sorted order. + + A significant benefit of this style of programming is that it + makes programs easier to understand and reason about. If every + operation on a data structure yields a new data structure, leaving + the old one intact, then there is no need to worry about how that + structure is being shared and whether a change by one part of the + program might break an invariant relied on by another part of the + program. These considerations are particularly critical in + concurrent systems, where every piece of mutable state that is + shared between threads is a potential source of pernicious bugs. + Indeed, a large part of the recent interest in functional + programming in industry is due to its simpler behavior in the + presence of concurrency. + + Another reason for the current excitement about functional + programming is related to the first: functional programs are often + much easier to parallelize and physically distribute than their + imperative counterparts. If running a computation has no effect + other than producing a result, then it does not matter _where_ it + is run. Similarly, if a data structure is never modified + destructively, then it can be copied freely, across cores or + across the network. Indeed, the "Map-Reduce" idiom, which lies at + the heart of massively distributed query processors like Hadoop + and is used by Google to index the entire web is a classic example + of functional programming. + + For purposes of this course, functional programming has yet + another significant attraction: it serves as a bridge between + logic and computer science. Indeed, Rocq itself can be viewed as a + combination of a small but extremely expressive functional + programming language plus a set of tools for stating and proving + logical assertions. Moreover, when we come to look more closely, + we find that these two sides of Rocq are actually aspects of the + very same underlying machinery -- i.e., _proofs are programs_. *) + +(* ================================================================= *) +(** ** Rocq vs. Coq *) + +(** Until 2025, the Rocq prover was known as Coq. According to the + official webpage, "The name 'Coq' referenced the Calculus of + Constructions (CoC), the foundational system it is based on, as + well as one of its creators, Thierry Coquand. Additionally, it + paid homage to the French national symbol, the rooster. The new + name, 'the Rocq Prover', honors Inria Rocquencourt, the original + site where the prover was developed. It also alludes to the + mythological bird Roc (or Rokh), symbolizing strength and not so + disconnected to a rooster. Furthermore, the name conveys a sense + of solidity, and its unintended connection to music adds a + pleasant resonance." + + The current release of Software Foundations is still in a + transitional state, and you will see references to both Coq and + Rocq. *) + +(* ================================================================= *) +(** ** Further Reading *) + +(** This text is intended to be self contained, but readers looking + for a deeper treatment of particular topics will find some + suggestions for further reading in the [Postscript] chapter. + Bibliographic information for all cited works can be found in the + file [Bib].*) + +(* ################################################################# *) +(** * Practicalities *) + +(* ================================================================= *) +(** ** System Requirements *) + +(** Rocq runs on Windows, Linux, and macOS. The files in this book + have been tested with Rocq 9.0.0. *) + +(* ----------------------------------------------------------------- *) +(** *** Recommended Installation Method: VSCode + Docker *) + +(** The Visual Studio Code IDE can cooperate with the Docker + virtualization platform to compile Rocq scripts without the need + for any separate Rocq installation. This method is recommended for + most Software Foundations readers. + + - Install Docker from {https://www.docker.com/get-started/} or + make sure your existing installation is up to date. + + - Make sure Docker is running. + + - Install VSCode from {https://code.visualstudio.com} and start it + running. + + - Install VSCode's Dev Containers Extension from + {https://marketplace.visualstudio.com/items?itemName=ms-vscode-remote.remote-containers} + + (Note that this extension only works with the official version + of VSCode, not with some VSCode forks like VsCodium.) + + - Set up a directory for this SF volume by downloading the + provided [.tgz] file. Besides the [.v] file for each chapter, + this directory will contain a [.devcontainer] subdirectory with + instructions for VSCode about where to find an appropriate + Docker image and a [_CoqProject] file, whose presence triggers + the VSCoq extension. + + - In VSCode, use [File > Open Folder] to open the new directory. + VSCode should ask you whether you want to run the project in the + associated Docker container. (If it does not ask you, you can + open the command palette by pressing F1 and run the command “Dev + Containers: Reopen in Container”.) + + This step may take some time. + + - Check that VSCoq is working by double-clicking the file + [Basics.v] from the list on the left (you should see a blinking + cursor in the window that opens; if not you can click in that + window to select it), and pressing [alt+downarrow] (on MacOS, + [control+option+downarrow]) a few times. You should see the + cursor move through the file and the region above the cursor get + highlighted. + + - If VSCoq does not work and you receive an error indicating that + [vscoqtop] was not found, open a new terminal in the container + (you can do this by opening the command palette and running the + command “Terminal: Create New Terminal”) and run the command + [which vscoqtop]. This should print the path to the VSCoq + installation inside the container. Copy this path + and paste it into the “VSCoq: Path” textbox in the + VSCoq extension settings (accessible via the gear icon on + the VSCoq extension page in VSCode), then reload your window. + + - To see what other key bindings are available, press F1 and then + type [Coq:], or visit the VSCoq web pages: + {https://github.com/rocq-prover/vsrocq}. *) + +(* ================================================================= *) +(** ** Alternative Installation Methods *) + +(** If you prefer, there are several other ways to use Rocq. You will need: + + - A current installation of Rocq, available from the Rocq home + page ({https://rocq-prover.org/install}). The "Rocq Platform" + offers the easiest installation experience for most people, + especially on Windows. + + - An IDE for interacting with Rocq. There are several choices: + + - _VsCoq_ is an extension for Visual Studio Code that offers a + simple interface via a familiar IDE. This option is the + recommended default. + + VsCoq can be used as an ordinary IDE or it can be combined + with Docker (see below) for a lightweight installation + experience. + + - _Proof General_ is an Emacs-based IDE. It tends to be + preferred by users who are already comfortable with Emacs. + It requires a separate installation (google "Proof General", + but generally all you need to do is [M-x package-list-packages], + then select the [proof-general] package from the list and + hit the [i] key for install, then hit the [x] key for execute). + + There are only a few commands you need to know to use ProofGeneral + effectively. They are: + + - [C-c C-n]: send the next command to Rocq. + - [C-c C-u]: undo (retract) the most recently executed command. + - [C-c C-RET]: submit everything up to the current cursor location to + Rocq for processing. + - [C-c C-.]: move the cursor to the end of the last command which has + been processed by Rocq. + - [C-c .]: toggle "electric terminator mode". When this mode is + turned on, simply typing a period will send the current command to + Rocq (normally you have to type a period and then type [C-c C-n]). + + Adventurous users of Rocq within Emacs may want to check out + extensions such as [company-coq] and [control-lock]. + + - _RocqIDE_ is a simpler stand-alone IDE. It is distributed with + the Rocq Platform, so it should be available once you have Rocq + installed. It can also be compiled from scratch, but on some + platforms this may involve installing additional packages for GUI + libraries and such. + + Users who like RocqIDE should consider running it with the + "asynchronous" and "error resilience" modes disabled: + + coqide -async-proofs off \ + -async-proofs-command-error-resilience off Foo.v & +*) + +(* ================================================================= *) +(** ** Exercises *) + +(** Each chapter includes numerous exercises. Each is marked with a + "star rating," which can be interpreted as follows: + + - One star: easy exercises that underscore points in the text + and that, for most readers, should take only a minute or two. + Get in the habit of working these as you reach them. + + - Two stars: straightforward exercises (five or ten minutes). + + - Three stars: exercises requiring a bit of thought (ten + minutes to half an hour). + + - Four and five stars: more difficult exercises (half an hour + and up). + + Those using SF in a classroom setting should note that the autograder + assigns extra points to harder exercises: + + 1 star = 1 point + 2 stars = 2 points + 3 stars = 3 points + 4 stars = 6 points + 5 stars = 10 points + + Some exercises are marked "advanced," and some are marked + "optional." Doing just the non-optional, non-advanced exercises + should provide good coverage of the core material. Optional + exercises provide a bit of extra practice with key concepts and + introduce secondary themes that may be of interest to some + readers. Advanced exercises are for readers who want an extra + challenge and a deeper cut at the material. + + _Please do not post solutions to the exercises in a public place_. + Software Foundations is widely used both for self-study and for + university courses. Having solutions easily available makes it + much less useful for courses, which typically have graded homework + assignments. We especially request that readers not post + solutions to the exercises anyplace where they can be found by + search engines. *) + +(* ================================================================= *) +(** ** Downloading the Rocq Files *) + +(** A tar file containing the full sources for the "release version" + of this book (as a collection of Rocq scripts and HTML files) is + available at {https://softwarefoundations.cis.upenn.edu}. + + If you are using the book as part of a class, your professor may + give you access to a locally modified version of the files; you + should use that one instead of the public release version, so that + you get any local updates during the semester. *) + +(* ================================================================= *) +(** ** Chapter Dependencies *) + +(** A diagram of the dependencies between chapters and some suggested + paths through the material can be found in the file [deps.html]. *) + +(* ================================================================= *) +(** ** Recommended Citation Format *) + +(** If you want to refer to this volume in your own writing, please + do so as follows: + + @book {Pierce:SF1, + author = {Benjamin C. Pierce and + Arthur Azevedo de Amorim and + Chris Casinghino and + Marco Gaboardi and + Michael Greenberg and + Cătălin Hriţcu and + Vilhelm Sjöberg and + Brent Yorgey}, + editor = {Benjamin C. Pierce}, + title = "Logical Foundations", + series = "Software Foundations", + volume = "1", + year = "2026", + publisher = "Electronic textbook", + note = {Version 7.0, \URL{http://softwarefoundations.cis.upenn.edu}} + } +*) + +(* ################################################################# *) +(** * Resources *) + +(* ================================================================= *) +(** ** Sample Exams *) + +(** A large compendium of exams from many offerings of + CIS5000 ("Software Foundations") at the University of Pennsylvania + can be found at + {https://www.seas.upenn.edu/~cis5000/current/exams/index.html}. + There has been some drift of notations over the years, but most of + the problems are still relevant to the current text. *) + +(* ================================================================= *) +(** ** Lecture Videos *) + +(** Lectures for two intensive summer courses based on _Logical + Foundations_ (part of the DeepSpec summer school series) can be + found at {https://deepspec.org/event/dsss17} and + {https://deepspec.org/event/dsss18/}. The video quality in the + 2017 lectures is poor at the beginning but gets better in the + later lectures. *) + +(* ################################################################# *) +(** * Note for Instructors and Contributors *) + +(** If you plan to use these materials in your own teaching, or if you + are using software foundations for self study and are finding + things you'd like to help add or improve, your contributions are + welcome! You are warmly invited to join the private SF git repo. + + In order to keep the legalities simple and to have a single point + of responsibility in case the need should ever arise to adjust the + license terms, sublicense, etc., we ask all contributors (i.e., + everyone with access to the developers' repository) to assign + copyright in their contributions to the appropriate "author of + record," as follows: + + - I hereby assign copyright in my past and future contributions + to the Software Foundations project to the Author of Record of + each volume or component, to be licensed under the same terms + as the rest of Software Foundations. I understand that, at + present, the Authors of Record are as follows: For Volumes 1 + and 2, known until 2016 as "Software Foundations" and from + 2016 as (respectively) "Logical Foundations" and "Programming + Foundations," and for Volume 4, "QuickChick: Property-Based + Testing in Rocq," the Author of Record is Benjamin C. Pierce. + For Volume 3, "Verified Functional Algorithms," and volume 5, + "Verifiable C," the Author of Record is Andrew W. Appel. For + Volume 6, "Separation Logic Foundations," the author of record + is Arthur Chargueraud. For components outside of designated + volumes (e.g., typesetting and grading tools and other + software infrastructure), the Author of Record is Benjamin C. + Pierce. + + To get started, please send an email to Benjamin Pierce, + describing yourself and how you plan to use the materials and + including (A) the above copyright transfer text and (B) your + github username. + + We'll set you up with access to the git repository and developers' + mailing lists. In the repository you'll find the files + [INSTRUCTORS] and [CONTRIBUTING] with further instructions. *) + +(* ################################################################# *) +(** * Translations *) + +(** Thanks to the efforts of a team of volunteer translators, + _Software Foundations_ can be enjoyed in Japanese at + {http://proofcafe.org/sf}. A Chinese translation is also underway; + you can preview it at {https://coq-zh.github.io/SF-zh/}. *) + +(* ################################################################# *) +(** * Thanks *) + +(** Development of the _Software Foundations_ series has been + supported, in part, by the National Science Foundation under the + NSF Expeditions grant 1521523, _The Science of Deep + Specification_. *) + +(* 2026-01-07 13:17 *) diff --git a/PrefaceTest.v b/PrefaceTest.v new file mode 100644 index 0000000..ed90900 --- /dev/null +++ b/PrefaceTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Preface. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Preface. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/ProofObjects.v b/ProofObjects.v new file mode 100644 index 0000000..a09a7ec --- /dev/null +++ b/ProofObjects.v @@ -0,0 +1,946 @@ +(** * ProofObjects: The Curry-Howard Correspondence *) + +Set Warnings "-notation-overridden,-notation-incompatible-prefix". +From LF Require Export IndProp. + +(** "Algorithms are the computational content of proofs." + (Robert Harper) *) + +(** We have seen that Rocq has mechanisms both for _programming_, + using inductive data types like [nat] or [list] and functions over + these types, and for _proving_ properties of these programs, using + inductive propositions (like [ev]), implication, universal + quantification, and the like. So far, we have mostly treated + these mechanisms as if they were quite separate, and for many + purposes this is a good way to think. But we have also seen hints + that Rocq's programming and proving facilities are closely related. + For example, the keyword [Inductive] is used to declare both data + types and propositions, and [->] is used both to describe the type + of functions on data and logical implication. This is not just a + syntactic accident! In fact, programs and proofs in Rocq are + almost the same thing. In this chapter we will study this connection + in more detail. + + We have already seen the fundamental idea: provability in Rocq is + always witnessed by _evidence_. When we construct the proof of a + basic proposition, we are actually building a tree of evidence, + which can be thought of as a concrete data structure. + + If the proposition is an implication like [A -> B], then its proof + is an evidence _transformer_: a recipe for converting evidence for + A into evidence for B. So at a fundamental level, proofs are + simply programs that manipulate evidence. *) + +(** Question: If evidence is data, what are propositions themselves? + + Answer: They are types! *) + +(** Look again at the formal definition of the [ev] property. *) + +Inductive ev : nat -> Prop := + | ev_0 : ev 0 + | ev_SS (n : nat) (H : ev n) : ev (S (S n)). + +(** We can pronounce the ":" here as either "has type" or "is a proof + of." For example, the second line in the definition of [ev] + declares that [ev_0 : ev 0]. Instead of "[ev_0] has type [ev 0]," + we can say that "[ev_0] is a proof of [ev 0]." *) + +(** This pun between types and propositions -- between [:] as "has type" + and [:] as "is a proof of" or "is evidence for" -- is called the + _Curry-Howard correspondence_. It proposes a deep connection + between the world of logic and the world of computation: + + propositions ~ types + proofs ~ programs + + See [Wadler 2015] (in Bib.v) for a brief history and modern exposition. *) + +(** Many useful insights follow from this connection. To begin with, + it gives us a natural interpretation of the type of the [ev_SS] + constructor: *) + +Check ev_SS + : forall n, + ev n -> + ev (S (S n)). + +(** This can be read "[ev_SS] is a constructor that takes two + arguments -- a number [n] and evidence for the proposition [ev + n] -- and yields evidence for the proposition [ev (S (S n))]." *) + +(** Now let's look again at an earlier proof involving [ev]. *) + +Theorem ev_4 : ev 4. +Proof. + apply ev_SS. apply ev_SS. apply ev_0. Qed. + +(** Just as with ordinary data values and functions, we can use the + [Print] command to see the _proof object_ that results from this + proof script. *) + +Print ev_4. +(* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) + : ev 4 *) + +(** Indeed, we can also write down this proof object directly, + with no need for a proof script at all: *) + +Check (ev_SS 2 (ev_SS 0 ev_0)) + : ev 4. + +(** The expression [ev_SS 2 (ev_SS 0 ev_0)] instantiates the + parameterized constructor [ev_SS] with the specific arguments [2] + and [0] plus the corresponding proof objects for its premises [ev + 2] and [ev 0]. Alternatively, we can think of [ev_SS] as a + primitive "evidence constructor" that, when applied to a + particular number, wants to be further applied to evidence that + this number is even; its type, + + forall n, ev n -> ev (S (S n)), + + expresses this functionality, in the same way that the polymorphic + type [forall X, list X] expresses the fact that the constructor + [nil] can be thought of as a function from types to empty lists + with elements of that type. *) + +(** We saw in the [Logic] chapter that we can use function + application syntax to instantiate universally quantified variables + in lemmas, as well as to supply evidence for assumptions that + these lemmas impose. For instance: *) + +Theorem ev_4': ev 4. +Proof. + apply (ev_SS 2 (ev_SS 0 ev_0)). +Qed. + +(* ################################################################# *) +(** * Proof Scripts *) + +(** The _proof objects_ we've been discussing lie at the core of how + Rocq operates. When Rocq is following a proof script, what is + happening internally is that it is gradually constructing a proof + object -- a term whose type is the proposition being proved. The + tactics between [Proof] and [Qed] tell it how to build up a term + of the required type. To see this process in action, let's use + the [Show Proof] command to display the current state of the proof + tree at various points in the following tactic proof. *) + +Theorem ev_4'' : ev 4. +Proof. + Show Proof. + apply ev_SS. + Show Proof. + apply ev_SS. + Show Proof. + apply ev_0. + Show Proof. +Qed. + +(** At any given moment, Rocq has constructed a term with a + "hole" (indicated by [?Goal] here, and so on), and it knows what + type of evidence is needed to fill this hole. + + Each hole corresponds to a subgoal, and the proof is + finished when there are no more subgoals. At this point, the + evidence we've built is stored in the global context under the name + given in the [Theorem] command. *) + +(** Tactic proofs are convenient, but they are not essential in Rocq: + in principle, we can always just construct the required evidence + by hand. Then we can use [Definition] (rather than [Theorem]) to + introduce a global name for this evidence. *) + +Definition ev_4''' : ev 4 := + ev_SS 2 (ev_SS 0 ev_0). + +(** All these different ways of building the proof lead to exactly the + same evidence being saved in the global environment. *) + +Print ev_4. +(* ===> ev_4 = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +Print ev_4'. +(* ===> ev_4' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +Print ev_4''. +(* ===> ev_4'' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) +Print ev_4'''. +(* ===> ev_4''' = ev_SS 2 (ev_SS 0 ev_0) : ev 4 *) + +(** **** Exercise: 2 stars, standard (eight_is_even) + + Give a tactic proof and a proof object showing that [ev 8]. *) + +Theorem ev_8 : ev 8. +Proof. + (* FILL IN HERE *) Admitted. + +Definition ev_8' : ev 8 + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(* ################################################################# *) +(** * Quantifiers, Implications, Functions *) + +(** In Rocq's computational universe (where data structures and + programs live), there are two sorts of values that have arrows in + their types: _constructors_ introduced by [Inductive]ly defined + data types, and _functions_. + + Similarly, in Rocq's logical universe (where we carry out proofs), + there are two ways of giving evidence for an implication: + constructors introduced by [Inductive]ly defined propositions, + and... functions! *) + +(** For example, consider this statement: *) + +Theorem ev_plus4 : forall n, ev n -> ev (4 + n). +Proof. + intros n H. simpl. + apply ev_SS. + apply ev_SS. + apply H. +Qed. + +(** What is the proof object corresponding to [ev_plus4]? *) + +(** We're looking for an expression whose _type_ is [forall n, ev n -> + ev (4 + n)] -- that is, a _function_ that takes two arguments (one + number and a piece of evidence) and returns a piece of evidence! + + Here it is: *) + +Definition ev_plus4' : forall n, ev n -> ev (4 + n) := + fun (n : nat) => fun (H : ev n) => + ev_SS (S (S n)) (ev_SS n H). + +(** Recall that [fun n => blah] means "the function that, given [n], + yields [blah]," and that Rocq treats [4 + n] and [S (S (S (S n)))] + as synonyms. Another equivalent way to write this definition is: *) + +Definition ev_plus4'' (n : nat) (H : ev n) + : ev (4 + n) := + ev_SS (S (S n)) (ev_SS n H). + +Check ev_plus4'' : forall n : nat, ev n -> ev (4 + n). + +(** When we view the proposition being proved by [ev_plus4] as a + function type, one interesting point becomes apparent: The second + argument's type, [ev n], mentions the _value_ of the first + argument, [n]. + + While such _dependent types_ are not found in most mainstream + programming languages, they can be quite useful in programming + too, as the flurry of activity in the functional programming + community over the past couple of decades demonstrates. *) + +(** Notice that both implication ([->]) and quantification ([forall]) + correspond to functions on evidence. In fact, they are really the + same thing: [->] is just a shorthand for a degenerate use of + [forall] where there is no dependency, i.e., no need to give a + name to the type on the left-hand side of the arrow: + + forall (x:nat), nat + = forall (_:nat), nat + = nat -> nat +*) + +(** For example, consider this proposition: *) + +Definition ev_plus2 : Prop := + forall n, forall (E : ev n), ev (n + 2). + +(** A proof term inhabiting this proposition would be a function + with two arguments: a number [n] and some evidence [E] that [n] is + even. But the name [E] for this evidence is not used in the rest + of the statement of [ev_plus2], so it's a bit silly to bother + making up a name for it. We could write it like this instead, + using the dummy identifier [_] in place of a real name: *) + +Definition ev_plus2' : Prop := + forall n, forall (_ : ev n), ev (n + 2). + +(** Or, equivalently, we can write it in a more familiar way: *) + +Definition ev_plus2'' : Prop := + forall n, ev n -> ev (n + 2). + +(** In general, "[P -> Q]" is just syntactic sugar for + "[forall (_:P), Q]". *) + +(* ################################################################# *) +(** * Programming with Tactics *) + +(** If we can build proofs by giving explicit terms rather than + executing tactic scripts, you may wonder whether we can build + _programs_ using tactics rather than by writing down explicit + terms. + + Naturally, the answer is yes! *) + +Definition add2 : nat -> nat. +intros n. +Show Proof. +apply S. +Show Proof. +apply S. +Show Proof. +apply n. Defined. + +Print add2. +(* ==> + add2 = fun n : nat => S (S n) + : nat -> nat +*) + +Compute add2 2. +(* ==> 4 : nat *) + +(** Notice that we terminated the [Definition] with a [.] rather than + with [:=] followed by a term. This tells Rocq to enter _proof + scripting mode_ to build an object of type [nat -> nat]. Also, we + terminate the proof with [Defined] rather than [Qed]; this makes + the definition _transparent_ so that it can be used in computation + like a normally-defined function. ([Qed]-defined objects are + opaque during computation.) + + This feature is mainly useful for writing functions with dependent + types, which we won't explore much further in this book. But it + does illustrate the uniformity and orthogonality of the basic + ideas in Rocq. *) + +(* ################################################################# *) +(** * Logical Connectives as Inductive Types *) + +(** Inductive definitions are powerful enough to express most of the + logical connectives we have seen so far. Indeed, only universal + quantification (with implication as a special case) is built into + Rocq; all the others are defined inductively. + + Let's see how. *) + +Module Props. + +(* ================================================================= *) +(** ** Conjunction *) + +(** To prove that [P /\ Q] holds, we must present evidence for both + [P] and [Q]. Thus, it makes sense to define a proof object for + [P /\ Q] to consist of a pair of two proofs: one for [P] and + another one for [Q]. This leads to the following definition. *) + +Module And. + +Inductive and (P Q : Prop) : Prop := + | conj : P -> Q -> and P Q. + +Arguments conj [P] [Q]. + +Notation "P /\ Q" := (and P Q) : type_scope. + +(** Notice the similarity with the definition of the [prod] type, + given in chapter [Poly]; the only difference is that [prod] takes + [Type] arguments, whereas [and] takes [Prop] arguments. *) + +Print prod. +(* ===> + Inductive prod (X Y : Type) : Type := + | pair : X -> Y -> X * Y. *) + +(** This similarity should clarify why [destruct] and [intros] + patterns can be used on a conjunctive hypothesis. Case analysis + allows us to consider all possible ways in which [P /\ Q] was + proved -- here just one (the [conj] constructor). *) + +Theorem proj1' : forall P Q, + P /\ Q -> P. +Proof. + intros P Q HPQ. destruct HPQ as [HP HQ]. apply HP. + Show Proof. +Qed. + +(** Similarly, the [split] tactic actually works for any inductively + defined proposition with exactly one constructor. In particular, + it works for [and]: *) + +Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P. +Proof. + intros P Q. split. + - intros [HP HQ]. split. + + apply HQ. + + apply HP. + - intros [HQ HP]. split. + + apply HP. + + apply HQ. +Qed. + +End And. + +(** This shows why the inductive definition of [and] can be + manipulated by tactics as we've been doing. We can also use it to + build proofs directly, using pattern-matching. For instance: *) + +Definition proj1'' P Q (HPQ : P /\ Q) : P := + match HPQ with + | conj HP HQ => HP + end. + +Definition and_comm'_aux P Q (H : P /\ Q) : Q /\ P := + match H with + | conj HP HQ => conj HQ HP + end. + +Definition and_comm' P Q : P /\ Q <-> Q /\ P := + conj (and_comm'_aux P Q) (and_comm'_aux Q P). + +(** **** Exercise: 2 stars, standard (conj_fact) + + Construct a proof object for the following proposition. *) + +Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Disjunction *) + +(** The inductive definition of disjunction uses two constructors, one + for each side of the disjunction: *) + +Module Or. + +Inductive or (P Q : Prop) : Prop := + | or_introl : P -> or P Q + | or_intror : Q -> or P Q. + +Arguments or_introl [P] [Q]. +Arguments or_intror [P] [Q]. + +Notation "P \/ Q" := (or P Q) : type_scope. + +(** This declaration explains the behavior of the [destruct] tactic on + a disjunctive hypothesis, since the generated subgoals match the + shape of the [or_introl] and [or_intror] constructors. *) + +(** Once again, we can also directly write proof objects for theorems + involving [or], without resorting to tactics. *) + +Definition inj_l : forall (P Q : Prop), P -> P \/ Q := + fun P Q HP => or_introl HP. + +Theorem inj_l' : forall (P Q : Prop), P -> P \/ Q. +Proof. + intros P Q HP. left. apply HP. + Show Proof. +Qed. + +Definition or_elim : forall (P Q R : Prop), (P \/ Q) -> (P -> R) -> (Q -> R) -> R := + fun P Q R HPQ HPR HQR => + match HPQ with + | or_introl HP => HPR HP + | or_intror HQ => HQR HQ + end. + +Theorem or_elim' : forall (P Q R : Prop), (P \/ Q) -> (P -> R) -> (Q -> R) -> R. +Proof. + intros P Q R HPQ HPR HQR. + destruct HPQ as [HP | HQ]. + - apply HPR. apply HP. + - apply HQR. apply HQ. +Qed. + +End Or. + +(** **** Exercise: 2 stars, standard (or_commut') + + Construct a proof object for the following proposition. *) + +Definition or_commut' : forall P Q, P \/ Q -> Q \/ P + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(* ================================================================= *) +(** ** Existential Quantification *) + +(** To give evidence for an existential quantifier, we package a + witness [x] together with a proof that [x] satisfies the property + [P]: *) + +Module Ex. + +Inductive ex {A : Type} (P : A -> Prop) : Prop := + | ex_intro : forall x : A, P x -> ex P. + +Notation "'exists' x , p" := + (ex (fun x => p)) + (at level 200, right associativity) : type_scope. + +End Ex. + +(** This probably needs a little unpacking. The core definition is + for a type former [ex] that can be used to build propositions of + the form [ex P], where [P] itself is a _function_ from witness + values in the type [A] to propositions. The [ex_intro] + constructor then offers a way of constructing evidence for [ex P], + given a witness [x] and a proof of [P x]. + + The notation in the standard library is a slight extension of + the above, enabling syntactic forms such as [exists x y, P x y]. *) + +(** The more familiar form [exists x, ev x] desugars to an expression + involving [ex]: *) + +Check ex (fun n => ev n) : Prop. + +(** Here's how to define an explicit proof object involving [ex]: *) + +Definition some_nat_is_even : exists n, ev n := + ex_intro ev 4 (ev_SS 2 (ev_SS 0 ev_0)). + +(** **** Exercise: 2 stars, standard (ex_ev_Sn) + + Construct a proof object for the following proposition. *) + +Definition ex_ev_Sn : ex (fun n => ev (S n)) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** To destruct existentials in a proof term we simply use match: *) +Definition dist_exists_or_term (X:Type) (P Q : X -> Prop) : + (exists x, P x \/ Q x) -> (exists x, P x) \/ (exists x, Q x) := + fun H => match H with + | ex_intro _ x Hx => + match Hx with + | or_introl HPx => or_introl (ex_intro _ x HPx) + | or_intror HQx => or_intror (ex_intro _ x HQx) + end + end. + +(** **** Exercise: 2 stars, standard (ex_match) + + Construct a proof object for the following proposition: *) +Definition ex_match : forall (A : Type) (P Q : A -> Prop), + (forall x, P x -> Q x) -> + (exists x, P x) -> (exists x, Q x) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(* ================================================================= *) +(** ** [True] and [False] *) + +(** The inductive definition of the [True] proposition is simple: *) + +Inductive True : Prop := + | I : True. + +(** It has one constructor (so every proof of [True] is the same, so + being given a proof of [True] is not informative.) *) + +(** **** Exercise: 1 star, standard (p_implies_true) + + Construct a proof object for the following proposition. *) + +Definition p_implies_true : forall P, P -> True + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** [False] is equally simple -- indeed, so simple it may look + syntactically wrong at first glance! *) + +Inductive False : Prop := . + +(** That is, [False] is an inductive type with _no_ constructors -- + i.e., no way to build evidence for it. For example, there is + no way to complete the following definition such that it + succeeds. *) + +Fail + Definition contra : False := + 42. + +(** But it is possible to destruct [False] by pattern matching. There can + be no patterns that match it, since it has no constructors. So + the pattern match also is so simple it may look syntactically + wrong at first glance. *) + +Definition false_implies_zero_eq_one : False -> 0 = 1 := + fun contra => match contra with end. + +(** Since there are no branches to evaluate, the [match] expression + can be considered to have any type we want, including [0 = 1]. + Fortunately, it's impossible to ever cause the [match] to be + evaluated, because we can never construct a value of type [False] + to pass to the function. *) + +(** **** Exercise: 1 star, standard (ex_falso_quodlibet') + + Construct a proof object for the following proposition. *) + +Definition ex_falso_quodlibet' : forall P, False -> P + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +End Props. + +(* ################################################################# *) +(** * Equality *) + +(** Even Rocq's equality relation is not built in. We can define + it ourselves: *) + +Module EqualityPlayground. + +Inductive eq {X:Type} : X -> X -> Prop := + | eq_refl : forall x, eq x x. + +Notation "x == y" := (eq x y) + (at level 70, no associativity) + : type_scope. + +(** The way to think about this definition (which is just a slight + variant of the standard library's) is that, given a set [X], it + defines a _family_ of propositions "[x] is equal to [y]," indexed + by pairs of values ([x] and [y]) from [X]. There is just one way + of constructing evidence for members of this family: applying the + constructor [eq_refl] to a type [X] and a single value [x : X], + which yields evidence that [x] is equal to [x]. + + Other types of the form [eq x y] where [x] and [y] are not the + same are thus uninhabited. *) + +(** We can use [eq_refl] to construct evidence that, for example, [2 = + 2]. Can we also use it to construct evidence that [1 + 1 = 2]? + Yes, we can. Indeed, it is the very same piece of evidence! + + The reason is that Rocq treats as "the same" any two terms that are + _convertible_ according to a simple set of computation rules. + + These rules, which are similar to those used by [Compute], include + evaluation of function application, inlining of definitions, and + simplification of [match]es. *) + +Lemma four: 2 + 2 == 1 + 3. +Proof. + apply eq_refl. +Qed. + +(** The [reflexivity] tactic that we have used to prove + equalities up to now is essentially just shorthand for [apply + eq_refl]. + + In tactic-based proofs of equality, the conversion rules are + normally hidden in uses of [simpl] (either explicit or implicit in + other tactics such as [reflexivity]). + + But you can see them directly at work in the following explicit + proof objects: *) + +Definition four' : 2 + 2 == 1 + 3 := + eq_refl 4. + +Definition singleton : forall (X:Type) (x:X), []++[x] == x::[] := + fun (X:Type) (x:X) => eq_refl [x]. + +(** We can also pattern-match on an equality proof: *) +Definition eq_add : forall (n1 n2 : nat), n1 == n2 -> (S n1) == (S n2) := + fun n1 n2 Heq => + match Heq with + | eq_refl n => eq_refl (S n) + end. + +(** By pattern-matching against [n1 == n2], we obtain a term [n] + that replaces [n1] and [n2] in the type we have to produce, so + instead of [(S n1) == (S n2)], we now have to produce something + of type [(S n) == (S n)], which we establish by [eq_refl (S n)]. *) + +(** A tactic-based proof runs into some difficulties if we try to use + our usual repertoire of tactics, such as [rewrite] and + [reflexivity]. Those work with *setoid* relations that Rocq knows + about, such as [=], but not our [==]. We could prove to Rocq that + [==] is a setoid, but a simpler way is to use [destruct] and + [apply] instead. *) + +Theorem eq_add' : forall (n1 n2 : nat), n1 == n2 -> (S n1) == (S n2). +Proof. + intros n1 n2 Heq. + Fail rewrite Heq. (* doesn't work for _our_ == relation *) + destruct Heq as [n]. (* n1 and n2 replaced by n in the goal! *) + Fail reflexivity. (* doesn't work for _our_ == relation *) + apply eq_refl. +Qed. + +(** **** Exercise: 2 stars, standard (eq_cons) + + Construct the proof object for the following theorem. Use pattern + matching on the equality hypotheses. *) + +Definition eq_cons : forall (X : Type) (h1 h2 : X) (t1 t2 : list X), + h1 == h2 -> t1 == t2 -> h1 :: t1 == h2 :: t2 + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (equality__leibniz_equality) + + The inductive definition of equality implies _Leibniz equality_: + what we mean when we say "[x] and [y] are equal" is that every + property on [P] that is true of [x] is also true of [y]. Prove + that. *) + +Lemma equality__leibniz_equality : forall (X : Type) (x y: X), + x == y -> forall (P : X -> Prop), P x -> P y. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (equality__leibniz_equality_term) + + Construct the proof object for the previous exercise. All it + requires is anonymous functions and pattern-matching; the large + proof term constructed by tactics in the previous exercise is + needessly complicated. Hint: pattern-match as soon as possible. *) +Definition equality__leibniz_equality_term : forall (X : Type) (x y: X), + x == y -> forall P : (X -> Prop), P x -> P y + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard, optional (leibniz_equality__equality) + + Show that, in fact, the inductive definition of equality is + _equivalent_ to Leibniz equality. Hint: the proof is quite short; + about all you need to do is to invent a clever property [P] to + instantiate the antecedent.*) + +Lemma leibniz_equality__equality : forall (X : Type) (x y: X), + (forall P:X->Prop, P x -> P y) -> x == y. +Proof. +(* FILL IN HERE *) Admitted. +(** [] *) + +End EqualityPlayground. + +(* ================================================================= *) +(** ** Inversion, Again *) + +(** We've seen [inversion] used with both equality hypotheses and + hypotheses about inductively defined propositions. Now that we've + seen that these are actually the same thing, we're in a position + to take a closer look at how [inversion] behaves. + + In general, the [inversion] tactic... + + - takes a hypothesis [H] whose type [P] is inductively defined, + and + + - for each constructor [C] in [P]'s definition, + + - generates a new subgoal in which we assume [H] was + built with [C], + + - adds the arguments (premises) of [C] to the context of + the subgoal as extra hypotheses, + + - matches the conclusion (result type) of [C] against the + current goal and calculates a set of equalities that must + hold in order for [C] to be applicable, + + - adds these equalities to the context (and, for convenience, + rewrites them in the goal), and + + - if the equalities are not satisfiable (e.g., they involve + things like [S n = O]), immediately solves the subgoal. *) + +(** _Example_: If we invert a hypothesis built with [or], there are + two constructors, so two subgoals get generated. The + conclusion (result type) of the constructor ([P \/ Q]) doesn't + place any restrictions on the form of [P] or [Q], so we don't get + any extra equalities in the context of the subgoal. *) + +(** _Example_: If we invert a hypothesis built with [and], there is + only one constructor, so only one subgoal gets generated. Again, + the conclusion (result type) of the constructor ([P /\ Q]) doesn't + place any restrictions on the form of [P] or [Q], so we don't get + any extra equalities in the context of the subgoal. The + constructor does have two arguments, though, and these can be seen + in the context in the subgoal. *) + +(** _Example_: If we invert a hypothesis built with [eq], there is + again only one constructor, so only one subgoal gets generated. + Now, though, the form of the [eq_refl] constructor does give us + some extra information: it tells us that the two arguments to [eq] + must be the same! The [inversion] tactic adds this fact to the + context. *) + +(* ################################################################# *) +(** * Rocq's Trusted Computing Base *) + +(** One question that arises with any automated proof assistant + is "why should we trust it?" -- i.e., what if there is a bug in + the implementation that renders all its reasoning suspect? + + While it is impossible to allay such concerns completely, the fact + that Rocq is based on the Curry-Howard correspondence gives it a + strong foundation. Because propositions are just types and proofs + are just terms, checking that an alleged proof of a proposition is + valid just amounts to _type-checking_ the term. Type checkers are + relatively small and straightforward programs, so the "trusted + computing base" for Rocq -- the part of the code that we have to + believe is operating correctly -- is small too. + + What must a typechecker do? Its primary job is to make sure that + in each function application the expected and actual argument + types match, that the arms of a [match] expression are constructor + patterns belonging to the inductive type being matched over and + all arms of the [match] return the same type, and so on. *) + +(** There are a few additional wrinkles: + + First, since Rocq types can themselves be expressions, the checker + must normalize these (by using the computation rules) before + comparing them. + + Second, the checker must make sure that [match] expressions are + _exhaustive_. That is, there must be an arm for every possible + constructor. To see why, consider the following alleged proof + object: *) + +Fail Definition or_bogus : forall P Q, P \/ Q -> P := + fun (P Q : Prop) (A : P \/ Q) => + match A with + | or_introl H => H + end. + +(** All the types here match correctly, but the [match] only + considers one of the possible constructors for [or]. Rocq's + exhaustiveness check will reject this definition. + + Third, the checker must make sure that each recursive function + terminates. It does this using a syntactic check to make sure + that each recursive call is on a subexpression of the original + argument. To see why this is essential, consider this alleged + proof: *) + +Fail Fixpoint infinite_loop {X : Type} (n : nat) {struct n} : X := + infinite_loop n. + +Fail Definition falso : False := infinite_loop 0. + +(** Recursive function [infinite_loop] purports to return a + value of any type [X] that you would like. (The [struct] + annotation on the function tells Rocq that it recurses on argument + [n], not [X].) Were Rocq to allow [infinite_loop], then [falso] + would be definable, thus giving evidence for [False]. So Rocq rejects + [infinite_loop]. *) + +(** Note that the soundness of Rocq depends only on the + correctness of this typechecking engine, not on the tactic + machinery. If there is a bug in a tactic implementation (which + does happen occasionally), that tactic might construct an invalid + proof term. But when you type [Qed], Rocq checks the term for + validity from scratch. Only theorems whose proofs pass the + type-checker can be used in further proof developments. *) + +(* ################################################################# *) +(** * More Exercises *) + +(** Most of the following theorems were already proved with tactics in + [Logic]. Now construct the proof objects for them + directly. *) + +(** **** Exercise: 2 stars, standard (and_assoc) *) +Definition and_assoc : forall P Q R : Prop, + P /\ (Q /\ R) -> (P /\ Q) /\ R + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (or_distributes_over_and) *) +Definition or_distributes_over_and : forall P Q R : Prop, + P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 3 stars, standard (negations) *) +Definition double_neg : forall P : Prop, + P -> ~~P + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Definition contradiction_implies_anything : forall P Q : Prop, + (P /\ ~P) -> Q + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Definition de_morgan_not_or : forall P Q : Prop, + ~ (P \/ Q) -> ~P /\ ~Q + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard (currying) *) +Definition curry : forall P Q R : Prop, + ((P /\ Q) -> R) -> (P -> (Q -> R)) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Definition uncurry : forall P Q R : Prop, + (P -> (Q -> R)) -> ((P /\ Q) -> R) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. +(** [] *) + +(* ################################################################# *) +(** * Proof Irrelevance (Advanced) *) + +(** In [Logic] we saw that functional extensionality could be + added to Rocq. A similar notion about propositions can also + be defined (and added as an axiom, if desired): *) + +Definition propositional_extensionality : Prop := + forall (P Q : Prop), (P <-> Q) -> P = Q. + +(** Propositional extensionality asserts that if two propositions are + equivalent -- i.e., each implies the other -- then they are in + fact equal. The _proof objects_ for the propositions might be + syntactically different terms. But propositional extensionality + overlooks that, just as functional extensionality overlooks the + syntactic differences between functions. *) + +(** **** Exercise: 1 star, advanced (pe_implies_or_eq) + + Prove the following consequence of propositional extensionality. *) + +Theorem pe_implies_or_eq : + propositional_extensionality -> + forall (P Q : Prop), (P \/ Q) = (Q \/ P). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, advanced (pe_implies_true_eq) + + Prove that if a proposition [P] is provable, then it is equal to + [True] -- as a consequence of propositional extensionality. *) + +Lemma pe_implies_true_eq : + propositional_extensionality -> + forall (P : Prop), P -> True = P. +Proof. (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced (pe_implies_pi) + + (Acknowledgment: this theorem and its proof technique are inspired + by Gert Smolka's manuscript Modeling and Proving in Computational + Type Theory Using the Coq Proof Assistant, 2021. *) + +(** Another, perhaps surprising, consequence of propositional + extensionality is that it implies _proof irrelevance_, which + asserts that all proof objects for a proposition are equal.*) + +Definition proof_irrelevance : Prop := + forall (P : Prop) (pf1 pf2 : P), pf1 = pf2. + +(** Prove that fact. Use [pe_implies_true_eq] to establish that the + proposition [P] in [proof_irrelevance] is equal to [True]. Leverage + that equality to establish that both proof objects [pf1] and + [pf2] must be just [I]. *) + +Theorem pe_implies_pi : + propositional_extensionality -> proof_irrelevance. +Proof. (* FILL IN HERE *) Admitted. +(** [] *) + +(* 2026-01-07 13:18 *) diff --git a/ProofObjectsTest.v b/ProofObjectsTest.v new file mode 100644 index 0000000..932f7e0 --- /dev/null +++ b/ProofObjectsTest.v @@ -0,0 +1,375 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import ProofObjects. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import ProofObjects. +Import Check. + +Goal True. + +idtac "------------------- eight_is_even --------------------". +idtac " ". + +idtac "#> ev_8". +idtac "Possible points: 1". +check_type @ev_8 ((ev 8)). +idtac "Assumptions:". +Abort. +Print Assumptions ev_8. +Goal True. +idtac " ". + +idtac "#> ev_8'". +idtac "Possible points: 1". +check_type @ev_8' ((ev 8)). +idtac "Assumptions:". +Abort. +Print Assumptions ev_8'. +Goal True. +idtac " ". + +idtac "------------------- conj_fact --------------------". +idtac " ". + +idtac "#> Props.conj_fact". +idtac "Possible points: 2". +check_type @Props.conj_fact ( +(forall (P Q R : Prop) (_ : and P Q) (_ : and Q R), and P R)). +idtac "Assumptions:". +Abort. +Print Assumptions Props.conj_fact. +Goal True. +idtac " ". + +idtac "------------------- or_commut' --------------------". +idtac " ". + +idtac "#> Props.or_commut'". +idtac "Possible points: 2". +check_type @Props.or_commut' ((forall (P Q : Prop) (_ : or P Q), or Q P)). +idtac "Assumptions:". +Abort. +Print Assumptions Props.or_commut'. +Goal True. +idtac " ". + +idtac "------------------- ex_ev_Sn --------------------". +idtac " ". + +idtac "#> Props.ex_ev_Sn". +idtac "Possible points: 2". +check_type @Props.ex_ev_Sn ((@ex nat (fun n : nat => ev (S n)))). +idtac "Assumptions:". +Abort. +Print Assumptions Props.ex_ev_Sn. +Goal True. +idtac " ". + +idtac "------------------- ex_match --------------------". +idtac " ". + +idtac "#> Props.ex_match". +idtac "Possible points: 2". +check_type @Props.ex_match ( +(forall (A : Type) (P Q : forall _ : A, Prop) + (_ : forall (x : A) (_ : P x), Q x) (_ : @ex A (fun x : A => P x)), + @ex A (fun x : A => Q x))). +idtac "Assumptions:". +Abort. +Print Assumptions Props.ex_match. +Goal True. +idtac " ". + +idtac "------------------- p_implies_true --------------------". +idtac " ". + +idtac "#> Props.p_implies_true". +idtac "Possible points: 1". +check_type @Props.p_implies_true ((forall (P : Type) (_ : P), Props.True)). +idtac "Assumptions:". +Abort. +Print Assumptions Props.p_implies_true. +Goal True. +idtac " ". + +idtac "------------------- ex_falso_quodlibet' --------------------". +idtac " ". + +idtac "#> Props.ex_falso_quodlibet'". +idtac "Possible points: 1". +check_type @Props.ex_falso_quodlibet' ((forall (P : Type) (_ : Props.False), P)). +idtac "Assumptions:". +Abort. +Print Assumptions Props.ex_falso_quodlibet'. +Goal True. +idtac " ". + +idtac "------------------- eq_cons --------------------". +idtac " ". + +idtac "#> EqualityPlayground.eq_cons". +idtac "Possible points: 2". +check_type @EqualityPlayground.eq_cons ( +(forall (X : Type) (h1 h2 : X) (t1 t2 : list X) + (_ : @EqualityPlayground.eq X h1 h2) + (_ : @EqualityPlayground.eq (list X) t1 t2), + @EqualityPlayground.eq (list X) (@cons X h1 t1) (@cons X h2 t2))). +idtac "Assumptions:". +Abort. +Print Assumptions EqualityPlayground.eq_cons. +Goal True. +idtac " ". + +idtac "------------------- equality__leibniz_equality --------------------". +idtac " ". + +idtac "#> EqualityPlayground.equality__leibniz_equality". +idtac "Possible points: 2". +check_type @EqualityPlayground.equality__leibniz_equality ( +(forall (X : Type) (x y : X) (_ : @EqualityPlayground.eq X x y) + (P : forall _ : X, Prop) (_ : P x), + P y)). +idtac "Assumptions:". +Abort. +Print Assumptions EqualityPlayground.equality__leibniz_equality. +Goal True. +idtac " ". + +idtac "------------------- equality__leibniz_equality_term --------------------". +idtac " ". + +idtac "#> EqualityPlayground.equality__leibniz_equality_term". +idtac "Possible points: 2". +check_type @EqualityPlayground.equality__leibniz_equality_term ( +(forall (X : Type) (x y : X) (_ : @EqualityPlayground.eq X x y) + (P : forall _ : X, Prop) (_ : P x), + P y)). +idtac "Assumptions:". +Abort. +Print Assumptions EqualityPlayground.equality__leibniz_equality_term. +Goal True. +idtac " ". + +idtac "------------------- and_assoc --------------------". +idtac " ". + +idtac "#> and_assoc". +idtac "Possible points: 2". +check_type @and_assoc ((forall (P Q R : Prop) (_ : and P (and Q R)), and (and P Q) R)). +idtac "Assumptions:". +Abort. +Print Assumptions and_assoc. +Goal True. +idtac " ". + +idtac "------------------- or_distributes_over_and --------------------". +idtac " ". + +idtac "#> or_distributes_over_and". +idtac "Possible points: 3". +check_type @or_distributes_over_and ( +(forall P Q R : Prop, iff (or P (and Q R)) (and (or P Q) (or P R)))). +idtac "Assumptions:". +Abort. +Print Assumptions or_distributes_over_and. +Goal True. +idtac " ". + +idtac "------------------- negations --------------------". +idtac " ". + +idtac "#> double_neg". +idtac "Possible points: 1". +check_type @double_neg ((forall (P : Prop) (_ : P), not (not P))). +idtac "Assumptions:". +Abort. +Print Assumptions double_neg. +Goal True. +idtac " ". + +idtac "#> contradiction_implies_anything". +idtac "Possible points: 1". +check_type @contradiction_implies_anything ((forall (P Q : Prop) (_ : and P (not P)), Q)). +idtac "Assumptions:". +Abort. +Print Assumptions contradiction_implies_anything. +Goal True. +idtac " ". + +idtac "#> de_morgan_not_or". +idtac "Possible points: 1". +check_type @de_morgan_not_or ( +(forall (P Q : Prop) (_ : not (or P Q)), and (not P) (not Q))). +idtac "Assumptions:". +Abort. +Print Assumptions de_morgan_not_or. +Goal True. +idtac " ". + +idtac "------------------- currying --------------------". +idtac " ". + +idtac "#> curry". +idtac "Possible points: 1". +check_type @curry ( +(forall (P Q R : Prop) (_ : forall _ : and P Q, R) (_ : P) (_ : Q), R)). +idtac "Assumptions:". +Abort. +Print Assumptions curry. +Goal True. +idtac " ". + +idtac "#> uncurry". +idtac "Possible points: 1". +check_type @uncurry ( +(forall (P Q R : Prop) (_ : forall (_ : P) (_ : Q), R) (_ : and P Q), R)). +idtac "Assumptions:". +Abort. +Print Assumptions uncurry. +Goal True. +idtac " ". + +idtac "------------------- pe_implies_or_eq --------------------". +idtac " ". + +idtac "#> pe_implies_or_eq". +idtac "Advanced". +idtac "Possible points: 1". +check_type @pe_implies_or_eq ( +(forall (_ : propositional_extensionality) (P Q : Prop), + @eq Prop (or P Q) (or Q P))). +idtac "Assumptions:". +Abort. +Print Assumptions pe_implies_or_eq. +Goal True. +idtac " ". + +idtac "------------------- pe_implies_true_eq --------------------". +idtac " ". + +idtac "#> pe_implies_true_eq". +idtac "Advanced". +idtac "Possible points: 1". +check_type @pe_implies_true_eq ( +(forall (_ : propositional_extensionality) (P : Prop) (_ : P), + @eq Prop True P)). +idtac "Assumptions:". +Abort. +Print Assumptions pe_implies_true_eq. +Goal True. +idtac " ". + +idtac "------------------- pe_implies_pi --------------------". +idtac " ". + +idtac "#> pe_implies_pi". +idtac "Advanced". +idtac "Possible points: 3". +check_type @pe_implies_pi ((forall _ : propositional_extensionality, proof_irrelevance)). +idtac "Assumptions:". +Abort. +Print Assumptions pe_implies_pi. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 28". +idtac "Max points - advanced: 33". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- ev_8 ---------". +Print Assumptions ev_8. +idtac "---------- ev_8' ---------". +Print Assumptions ev_8'. +idtac "---------- Props.conj_fact ---------". +Print Assumptions Props.conj_fact. +idtac "---------- Props.or_commut' ---------". +Print Assumptions Props.or_commut'. +idtac "---------- Props.ex_ev_Sn ---------". +Print Assumptions Props.ex_ev_Sn. +idtac "---------- Props.ex_match ---------". +Print Assumptions Props.ex_match. +idtac "---------- Props.p_implies_true ---------". +Print Assumptions Props.p_implies_true. +idtac "---------- Props.ex_falso_quodlibet' ---------". +Print Assumptions Props.ex_falso_quodlibet'. +idtac "---------- EqualityPlayground.eq_cons ---------". +Print Assumptions EqualityPlayground.eq_cons. +idtac "---------- EqualityPlayground.equality__leibniz_equality ---------". +Print Assumptions EqualityPlayground.equality__leibniz_equality. +idtac "---------- EqualityPlayground.equality__leibniz_equality_term ---------". +Print Assumptions EqualityPlayground.equality__leibniz_equality_term. +idtac "---------- and_assoc ---------". +Print Assumptions and_assoc. +idtac "---------- or_distributes_over_and ---------". +Print Assumptions or_distributes_over_and. +idtac "---------- double_neg ---------". +Print Assumptions double_neg. +idtac "---------- contradiction_implies_anything ---------". +Print Assumptions contradiction_implies_anything. +idtac "---------- de_morgan_not_or ---------". +Print Assumptions de_morgan_not_or. +idtac "---------- curry ---------". +Print Assumptions curry. +idtac "---------- uncurry ---------". +Print Assumptions uncurry. +idtac "". +idtac "********** Advanced **********". +idtac "---------- pe_implies_or_eq ---------". +Print Assumptions pe_implies_or_eq. +idtac "---------- pe_implies_true_eq ---------". +Print Assumptions pe_implies_true_eq. +idtac "---------- pe_implies_pi ---------". +Print Assumptions pe_implies_pi. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/README.md b/README.md new file mode 100644 index 0000000..59b7ffb --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# Software Foundations 1 + +This is a template repository for the code found in [Software Foundations 1](https://softwarefoundations.cis.upenn.edu/lf-current/index.html) + +It contains an additional nix-shell and envrc file to easily get started. + +All the HTML has been removed, most of the content is inlined in the files anyway, and the rendered HTML is available online if you need it. + +Fork me, and go ham. + +![Deps](./deps.svg) + +--- + +## Original README + +``` +######################################################################### + SOFTWARE FOUNDATIONS +######################################################################### + +This directory contains both Rocq scripts (.v files) and generated HTML +files for Volume 1 of the Software Foundations electronic textbook +series. + + - Preface.v or Preface.html + The place to start reading, including details on how to install + required software + + - index.html + The book's cover page and navigation starting point + + - deps.html + Overview of the ordering of chapters + + - LICENSE + Explanation of how these files may be redistributed +``` diff --git a/Rel.v b/Rel.v new file mode 100644 index 0000000..91a96df --- /dev/null +++ b/Rel.v @@ -0,0 +1,412 @@ +(** * Rel: Properties of Relations *) + +(** This short (and optional) chapter develops some basic definitions + and a few theorems about binary relations in Rocq. The key + definitions are repeated where they are actually used (in the + [Smallstep] chapter of _Programming Language Foundations_), + so readers who are already comfortable with these ideas can safely + skim or skip this chapter. However, relations are also a good + source of exercises for developing facility with Rocq's basic + reasoning facilities, so it may be useful to look at this material + just after the [IndProp] chapter. *) + +Set Warnings "-notation-overridden". +From LF Require Export IndProp. + +(* ################################################################# *) +(** * Relations *) + +(** A binary _relation_ on a set [X] is a family of propositions + parameterized by two elements of [X] -- i.e., a proposition about + pairs of elements of [X]. *) + +Definition relation (X: Type) := X -> X -> Prop. + +(** Somewhat confusingly, the Rocq standard library hijacks the generic + term "relation" for this specific instance of the idea. To + maintain consistency with the library, we will do the same. So, + henceforth, the Rocq identifier [relation] will always refer to a + binary relation _on_ some set (between the set and itself), + whereas in ordinary mathematical English the word "relation" can + refer either to this specific concept or the more general concept + of a relation between any number of possibly different sets. The + context of the discussion should always make clear which is + meant. *) + +(** An example relation on [nat] is [le], the less-than-or-equal-to + relation, which we usually write [n1 <= n2]. *) + +Print le. +(* ====> Inductive le (n : nat) : nat -> Prop := + le_n : n <= n + | le_S : forall m : nat, n <= m -> n <= S m *) +Check le : nat -> nat -> Prop. +Check le : relation nat. +(** (Why did we write it this way instead of starting with [Inductive + le : relation nat...]? Because we wanted to put the first [nat] + to the left of the [:], which makes Rocq generate a somewhat nicer + induction principle for reasoning about [<=].) *) + +(* ################################################################# *) +(** * Basic Properties *) + +(** As anyone knows who has taken an undergraduate discrete math + course, there is a lot to be said about relations in general, + including ways of classifying relations (as reflexive, transitive, + etc.), theorems that can be proved generically about certain sorts + of relations, constructions that build one relation from another, + etc. For example... *) + +(* ----------------------------------------------------------------- *) +(** *** Partial Functions *) + +(** A relation [R] on a set [X] is a _partial function_ if, for every + [x], there is at most one [y] such that [R x y] -- i.e., [R x y1] + and [R x y2] together imply [y1 = y2]. *) + +Definition partial_function {X: Type} (R: relation X) := + forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2. + +(** For example, the [next_nat] relation is a partial function. *) +Inductive next_nat : nat -> nat -> Prop := + | nn n : next_nat n (S n). + +Check next_nat : relation nat. + +Theorem next_nat_partial_function : + partial_function next_nat. +Proof. + unfold partial_function. + intros x y1 y2 H1 H2. + inversion H1. inversion H2. + reflexivity. Qed. + +(** However, the [<=] relation on numbers is not a partial + function. (Assume, for a contradiction, that [<=] is a partial + function. But then, since [0 <= 0] and [0 <= 1], it follows that + [0 = 1]. This is nonsense, so our assumption was + contradictory.) *) + +Theorem le_not_a_partial_function : + ~ (partial_function le). +Proof. + unfold not. unfold partial_function. intros Hc. + assert (0 = 1) as Nonsense. { + apply Hc with (x := 0). + - apply le_n. + - apply le_S. apply le_n. } + discriminate Nonsense. Qed. + +(** **** Exercise: 2 stars, standard, optional (total_relation_not_partial_function) + + Show that the [total_relation] defined in (an exercise in) + [IndProp] is not a partial function. *) + +(** Copy the definition of [total_relation] from your [IndProp] + here so that this file can be graded on its own. *) +Inductive total_relation : nat -> nat -> Prop := + (* FILL IN HERE *) +. + +Theorem total_relation_not_partial_function : + ~ (partial_function total_relation). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (empty_relation_partial_function) + + Show that the [empty_relation] defined in (an exercise in) + [IndProp] is a partial function. *) + +(** Copy the definition of [empty_relation] from your [IndProp] + here so that this file can be graded on its own. *) +Inductive empty_relation : nat -> nat -> Prop := + (* FILL IN HERE *) +. + +Theorem empty_relation_partial_function : + partial_function empty_relation. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ----------------------------------------------------------------- *) +(** *** Reflexive Relations *) + +(** A _reflexive_ relation on a set [X] is one for which every element + of [X] is related to itself. *) + +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. + +(* ----------------------------------------------------------------- *) +(** *** Transitive Relations *) + +(** A relation [R] is _transitive_ if [R a c] holds whenever [R a b] + and [R b c] do. *) + +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. + - (* le_n *) apply Hnm. + - (* 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. + +(** **** Exercise: 2 stars, standard, optional (le_trans_hard_way) + + We can also prove [lt_trans] more laboriously by induction, + without using [le_trans]. Do this. *) + +Theorem lt_trans' : + transitive lt. +Proof. + (* Prove this by induction on evidence that [m] is less than [o]. *) + unfold lt. unfold transitive. + intros n m o Hnm Hmo. + induction Hmo as [| m' Hm'o]. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (lt_trans'') + + Prove the same thing again by induction on [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. +(** [] *) + +(** The transitivity of [le], in turn, can be used to prove some facts + that will be useful later (e.g., for the proof of antisymmetry + below)... *) + +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. + +(** **** Exercise: 1 star, standard, optional (le_S_n) *) +Theorem le_S_n : forall n m, + (S n <= S m) -> (n <= m). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (le_Sn_n_inf) + + Provide an informal proof of the following theorem: + + Theorem: For every [n], [~ (S n <= n)] + + A formal proof of this is an optional exercise below, but try + writing an informal proof without doing the formal proof first. + + Proof: *) + (* FILL IN HERE + + [] *) + +(** **** Exercise: 1 star, standard, optional (le_Sn_n) *) +Theorem le_Sn_n : forall n, + ~ (S n <= n). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Reflexivity and transitivity are the main concepts we'll need for + later chapters, but, for a bit of additional practice working with + relations in Rocq, let's look at a few other common ones... *) + +(* ----------------------------------------------------------------- *) +(** *** Symmetric and Antisymmetric Relations *) + +(** A relation [R] is _symmetric_ if [R a b] implies [R b a]. *) + +Definition symmetric {X: Type} (R: relation X) := + forall a b : X, (R a b) -> (R b a). + +(** **** Exercise: 2 stars, standard, optional (le_not_symmetric) *) +Theorem le_not_symmetric : + ~ (symmetric le). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together + imply [a = b] -- that is, if the only "cycles" in [R] are trivial + ones. *) + +Definition antisymmetric {X: Type} (R: relation X) := + forall a b : X, (R a b) -> (R b a) -> a = b. + +(** **** Exercise: 2 stars, standard, optional (le_antisymmetric) *) +Theorem le_antisymmetric : + antisymmetric le. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, standard, optional (le_step) *) +Theorem le_step : forall n m p, + n < m -> + m <= S p -> + n <= p. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ----------------------------------------------------------------- *) +(** *** Equivalence Relations *) + +(** A relation is an _equivalence_ if it's reflexive, symmetric, and + transitive. *) + +Definition equivalence {X:Type} (R: relation X) := + (reflexive R) /\ (symmetric R) /\ (transitive R). + +(* ----------------------------------------------------------------- *) +(** *** Partial Orders and Preorders *) + +(** A relation is a _partial order_ when it's reflexive, + _anti_-symmetric, and transitive. In the Rocq standard library + it's called just "order" for short. *) + +Definition order {X:Type} (R: relation X) := + (reflexive R) /\ (antisymmetric R) /\ (transitive R). + +(** A preorder is almost like a partial order, but doesn't have to be + antisymmetric. *) + +Definition preorder {X:Type} (R: relation X) := + (reflexive R) /\ (transitive R). + +Theorem le_order : + order le. +Proof. + unfold order. split. + - (* refl *) apply le_reflexive. + - split. + + (* antisym *) apply le_antisymmetric. + + (* transitive. *) apply le_trans. Qed. + +(* ################################################################# *) +(** * Reflexive, Transitive Closure *) + +(** The _reflexive, transitive closure_ of a relation [R] is the + smallest relation that contains [R] and that is both reflexive and + transitive. Formally, it is defined like this in the Relations + module of the Rocq standard library: *) + +Inductive clos_refl_trans {A: Type} (R: relation A) : relation A := + | rt_step x y (H : R x y) : clos_refl_trans R x y + | rt_refl x : clos_refl_trans R x x + | rt_trans x y z + (Hxy : clos_refl_trans R x y) + (Hyz : clos_refl_trans R y z) : + clos_refl_trans R x z. + +(** For example, the reflexive and transitive closure of the + [next_nat] relation coincides with the [le] relation. *) + +Theorem next_nat_closure_is_le : forall n m, + (n <= m) <-> ((clos_refl_trans next_nat) n m). +Proof. + intros n m. split. + - (* -> *) + intro H. induction H. + + (* le_n *) apply rt_refl. + + (* le_S *) + apply rt_trans with m. apply IHle. apply rt_step. + apply nn. + - (* <- *) + intro H. induction H. + + (* rt_step *) inversion H. apply le_S. apply le_n. + + (* rt_refl *) apply le_n. + + (* rt_trans *) + apply le_trans with y. + apply IHclos_refl_trans1. + apply IHclos_refl_trans2. Qed. + +(** The above definition of reflexive, transitive closure is natural: + it says, explicitly, that the reflexive and transitive closure of + [R] is the least relation that includes [R] and that is closed + under rules of reflexivity and transitivity. But it turns out + that this definition is not very convenient for doing proofs, + since the "nondeterminism" of the [rt_trans] rule can sometimes + lead to tricky inductions. Here is a more useful definition: *) + +Inductive clos_refl_trans_1n {A : Type} + (R : relation A) (x : A) + : A -> Prop := + | rt1n_refl : clos_refl_trans_1n R x x + | rt1n_trans (y z : A) + (Hxy : R x y) (Hrest : clos_refl_trans_1n R y z) : + clos_refl_trans_1n R x z. + +(** Our new definition of reflexive, transitive closure "bundles" + the [rt_step] and [rt_trans] rules into the single rule step. + The left-hand premise of this step is a single use of [R], + leading to a much simpler induction principle. + + Before we go on, we should check that the two definitions do + indeed define the same relation... + + First, we prove two lemmas showing that [clos_refl_trans_1n] mimics + the behavior of the two "missing" [clos_refl_trans] + constructors. *) + +Lemma rsc_R : forall (X:Type) (R:relation X) (x y : X), + R x y -> clos_refl_trans_1n R x y. +Proof. + intros X R x y H. + apply rt1n_trans with y. apply H. apply rt1n_refl. Qed. + +(** **** Exercise: 2 stars, standard, optional (rsc_trans) *) +Lemma rsc_trans : + forall (X:Type) (R: relation X) (x y z : X), + clos_refl_trans_1n R x y -> + clos_refl_trans_1n R y z -> + clos_refl_trans_1n R x z. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Then we use these facts to prove that the two definitions of + reflexive, transitive closure do indeed define the same + relation. *) + +(** **** Exercise: 3 stars, standard, optional (rtc_rsc_coincide) *) +Theorem rtc_rsc_coincide : + forall (X:Type) (R: relation X) (x y : X), + clos_refl_trans R x y <-> clos_refl_trans_1n R x y. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* 2026-01-07 13:18 *) diff --git a/RelTest.v b/RelTest.v new file mode 100644 index 0000000..897970d --- /dev/null +++ b/RelTest.v @@ -0,0 +1,68 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Rel. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Rel. +Import Check. + +Goal True. + +idtac " ". + +idtac "Max points - standard: 0". +idtac "Max points - advanced: 0". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "". +idtac "********** Advanced **********". +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/Tactics.v b/Tactics.v new file mode 100644 index 0000000..4718d30 --- /dev/null +++ b/Tactics.v @@ -0,0 +1,1301 @@ +(** * Tactics: More Basic Tactics *) + +(** This chapter introduces several additional proof strategies + and tactics that allow us to begin proving more interesting + properties of functional programs. + + We will see: + - how to use auxiliary lemmas in both "forward-" and + "backward-style" proofs; + - how to reason about data constructors -- in particular, how to + use the fact that they are injective and disjoint; + - how to strengthen an induction hypothesis, and when such + strengthening is required; and + - more details on how to reason by case analysis. *) + +Set Warnings "-notation-overridden". +From LF Require Export Poly. + +(* ################################################################# *) +(** * The [apply] Tactic *) + +(** We often encounter situations where the goal to be proved is + _exactly_ the same as some hypothesis in the context or some + previously proved lemma. *) + +Theorem silly1 : forall (n m : nat), + n = m -> + n = m. +Proof. + intros n m eq. + +(** Here, we could finish with "[rewrite -> eq. reflexivity.]" as we + have done several times before. Or we can finish in a single step + by using [apply]: *) + + apply eq. Qed. + +(** The [apply] tactic also works with _conditional_ hypotheses + and lemmas: if the statement being applied is an implication, then + the premises of this implication will be added to the list of + subgoals needing to be proved. + + [apply] also works with _conditional_ hypotheses: *) + +Theorem silly2 : forall (n m o p : nat), + n = m -> + (n = m -> [n;o] = [m;p]) -> + [n;o] = [m;p]. +Proof. + intros n m o p eq1 eq2. + apply eq2. apply eq1. Qed. + +(** Typically, when we use [apply H], the statement [H] will + begin with a [forall] that introduces some _universally quantified + variables_. + + When Rocq matches the current goal against the conclusion of [H], + it will try to find appropriate values for these variables. For + example, when we do [apply eq2] in the following proof, the + universal variable [q] in [eq2] gets instantiated with [n], and + [r] gets instantiated with [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. + +(** **** Exercise: 2 stars, standard, optional (silly_ex) + + Complete the following proof using only [intros] and [apply]. *) +Theorem silly_ex : forall p, + (forall n, even n = true -> even (S n) = false) -> + (forall n, even n = false -> odd n = true) -> + even p = true -> + odd (S p) = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** To use the [apply] tactic, the (conclusion of the) fact + being applied must match the goal exactly (perhaps after + simplification) -- for example, [apply] will not work if the left + and right sides of the equality are swapped. *) + +Theorem silly3 : forall (n m : nat), + n = m -> + m = n. +Proof. + intros n m H. + + (** Here we cannot use [apply] directly... *) + + Fail apply H. + + (** ...but we can use the [symmetry] tactic, which switches the left + and right sides of an equality in the goal. *) + + symmetry. apply H. Qed. + +(** **** Exercise: 2 stars, standard (apply_exercise1) + + You can use [apply] with previously defined theorems, not + just hypotheses in the context. Use [Search] to find a + previously-defined theorem about [rev] from [Lists]. Use + that theorem as part of your (relatively short) solution to this + exercise. You do not need [induction]. *) + +Theorem rev_exercise1 : forall (l l' : list nat), + l = rev l' -> + l' = rev l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 1 star, standard, optional (apply_rewrite) + + Briefly explain the difference between the tactics [apply] and + [rewrite]. What are the situations where both can usefully be + applied? *) + +(* FILL IN HERE + + [] *) + +(* ################################################################# *) +(** * The [apply with] Tactic *) + +(** The following silly example uses two rewrites in a row to + get from [[a;b]] to [[e;f]]. *) + +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. apply eq2. Qed. + +(** Since this is a common pattern, we might like to pull it out as a + lemma that records, once and for all, the fact that equality is + transitive. *) + +Theorem trans_eq : forall (X:Type) (x y z : X), + x = y -> y = z -> x = z. +Proof. + intros X x y z eq1 eq2. rewrite -> eq1. rewrite -> eq2. + reflexivity. Qed. + +(** Now, we should be able to use [trans_eq] to prove the above + example. However, to do this we need a slight refinement of the + [apply] tactic. *) + +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. + +(** If we simply tell Rocq [apply trans_eq] at this point, it can + tell (by matching the goal against the conclusion of the lemma) + that it should instantiate [X] with [[nat]], [x] with [[a,b]], and + [z] with [[e,f]]. However, the matching process doesn't determine + an instantiation for [y]: we have to supply one explicitly by + adding "[with (y:=[c,d])]" to the invocation of [apply]. *) + + apply trans_eq with (y:=[c;d]). + apply eq1. apply eq2. Qed. + +(** Actually, the name [y] in the [with] clause is not required, + since Rocq is often smart enough to figure out which variable we + are instantiating. We could instead simply write [apply trans_eq + with [c;d]]. *) + +(** Rocq also has a built-in tactic [transitivity] that + accomplishes the same purpose as applying [trans_eq]. The tactic + requires us to state the instantiation we want, just like [apply + with] does. *) + +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. + transitivity [c;d]. + apply eq1. apply eq2. Qed. + +(** **** Exercise: 3 stars, standard, optional (trans_eq_exercise) *) +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. +(** [] *) + +(* ################################################################# *) +(** * The [injection] and [discriminate] Tactics *) + +(** Recall the definition of natural numbers: + + Inductive nat : Type := + | O + | S (n : nat). + + It is obvious from this definition that every number has one of + two forms: either it is the constructor [O] or it is built by + applying the constructor [S] to another number. But there is more + here than meets the eye: implicit in the definition are two + additional facts: + + - The constructor [S] is _injective_ (or _one-to-one_). That is, + if [S n = S m], it must also be that [n = m]. + + - The constructors [O] and [S] are _disjoint_. That is, [O] is not + equal to [S n] for any [n]. *) + +(** Similar principles apply to every inductively defined type: + all constructors are injective, and the values built from distinct + constructors are never equal. For lists, the [cons] constructor + is injective and the empty list [nil] is different from every + non-empty list. For booleans, [true] and [false] are different. + (Since [true] and [false] take no arguments, their injectivity is + neither here nor there.) And so on. *) + +(** We can _prove_ the injectivity of [S] by using the [pred] function + defined in [Basics.v]. *) + +Theorem S_injective : forall (n m : nat), + S n = S m -> + n = m. +Proof. + intros n m H1. + assert (H2: n = pred (S n)). { reflexivity. } + rewrite H2. rewrite H1. simpl. reflexivity. +Qed. + +(** Rocq's [assert] tactic, used above, adds the given hypothesis + to the context, but it first requires you to prove the hypothesis + as a new goal. + + This technique for injectivity can be generalized to any constructor + by writing the equivalent of [pred] -- i.e., writing a function that + "undoes" one application of the constructor. + + As a convenient alternative, Rocq provides a tactic called + [injection] that allows us to exploit the injectivity of any + constructor. Here is an alternate proof of the above theorem + using [injection]: *) + +Theorem S_injective' : forall (n m : nat), + S n = S m -> + n = m. +Proof. + intros n m H. + +(** By writing [injection H as Hmn] at this point, we are asking Rocq + to generate all equations that it can infer from [H] using the + injectivity of constructors (in the present example, the equation + [n = m]). Each such equation is added as a hypothesis (called + [Hmn] in this case) into the context. *) + + injection H as Hnm. apply Hnm. +Qed. + +(** Here's a more interesting example that shows how [injection] can + derive multiple equations at once. *) + +Theorem injection_ex1 : forall (n m o : nat), + [n;m] = [o;o] -> + n = m. +Proof. + intros n m o H. + (* WORKED IN CLASS *) + injection H as H1 H2. + rewrite H1. rewrite H2. reflexivity. +Qed. + +(** **** Exercise: 3 stars, standard (injection_ex3) *) +Example injection_ex3 : forall (X : Type) (x y z : X) (l j : list X), + x :: y :: l = z :: j -> + j = z :: l -> + x = y. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** So much for injectivity of constructors. What about disjointness? *) + +(** The principle of disjointness says that two terms beginning + with different constructors (like [O] and [S], or [true] and [false]) + can never be equal. This means that, any time we find ourselves + in a context where we've _assumed_ that two such terms are equal, + we are justified in concluding anything we want, since the + assumption is nonsensical. *) + +(** The [discriminate] tactic embodies this principle: It is used + on a hypothesis involving an equality between different + constructors (e.g., [false = true]), and it solves the current + goal immediately. Some examples: *) + +Theorem discriminate_ex1 : forall (n m : nat), + false = true -> + n = m. +Proof. + intros n m contra. discriminate contra. Qed. + +Theorem discriminate_ex2 : forall (n : nat), + S n = O -> + 2 + 2 = 5. +Proof. + intros n contra. discriminate contra. Qed. + +(** These examples are instances of a logical principle known as the + _principle of explosion_, which asserts that a contradictory + hypothesis entails anything (even manifestly false things!). *) + +(** If you find the principle of explosion confusing, remember + that these proofs are _not_ showing that the conclusion of the + statement holds. Rather, they are showing that, _if_ the + nonsensical situation described by the premise did somehow hold, + _then_ the nonsensical conclusion would too -- because we'd be + living in an inconsistent universe where every statement is true. + + We'll explore the principle of explosion in more detail in the + next chapter. *) + +(** **** Exercise: 1 star, standard (discriminate_ex3) *) +Example discriminate_ex3 : + forall (X : Type) (x y z : X) (l j : list X), + x :: y :: l = [] -> + x = z. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** For a more useful example, we can use [discriminate] to make a + connection between the two different notions of equality ([=] and + [=?]) that we have seen for natural numbers. *) +Theorem eqb_0_l : forall n, + 0 =? n = true -> n = 0. +Proof. + intros n. + +(** We can proceed by case analysis on [n]. The first case is + trivial. *) + + destruct n as [| n'] eqn:E. + - (* n = 0 *) + intros H. reflexivity. + +(** However, the second one doesn't look so simple: assuming + [0 =? (S n') = true], we must show [S n' = 0]! The way forward + is to observe that the assumption itself is nonsensical: *) + + - (* n = S n' *) + simpl. + +(** If we use [discriminate] on this hypothesis, Rocq confirms + that the subgoal we are working on is impossible and removes it + from further consideration. *) + + intros H. discriminate H. +Qed. + +(** The injectivity of constructors allows us to reason that [forall + (n m : nat), S n = S m -> n = m]. The converse of this + implication is an instance of a more general fact about both + constructors and functions, which we will find useful below: *) + +Theorem f_equal : forall (A B : Type) (f: A -> B) (x y: A), + x = y -> f x = f y. +Proof. intros A B f x y eq. rewrite eq. reflexivity. Qed. + +Theorem eq_implies_succ_equal : forall (n m : nat), + n = m -> S n = S m. +Proof. intros n m H. apply f_equal. apply H. Qed. + +(** Indeed, there is also a tactic named `f_equal` that can + prove such theorems directly. Given a goal of the form [f a1 + ... an = g b1 ... bn], the tactic [f_equal] will produce subgoals + of the form [f = g], [a1 = b1], ..., [an = bn]. At the same time, + any of these subgoals that are simple enough (e.g., immediately + provable by [reflexivity]) will be automatically discharged. *) + +Theorem eq_implies_succ_equal' : forall (n m : nat), + n = m -> S n = S m. +Proof. intros n m H. f_equal. apply H. Qed. + +(* ################################################################# *) +(** * Using Tactics on Hypotheses *) + +(** By default, most tactics work on the goal formula and leave + the context unchanged. However, most tactics also have a variant + that performs a similar operation on a statement in the context. + + For example, the tactic "[simpl in H]" performs simplification on + the hypothesis [H] in the context. *) + +Theorem S_inj : forall (n m : nat) (b : bool), + ((S n) =? (S m)) = b -> + (n =? m) = b. +Proof. + intros n m b H. simpl in H. apply H. Qed. + +(** Similarly, [apply L in H] matches some conditional statement + [L] (of the form [X -> Y], say) against a hypothesis [H] in the + context. However, unlike ordinary [apply] (which rewrites a goal + matching [Y] into a subgoal [X]), [apply L in H] matches [H] + against [X] and, if successful, replaces it with [Y]. + + In other words, [apply L in H] gives us a form of "forward + reasoning": given [X -> Y] and a hypothesis matching [X], it + produces a hypothesis matching [Y]. + + By contrast, [apply L] is "backward reasoning": it says that if we + know [X -> Y] and we are trying to prove [Y], it suffices to prove + [X]. + + Here is a variant of a proof from above, using forward reasoning + throughout instead of backward reasoning. *) + +Theorem silly4 : forall (n m p q : nat), + (n = m -> p = q) -> + m = n -> + q = p. +Proof. + intros n m p q EQ H. + symmetry in H. apply EQ in H. symmetry in H. + apply H. Qed. + +(** Forward reasoning starts from what is _given_ (premises, + previously proven theorems) and iteratively draws conclusions from + them until the goal is reached. Backward reasoning starts from + the _goal_ and iteratively reasons about what would imply the + goal, until premises or previously proven theorems are reached. + + The informal proofs seen in math or computer science classes tend + to use forward reasoning. By contrast, idiomatic use of Rocq + generally favors backward reasoning, though in some situations the + forward style can be easier to think about. *) + +(* ################################################################# *) +(** * Specializing Hypotheses *) + +(** Another handy tactic for manipulating hypotheses is [specialize]. + It is essentially just a combination of [assert] and [apply], but + it often provides a pleasingly smooth way to nail down overly + general assumptions. It works like this: + + If [H] is a quantified hypothesis in the current context -- i.e., + [H : forall (x:T), P] -- then [specialize H with (x := e)] will + change [H] so that it looks like [P] with [x] replaced by [e]. + + For example: *) + +Theorem specialize_example: forall n, + (forall m, m*n = 0) + -> n = 0. +Proof. + intros n H. + specialize H with (m := 1). + rewrite mult_1_l in H. + apply H. Qed. + +(** **** Exercise: 3 stars, standard (nth_error_always_none) *) + +(** Use [specialize] to prove the the following lemma, following the + model of [specialize_example] above. Do not use [induction]. *) +Lemma nth_error_always_none: forall (l : list nat), + (forall i, nth_error l i = None) -> + l = []. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** Using [specialize] before [apply] gives us yet another way to + control where [apply] does its work. *) +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. + specialize trans_eq with (y:=[c;d]) as H. + apply H. + apply eq1. + apply eq2. Qed. +(** Things to note: + - We can [specialize] facts in the global context, not just + local hypotheses. + - The [as...] clause at the end tells [specialize] how to name + the new hypothesis in this case. *) + +(* ################################################################# *) +(** * Varying the Induction Hypothesis *) + +(** Sometimes it is important to control the exact form of the + induction hypothesis when carrying out inductive proofs in Rocq. + In particular, we may need to be careful about which of the + assumptions we move (using [intros]) from the goal to the context + before invoking the [induction] tactic. + + For example, suppose we want to show that [double] is injective -- + i.e., that it maps different arguments to different results: + + Theorem double_injective: forall n m, + double n = double m -> + n = m. + + The way we start this proof is a bit delicate: if we begin it with + + intros n. induction n. + + then all will be well. But if we begin it with introducing _both_ + variables + + intros n m. induction n. + + we get stuck in the middle of the inductive case... *) + +Theorem double_injective_FAILED : forall n m, + double n = double m -> + n = m. +Proof. + intros n m. induction n as [| n' IHn']. + - (* n = O *) simpl. intros eq. destruct m as [| m'] eqn:E. + + (* m = O *) reflexivity. + + (* m = S m' *) discriminate eq. + - (* n = S n' *) intros eq. destruct m as [| m'] eqn:E. + + (* m = O *) discriminate eq. + + (* m = S m' *) f_equal. + +(** At this point, the induction hypothesis ([IHn']) does _not_ give us + [n' = m'] -- there is an extra [S] in the way -- so the goal is + not provable. *) + +Abort. + +(** What went wrong? *) + +(** The problem is that, at the point where we invoke the + induction hypothesis, we have already introduced [m] into the + context -- intuitively, we have told Rocq, "Let's consider some + particular [n] and [m]..." and we now have to prove that, if + [double n = double m] for _these particular_ [n] and [m], then + [n = m]. + + The next tactic, [induction n] says to Rocq: We are going to show + the goal by induction on [n]. That is, we are going to prove, for + _all_ [n], that the proposition + + - [P n] = "if [double n = double m], then [n = m]" + + holds, by showing + + - [P O] + + (i.e., "if [double O = double m] then [O = m]") and + + - [P n -> P (S n)] + + (i.e., "if [double n = double m] then [n = m]" implies "if + [double (S n) = double m] then [S n = m]"). + + If we look closely at the second statement, it is saying something + rather strange: that, for a _particular_ [m], if we know + + - "if [double n = double m] then [n = m]" + + then we can prove + + - "if [double (S n) = double m] then [S n = m]". + + To see why this is strange, let's think of a particular [m] -- + say, [5]. The statement is then saying that, if we know + + - [Q] = "if [double n = 10] then [n = 5]" + + then we can prove + + - [R] = "if [double (S n) = 10] then [S n = 5]". + + But knowing [Q] doesn't give us any help at all with proving [R]! + If we tried to prove [R] from [Q], we would start with something + like "Suppose [double (S n) = 10]..." but then we'd be stuck: + knowing that [double (S n)] is [10] tells us nothing helpful about + whether [double n] is [10] (indeed, it strongly suggests that + [double n] is _not_ [10]!!), so [Q] is useless. *) + +(** Trying to carry out this proof by induction on [n] when [m] is + already in the context doesn't work because we are then trying to + prove a statement involving _every_ [n] but just a _particular_ + [m]. *) + +(** A successful proof of [double_injective] keeps [m] universally + quantified in the goal statement at the point where the + [induction] tactic is invoked on [n]: *) + +Theorem double_injective : forall n m, + double n = double m -> + n = m. +Proof. + intros n. induction n as [| n' IHn']. + - (* n = O *) simpl. intros m eq. destruct m as [| m'] eqn:E. + + (* m = O *) reflexivity. + + (* m = S m' *) discriminate eq. + - (* n = S n' *) + +(** Notice that both the goal and the induction hypothesis are + different this time: the goal asks us to prove something more + general (i.e., we must prove the statement for _every_ [m]), but + the induction hypothesis [IH'] is correspondingly more flexible, + allowing us to choose any [m] we like when we apply it. *) + + intros m eq. + +(** Now we've chosen a particular [m] and introduced the assumption + that [double n = double m]. Since we are doing a case analysis on + [n], we also need a case analysis on [m] to keep the two in sync. *) + + destruct m as [| m'] eqn:E. + + (* m = O *) + +(** The 0 case is trivial: *) + + discriminate eq. + + (* m = S m' *) + f_equal. + +(** Since we are now in the second branch of the [destruct m], the + [m'] mentioned in the context is the predecessor of the [m] we + started out talking about. Since we are also in the [S] branch of + the induction, this is perfect: if we instantiate the generic [m] + in the IH with the current [m'] (this instantiation is performed + automatically by the [apply] in the next step), then [IHn'] gives + us exactly what we need to finish the proof. *) + + apply IHn'. simpl in eq. injection eq as goal. apply goal. Qed. + +(** The thing to take away from all this is that you need to be + careful, when using induction, that you are not trying to prove + something too specific: When proving a property quantified over + variables [n] and [m] by induction on [n], it is sometimes crucial + to leave [m] "generic." *) + +(** The following exercise, which further strengthens the link between + [=?] and [=], follows the same pattern. *) +(** **** Exercise: 2 stars, standard (eqb_true) *) +Theorem eqb_true : forall n m, + n =? m = true -> n = m. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 2 stars, advanced, optional (eqb_true_informal) + + Give a careful informal proof of [eqb_true], stating the induction + hypothesis explicitly and being as explicit as possible about + quantifiers, everywhere. *) + +(* FILL IN HERE *) + +(* Do not modify the following line: *) +Definition manual_grade_for_informal_proof : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 3 stars, standard, especially useful (plus_n_n_injective) + + In addition to being careful about how you use [intros], practice + using "in" variants in this proof. (Hint: use [plus_n_Sm].) *) +Theorem plus_n_n_injective : forall n m, + n + n = m + m -> + n = m. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The strategy of doing fewer [intros] before an [induction] to + obtain a more general IH doesn't always work; sometimes some + _rearrangement_ of quantified variables is needed. Suppose, for + example, that we wanted to prove [double_injective] by induction + on [m] instead of [n]. *) + +Theorem double_injective_take2_FAILED : forall n m, + double n = double m -> + n = m. +Proof. + intros n m. induction m as [| m' IHm']. + - (* m = O *) simpl. intros eq. destruct n as [| n'] eqn:E. + + (* n = O *) reflexivity. + + (* n = S n' *) discriminate eq. + - (* m = S m' *) intros eq. destruct n as [| n'] eqn:E. + + (* n = O *) discriminate eq. + + (* n = S n' *) f_equal. + (* We are stuck here, just like before. *) +Abort. + +(** The problem is that, to do induction on [m], we must first + introduce [n]. (If we simply say [induction m] without + introducing anything first, Rocq will automatically introduce [n] + for us!) *) + +(** What can we do about this? One possibility is to rewrite the + statement of the lemma so that [m] is quantified before [n]. This + works, but it's not nice: We don't want to have to twist the + statements of lemmas to fit the needs of a particular strategy for + proving them! Rather we want to state them in the clearest and + most natural way. *) + +(** What we can do instead is to first introduce all the quantified + variables and then _re-generalize_ one or more of them, + selectively taking variables out of the context and putting them + back at the beginning of the goal. The [generalize dependent] + tactic does this. *) + +Theorem double_injective_take2 : forall n m, + double n = double m -> + n = m. +Proof. + intros n m. + (* [n] and [m] are both in the context *) + generalize dependent n. + (* Now [n] is back in the goal and we can do induction on + [m] and get a sufficiently general IH. *) + induction m as [| m' IHm']. + - (* m = O *) simpl. intros n eq. destruct n as [| n'] eqn:E. + + (* n = O *) reflexivity. + + (* n = S n' *) discriminate eq. + - (* m = S m' *) intros n eq. destruct n as [| n'] eqn:E. + + (* n = O *) discriminate eq. + + (* n = S n' *) f_equal. + apply IHm'. injection eq as goal. apply goal. Qed. + +(** Let's look at an informal proof of this theorem. Note that + the proposition we prove by induction leaves [n] quantified, + corresponding to the use of generalize dependent in our formal + proof. + + _Theorem_: For any nats [n] and [m], if [double n = double m], then + [n = m]. + + _Proof_: Let [m] be a [nat]. We prove by induction on [m] that, for + any [n], if [double n = double m] then [n = m]. + + - First, suppose [m = 0], and suppose [n] is a number such + that [double n = double m]. We must show that [n = 0]. + + Since [m = 0], by the definition of [double] we have [double n = + 0]. There are two cases to consider for [n]. If [n = 0] we are + done, since [m = 0 = n], as required. Otherwise, if [n = S n'] + for some [n'], we derive a contradiction: by the definition of + [double], we can calculate [double n = S (S (double n'))], but + this contradicts the assumption that [double n = 0]. + + - Second, suppose [m = S m'] and that [n] is again a number such + that [double n = double m]. We must show that [n = S m'], with + the induction hypothesis that for every number [s], if [double s = + double m'] then [s = m']. + + By the fact that [m = S m'] and the definition of [double], we + have [double n = S (S (double m'))]. There are two cases to + consider for [n]. + + If [n = 0], then by definition [double n = 0], a contradiction. + + Thus, we may assume that [n = S n'] for some [n'], and again by + the definition of [double] we have [S (S (double n')) = + S (S (double m'))], which implies by injectivity that [double n' = + double m']. Instantiating the induction hypothesis with [n'] thus + allows us to conclude that [n' = m'], and it follows immediately + that [S n' = S m']. Since [S n' = n] and [S m' = m], this is just + what we wanted to show. [] *) + +(* ################################################################# *) +(** * Rewriting with conditional statements *) + +(** Suppose that we want to show that [plus] is the inverse of + [minus]. Since we are working with natural numbers, we need an + assumption to prevent [minus] from truncating its result. With + this assumption, the induction hypothesis becomes [forall m, n' + <=? m = true -> (m - n') + n' = m]. The beginning of the proof + uses techniques we have already seen -- in particular, notice how + we induct on [n] before introducing [m], so that the induction + hypothesis becomes sufficiently general. *) + +Lemma sub_add_leb : forall n m, n <=? m = true -> (m - n) + n = m. +Proof. + intros n. + induction n as [| n' IHn']. + - (* n = 0 *) + intros m H. rewrite add_0_r. destruct m as [| m']. + + (* m = 0 *) + reflexivity. + + (* m = S m' *) + reflexivity. + - (* n = S n' *) + intros m H. destruct m as [| m']. + + (* m = 0 *) + discriminate. + + (* m = S m' *) + simpl in H. simpl. rewrite <- plus_n_Sm. + +(** At this point, we need to show [S ((m' - n') + n') = S m'] from + the assumption [(n' <= m') = true]. We could use the [assert] + tactic to prove [(m' - n') + n' = m'] from the induction + hypothesis. However, we can also just use [rewrite] directly: if + we rewrite with a conditional statement of the form [P -> a = b], + then Rocq tries to rewrite with [a = b], and then asks us to prove + [P] in a new subgoal. If the statement has more than one + assumption, then we get one subgoal for each assumption. *) + + rewrite IHn'. + * reflexivity. + * apply H. +Qed. + +(** **** Exercise: 3 stars, standard, especially useful (gen_dep_practice) + + Prove this by induction on [l]. *) + +Theorem nth_error_after_last: forall (n : nat) (X : Type) (l : list X), + length l = n -> + nth_error l n = None. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Unfolding Definitions *) + +(** It sometimes happens that we need to manually unfold a name that + has been introduced by a [Definition] so that we can manipulate + the expression it stands for. + + For example, if we define... *) + +Definition square n := n * n. + +(** ...and try to prove a simple fact about [square]... *) + +Lemma square_mult : forall n m, square (n * m) = square n * square m. +Proof. + intros n m. + simpl. + +(** ...we appear to be stuck: [simpl] doesn't simplify anything, and + since we haven't proved any other facts about [square], there is + nothing we can [apply] or [rewrite] with. *) + +(** To make progress, we can manually [unfold] the definition of + [square]: *) + + unfold square. + +(** Now we have plenty to work with: both sides of the equality are + expressions involving multiplication, and we have lots of facts + about multiplication at our disposal. In particular, we know that + it is commutative and associative, and from these it is not hard + to finish the proof. *) + + rewrite mult_assoc. + assert (H : n * m * n = n * n * m). + { rewrite mul_comm. apply mult_assoc. } + rewrite H. rewrite mult_assoc. reflexivity. +Qed. + +(** At this point, a bit deeper discussion of unfolding and + simplification is in order. + + We already have observed that tactics like [simpl], [reflexivity], + and [apply] will often unfold the definitions of functions + automatically when this allows them to make progress. For + example, if we define [foo m] to be the constant [5]... *) + +Definition foo (x: nat) := 5. + +(** .... then the [simpl] in the following proof (or the + [reflexivity], if we omit the [simpl]) will unfold [foo m] to + [(fun x => 5) m] and further simplify this expression to just + [5]. *) + +Fact silly_fact_1 : forall m, foo m + 1 = foo (m + 1) + 1. +Proof. + intros m. + simpl. + reflexivity. +Qed. + +(** But this automatic unfolding is somewhat conservative. For + example, if we define a slightly more complicated function + involving a pattern match... *) + +Definition bar x := + match x with + | O => 5 + | S _ => 5 + end. + +(** ...then the analogous proof will get stuck: *) + +Fact silly_fact_2_FAILED : forall m, bar m + 1 = bar (m + 1) + 1. +Proof. + intros m. + simpl. (* Does nothing! *) +Abort. + +(** The reason that [simpl] doesn't make progress here is that it + notices that, after tentatively unfolding [bar m], it is left with + a match whose scrutinee, [m], is a variable, so the [match] cannot + be simplified further. It is not smart enough to notice that the + two branches of the [match] are identical, so it gives up on + unfolding [bar m] and leaves it alone. + + Similarly, tentatively unfolding [bar (m+1)] leaves a [match] + whose scrutinee is a function application (that cannot itself be + simplified, even after unfolding the definition of [+]), so + [simpl] leaves it alone. *) + +(** At this point, there are two ways to make progress. One is to use + [destruct m] to break the proof into two cases, each focusing on a + more concrete choice of [m] ([O] vs [S _]). In each case, the + [match] inside of [bar] can now make progress, and the proof is + easy to complete. *) + +Fact silly_fact_2 : forall m, bar m + 1 = bar (m + 1) + 1. +Proof. + intros m. + destruct m eqn:E. + - simpl. reflexivity. + - simpl. reflexivity. +Qed. + +(** This approach works, but it depends on our recognizing that the + [match] hidden inside [bar] is what was preventing us from making + progress. *) + +(** A more straightforward way forward is to explicitly tell Rocq to + unfold [bar]. *) + +Fact silly_fact_2' : forall m, bar m + 1 = bar (m + 1) + 1. +Proof. + intros m. + unfold bar. + +(** Now it is apparent that we are stuck on the [match] expressions on + both sides of the [=], and we can use [destruct] to finish the + proof without thinking so hard. *) + + destruct m eqn:E. + - reflexivity. + - reflexivity. +Qed. + +(* ################################################################# *) +(** * Using [destruct] on Compound Expressions *) + +(** We have seen many examples where [destruct] is used to + perform case analysis of the value of some variable. Sometimes we + need to reason by cases on the result of some _expression_. We + can also do this with [destruct]. + + Here are some examples: *) + +Definition sillyfun (n : nat) : bool := + if n =? 3 then false + else if n =? 5 then false + else false. + +Theorem sillyfun_false : forall (n : nat), + sillyfun n = false. +Proof. + intros n. unfold sillyfun. + destruct (n =? 3) eqn:E1. + - (* n =? 3 = true *) reflexivity. + - (* n =? 3 = false *) destruct (n =? 5) eqn:E2. + + (* n =? 5 = true *) reflexivity. + + (* n =? 5 = false *) reflexivity. Qed. + +(** After unfolding [sillyfun] in the above proof, we find that + we are stuck on [if (n =? 3) then ... else ...]. But either + [n] is equal to [3] or it isn't, so we can use [destruct (eqb + n 3)] to let us reason about the two cases. + + In general, the [destruct] tactic can be used to perform case + analysis of the results of arbitrary computations. If [e] is an + expression whose type is some inductively defined type [T], then, + for each constructor [c] of [T], [destruct e] generates a subgoal + in which all occurrences of [e] (in the goal and in the context) + are replaced by [c]. *) + +(** **** Exercise: 3 stars, standard (combine_split) + + Here is an implementation of the [split] function mentioned in + chapter [Poly]: *) + +Fixpoint split {X Y : Type} (l : list (X*Y)) + : (list X) * (list Y) := + match l with + | [] => ([], []) + | (x, y) :: t => + match split t with + | (lx, ly) => (x :: lx, y :: ly) + end + end. + +(** Prove that [split] and [combine] are inverses in the following + sense: *) + +Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2, + split l = (l1, l2) -> + combine l1 l2 = l. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** The [eqn:] part of the [destruct] tactic is optional; although + we've chosen to include it most of the time, for the sake of + documentation, it can often be omitted without harm. + + One example where it _cannot _ be omitted is when we are + [destruct]ing compound expressions; here, the information recorded + by the [eqn:] can actually be critical, and, if we leave it out, + then [destruct] can erase information we need to complete a proof. *) + (** For example, suppose we define a function [sillyfun1] like + this: *) + +Definition sillyfun1 (n : nat) : bool := + if n =? 3 then true + else if n =? 5 then true + else false. + +(** Now suppose that we want to convince Rocq that [sillyfun1 n] + yields [true] only when [n] is odd. If we start the proof like + this (with no [eqn:] on the [destruct])... *) + +Theorem sillyfun1_odd_FAILED : forall (n : nat), + sillyfun1 n = true -> + odd n = true. +Proof. + intros n eq. unfold sillyfun1 in eq. + destruct (n =? 3). + (* stuck... *) +Abort. + +(** ... then we are stuck at this point because the context does + not contain enough information to prove the goal! The problem is + that the substitution performed by [destruct] is quite brutal -- + in this case, it throws away every occurrence of [n =? 3], but we + need to keep some memory of this expression and how it was + destructed, because we need to be able to reason that, since we + are assuming [n =? 3 = true] in this branch of the case analysis, + it must be that [n = 3], from which it follows that [n] is odd. + + What we want here is to substitute away all existing occurrences + of [n =? 3], but at the same time add an equation to the context + that records which case we are in. This is precisely what the + [eqn:] qualifier does. *) + +Theorem sillyfun1_odd : forall (n : nat), + sillyfun1 n = true -> + odd n = true. +Proof. + intros n eq. unfold sillyfun1 in eq. + destruct (n =? 3) eqn:Heqe3. + (** Now we have the same state as at the point where we got + stuck above, except that the context contains an extra + equality assumption, which is exactly what we need to + make progress. *) + - (* e3 = true *) apply eqb_true in Heqe3. + rewrite -> Heqe3. reflexivity. + - (* e3 = false *) + (** When we come to the second equality test in the body + of the function we are reasoning about, we can use + [eqn:] again in the same way, allowing us to finish the + proof. *) + destruct (n =? 5) eqn:Heqe5. + + (* e5 = true *) + apply eqb_true in Heqe5. + rewrite -> Heqe5. reflexivity. + + (* e5 = false *) discriminate eq. Qed. + +(** **** Exercise: 2 stars, standard (destruct_eqn_practice) *) +Theorem bool_fn_applied_thrice : + forall (f : bool -> bool) (b : bool), + f (f (f b)) = f b. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(* ################################################################# *) +(** * Review *) + +(** We've now talked about many of Rocq's most fundamental tactics. + We'll introduce a few more in the coming chapters, and later on + we'll see some more powerful _automation_ tactics that make Rocq + help us with low-level details. But basically we've got what we + need to get work done. + + Here are the ones we've seen: + + - [intros]: move hypotheses/variables from goal to context + + - [reflexivity]: finish the proof (when the goal looks like [e = + e]) + + - [apply]: prove goal using a hypothesis, lemma, or constructor + + - [apply... in H]: apply a hypothesis, lemma, or constructor to + a hypothesis in the context (forward reasoning) + + - [apply... with...]: explicitly specify values for variables + that cannot be determined by pattern matching + + - [specialize (H ...)]: refine a hypothesis by fixing some of + its variables + + - [simpl]: simplify computations in the goal + + - [simpl in H]: ... or a hypothesis + + - [rewrite]: use an equality hypothesis (or lemma) to rewrite + the goal + + - [rewrite ... in H]: ... or a hypothesis + + - [symmetry]: changes a goal of the form [t=u] into [u=t] + + - [symmetry in H]: changes a hypothesis of the form [t=u] into + [u=t] + + - [transitivity y]: prove a goal [x=z] by proving two new subgoals, + [x=y] and [y=z] + + - [unfold]: replace a defined constant by its right-hand side in + the goal + + - [unfold... in H]: ... or a hypothesis + + - [destruct... as...]: case analysis on values of inductively + defined types + + - [destruct... eqn:...]: specify the name of an equation to be + added to the context, recording the result of the case + analysis + + - [induction... as...]: induction on values of inductively + defined types + + - [injection... as...]: reason by injectivity on equalities + between values of inductively defined types + + - [discriminate]: reason by disjointness of constructors on + equalities between values of inductively defined types + + - [replace x with y]: replaces [x] with [y] everywhere for the + current goal, creating a subgoal that [x = y]. + + - [assert (H: e)] (or [assert (e) as H]): introduce a "local + lemma" [e] and call it [H] + + - [generalize dependent x]: move the variable [x] (and anything + else that depends on it) from the context back to an explicit + hypothesis in the goal formula + + - [f_equal]: change a goal of the form [f x = f y] into [x = y] *) + +(* ################################################################# *) +(** * Additional Exercises *) + +(** **** Exercise: 3 stars, standard (eqb_sym) *) +Theorem eqb_sym : forall (n m : nat), + (n =? m) = (m =? n). +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced, optional (eqb_sym_informal) + + Give an informal proof of this lemma that corresponds to your + formal proof above: + + Theorem: For any [nat]s [n] [m], [(n =? m) = (m =? n)]. + + Proof: *) + (* FILL IN HERE + + [] *) + +(** **** Exercise: 3 stars, standard, optional (eqb_trans) *) +Theorem eqb_trans : forall n m p, + n =? m = true -> + m =? p = true -> + n =? p = true. +Proof. + (* FILL IN HERE *) Admitted. +(** [] *) + +(** **** Exercise: 3 stars, advanced (split_combine) + + We proved, in an exercise above, that [combine] is the inverse of + [split]. Complete the definition of [split_combine_statement] + below with a property that states that [split] is the inverse of + [combine]. Then, prove that the property holds. + + Hint: Take a look at the definition of [combine] in [Poly]. + Your property will need to account for the behavior of [combine] + in its base cases, which possibly drop some list elements. *) + +Definition split_combine_statement : Prop + (* ("[: Prop]" means that we are giving a name to a + logical proposition here.) *) + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem split_combine : split_combine_statement. +Proof. +(* FILL IN HERE *) Admitted. + +(* Do not modify the following line: *) +Definition manual_grade_for_split_combine : option (nat*string) := None. +(** [] *) + +(** **** Exercise: 3 stars, advanced (filter_exercise) *) +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. +(** [] *) + +(** **** Exercise: 4 stars, advanced, especially useful (forall_exists_challenge) + + Define two recursive [Fixpoints], [forallb] and [existsb]. The + first checks whether every element in a list satisfies a given + predicate: + + forallb odd [1;3;5;7;9] = true + forallb negb [false;false] = true + forallb even [0;2;4;5] = false + forallb (eqb 5) [] = true + + The second checks whether there exists an element in the list that + satisfies a given predicate: + + existsb (eqb 5) [0;2;3;6] = false + existsb (andb true) [true;true;false] = true + existsb odd [1;0;0;0;0;3] = true + existsb even [] = false + + Next, define a _nonrecursive_ version of [existsb] -- call it + [existsb'] -- using [forallb] and [negb]. + + Finally, prove a theorem [existsb_existsb'] stating that + [existsb'] and [existsb] have the same behavior. +*) + +Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_forallb_1 : forallb odd [1;3;5;7;9] = true. +Proof. (* FILL IN HERE *) Admitted. + +Example test_forallb_2 : forallb negb [false;false] = true. +Proof. (* FILL IN HERE *) Admitted. + +Example test_forallb_3 : forallb even [0;2;4;5] = false. +Proof. (* FILL IN HERE *) Admitted. + +Example test_forallb_4 : forallb (eqb 5) [] = true. +Proof. (* FILL IN HERE *) Admitted. + +Fixpoint existsb {X : Type} (test : X -> bool) (l : list X) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Example test_existsb_1 : existsb (eqb 5) [0;2;3;6] = false. +Proof. (* FILL IN HERE *) Admitted. + +Example test_existsb_2 : existsb (andb true) [true;true;false] = true. +Proof. (* FILL IN HERE *) Admitted. + +Example test_existsb_3 : existsb odd [1;0;0;0;0;3] = true. +Proof. (* FILL IN HERE *) Admitted. + +Example test_existsb_4 : existsb even [] = false. +Proof. (* FILL IN HERE *) Admitted. + +Definition existsb' {X : Type} (test : X -> bool) (l : list X) : bool + (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. + +Theorem existsb_existsb' : forall (X : Type) (test : X -> bool) (l : list X), + existsb test l = existsb' test l. +Proof. (* FILL IN HERE *) Admitted. + +(** [] *) + +(* 2026-01-07 13:17 *) diff --git a/TacticsTest.v b/TacticsTest.v new file mode 100644 index 0000000..1704d69 --- /dev/null +++ b/TacticsTest.v @@ -0,0 +1,275 @@ +Set Warnings "-notation-overridden,-parsing". +From Stdlib Require Export String. +From LF Require Import Tactics. + +Parameter MISSING: Type. + +Module Check. + +Ltac check_type A B := + match type of A with + | context[MISSING] => idtac "Missing:" A + | ?T => first [unify T B; idtac "Type: ok" | idtac "Type: wrong - should be (" B ")"] + end. + +Ltac print_manual_grade A := + match eval compute in A with + | Some (_ ?S ?C) => + idtac "Score:" S; + match eval compute in C with + | ""%string => idtac "Comment: None" + | _ => idtac "Comment:" C + end + | None => + idtac "Score: Ungraded"; + idtac "Comment: None" + end. + +End Check. + +From LF Require Import Tactics. +Import Check. + +Goal True. + +idtac "------------------- apply_exercise1 --------------------". +idtac " ". + +idtac "#> rev_exercise1". +idtac "Possible points: 2". +check_type @rev_exercise1 ( +(forall (l l' : list nat) (_ : @eq (list nat) l (@rev nat l')), + @eq (list nat) l' (@rev nat l))). +idtac "Assumptions:". +Abort. +Print Assumptions rev_exercise1. +Goal True. +idtac " ". + +idtac "------------------- injection_ex3 --------------------". +idtac " ". + +idtac "#> injection_ex3". +idtac "Possible points: 3". +check_type @injection_ex3 ( +(forall (X : Type) (x y z : X) (l j : list X) + (_ : @eq (list X) (@cons X x (@cons X y l)) (@cons X z j)) + (_ : @eq (list X) j (@cons X z l)), + @eq X x y)). +idtac "Assumptions:". +Abort. +Print Assumptions injection_ex3. +Goal True. +idtac " ". + +idtac "------------------- discriminate_ex3 --------------------". +idtac " ". + +idtac "#> discriminate_ex3". +idtac "Possible points: 1". +check_type @discriminate_ex3 ( +(forall (X : Type) (x y z : X) (l _ : list X) + (_ : @eq (list X) (@cons X x (@cons X y l)) (@nil X)), + @eq X x z)). +idtac "Assumptions:". +Abort. +Print Assumptions discriminate_ex3. +Goal True. +idtac " ". + +idtac "------------------- nth_error_always_none --------------------". +idtac " ". + +idtac "#> nth_error_always_none". +idtac "Possible points: 3". +check_type @nth_error_always_none ( +(forall (l : list nat) + (_ : forall i : nat, @eq (option nat) (@nth_error nat l i) (@None nat)), + @eq (list nat) l (@nil nat))). +idtac "Assumptions:". +Abort. +Print Assumptions nth_error_always_none. +Goal True. +idtac " ". + +idtac "------------------- eqb_true --------------------". +idtac " ". + +idtac "#> eqb_true". +idtac "Possible points: 2". +check_type @eqb_true ((forall (n m : nat) (_ : @eq bool (eqb n m) true), @eq nat n m)). +idtac "Assumptions:". +Abort. +Print Assumptions eqb_true. +Goal True. +idtac " ". + +idtac "------------------- plus_n_n_injective --------------------". +idtac " ". + +idtac "#> plus_n_n_injective". +idtac "Possible points: 3". +check_type @plus_n_n_injective ( +(forall (n m : nat) (_ : @eq nat (Nat.add n n) (Nat.add m m)), @eq nat n m)). +idtac "Assumptions:". +Abort. +Print Assumptions plus_n_n_injective. +Goal True. +idtac " ". + +idtac "------------------- gen_dep_practice --------------------". +idtac " ". + +idtac "#> nth_error_after_last". +idtac "Possible points: 3". +check_type @nth_error_after_last ( +(forall (n : nat) (X : Type) (l : list X) (_ : @eq nat (@length X l) n), + @eq (option X) (@nth_error X l n) (@None X))). +idtac "Assumptions:". +Abort. +Print Assumptions nth_error_after_last. +Goal True. +idtac " ". + +idtac "------------------- combine_split --------------------". +idtac " ". + +idtac "#> combine_split". +idtac "Possible points: 3". +check_type @combine_split ( +(forall (X Y : Type) (l : list (prod X Y)) (l1 : list X) + (l2 : list Y) + (_ : @eq (prod (list X) (list Y)) (@split X Y l) + (@pair (list X) (list Y) l1 l2)), + @eq (list (prod X Y)) (@combine X Y l1 l2) l)). +idtac "Assumptions:". +Abort. +Print Assumptions combine_split. +Goal True. +idtac " ". + +idtac "------------------- destruct_eqn_practice --------------------". +idtac " ". + +idtac "#> bool_fn_applied_thrice". +idtac "Possible points: 2". +check_type @bool_fn_applied_thrice ( +(forall (f : forall _ : bool, bool) (b : bool), @eq bool (f (f (f b))) (f b))). +idtac "Assumptions:". +Abort. +Print Assumptions bool_fn_applied_thrice. +Goal True. +idtac " ". + +idtac "------------------- eqb_sym --------------------". +idtac " ". + +idtac "#> eqb_sym". +idtac "Possible points: 3". +check_type @eqb_sym ((forall n m : nat, @eq bool (eqb n m) (eqb m n))). +idtac "Assumptions:". +Abort. +Print Assumptions eqb_sym. +Goal True. +idtac " ". + +idtac "------------------- split_combine --------------------". +idtac " ". + +idtac "#> Manually graded: split_combine". +idtac "Advanced". +idtac "Possible points: 3". +print_manual_grade manual_grade_for_split_combine. +idtac " ". + +idtac "------------------- filter_exercise --------------------". +idtac " ". + +idtac "#> filter_exercise". +idtac "Advanced". +idtac "Possible points: 3". +check_type @filter_exercise ( +(forall (X : Type) (test : forall _ : X, bool) (x : X) + (l lf : list X) (_ : @eq (list X) (@filter X test l) (@cons X x lf)), + @eq bool (test x) true)). +idtac "Assumptions:". +Abort. +Print Assumptions filter_exercise. +Goal True. +idtac " ". + +idtac "------------------- forall_exists_challenge --------------------". +idtac " ". + +idtac "#> existsb_existsb'". +idtac "Advanced". +idtac "Possible points: 6". +check_type @existsb_existsb' ( +(forall (X : Type) (test : forall _ : X, bool) (l : list X), + @eq bool (@existsb X test l) (@existsb' X test l))). +idtac "Assumptions:". +Abort. +Print Assumptions existsb_existsb'. +Goal True. +idtac " ". + +idtac " ". + +idtac "Max points - standard: 25". +idtac "Max points - advanced: 37". +idtac "". +idtac "Allowed Axioms:". +idtac "functional_extensionality". +idtac "FunctionalExtensionality.functional_extensionality_dep". +idtac "plus_le". +idtac "le_trans". +idtac "le_plus_l". +idtac "add_le_cases". +idtac "Sn_le_Sm__n_le_m". +idtac "O_le_n". +idtac "". +idtac "". +idtac "********** Summary **********". +idtac "". +idtac "Below is a summary of the automatically graded exercises that are incomplete.". +idtac "". +idtac "The output for each exercise can be any of the following:". +idtac " - 'Closed under the global context', if it is complete". +idtac " - 'MANUAL', if it is manually graded". +idtac " - A list of pending axioms, containing unproven assumptions. In this case". +idtac " the exercise is considered complete, if the axioms are all allowed.". +idtac "". +idtac "********** Standard **********". +idtac "---------- rev_exercise1 ---------". +Print Assumptions rev_exercise1. +idtac "---------- injection_ex3 ---------". +Print Assumptions injection_ex3. +idtac "---------- discriminate_ex3 ---------". +Print Assumptions discriminate_ex3. +idtac "---------- nth_error_always_none ---------". +Print Assumptions nth_error_always_none. +idtac "---------- eqb_true ---------". +Print Assumptions eqb_true. +idtac "---------- plus_n_n_injective ---------". +Print Assumptions plus_n_n_injective. +idtac "---------- nth_error_after_last ---------". +Print Assumptions nth_error_after_last. +idtac "---------- combine_split ---------". +Print Assumptions combine_split. +idtac "---------- bool_fn_applied_thrice ---------". +Print Assumptions bool_fn_applied_thrice. +idtac "---------- eqb_sym ---------". +Print Assumptions eqb_sym. +idtac "". +idtac "********** Advanced **********". +idtac "---------- split_combine ---------". +idtac "MANUAL". +idtac "---------- filter_exercise ---------". +Print Assumptions filter_exercise. +idtac "---------- existsb_existsb' ---------". +Print Assumptions existsb_existsb'. +Abort. + +(* 2026-01-07 13:18 *) + +(* 2026-01-07 13:18 *) diff --git a/_CoqProject b/_CoqProject new file mode 100644 index 0000000..36aea0f --- /dev/null +++ b/_CoqProject @@ -0,0 +1 @@ +-Q . LF diff --git a/deps.svg b/deps.svg new file mode 100644 index 0000000..a3abd81 --- /dev/null +++ b/deps.svg @@ -0,0 +1,387 @@ + + + + + + + + + + +legend + + + + + Core chapters  + + +Contributed chapters +⟶ +     Chapter dependencies +⟶ +     Recommended path for semester course + + + + + +Preface + + +Preface + + + + + +Basics + + +Basics +Functional Programming in Rocq + + + + + +Preface->Basics + + + + + +Postscript + + +Postscript + + + + + +Bib + + +Bib +Bibliography + + + + + +Postscript->Bib + + + + + +Induction + + +Induction +Proof by Induction + + + + + +Basics->Induction + + + + + +Basics->Induction + + + + + +Lists + + +Lists +Working with Structured Data + + + + + +Induction->Lists + + + + + +Induction->Lists + + + + + +Poly + + +Poly +Polymorphism and Higher-Order Functions + + + + + +Lists->Poly + + + + + +Lists->Poly + + + + + +Tactics + + +Tactics +More Basic Tactics + + + + + +Poly->Tactics + + + + + +Poly->Tactics + + + + + +Logic + + +Logic +Logic in Rocq + + + + + +Tactics->Logic + + + + + +Tactics->Logic + + + + + +IndProp + + +IndProp +Inductively Defined Propositions + + + + + +Maps + + +Maps +Total and Partial Maps + + + + + +IndProp->Maps + + + + + +IndProp->Maps + + + + + +ProofObjects + + +ProofObjects +The Curry-Howard Correspondence + + + + + +IndProp->ProofObjects + + + + + +Rel + + +Rel +Properties of Relations + + + + + +IndProp->Rel + + + + + +Logic->IndProp + + + + + +Logic->IndProp + + + + + +Imp + + +Imp +Simple Imperative Programs + + + + + +Maps->Imp + + + + + +Maps->Imp + + + + + +IndPrinciples + + +IndPrinciples +More on Induction + + + + + +ProofObjects->IndPrinciples + + + + + +ImpParser + + +ImpParser +Lexing and Parsing in Rocq + + + + + +Imp->ImpParser + + + + + +ImpCEvalFun + + +ImpCEvalFun +An Evaluation Function for Imp + + + + + +Imp->ImpCEvalFun + + + + + +Auto + + +Auto +More Automation + + + + + +Imp->Auto + + + + + +Imp->Auto + + + + + +Extraction + + +Extraction +Extracting ML From Stdlib + + + + + +ImpParser->Extraction + + + + + +Auto->Postscript + + + + + +Auto->Postscript + + + + + diff --git a/impdriver.ml b/impdriver.ml new file mode 100644 index 0000000..eb9fdf9 --- /dev/null +++ b/impdriver.ml @@ -0,0 +1,37 @@ +open Imp + +let explode s = + let rec exp i l = + if i < 0 then l else exp (i - 1) (s.[i] :: l) in + exp (String.length s - 1) [];; + +let test s = + print_newline(); + print_endline ("Propgram: " ^ s); + let parse_res = parse (explode s) in + (match parse_res with + NoneE _ -> print_endline ("Syntax error"); + | SomeE c -> + let fuel = 1000 in + match (ceval_step empty_st c fuel) with + None -> + print_endline + ("Still running after " ^ string_of_int fuel ^ " steps") + | Some res -> + print_endline ( + "Result: [" + ^ string_of_int (res ['w']) ^ " " + ^ string_of_int (res ['x']) ^ " " + ^ string_of_int (res ['y']) ^ " " + ^ string_of_int (res ['z']) ^ " ...]")) +;; + +test "x:=1 ; y:=2";; + +test "true";; (* syntax error *) +test "skip";; +test "skip;skip";; +test "while true do skip end";; +test "x:=3";; +test "x:=3; while 0<=x do skip end";; +test "x:=3; while 1<=x do y:=y+1; x:=x-1 end";; diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..d6fcfc1 --- /dev/null +++ b/shell.nix @@ -0,0 +1,14 @@ +{ pkgs ? import {} }: +pkgs.mkShell { + packages = with pkgs; [ + # coq_8_20 + coq + coqPackages.stdlib + # coqPackages.vscoq-language-server + ]; + + shellHook = '' + export ROCQPATH="$COQPATH" + unset COQPATH + ''; +}