(** * Software Foundations, Formally   
      Benjamin C. Pierce
      Version of 9/10/2007
*)

(** * The official solution to LECTURE 1 is in lec02.v *)
(** * LECTURE 2 *)

(* Wei: Pull in lec01_sol.v so that we don't copy its content in this file.
   Before we can do that, we need to coqc it to .vo file.
   Require pulls in the file. Import opens the module. Export not only imports the module but also exports it
   to any file that imports this file. *)
Require Export lec01_sol.
Import NatList.
Print LoadPath.

(* -------------------------------------------------------------- *)
Module NatList.

(* We can use [natoption] as a way of returning "error
   codes" from functions.  For example, suppose we want to
   write a function that returns the nth element of some
   list.  If we give it type [nat->natlist->nat], then we'll
   have to return some number when the list is too short! *)
Fixpoint nth_lessgood (n : nat) (l : natlist) {struct l} : nat :=
  match l with
  | nil => twelve  (* arbitrary! *)
  | a :: l' => if eqnat n O then a else nth_lessgood (pred n) l'
  end.

(* If we give it type [nat->natlist->natoption], then we can
   return [None] when the list is too short and [Some m]
   when the list has enough members and [m] is the one at
   position [n]. *)
Fixpoint nth (n : nat) (l : natlist) {struct l} : natoption :=
  match l with
  | nil => None 
  | a :: l' => if eqnat n O then Some a else nth (pred n) l'
  end.

Lemma check_nth1 :
  nth zero [four,five,six,seven] = Some four.
Proof. simpl. reflexivity. Qed.
Lemma check_nth2 :
  nth three [four,five,six,seven] = Some seven.
Proof. simpl. reflexivity. Qed.
Lemma check_nth3 :
  nth ten [four,five,six,seven] = None.
Proof. simpl. reflexivity. Qed.

(* -------------------------------------------------------------- *)
(** * Higher-order functions *)

(* A HIGHER-ORDER function is one that returns a function as
   its result or takes a function as a parameters -- i.e.,
   it treats functions as data. *)

(* In fact, the multiple-argument functions we have already
   seen are simple examples of higher-order functions.  For
   instance, the type of [plus] is [nat->nat->nat]. *)
Check plus.
(* Since [->] associates to the right, this type can also be
   written [nat -> (nat->nat)] -- i.e., the type can be read
   as saying that "[plus] is a one-argument function that
   takes a [nat] and returns a one-argument function that
   takes another [nat] and returns a [nat]."  In the examples
   above, we have always applied [plus] to both of its
   arguments at once, but if we like we can supply just the
   first.  This is called "partial application." *)
Definition plus3 : nat->nat := plus three.

Lemma check_plus3 :
  plus3 four = seven.
Proof. simpl. reflexivity. Qed.

(* More novel are functions that take other functions as
   parameters.  Here is a simple one. *)
Definition doitthreetimes (f:nat->nat) (n:nat) := f (f (f n)).

Lemma check_doitthreetimes1: 
  doitthreetimes minustwo nine = three.
Proof. simpl. reflexivity. Qed.
Lemma check_doitthreetimes2: 
  doitthreetimes plus3 two = eleven.
Proof. simpl. reflexivity. Qed.

(* Here is a more useful one... *)
Fixpoint filter (f: nat->yesno) (l: natlist) {struct l} : natlist :=
  match l with 
  | nil => nil
  | hd::tl => 
      match f hd with
      | yes => hd :: (filter f tl)
      | no => filter f tl
      end
  end.

Lemma check_filter1 :
  filter even [four,five,six,seven] = [four,six].
Proof. simpl. reflexivity. Qed.

(* This gives us, for example, a more concise way to define
   the [countoddmembers] function we saw before. *)
Definition countoddmembers' (l:natlist) : nat := length (filter odd l).

Lemma check_countoddmembers'1: 
  countoddmembers' [one,zero,three,one,four,five] = four.
Proof. simpl. reflexivity. Qed.
Lemma check_countoddmembers'2: 
  countoddmembers' [zero,two,four] = zero.
Proof. simpl. reflexivity. Qed.
Lemma check_countoddmembers'3: 
  countoddmembers' nil = zero.
Proof. simpl. reflexivity. Qed.

(* EXERCISE: Complete the following definition. *)
Definition countzeros (l:natlist) : nat := 
length (filter (eqnat zero) l).

Lemma check_countzeros1: 
  countzeros [one,zero,three,zero,four,five] = two.
Proof. simpl. reflexivity. Qed.

(* Another very handy higher-order function is [map]. *)
Fixpoint map (f:nat->nat) (l:natlist) {struct l} : natlist := 
  match l with
  | nil    => nil 
  | h :: t => (f h) :: (map f t)
  end.

Lemma check_map1: 
  map minustwo [one,two,three,four,five] = [zero,zero,one,two,three].
Proof. simpl. reflexivity. Qed.
Lemma check_map2: 
  map (plus three) [one,two,three,four] = [four,five,six,seven].
Proof. simpl. reflexivity. Qed.
Lemma check_map3: 
  map S [one,two,three,four] = [two,three,four,five].
Proof. simpl. reflexivity. Qed.

(** ** Anonymous functions *)  

(* Functions in Coq are ordinary data values.  In fact, it
   is possible to construct a function "on the fly" without
   declaring it at the top level and giving it a name; this
   is analogous to the notation we've been using for writing
   down constant lists, etc. *)
Eval simpl in (map (fun n => times n n) [two,zero,three,one]).
(* The expression [fun n => times n n] here can be read "The
   function that, given a number [n], returns [times n n]." *)

Lemma check_doitthreetimes4: 
  doitthreetimes (fun n => minus (times n two) one) two = nine.
Proof. simpl. reflexivity. Qed.

(* ** A different implementation of bags *)

(* Higher-order functions can be used to give an alternate
   implementation of bags.  In this version, a bag is a
   function from numbers to numbers: *)
Definition bagf := nat -> nat.  

(* When applied to an argument n, this function tells you
   how many times n occurs in the bag. *)
Definition countf (v:nat) (s:bagf) : nat := 
  s v.

(* Here is a function that converts from the old
   representation of bags to the new one. *)
Fixpoint bag2bagf (b:bag) {struct b} : bagf :=
  match b with
  | nil => (fun n => zero)
  | h::t => (fun n => 
               match eqnat n h with 
               | no => (bag2bagf t) n
               | yes => S ((bag2bagf t) n)
               end)
  end.

Lemma check_bag2bagf1: 
  countf one (bag2bagf [one,two,three,one,four,one]) = three.
Proof. simpl. reflexivity. Qed.  
Lemma check_bag2bagf2: 
  countf five (bag2bagf [one,two,three,one,four,one]) = zero.
Proof. simpl. reflexivity. Qed.  

(* EXERCISE: Complete the following definitions for this new
   implementation of bags *)

Definition addf (v:nat) (s:bagf) : bagf := 
fun n =>
  match eqnat n v with
    | yes => S(s n)
    | no => s n
  end.

Lemma check_addf1: 
  countf one (addf one (bag2bagf [one,four,one])) = three.
Proof. simpl. reflexivity. Qed.
  
Lemma check_addf2: 
  countf five (addf one (bag2bagf [one,four,one])) = zero.
 Proof. simpl. reflexivity. Qed.

Definition unionf (b1 b2 : bagf) := 
fun n =>
  plus (b1 n) (b2 n).

Lemma check_unionf1: 
  countf one (unionf (bag2bagf [one,two,three]) (bag2bagf [one,four,one])) 
  = three.
Proof. simpl. reflexivity. Qed.

Definition remove_onef (v:nat) (s:bagf) : bagf :=
fun n =>
  match eqnat n v with
    | yes => minus (s n) one
    | no => s n
  end.

Lemma check_remove_onef1: 
  countf five (remove_onef five (bag2bagf [two,one,five,four,one])) 
  = zero.
Proof. simpl. reflexivity. Qed.
Lemma check_remove_onef2: 
  countf five (remove_onef five (bag2bagf [two,one,four,one])) 
  = zero.
Proof. simpl. reflexivity. Qed.
Lemma check_remove_onef3: 
  countf four (remove_onef five (bag2bagf [two,one,four,five,one,four])) 
  = two.
Proof. simpl. reflexivity. Qed.
Lemma check_remove_onef4: 
  countf five (remove_onef five (bag2bagf [two,one,five,four,five,one,four])) 
  = one.
Proof. simpl. reflexivity. Qed.

(* THOUGHT PROBLEM (not to be handed in): Can you write a
   [subset] function for this variant of bags? *)
End NatList.

(* ---------------------------------------------------------------------- *)
(** ** Polymorphism *)

(* It happens very common that we need different variants of
   a given function with different type annotations.  As a
   trivial example, we might want a doitthreetimes function
   that works with yesno values instead of numbers. *)
Definition doitthreetimes_yn (f:yesno->yesno) (n:yesno) : yesno := 
  f (f (f n)).

(* Defining all these different variants explicitly is
   annoying and error-prone.  Many programming languages --
   including Coq -- allow us to give a single
   POLYMORPHIC (or GENERIC) definition: *)
Definition doitthreetimes (X:Set) (f:X->X) (n:X) : X := 
  f (f (f n)).

(* This definition adds an extra parameter to the function,
   telling it what SET to expect its third argument to come
   from (and its second argument [f] to accept and return).
   To use [doitthreetimes], we must now apply it an
   appropriate set in addition to its other arguments. *)

Lemma check_doitthreetimes1: 
  doitthreetimes nat minustwo nine = three.
Proof. simpl. reflexivity. Qed.
Lemma check_doitthreetimes2: 
  doitthreetimes nat (plus three) two = eleven.
Proof. simpl. reflexivity. Qed.
Lemma check_doitthreetimes3: 
  doitthreetimes yesno swap_yesno yes = no.
Proof. simpl. reflexivity. Qed.

(* Let's have a look at the type Coq assigns to the generic
   [doitthreetimes]: *)
Check doitthreetimes.
(* The prefix [forall X : Set] corresponds to the first
   parameter [X].  The whole type

      [forall X : Set, (X -> X) -> X -> X]

   can be thought of as a more refined version of the type

      [Set -> (X -> X) -> X -> X]
      
   (that is, it tells us that [doitthreetimes] takes three
   arguments, the first of which is a Set, the second a
   function, etc.); the difference is that the [forall X]
   prefix BINDS the variable [X] in the rest of the type,
   telling us that the second parameter must be a function
   from the set given as the the first parameter to itself,
   etc.  Following this intuition, we might be tempted to
   write it like this

      [X:Set -> (X -> X) -> X -> X]
      
   but you'll find Coq's [forall] notation becomes very
   natural with a little familiarity. *)

(* ---------------------------------------------------------------------- *)
(** ** Polymorphic lists *)

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

Check nil.
Check cons.

Definition l123 := cons nat one (cons nat two (cons nat three (nil nat))).

(* Wei: There is a cleaner approach than _, see Sec 2.7  Implicit arguments,
   http://coq.inria.fr/V8.1/refman/Reference-Manual004.html#toc18 *)
(* It is annoying to have to write all the "nat"s in expressions like
   this, since it seems obvious how to fill them in.  This motivates
   implicit arguments... *)
Definition l123' := cons _ one (cons _ two (cons _ three (nil _))).

(* We can use an implicit argument to define an infix notation for
   cons, as we did above. *)
Notation "X :: Y" := (cons _ X Y) (at level 60, right associativity).

Definition l000 := zero :: zero :: zero :: nil _.

(* EXERCISE: Fill in the implicit arguments here (i.e., replace all
   occurrences of _ by explicit types): *)
Definition l000l000 := cons (list nat) l000 (cons (list nat) l000 (nil (list nat))).

Notation "[ x , .. , y ]" := (cons _ x .. (cons _ y (nil _)) ..).
Eval simpl in [one,two,three].

(* Side remark: While we're talking about writing less type
   information, we should also mention that Coq can usually
   infer the result types of [Definition]s and
   [Fixpoint]s -- just leave off the result type and the
   colon.  In what follows, we'll generally continue to show
   result types explicitly, for the sake of
   documentation. *)

(* Here is a polymorphic version of the [map] function we
   saw before. *)
Fixpoint map (X:Set) (y:Set) (f:X->y) (l:list X) {struct l} : (list y) := 
  match l with
  | nil    => nil y
  | h :: t => (f h) :: (map X y f t)
  end.

Lemma check_map1: 
  map nat nat (plus three) [two,zero,two] = [five,three,five].
Proof. simpl. reflexivity. Qed.
Lemma check_map2: 
  map nat yesno odd [two,one,two,five] = [no,yes,no,yes].
Proof. simpl. reflexivity. Qed.

(* Polymorphic versions of some other useful list processing
   functions... *)
Fixpoint length (X:Set) (l:list X) {struct l} : nat := 
  match l with
  | nil => zero
  | h :: t => S (length X t)
  end.

Fixpoint append (X : Set) (l1 l2 : list X) {struct l1} : (list X) := 
  match l1 with
  | nil    => l2
  | h :: t => h :: (append X t l2)
  end.

Notation "x ++ y" := (append _ x y) (at level 59).

Fixpoint snoc (X:Set) (l:list X) (v:X) {struct l} : (list X) := 
  match l with
  | nil    => [v]
  | h :: t => h :: (snoc _ t v)
  end.

Fixpoint reverse (X:Set) (l:list X) {struct l} : list X := 
  match l with
  | nil    => (nil _)
  | h :: t => snoc _ (reverse _ t) h
  end.

(* EXERCISE: Complete the following function definitions.
   Make sure you understand what is going on in all the test
   cases! *)
(* Wei: The following warnings occur because hd and tl are previously defined in lec01 as functions.
   Warning: pattern hd is understood as a pattern variable
   Warning: pattern tl is understood as a pattern variable
   *)
Fixpoint filter (X:Set) (test: X->yesno) (l:list X) {struct l} : (list X) :=
  match l with 
  | nil => nil _
  | hd::tl => 
      match test hd with
      | yes => hd :: (filter _ test tl)
      | no => filter _ test tl
      end
  end.

Lemma check_filter1: 
  filter nat even [one,two,three,four] = [two,four].
Proof. simpl. reflexivity. Qed.
Lemma check_filter2: 
  filter (list nat) (fun l => eqnat (length nat l) one) 
         [ [one, two], [three], [four], [five,six,seven], (nil _), [eight] ]
  = [ [three], [four], [eight] ].
Proof. simpl. reflexivity. Qed.
  
Fixpoint repeat (X : Set) (n : X) (count : nat) {struct count} : list X := 
  match count with
  | O => nil _
  | S count' => n :: (repeat _ n count')
  end.

Lemma check_repeat1: 
  repeat yesno yes five = [yes,yes,yes,yes,yes].
Proof. simpl. reflexivity. Qed.
Lemma check_repeat2: 
  map nat (list yesno) (fun n => repeat yesno no n) [two,one,three] 
  = [ [no,no], [no], [no,no,no] ].
Proof. simpl. reflexivity. Qed.


(* ---------------------------------------------------------------------- *)
(** ** Polymorphic pairs *)
Inductive prod (X Y : Set) : Set :=
  pair : X -> Y -> prod X Y.

Notation "x * y" := (prod x y) : type_scope.
Notation "( x , y )" := (pair _ _ x y).

Definition fst (X Y : Set) (p : X * Y) : X := 
  match p with
  | (x, y) => x
  end.

Definition snd (X Y : Set) (p : X * Y) : Y := 
  match p with
  | (x, y) => y
  end.

(* ---------------------------------------------------------------------- *)
(** ** Polymorphic options *)

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

Fixpoint nth (X : Set) (n : nat)
             (l : list X) {struct l} : option X :=
  match l with
  | nil => None _
  | a :: l' => if eqnat n O then Some _ a else nth _ (pred n) l'
  end.

(* Side note: Coq comes with a large "standard library" of
   useful types (and functions over them), including
   booleans, natural numbers, (polymorphic) pairs, lists,
   sets, options, etc.  We're building everything ourselves
   here, for the sake of seeing exactly how it is done, but
   of course expert Coq programmers don't need to start from
   scratch like this every time! *)

(* ---------------------------------------------------------------------- *)
(** * Example: Permutations of a list *)

Fixpoint inserteverywhere (X:Set) (v:X) (l:list X) {struct l} 
                          : (list (list X)) := 
  match l with
  | nil => [[v]]
  | h :: t =>
         (v :: l) ::
         (map (list X) (list X) (cons X h) (inserteverywhere X v t))
  end.

Lemma check_inserteverywhere1: 
  inserteverywhere nat three l000 
  = [[three, zero, zero, zero], [zero, three, zero, zero],
     [zero, zero, three, zero], [zero, zero, zero, three]].
Proof. simpl. reflexivity. Qed.

Fixpoint mapappend (X:Set) (y:Set) (f:X -> list y) (l:list X) {struct l} 
                   : (list y) := 
  match l with
  | nil    => nil y
  | h :: t => (f h) ++ (mapappend X y f t)
  end.

Definition inserteverywhereall (X:Set) (v:X) (l:list (list X)) 
                               : (list (list X)) :=  
  mapappend (list X) (list X) (inserteverywhere X v) l.

Lemma check_inserteverywhereall1: 
  inserteverywhereall nat three l000l000
  = [[three, zero, zero, zero], [zero, three, zero, zero],
     [zero, zero, three, zero], [zero, zero, zero, three],
     [three, zero, zero, zero], [zero, three, zero, zero],
     [zero, zero, three, zero], [zero, zero, zero, three]].
Proof. simpl. reflexivity. Qed.

Fixpoint perm (X: Set) (l:list X) {struct l} : (list (list X)) := 
  match l with
  | nil => [nil X]
  | h :: t =>
      inserteverywhereall X h (perm X t)
  end.

Lemma check_perm1: 
  perm nat l123
  = [[one, two, three], [two, one, three], [two, three, one],
     [one, three, two], [three, one, two], [three, two, one]].
Proof. simpl. reflexivity. Qed.

(* ---------------------------------------------------------------------- *)
(** * Example: Currying and uncurrying *)

(* Note: The rest of the notes for today may not be covered,
   if things are running late in class... *)

Definition curry (X Y Z : Set) (f : X * Y -> Z) : X -> Y -> Z :=
  fun x => fun y => f (x,y).

Definition uncurry (X Y Z : Set) (f : X -> Y -> Z) : (X * Y) -> Z :=
  fun p => 
    match p with
      (x,y) => f x y
    end.

Check curry.
Check uncurry.


(* ---------------------------------------------------------------------- *)
(** * Non-structural recursion *)

(* Notes:
     - the termination parameter is the auxiliary 'c'
       argument ('c' for counter)
     - the annotation for the result type is needed because
       of the way that all_interleavings_aux is called in
       the body -- it's a little too complicated for Coq to
       work out what the result type must be
*)
Fixpoint all_interleavings_aux 
            (c:nat) (X:Set) (l1 : list X) (l2 : list X) {struct c} 
            : list (list X) :=
  match c with
  | O => nil _  (* If out of steam, return something silly *)
  | S c' =>
    match l1 with
    | nil => l2 :: (nil _)
    | h1 :: t1 =>
        match l2 with
        | nil => l1 :: (nil _)
        | h2 :: t2 => 
              (map _ _ (cons _ h1) (all_interleavings_aux c' _ t1 l2))
           ++ (map _ _ (cons _ h2) (all_interleavings_aux c' _ l1 t2))
        end
    end
  end.

Definition all_interleavings (X:Set) (l1 : list X) (l2 : list X) : (list (list X)) :=
  all_interleavings_aux
    (length _ (l1 ++ l2))
    X
    l1
    l2.

Lemma check_all_interleavings1: 
  all_interleavings _ [one,two] [three,four]
  = [[one, two, three, four], [one, three, two, four],
     [one, three, four, two], [three, one, two, four],
     [three, one, four, two], [three, four, one, two]].
Proof. simpl. reflexivity. Qed.