Examples of W-types

W-types were introduced by Martin-Löf and they serve as general framework for inductive types in type theory. In this file, we show how several well-known inductive types can be obtained via W-types. The types that we consider, are natural numbers, lists, and trees.

1. Axioms

W-types only give us a suitable framework for inductive types if our type theory supports an additional axiom, namely function extensionality. By default, Coq does not have function extensionality built in, and because of that, inductive families are more suitable. We formulate function extensionality for dependent functions.

Axiom funext
  : forall {X : Type}
           {Y : X -> Type}
           (f g : forall (x : X), Y x),
    (forall (x : X), f x = g x)
    ->
    f = g.

To simplify the development, we also assume another axiom, which is called 'uniqueness of identity proofs' (UIP). This axiom says that inhabitants of the identity type are unique. More concretely, is says that every proof of equality is equal. UIP also is not available by default in Coq.

Axiom UIP
  : forall {X : Type}
           {x y : X}
           (p q : x = y),
     p = q.

2. W-types

A W-type is specified by

a type A that represents the names of the constructors;
a type family B on A that represents the number of arguments of each constructor (i.e., the arity of each constructor).

In Coq, we define W-types as the following inductive type with one constructor.

Inductive W (A : Type) (B : A -> Type) : Type :=
| sup : forall (a : A), (B a -> W A B) -> W A B.

Arguments sup {A B} _ _.

3. Natural numbers as a W-types

3.1. The type

To understand W-types, let us consider the type of natural numbers. This type has two constructors, namely zero and successor. The zero constructor takes no arguments, while the successor takes only one argument. As such, for A we take the type of booleans, because that type has two inhabitants. For B, we take the following type family.

Definition nat_arity : bool -> Type
  := fun b =>
       match b with
       | true => False
       | false => unit
       end.

Definition nat : Type := W bool nat_arity.

3.2. The constructors

Since nat is a W-type, we only have the following constructor.

Check @sup bool nat_arity.sup
     : forall a : bool,
       (nat_arity a -> W bool nat_arity) ->
       W bool nat_arity

We can further specialize this constructor, because we have two cases for b. The first possibility is that b is true, which gives us

Check sup true : (False -> nat) -> nat.sup true : (False -> nat) -> nat
     : (False -> nat) -> nat

Since there is a unique map from the empty type to every other type, we get the constructor for zero.

Definition zero : nat.nat
Proof.nat
  refine (sup true _) ; cbn.False -> W bool nat_arity
  intro w.w: False
W bool nat_arity
  induction w.
Defined.

The other possibility is that b is false, and that gives us

Check sup false : (unit -> nat) -> nat.sup false : (unit -> nat) -> nat
     : (unit -> nat) -> nat

From this we get the successor.

Definition suc (n : nat) : nat.n: nat
nat
Proof.n: nat
nat
  refine (sup false _) ; cbn.n: nat
unit -> W bool nat_arity
  exact (fun _ => n).
Defined.

All in all, we see that for each inhabitant of A the W-type has a constructor with the specified arity.

3.4. Induction

Now we look at the induction principle, and this is where we need to use axioms that we assumed. A naive attempt to define the induction principle fails.

Definition nat_ind
           {P : nat -> Type}
           (Pz : P zero)
           (Ps : forall (n : nat), P n -> P (suc n))
           (n : nat)
  : P n.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
P n
Proof.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
P n
  induction n as [ a f H ].P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
a: bool
f: nat_arity a -> W bool nat_arity
H: forall b : nat_arity a, P (f b)
P (sup a f)
  induction a ; cbn in *.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: False -> W bool nat_arity
H: forall b : False, P (f b)
P (sup true f)
P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: unit -> W bool nat_arity
H: forall b : unit, P (f b)
P (sup false f)
  -P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: False -> W bool nat_arity
H: forall b : False, P (f b)
P (sup true f) Fail (apply Pz).The command has indeed failed with message:
In environment
P : nat -> Type
Pz : P zero
Ps : forall n : nat, P n -> P (suc n)
f : False -> W bool nat_arity
H : forall b : False, P (f b)
Unable to unify "P zero" with "P (sup true f)".
P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: False -> W bool nat_arity
H: forall b : False, P (f b)
P (sup true f)

This tactic fails. We need to give an inhabitant of P (sup true f), but the term Pz has type P zero. Note that sup true f and zero are propositionally equal, but not definitionally.

    admit.
  -P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: unit -> W bool nat_arity
H: forall b : unit, P (f b)
P (sup false f) Fail apply (Ps (f tt) (H tt)).The command has indeed failed with message:
In environment
P : nat -> Type
Pz : P zero
Ps : forall n : nat, P n -> P (suc n)
f : unit -> W bool nat_arity
H : forall b : unit, P (f b)
Unable to unify "P (suc (f tt))" with
 "P (sup false f)".
P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: unit -> W bool nat_arity
H: forall b : unit, P (f b)
P (sup false f)

This tactic also fails. We need to give an inhabitant of type P (sup false f). However, Ps (f tt) (H tt) has type P (suc (f tt)). Note that sup false f and suc (f tt) are propositionally equal, but not definitionally.

    admit.
Abort.

To define the induction principle, we first define the transport operation. If we have a type family Y over X and an equality x1 = x2, then every inhabitant of type Y x1 gives rise to an inhabitant of type Y x2.

Definition transport
           {X : Type}
           (Y : X -> Type)
           {x1 x2 : X}
           (p : x1 = x2)
           (y : Y x1)
  : Y x2.X: Type
Y: X -> Type
x1, x2: X
p: x1 = x2
y: Y x1
Y x2
Proof.X: Type
Y: X -> Type
x1, x2: X
p: x1 = x2
y: Y x1
Y x2
  subst.X: Type
Y: X -> Type
x2: X
y: Y x2
Y x2
  exact y.
Defined.

Now we prove the aforementioned equalities. Note the usage of function extensionality.

Lemma nat_ind_z_eq
      {f : False -> nat}
  : zero = sup true f.f: False -> nat
zero = sup true f
Proof.f: False -> nat
zero = sup true f
  unfold zero.f: False -> nat
sup true
  (fun w : False => False_rect (W bool nat_arity) w) =
sup true f
  f_equal.f: False -> nat
(fun w : False => False_rect (W bool nat_arity) w) = f
  apply funext. (* Here we use function extensionality *)f: False -> nat
forall x : False,
False_rect (W bool nat_arity) x = f x
  intro x.f: False -> nat
x: False
False_rect (W bool nat_arity) x = f x
  induction x.
Qed.

Lemma nat_ind_s_eq
      {f : unit -> nat}
  : suc (f tt) = sup false f.f: unit -> nat
suc (f tt) = sup false f
Proof.f: unit -> nat
suc (f tt) = sup false f
  unfold suc.f: unit -> nat
sup false (fun _ : unit => f tt) = sup false f
  f_equal.f: unit -> nat
(fun _ : unit => f tt) = f
  apply funext. (* Here we use function extensionality *)f: unit -> nat
forall x : unit, f tt = f x
  intro x.f: unit -> nat
x: unit
f tt = f x
  induction x.f: unit -> nat
f tt = f tt
  reflexivity.
Qed.

And now we have everything in place to prove the induction principle for the natural numbers.

Section Induction.
  Context {P : nat -> Type}
          (Pz : P zero)
          (Ps : forall (n : nat), P n -> P (suc n)).
  
  Definition nat_ind
             (n : nat)
    : P n.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
P n
  Proof.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
P n
    induction n as [ a f H ].P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
a: bool
f: nat_arity a -> W bool nat_arity
H: forall b : nat_arity a, P (f b)
P (sup a f)
    induction a ; cbn in *.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: False -> W bool nat_arity
H: forall b : False, P (f b)
P (sup true f)
P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: unit -> W bool nat_arity
H: forall b : unit, P (f b)
P (sup false f)
    - (* Case: zero *)P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: False -> W bool nat_arity
H: forall b : False, P (f b)
P (sup true f)
      refine (transport P _ Pz).P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: False -> W bool nat_arity
H: forall b : False, P (f b)
zero = sup true f
      apply nat_ind_z_eq.
    - (* Case: successor *)P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: unit -> W bool nat_arity
H: forall b : unit, P (f b)
P (sup false f)
      refine (transport P _ (Ps (f tt) (H tt))).P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
f: unit -> W bool nat_arity
H: forall b : unit, P (f b)
suc (f tt) = sup false f
      apply nat_ind_s_eq.
  Defined.

3.5. Computation rules

We also need to verify the computation rules for the induction principle. Let us start by checking what happens with zero.

  Eval simpl in nat_ind zero.= transport P nat_ind_z_eq Pz
: P zero

The key thing to note is that nat_ind zero evaluates to transport P nat_ind_z_eq Pz, and we want to prove this is equal to pz. Here we have nat_ind_z_eq : zero = zero, so we can use the following lemma to simplify this term.

  Proposition transport_refl
              {X : Type}
              (Y : X -> Type)
              {x : X}
              (p : x = x)
              (y : Y x)
    : transport Y p y = y.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
transport Y p y = y
  Proof.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
transport Y p y = y
    assert (p = eq_refl x) as r.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
p = eq_refl
P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
r: p = eq_refl
transport Y p y = y
    {P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
p = eq_refl
      apply UIP.
    }P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
r: p = eq_refl
transport Y p y = y
    rewrite r.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
X: Type
Y: X -> Type
x: X
p: x = x
y: Y x
r: p = eq_refl
transport Y eq_refl y = y
    reflexivity.
  Qed.

Now we have everything to prove the necessary computation rules. They are proven in the same way for both zero and the successor.

  Proposition nat_ind_zero
    : nat_ind zero = Pz.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
nat_ind zero = Pz
  Proof.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
nat_ind zero = Pz
    simpl.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
transport P nat_ind_z_eq Pz = Pz
    rewrite transport_refl.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
Pz = Pz
    reflexivity.
  Qed.
  
  Proposition nat_ind_suc
              (n : nat)
    : nat_ind (suc n) = Ps n (nat_ind n).P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
nat_ind (suc n) = Ps n (nat_ind n)
  Proof.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
nat_ind (suc n) = Ps n (nat_ind n)
    simpl.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
transport P nat_ind_s_eq (Ps n (nat_ind n)) =
Ps n (nat_ind n)
    rewrite transport_refl.P: nat -> Type
Pz: P zero
Ps: forall n : nat, P n -> P (suc n)
n: nat
Ps n (nat_ind n) = Ps n (nat_ind n)
    reflexivity.
  Qed.
End Induction.

All in all, we have shown that the natural numbers can be constructed as a W-type, and that we can derive the usual constructors and induction rule for them. In this construction, we used function extensionality, which is why W-types only work well if we have that axiom. Since Coq does not support function extensionality by default, W-types do not give a good way to develop inductive definitions. However, there are other forms of type theory where function extensionality is available and for those W-types are suitable.

5. Lists as a W-type

Section FixAType.
  Context (X : Type).

5.1. The type

Now we show how to define the type of lists over a fixed type X using W-types. However, here something interesting happens. Let us consider the constructor cons.
cons : X → list → list

In this constructor, we have a non-recursive and a recursive argument. It takes a head, which is of type X, and that argument is non-recursive. The constructor cons also takes a tail, which is of type list, so that argument is recursive.

The arity of a constructor in a W-type specifies the number of recursive arguments. Hence, the arity of the constructor cons is only 1, because there only is one recursive argument. To take the head into account, we add a constructor for every x : X. More specifically, we take the type A to be unit + X. This means that we have a constructor inl tt, which gives us the empty list, and for every x : X, we have a constructor inr x, and that gives us cons x. Precisely, we define the type of lists as follows.

  Definition list_arg (x : unit + X) : Type
    := match x with
       | inl x => False
       | inr a => unit
       end.
  
  Definition list : Type := W (unit + X) list_arg.

5.2. The constructors

For the remainder, we use the same ideas as for the natural numbers. We define the constructors of lists using sup.

  Definition nil : list.X: Type
list
  Proof.X: Type
list
    refine (sup (inl tt) _).X: Type
list_arg (inl tt) -> W (unit + X) list_arg
    cbn.X: Type
False -> W (unit + X) list_arg
    intro x.X: Type
x: False
W (unit + X) list_arg
    induction x.
  Defined.

  Definition cons (x : X) (xs : list) : list.X: Type
x: X
xs: list
list
  Proof.X: Type
x: X
xs: list
list
    refine (sup (inr x) _).X: Type
x: X
xs: list
list_arg (inr x) -> W (unit + X) list_arg
    cbn.X: Type
x: X
xs: list
unit -> W (unit + X) list_arg
    exact (fun _ => xs).
  Defined.

5.3. The induction principle

The induction principle is also proven in the same way. Note that we first have to prove a couple of equalities.

  Lemma list_nil_eq
        {f : False -> W (unit + X) list_arg}
    : nil = sup (inl tt) f.X: Type
f: False -> W (unit + X) list_arg
nil = sup (inl tt) f
  Proof.X: Type
f: False -> W (unit + X) list_arg
nil = sup (inl tt) f
    unfold nil.X: Type
f: False -> W (unit + X) list_arg
sup (inl tt)
  (fun x : False =>
   False_rect (W (unit + X) list_arg) x) =
sup (inl tt) f
    f_equal.X: Type
f: False -> W (unit + X) list_arg
(fun x : False => False_rect (W (unit + X) list_arg) x) =
f
    apply funext. (* Here we use function extensionality *)X: Type
f: False -> W (unit + X) list_arg
forall x : False,
False_rect (W (unit + X) list_arg) x = f x
    intro x.X: Type
f: False -> W (unit + X) list_arg
x: False
False_rect (W (unit + X) list_arg) x = f x
    induction x.
  Qed.

  Lemma list_cons_eq
        {x : X}
        {f : unit -> list}
    : cons x (f tt) = sup (inr x) f.X: Type
x: X
f: unit -> list
cons x (f tt) = sup (inr x) f
  Proof.X: Type
x: X
f: unit -> list
cons x (f tt) = sup (inr x) f
    unfold cons.X: Type
x: X
f: unit -> list
sup (inr x) (fun _ : unit => f tt) = sup (inr x) f
    f_equal.X: Type
x: X
f: unit -> list
(fun _ : unit => f tt) = f
    apply funext. (* Here we use function extensionality *)X: Type
x: X
f: unit -> list
forall x : unit, f tt = f x
    intro z.X: Type
x: X
f: unit -> list
z: unit
f tt = f z
    induction z.X: Type
x: X
f: unit -> list
f tt = f tt
    reflexivity.
  Qed.

  Section Induction.
    Context {P : list -> Type}
            (Pnil : P nil)
            (Pcons : forall (x : X) (xs : list), P xs -> P (cons x xs)).

    Definition list_ind
               (xs : list)
      : P xs.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
xs: list
P xs
    Proof.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
xs: list
P xs
      induction xs as [ a f H ].X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
a: (unit + X)%type
f: list_arg a -> W (unit + X) list_arg
H: forall b : list_arg a, P (f b)
P (sup a f)
      induction a as [ [ ] | x ] ; cbn in *.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
f: False -> W (unit + X) list_arg
H: forall b : False, P (f b)
P (sup (inl tt) f)
X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
f: unit -> W (unit + X) list_arg
H: forall b : unit, P (f b)
P (sup (inr x) f)
      -X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
f: False -> W (unit + X) list_arg
H: forall b : False, P (f b)
P (sup (inl tt) f) refine (transport P _ Pnil).X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
f: False -> W (unit + X) list_arg
H: forall b : False, P (f b)
nil = sup (inl tt) f
        apply list_nil_eq.
      -X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
f: unit -> W (unit + X) list_arg
H: forall b : unit, P (f b)
P (sup (inr x) f) refine (transport P _ (Pcons x _ (H tt))).X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
f: unit -> W (unit + X) list_arg
H: forall b : unit, P (f b)
cons x (f tt) = sup (inr x) f
        apply list_cons_eq.
    Defined.

5.4. The computation rules

Finally, we prove the computation rules in the same way.

    Proposition list_ind_nil
      : list_ind nil = Pnil.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
list_ind nil = Pnil
    Proof.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
list_ind nil = Pnil
      simpl.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
transport P list_nil_eq Pnil = Pnil
      rewrite transport_refl.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
Pnil = Pnil
      reflexivity.
    Qed.
    
    Proposition list_ind_cons
                (x : X)
                (xs : list)
      : list_ind (cons x xs) = Pcons x xs (list_ind xs).X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
xs: list
list_ind (cons x xs) = Pcons x xs (list_ind xs)
    Proof.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
xs: list
list_ind (cons x xs) = Pcons x xs (list_ind xs)
      simpl.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
xs: list
transport P list_cons_eq (Pcons x xs (list_ind xs)) =
Pcons x xs (list_ind xs)
      rewrite transport_refl.X: Type
P: list -> Type
Pnil: P nil
Pcons: forall (x : X) (xs : list),
P xs -> P (cons x xs)
x: X
xs: list
Pcons x xs (list_ind xs) = Pcons x xs (list_ind xs)
      reflexivity.
    Qed.
  End Induction.
End FixAType.

6. Binary trees as a W-type

Section FixAType.
  Context (X : Type).

6.1. The type

We define binary trees whose nodes hold values from some type X, and whose leafs hold no value. Note that we use the same trick as for lists to represent the constructors. In addition, the constructor node has two recursive arguments, and thus its arity becomes the type of booleans.

  Definition tree_arg (x : unit + X) : Type
    := match x with
       | inl x => False
       | inr a => bool
       end.
  
  Definition tree : Type := W (unit + X) tree_arg.

6.2. The constructors

We deal with the constructors in the same way as for lists and natural numbers.

  Definition leaf : tree.X: Type
tree
  Proof.X: Type
tree
    refine (sup (inl tt) _).X: Type
tree_arg (inl tt) -> W (unit + X) tree_arg
    cbn.X: Type
False -> W (unit + X) tree_arg
    intro x.X: Type
x: False
W (unit + X) tree_arg
    induction x.
  Defined.

  Definition node (x : X) (l r : tree) : tree.X: Type
x: X
l, r: tree
tree
  Proof.X: Type
x: X
l, r: tree
tree
    refine (sup (inr x) _).X: Type
x: X
l, r: tree
tree_arg (inr x) -> W (unit + X) tree_arg
    cbn.X: Type
x: X
l, r: tree
bool -> W (unit + X) tree_arg
    intro b.X: Type
x: X
l, r: tree
b: bool
W (unit + X) tree_arg
    induction b.X: Type
x: X
l, r: tree
W (unit + X) tree_arg
X: Type
x: X
l, r: tree
W (unit + X) tree_arg
    -X: Type
x: X
l, r: tree
W (unit + X) tree_arg exact l.
    -X: Type
x: X
l, r: tree
W (unit + X) tree_arg exact r.
  Defined.

6.3. The induction principle

The induction principle also is proven in the same way as for lists and natural numbers.

  Lemma tree_ind_leaf_eq
        {f : False -> W (unit + X) tree_arg}
    : leaf = sup (inl tt) f.X: Type
f: False -> W (unit + X) tree_arg
leaf = sup (inl tt) f
  Proof.X: Type
f: False -> W (unit + X) tree_arg
leaf = sup (inl tt) f
    unfold leaf.X: Type
f: False -> W (unit + X) tree_arg
sup (inl tt)
  (fun x : False =>
   False_rect (W (unit + X) tree_arg) x) =
sup (inl tt) f
    f_equal.X: Type
f: False -> W (unit + X) tree_arg
(fun x : False => False_rect (W (unit + X) tree_arg) x) =
f
    apply funext. (* Here we use function extensionality *)X: Type
f: False -> W (unit + X) tree_arg
forall x : False,
False_rect (W (unit + X) tree_arg) x = f x
    intro x.X: Type
f: False -> W (unit + X) tree_arg
x: False
False_rect (W (unit + X) tree_arg) x = f x
    induction x.
  Qed.

  Lemma tree_ind_node_eq
        {x : X}
        {f : bool -> tree}
    : node x (f true) (f false) = sup (inr x) f.X: Type
x: X
f: bool -> tree
node x (f true) (f false) = sup (inr x) f
  Proof.X: Type
x: X
f: bool -> tree
node x (f true) (f false) = sup (inr x) f
    unfold node.X: Type
x: X
f: bool -> tree
sup (inr x)
  (fun b : bool =>
   bool_rect (fun _ : bool => W (unit + X) tree_arg)
     (f true) (f false) b) = sup (inr x) f
    f_equal.X: Type
x: X
f: bool -> tree
(fun b : bool =>
 bool_rect (fun _ : bool => W (unit + X) tree_arg)
   (f true) (f false) b) = f
    apply funext. (* Here we use function extensionality *)X: Type
x: X
f: bool -> tree
forall x : bool,
bool_rect (fun _ : bool => W (unit + X) tree_arg)
  (f true) (f false) x = f x
    intro b.X: Type
x: X
f: bool -> tree
b: bool
bool_rect (fun _ : bool => W (unit + X) tree_arg)
  (f true) (f false) b = f b
    induction b.X: Type
x: X
f: bool -> tree
bool_rect (fun _ : bool => W (unit + X) tree_arg)
  (f true) (f false) true = f true
X: Type
x: X
f: bool -> tree
bool_rect (fun _ : bool => W (unit + X) tree_arg)
  (f true) (f false) false = f false
    -X: Type
x: X
f: bool -> tree
bool_rect (fun _ : bool => W (unit + X) tree_arg)
  (f true) (f false) true = f true reflexivity.
    -X: Type
x: X
f: bool -> tree
bool_rect (fun _ : bool => W (unit + X) tree_arg)
  (f true) (f false) false = f false reflexivity.
  Qed.

  Section Induction.
    Context {P : tree -> Type}
            (Pleaf : P leaf)
            (Pnode : forall (x : X)
                            (l r : tree),
                     P l -> P r -> P (node x l r)).

    Definition tree_ind
               (t : tree)
      : P t.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
t: tree
P t
    Proof.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
t: tree
P t
      induction t as [ a f H ].X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
a: (unit + X)%type
f: tree_arg a -> W (unit + X) tree_arg
H: forall b : tree_arg a, P (f b)
P (sup a f)
      induction a as [ [ ] | x ] ; cbn in *.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
f: False -> W (unit + X) tree_arg
H: forall b : False, P (f b)
P (sup (inl tt) f)
X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
f: bool -> W (unit + X) tree_arg
H: forall b : bool, P (f b)
P (sup (inr x) f)
      -X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
f: False -> W (unit + X) tree_arg
H: forall b : False, P (f b)
P (sup (inl tt) f) refine (transport P _ Pleaf).X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
f: False -> W (unit + X) tree_arg
H: forall b : False, P (f b)
leaf = sup (inl tt) f
        apply tree_ind_leaf_eq.
      -X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
f: bool -> W (unit + X) tree_arg
H: forall b : bool, P (f b)
P (sup (inr x) f) refine (transport P _ (Pnode x _ _ (H true) (H false))).X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
f: bool -> W (unit + X) tree_arg
H: forall b : bool, P (f b)
node x (f true) (f false) = sup (inr x) f
        apply tree_ind_node_eq.
    Defined.

6.4. The computation rules

Finally, we derive the computation rules.

    Proposition tree_ind_leaf
      : tree_ind leaf = Pleaf.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
tree_ind leaf = Pleaf
    Proof.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
tree_ind leaf = Pleaf
      simpl.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
transport P tree_ind_leaf_eq Pleaf = Pleaf
      rewrite transport_refl.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
Pleaf = Pleaf
      reflexivity.
    Qed.

    Proposition tree_ind_node
                (x : X)
                (l r : tree)
      : tree_ind (node x l r)
        =
        Pnode x l r (tree_ind l) (tree_ind r).X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
l, r: tree
tree_ind (node x l r) =
Pnode x l r (tree_ind l) (tree_ind r)
    Proof.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
l, r: tree
tree_ind (node x l r) =
Pnode x l r (tree_ind l) (tree_ind r)
      simpl.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
l, r: tree
transport P tree_ind_node_eq
  (Pnode x l r (tree_ind l) (tree_ind r)) =
Pnode x l r (tree_ind l) (tree_ind r)
      rewrite transport_refl.X: Type
P: tree -> Type
Pleaf: P leaf
Pnode: forall (x : X) (l r : tree),
P l -> P r -> P (node x l r)
x: X
l, r: tree
Pnode x l r (tree_ind l) (tree_ind r) =
Pnode x l r (tree_ind l) (tree_ind r)
      reflexivity.
    Qed.
  End Induction.
End FixAType.

7. Exercise

Construct the following inductive type using W-types.

Inductive Expr : Type :=
| num : nat -> Expr
| plus : Expr -> Expr -> Expr.

8. Conclusion

W-types can be used to define various inductive types, as long as the type theory that is used supports function extensionality. This holds for a wide class of data types, namely those given by polynomial functors.

9. Bibliography

Constructive mathematics and computer programming, Per Martin-Löf
Intuitionistic type theory, Per Martin-Löf
Inductive families, Peter Dybjer
Representing inductively defined sets by wellorderings in Martin-Löf's type theory, Peter Dybjer