Inductive equal (T: Type): T -> T -> Type :=
  | refl : forall t: T, equal T t t
.

Definition symmetry (T: Type) (x y: T) (H: equal T x y): equal T y x :=
  match H in equal _ a b return equal T b a with
  | refl c => refl T c
  end .

Definition transitivity (T: Type) (x y z: T)
    (H1: equal T x y) (H2: equal T y z): equal T x z :=
  match H2 in equal _ a b return equal T x a -> equal T x b with
  | refl c => fun H: equal T x c => H
  end H1 .

(* basic operations *)

(* subst: if [T=U], then [T -> U].

   The returned [T -> U] function is an isomorphism.
*)
Definition subst (T U: Type)
    (H: equal _ T U): T -> U :=
  match H in equal _ A B return A -> B with
  | refl C => fun x: C => x
  end .

(* subst applied to reflexivity is the identity  *)
Definition subst_refl (T: Type) (x: T):
  equal T
    (subst T T (refl Type T) x)
    x :=
  refl T x
.

(* subst also respects symmetry and transitivity:
   it returns the inverse isomorphism on symmetry,
   and the composition on transitivity
*)



(* transport: if [x=y], then [P x -> P y] *)
Definition transport (T: Type) (P: T -> Type)
    (x y: T) (H: equal T x y): P x -> P y :=
  match H in equal _ a b return P a -> P b with
  | refl c => fun w: P c => w
  end .

(* subst is a special case of transport *)
Definition subst_alternative (T U: Type)
    (H: equal _ T U): T -> U :=
  transport Type (fun A: Type => A) T U H .

(* ap: if [x = y], then [f x = f y] *)
Definition ap (T U: Type) (f: T -> U)
    (x y: T) (H: equal T x y): equal U (f x) (f y) :=
  match H in equal _ a b return equal U (f a) (f b) with
  | refl c => refl U (f c)
  end .

(* ap_dep: a dependent variant of [ap].

   Here, the function [f] is generalized to dependent products
   [F: forall (t: T), U t]. Note how [U] is now a [T]-indexed family
   of types.

   We would like to state "if [x=y], then [F x = F y]"
   but this is ill-typed, since [F x] and [F y] are not in the same type!
   We have [F x: U x] and [F y: U y]. Now, since [x=y], we know a proof for
   [U x = U y] but that _still_ does not allow us to write
   [F x = F y] as a type expression! We can only write
   [transport ... (F x) = F y].
 *)
Definition ap_dep (T: Type) (U: T -> Type) (F: forall (t: T), U t)
    (x y: T) (H: equal T x y):
    equal (U y) (transport T U x y H (F x)) (F y) :=
  match H as H2 in equal _ a b
  return equal (U b) (transport T U a b H2 (F a)) (F b) with
  | refl c => refl (U c) (F c)
  end .

(* The above crucially relies on transport to beta-reduce to the identity
   when [H2] is [refl c]
*)

(* Leibniz equality *)
Definition Lequal (T: Type) (x y: T): Type :=
  forall (P: T -> Type), P x -> P y.

(* We prove that Lequal is logically equivalent to equal *)
Definition Lequal_implies_equal (T: Type) (x y: T)
    (H: Lequal T x y): equal T x y :=
  let P (a: T): Type := equal T x a
  in
  H P (refl T x).

Definition Equal_implies_Lequal (T: Type) (x y: T)
    (H: equal T x y): Lequal T x y :=
  match H in equal _ a b return Lequal T a b with
  | refl c => fun (P: T -> Type) (H2: P c) => H2
  end .


(* A final digression:

if [H: x=x], we can not conclude [H=refl x] !

Tring to prove this via dependent match, we would write something like

   match H as H2 in a = b return H2 = refl a with
   | refl c => refl (refl c)
   end

but [H2 = refl x] is ill-typed! Indeed, the former has type [a = b] !

However, if we are working on a type [T] with decidable equality,
e.g. if we have [forall x y:T, x=y \/ not (x=y)], we can exploit
that to obtain the wanted [H = refl] -- equality proofs are unique.
For example, on naturals we do have decidable equality (we can
exploit induction), hence if [H : 5=5] then [H = refl].

We can require [H = refl] on all types using an additional axiom:
Streicher's axiom K does that, for instance.

Instead, Homotopy Type Theory (HoTT) goes in the opposite direction, with
its Univalence axiom. This axiom implies that, roughly, there is a
bijection between the equality proofs between two types [H: T=U]
and the isomorphisms between types [T] and [U].

Since many isomorphisms can exist, we obtain many equality proofs.

For instance, we can find two different proofs for [Bool = Bool].
One is reflexivity, corresponding to the identity isomorphism.
But there is another, corresponding to boolean negation.

Under univalence, we effectively work with types "modulo isomorphism",
which can be very alluring!

Some results in HoTT may be quite surprising though.
We mention the following (possible projects):
- univalence is inconsistent with the Law of Excluded Middle (!).
- univalence implies functional extensionality

As a more basic example, consider the product type
[Type * Bool], and an equality inside it [H: (T, a) = (U, b)].
Then, [H] intuitively corresponds to a pair containig:
1) an isomorphism between [T] and [U]
2) a proof [a=b] in [Bool]

For instance, we can have two proofs for
[(Bool, true) = (Bool, true)] and none for
[(Bool, true) = (Bool, false)].

So far so good. But what happens if we move to dependent sums
and dependent pairs?

Consider [Ex Type (fun T: Type => T)], a type which is inhabited
by e.g. [(Bool, true)] and [(Nat, 42)].

Here, an equality proof [H: (T, a) = (U, b)].
correspond to a pair containig:
1) an isomorphism [i] between [T] and [U]
2) a proof [(i a) = b] in [U]

Note the additional [i]! We can not write [a=b], since [a] and
[b] have different types!

Consequently, we now have only a single proof for
[(Bool, true) = (Bool, true)], where [i] is the identity.
Surprisingly, we also get a proof for
[(Bool, true) = (Bool, false)], where [i] is negation!

*)