lecture10.v

From Equations Require Import Equations.
From mathcomp Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path.
From mathcomp Require Import zify.

(*|
A potpourri of tools
-------------------- |*)

(*|
`Equations` plugin
================== *)

Set Equations Transparent.

(*| Installation: `opam install coq-equations`. To
use the plugin, add the following import `From
Equations Require Import Equations.`. |*)

Equations fib (n : nat) : nat :=
  fib 0             := 0;
  fib n'.+1 with n' :=
    fib n'.+1 n''.+1 := fib n'' + fib n';
    fib n'.+1 0      := 1.


Equations fib_iter (n : nat) (f0 f1 : nat) : nat :=
  fib_iter n'.+1 f0 f1 := fib_iter n' f1 (f0 + f1);
  fib_iter 0     f0 f1 := f0.


(*|
`mczify` package
================ *)

(*| The `mczify` package provides access to linear
and non-linear integral arithmetic solver tactics:
`lia` and `nia`, which work with Mathcomp's
definitions.

To install execute `opam install
coq-mathcomp-zify`. To use the plugin, import
`From mathcomp Require Import zify`. |*)


(*| Note that Coq also has its version of the
`lia` tactic, to use it, one has to import the
`Psatz` module. But the vanilla `lia` tactic
cannot process Mathcomp's definitions. |*)

Lemma fib_iter_spec n f0 f1 :
  fib_iter n.+1 f0 f1 = f0 * fib n + f1 * fib n.+1.
Proof.
elim: n f0 f1=> [/=|n IHn] f0 f1; first by lia.
rewrite fib_iter_equation_2 IHn /=; lia.
Qed.

(*| `fib_iter_equation_2` is a one-step reduction
equation generated by `Equations` |*)

(*|
Functional induction
==================== |*)

(*| `Equations` generates induction principles for
functions which mirror their definitions. *)

Lemma fib_iter_correct n :
  fib_iter n 0 1 = fib n.
Proof.
(* We had to use a custom induction principle here:
   elim/nat_ind2: n => // n IHn1 IHn2. *)

apply: (fib_elim (fun n f => fib_iter n 0 1 = f))=> //.

move=> {}n n' IH1 IH2 n_eq_Sn'.
rewrite n_eq_Sn' in IH2 *.
rewrite fib_iter_spec /=; lia.
Qed.


(*|
`CoqHammer` package
=================== *)

(*| The `CoqHammer` package provides a number of
tactics like `sauto`, `sfirstorder`, `hammer` to
automate proofs.

Note: these tactics never use induction, so you
might need to start your proofs by induction first
and then call the solvers.

The `sauto` tactic does general proof search for
the goal expressed in Calculus of Inductive
Construction and does not rely on external tools.

On the other hand, `hammer` relies on external
automated theorem provers (ATP) and SMT-solvers
like: Eprover, Vampire, CVC4, Z3.

`CoqHammer` only uses SMT solvers as ATPs, meaning
that the natural numbers, lists and other
datastructures are treated as uninterpreted by the
supported SMT solvers.

The `hammer` tactic works in three phases:

 1. Use simple and fast machine-learning for premise selection;
 2. Translate the goal into the format ATPs understand
    and call the available ATPs;
 3. Post-process the ATPs' output: reinterpret artefacts returned
    by the ATPs into Coq's logic (most ATPs use classical logic).

Installation: `opam install coq-hammer` (will be
available soon for Coq 8.13 too). Import: `From
Hammer Require Import Hammer.`. |*)

From Hammer Require Import Hammer.

Lemma foo m n p q r :
  m + (n + p * (q * r)) = m + n + p * q * r.
Proof. hammer. Qed.

Lemma lt_zero_lt_one x : x < 0 -> x < 1.
Proof. hammer. Qed.

(*| Note: `lia` or `sauto` can also handle the two above goals. |*)



(*|
QuickChick plugin
================= |*)

(*| If we try proving a lemma for a long time without
actually succeeding we might start asking
ourselves if it's not provable at all because we
made a mistake somewhere.

If only we had a quicker way of checking if it
makes sense to prove a property of an algorithm.

Property-based randomized testing to the rescue! |*)

(*|
Key ideas:
- Write specifications as *computable* predicates;
- Generate lots of random inputes to test your functions;
- Shrink counterexamples;
|*)

(*| One could say that property-based randomized
testing sits in the sweet spot between
hand-written unit tests and fully formal proofs.

Installation: `opam install coq-quickchick`.
Import: `From QuickChick Require Import
QuickChick.`.

QuickChick is a port of QuickCheck written around
the year 2000 by John Hughes for Haskell.

For more detail about QuickChick see "Foundational
Property-Based Testing" by Paraskevopoulou,
Hritcu, Denes, Lampropoulos, Pierce.

Also, "QuickChick: Property-Based Testing in Coq"
by Lampropoulos and Pierce provides a gentle
introduction into the topic:
https://softwarefoundations.cis.upenn.edu/qc-current/index.html
|*)

From QuickChick Require Import QuickChick.
Import QcDefaultNotation.
Open Scope qc_scope.
Import GenLow GenHigh.
Set Warnings "-extraction-opaque-accessed,-extraction".


Inductive instr := Push (n : nat) | Add | Sub | Mul.

(*| We are going to the Deriving plugin to
deriving an instance of `eqType` for `instr`.
Installation: `opam install coq-deriving`. Import:
`From deriving Require Import deriving.`. |*)

From deriving Require Import deriving.

Fail Check erefl : Add == Add.
(*| The following boilerplate (four lines) does the job: |*)
Definition instr_indDef := [indDef for instr_rect].
Canonical instr_indType := IndType instr instr_indDef.
Definition instr_eqMixin := [derive eqMixin for instr].
Canonical instr_eqType := EqType instr instr_eqMixin.

Check erefl : Add == Add.


Definition prog := seq instr.
Definition stack := seq nat.

Fixpoint run (p : prog) (s : stack) : stack :=
  if p is (i :: p') then
    let s' :=
      match i with
      | Push n => n :: s
      | Add => if s is (a1 :: a2 :: s') then a2 + a1 :: s'
                else s
      | Sub => if s is (a1 :: a2 :: s') then a2 - a1 :: s'
                else s
      | Mul => if s is (a1 :: a2 :: s') then a2 * a1 :: s'
                else s
      end
    in run p' s'
  else s.

(*| Now, to prove properties about `run`, one would find useful
the following lemma. |*)
Lemma run_append p1 p2 s :
  run (p1 ++ p2) s = run p2 (run p1 s).
Proof. by elim: p1 s=> /=. Qed.


(*| Unfortunately, if we change the semantics of
`run` to the one that stops processing its input
immediately once there is an error condition, this
property would not hold. |*)

Fixpoint run' (p : prog) (s : stack) : stack :=
  if p is (i :: p') then
    match i with
    | Push n => run' p' (n :: s)
    | Add => if s is (a1 :: a2 :: s') then run' p' (a2 + a1 :: s')
              else s
    | Sub => if s is (a1 :: a2 :: s') then run' p' (a2 - a1 :: s')
              else s
    | Mul => if s is (a1 :: a2 :: s') then run' p' (a2 * a1 :: s')
              else s
    end
  else s.

(*| The user writes their generators and
shrinkers, but luckily for us for sufficiently
simple datatypes QuickChick can do it
automatically. |*)

Derive Arbitrary for instr.
Derive Show for instr.

Definition cat_run'_prop (p1 p2 : prog) (s : stack) :=
  run' (p1 ++ p2) s == run' p2 (run' p1 s).

QuickChick cat_run'_prop.
(*
[Mul; Sub; Sub; Sub; Mul]
[Push 0]
[]
*** Failed after 6 tests and 11 shrinks. (0 discards)
*)

(*| For the original `run`, QuickChick cannot find
counter-examples: |*)
Definition cat_run_prop (p1 p2 : prog) (s : stack) :=
  run (p1 ++ p2) s == run p2 (run p1 s).

QuickChick cat_run_prop.
(* +++ Passed 10000 tests (0 discards) *)


(*| Practical observation: Using QuickChick can be
a nice way of figuring out the precodintions to
the lemmas of interest, i.e. testing helps
proving!

Moreover, since our testing code (and most of
QuickChick itself) is written in Coq, we can also
formally verify this code using Coq. That is,
proving helps testing! *)

(*| Property-based randomized testing is a
powerful yet complex beast and we barely scratched
the surface here.

It's easy to end up generating lots of dead inputs
-- in many cases the precodintions discard *a lot*
of random inputs. *)

Fixpoint insert e s : seq nat :=
  if s is x :: s' then
    if e <= x then
      e :: s
    else
      x :: (insert e s')
  else [:: e].


Definition insert_sorted_prop (e : nat) (s : seq nat) :=
  sorted leq s ==> sorted leq (insert e s).

(*| Let us check how many inputs we generate for
nothing: one can use QuickChick's `collect`
facility to do that. |*)

Time QuickChick (fun e s =>
  collect (sorted leq s) (insert_sorted_prop e s)).
(*
5526 : false
4474 : true
+++ Passed 10000 tests (0 discards)
*)

(*| QuickChick supports user-defined random
generators that can produce inputs with the
required properties. Even more, the user can
formally verify that the supplied random generator
is sound and complete.

Moreover, there is an improvement over QuickChick
called FuzzChick which combines methods developed
in the fuzzing communitywith the methods developed
in PBRT community to alleviate the pain of
implementing custom generators which can be quite
complex. |*)


(*|
Mutation Proving
================ |*)

(*| mCoq: Mutation Proving for Analysis of Verification Projects
by K. Palmskog et al.(2019).

This is related to Mutation Testing:

- make small changes resembling faults to software system;
- execute accompanying test suite on changed system;
- measure how well the test suite catches introduced faults;
- improve test suite and repeat;


Mutation Proving:

- a mutation operator `op` is applied to a Coq project;
- `op` may generate a mutant
  where specifications are different;
- an `op` mutant where a proof fails during
  checking is killed;
- a `op` mutant where all proofs are successfully
  checked is live.

Examples of operations:

- Reorder branches of if-expressions;
- Replace plus with minus;
- Replace a list with its tail;
- ...


A practical observation:
a high amount of live mutants might indicate weak specs.


But sometimes it's just hard to come up
with a precise spec, e.g. this is often the case
when talking about time/space complexity:

The key but unstated invariant of `ss` is that
its `i`th item has size `2i` if it is not empty,
so that merge sort push only performs perfectly
balanced merges... without the `[::]` placeholder
the MathComp sort becomes two element-wise insertion sort.
—Georges Gonthier

A bit of context: |*)

(*|
.. code-block:: Coq

  Section SortSeq.

  Variables (T : Type) (leT : rel T).

  Fixpoint merge_sort_push s1 ss :=
    match ss with
    | [::] :: ss'
    | [::] as ss' => s1 :: ss'
    | s2 :: ss' => [::] :: merge_sort_push (merge s2 s1) ss'
                  ^^^^
    this can be deleted, but proofs will still go through
    end.

  Fixpoint merge_sort_pop s1 ss :=
    if ss is s2 :: ss' then merge_sort_pop (merge s2 s1) ss'
    else s1.

  Fixpoint merge_sort_rec ss s :=
    if s is [:: x1, x2 & s'] then
      let s1 := if leT x1 x2 then [:: x1; x2]
                else [:: x2; x1] in
      merge_sort_rec (merge_sort_push s1 ss) s'
    else merge_sort_pop s ss.

  Definition sort := merge_sort_rec [::].

  (* ... *)

  End SortSeq.
|*)


(*|
Extraction
========== |*)

From Coq Require Import Extraction.

Module Insertion.
Section InsertionSort.

Variable T : eqType.
Variable leT : rel T.
Implicit Types x y z : T.
Implicit Types s t u : seq T.
Fixpoint insert e s : seq T :=
  if s is x :: s' then
    if leT e x then
      e :: s
    else
      x :: (insert e s')
  else [:: e].

(*| Sort input list `s` |*)
Fixpoint sort s : seq T :=
  if s is x :: s' then
    insert x (sort s')
  else
    [::].

(*| Proofs of correctness skipped |*)

End InsertionSort.

Extraction Language OCaml.
Extraction sort.


Extraction Language Haskell.
Extraction sort.


(*| Caveat: extracting SSReflect-based projects is
usually not straightforward. It can be done, see
e.g. https://github.com/certichain/toychain. But
one has to overcome some issues. |*)

End Insertion.