(* Formalizing and Proving Theorems in Coq --- Homework 7
   curated by Tobias Kappé, May 2022.

   This file goes over a few different ways to define a non-standard fixpoint.
   Most importantly, it demonstrates the Equations plugin.

   There are no homework exercises. *)

Require Import Coq.micromega.Lia.
Require Import Coq.Lists.List.

(* Suppose we want to define a function that zips two lists, i.e., takes the
   first element from the first list, followed by the first element from the
   second list, then the second element from the first list, et cetera.

   The naive way to do this is to write a fixpoint. Unfortunately, Coq's
   termination checker fails us here. *)

Fail Fixpoint zip {A: Type} (l1 l2: list A): list A :=
  match l1 with
  | nil => l2
  | cons h1 t1 => cons h1 (zip l2 t1)
  end
.

(* One way around this is to massage the fixpoint definition again, so that
   the decreasing argument always appears in the same position. This is not
   always possible, but in this case it works out. *)
Fixpoint zip {A : Type} (l1 l2 : list A) : list A :=
  match l1, l2 with
  | nil, _ => l2
  | _, nil => l1
  | cons h1 t1, cons h2 t2 => cons h1 (cons h2 (zip t1 t2))
  end
.

(* We can now prove properties of zip, like this one. *)
Lemma zip_nil {A: Type}: forall l : list A, zip l nil = l.
Proof.
  intros.
  destruct l.
  - simpl.
    reflexivity.
  - simpl.
    reflexivity.
Qed.

(* Another way of using our old definition anyway is to explicitly prove that
   our fixpoints are well-founded, i.e., that some measure of the arguments
   decreases strictly for every call. To do this, we need a library. *)
Require Import Coq.Program.Wf.

(* Here is an alternative version of zip, that explicitly singles out the sum
   of the length of the two lists as a measure that decreases with every
   recursive call. Note the "Program" keyword in the vernacular. *)
Program Fixpoint zip'
  {A : Type}
  (l1 l2 : list A)
  {measure (length l1 + length l2)}
  : list A
:=
  match l1 with
  | nil => l2
  | cons h1 t1 => cons h1 (zip' l2 t1)
  end
.
(* The messages window says that we have an obligation to fulfill to show that
   the definition of zip' is sound. We can do this by entering proof mode. *)
Next Obligation.
  simpl.
  lia.
Qed.

(* Let's have a peek inside the actual generated code; it ain't pretty. *)
Print zip'.
Print zip'_func.

(* Luckily, we can still prove the same property. *)
Lemma zip_nil' {A: Type}: forall l : list A, zip' l nil = l.
Proof.
  intros.
  destruct l.
  - (* Hmm, that doesn't seem to do anything .*)
    simpl.
    (* Maybe Coq can figure this out for us? *)
    reflexivity.
  - (* Huh, I suppose that worked. Let's try it here too. *)
    reflexivity.
Qed.

(* Here is a third approach that uses the Equations plugin, which lets you
   write Haskell-like function signatures and also allows you to specify
   the decreasing argument. *)

From Equations Require Import Equations.

Equations zip'' {A} (l l' : list A)
  : list A by wf (length l + length l') lt := {
  zip'' nil l' := l';
  zip'' (cons a l) l' := cons a (zip'' l' l)
}.
Next Obligation.
  lia.
Qed.

(* The generated function is, again, not very great. *)
Print zip''.

Lemma zip_nil'' {A: Type}: forall l : list A, zip'' l nil = l.
Proof.
  intros.
  destruct l.
  - simpl.
    (* That does not work, because Equations makes definitions opaque by
       default, because they typically do not simplify on account of the
       horrible mess that you just saw. But what do we know about zip''?. *)
    Search zip''.
    (* Aha, we can use the equation generated by the Equations plugin! *)
    now rewrite zip''_equation_1.
  - (* The same goes for the other case. *)
    rewrite zip''_equation_2.
    now rewrite zip''_equation_1.
Qed.