A Series on Strongly-Specified Functions in Coq

Implementing Strongly-Specified Functions with the Program Framework

January 1, 2017

Implementing Strongly-Specified Functions with the `Program` Framework

The Theory

If I had to explain Program, I would say Program is the heir of the refine tactic. It gives you a convenient way to embed proofs within functional programs that are supposed to fade away during code extraction. But what do I mean when I say "embed proofs" within functional programs? I found two ways to do it.

Invariants

First, we can define a record with one or more fields of type Prop. By doing so, we can constrain the values of other fields. Put another way, we can specify invariant for our type. For instance, in SpecCert , I have defined the memory controller's SMRAMC register as follows:

Record SmramcRegister := {
  d_open: bool;
  d_lock: bool;
  lock_is_close: d_lock = true -> d_open = false;
}.

So lock_is_closed is an invariant I know each instance of SmramcRegister will have to comply with, because every time I will construct a new instance, I will have to prove lock_is_closed holds true. For instance:

Definition lock (reg: SmramcRegister)
  : SmramcRegister.
  refine ({| d_open := false; d_lock := true |}).

Coq leaves us this goal to prove.

reg : SmramcRegister
============================
true = true -> false = false

This sound reasonable enough.

Proof.
  trivial.
Defined.

We have seen in my previous article about strongly specified functions that mixing proofs and regular terms may lead to cumbersome code.

From that perspective, Program helps. Indeed, the lock function can also be defined as follows:

From Coq Require Import Program.

#[program]
Definition lock' (reg: SmramcRegister)
  : SmramcRegister :=
  {| d_open := false
   ; d_lock := true
   |}.

Pre and Post Conditions

Another way to "embed proofs in a program" is by specifying pre- and post-conditions for its component. In Coq, this is done using sigma types.

On the one hand, a precondition is a proposition a function input has to satisfy in order for the function to be applied. For instance, a precondition for head : forall {a}, list a -> a the function that returns the first element of a list l requires l to contain at least one element. We can write that using a sigma-type. The type of head then becomes forall {a} (l: list a | l <> []) : a.

On the other hand, a post condition is a proposition a function output has to satisfy in order for the function to be correctly implemented. In this way, head should in fact return the first element of l and not something else.

Program makes writing this specification straightforward.

#[program]
Definition head {a} (l : list a | l <> [])
  : { x : a | exists l', x :: l' = l }.

We recall that because { l: list a | l <> [] } is not the same as list a, in theory we cannot just compare l with x :: l' (we need to use proj1_sig). One advantage of Program is to deal with it using an implicit coercion.

Note that for the type inference to work as expected, the unwrapped value (here, x :: l') needs to be the left operand of =.

Now that head have been specified, we have to implement it.

#[program]
Definition head {a} (l: list a | l <> [])
  : { x : a | exists l', cons x l' = l } :=
  match l with
  | x :: l' => x
  | [] => !
  end.

Next Obligation.
  exists l'.
  reflexivity.
Qed.

I want to highlight several things here:

We return x (of type a) rather than a sigma-type, then Program is smart enough to wrap it. To do so, it tries to prove the post condition and because it fails, we have to do it ourselves (this is the Obligation we solve after the function definition.)
The [] case is absurd regarding the precondition, we tell Coq that using the bang (!) symbol.

We can have a look at the extracted code:

(** val head : 'a1 list -> 'a1 **)
let head = function
| Nil -> assert false (* absurd case *)
| Cons (a, _) -> a

The implementation is pretty straightforward, but the pre- and post conditions have faded away. Also, the absurd case is discarded using an assertion. This means one thing: [head] should not be used directly from the Ocaml world. "Interface" functions have to be total. *)

The Practice

From Coq Require Import Lia.

I have challenged myself to build a strongly specified library. My goal was to define a type vector : nat -> Type -> Type such as vector a n is a list of n instance of a.

Inductive vector (a : Type) : nat -> Type :=
| vcons {n} : a -> vector a n -> vector a (S n)
| vnil : vector a O.

Arguments vcons [a n] _ _.
Arguments vnil {a}.

I had three functions in mind: take, drop and extract. I learned a few lessons. My main takeaway remains: do not use sigma types, Program and dependent types together. From my point of view, Coq is not yet ready for this. Maybe it is possible to make those three work together, but I have to admit I did not find out how. As a consequence, my preconditions are defined as extra arguments.

To be able to specify the post conditions of my three functions and some others, I first defined nth to get the nth element of a vector.

My first attempt to write nth was a failure.

#[program]
Fixpoint nth {a n}
    (v : vector a n) (i : nat) {struct v}
  : option a :=
  match v, i with
  | vcons x _, O => Some x
  | vcons x r, S i => nth r i
  | vnil, _ => None
  end.

raised an anomaly.

#[program]
Fixpoint nth {a n}
    (v : vector a n) (i : nat) {struct v}
  : option a :=
  match v with
  | vcons x r =>
    match i with
    | O => Some x
    | S i => nth r i
    end
  | vnil => None
  end.

With nth, it is possible to give a very precise definition of take:

#[program]
Fixpoint take {a n}
    (v : vector a n) (e : nat | e <= n)
  : { u : vector a e | forall i : nat,
        i < e -> nth u i = nth v i } :=
  match e with
  | S e' => match v with
            | vcons x r => vcons x (take r e')
            | vnil => !
            end
  | O => vnil
  end.

Next Obligation.
  now apply le_S_n.
Defined.

Next Obligation.
  induction i.
  + reflexivity.
  + apply e0.
    now apply Lt.lt_S_n.
Defined.

Next Obligation.
  now apply PeanoNat.Nat.nle_succ_0 in H.
Defined.

Next Obligation.
  now apply PeanoNat.Nat.nlt_0_r in H.
Defined.

As a side note, I wanted to define the post condition as follows: { v': vector A e | forall (i : nat | i < e), nth v' i = nth v i }. However, this made the goals and hypotheses become very hard to read and to use. Sigma types in sigma types: not a good idea.

(** val take : 'a1 vector -> nat -> 'a1 vector **)

let rec take v = function
| O -> Vnil
| S e' ->
  (match v with
   | Vcons (_, x, r) -> Vcons (e', x, (take r e'))
   | Vnil -> assert false (* absurd case *))

Then I could tackle drop in a very similar manner:

#[program]
Fixpoint drop {a n}
    (v : vector a n) (b : nat | b <= n)
  : { v': vector a (n - b) | forall i,
        i < n - b -> nth v' i = nth v (b + i) } :=
  match b with
  | 0 => v
  | S n => (match v with
           | vcons _ r => (drop r n)
           | vnil => !
           end)
  end.

Next Obligation.
  now rewrite <- Minus.minus_n_O.
Defined.

Next Obligation.
  induction n;
    rewrite <- eq_rect_eq;
    reflexivity.
Defined.

Next Obligation.
  now apply le_S_n.
Defined.

Next Obligation.
  now apply PeanoNat.Nat.nle_succ_0 in H.
Defined.

The proofs are easy to write, and the extracted code is exactly what one might want it to be:

(** val drop : 'a1 vector -> nat -> 'a1 vector **)
let rec drop v = function
| O -> v
| S n ->
  (match v with
   | Vcons (_, _, r) -> drop r n
   | Vnil -> assert false (* absurd case *))

But Program really shone when it comes to implementing extract. I just had to combine take and drop. *)

#[program]
Definition extract {a n} (v : vector a n)
    (e : nat | e <= n) (b : nat | b <= e)
  : { v': vector a (e - b) | forall i,
        i < (e - b) -> nth v' i = nth v (b + i) } :=
  take (drop v b) (e - b).


Next Obligation.
  transitivity e; auto.
Defined.

Next Obligation.
  now apply PeanoNat.Nat.sub_le_mono_r.
Defined.

Next Obligation.
  destruct drop; cbn in *.
  destruct take; cbn in *.
  rewrite e1; auto.
  rewrite <- e0; auto.
  lia.
Defined.

The proofs are straightforward because the specifications of drop and take are precise enough, and we do not need to have a look at their implementations. The extracted version of extract is as clean as we can anticipate.

(** val extract : 'a1 vector -> nat -> nat -> 'a1 vector **)
let extract v e b =
  take (drop v b) (sub e b)

I was pretty happy, so I tried some more. Each time, using nth, I managed to write a precise post condition and to prove it holds true. For instance, given map to apply a function f to each element of a vector v:

#[program]
Fixpoint map {a b n} (v : vector a n) (f : a -> b)
  : { v': vector b n | forall i,
        nth v' i = option_map f (nth v i) } :=
  match v with
  | vnil => vnil
  | vcons a v => vcons (f a) (map v f)
  end.

Next Obligation.
  induction i.
  + reflexivity.
  + apply e.
Defined.

I also managed to specify and write append:

#[program]
Fixpoint append {a n m}
    (v : vector a n) (u : vector a m)
  : { w : vector a (n + m) | forall i,
        (i < n -> nth w i = nth v i) /\
        (n <= i -> nth w i = nth u (i - n))
    } :=
  match v with
  | vnil => u
  | vcons a v => vcons a (append v u)
  end.

Next Obligation.
  split.
  + now intro.
  + intros _.
    now rewrite PeanoNat.Nat.sub_0_r.
Defined.

Next Obligation.
  rename wildcard' into n.
  destruct (Compare_dec.lt_dec i (S n)); split.
  + intros _.
    destruct i.
    ++ reflexivity.
    ++ cbn.
       specialize (a1 i).
       destruct a1 as [a1 _].
       apply a1.
       auto with arith.
  + intros false.
    lia.
  + now intros.
  + intros ord.
    destruct i.
    ++ lia.
    ++ cbn.
       specialize (a1 i).
       destruct a1 as [_ a1].
       apply a1.
       auto with arith.
Defined.

Finally, I tried to implement map2 that takes a vector of a, a vector of b (both of the same size) and a function f : a -> b -> c and returns a vector of c.

First, we need to provide a precise specification for map2. To do that, we introduce option_app, a function that Haskellers know all to well as being part of the Applicative type class.

Definition option_app {a b}
    (opf: option (a -> b))
    (opx: option a)
  : option b :=
  match opf, opx with
  | Some f, Some x => Some (f x)
  | _, _ => None
end.

We thereafter use <$> as an infix operator for option_map and <*> as an infix operator for option_app. *)

Infix "<$>" := option_map (at level 50).
Infix "<*>" := option_app (at level 55).

Given two vectors v and u of the same size and a function f, and given w the result computed by map2, then we can propose the following specification for map2:

forall (i : nat), nth w i = f <$> nth v i <*> nth u i

This reads as follows: the ith element of w is the result of applying the ith elements of v and u to f.

It turns out implementing map2 with the Program framework has proven to be harder than I originally expected. My initial attempt was the following:

#[program]
Fixpoint map2 {a b c n}
    (v : vector a n) (u : vector b n)
    (f : a -> b -> c) {struct v}
  : { w: vector c n | forall i,
        nth w i = f <$> nth v i <*> nth u i
    } :=
  match v, u with
  | vcons x rst, vcons x' rst' =>
      vcons (f x x') (map2 rst rst' f)
  | vnil, vnil => vnil
  | _, _ => !
  end.

Illegal application:
The term "@eq" of type "forall A : Type, A -> A -> Prop"
cannot be applied to the terms
 "nat" : "Set"
 "S wildcard'" : "nat"
 "b" : "Type"
The 3rd term has type "Type" which should be coercible
to "nat".

So I had to fallback to defining the function in pure Ltac.

#[program]
Fixpoint map2 {a b c n}
    (v : vector a n) (u : vector b n)
    (f : a -> b -> c) {struct v}
  : { w: vector c n | forall i,
        nth w i = f <$> nth v i <*> nth u i
    } := _.

Next Obligation.
  dependent induction v; dependent induction u.
  + remember (IHv u f) as u'.
    inversion u'.
    refine (exist _ (vcons (f a0 a1) x) _).
    intros i.
    induction i.
    * reflexivity.
    * apply (H i).
  + refine (exist _ vnil _).
    reflexivity.
Qed.

Is It Usable?

This post mostly gives the "happy ends" for each function. I think I tried too hard for what I got in return and therefore I am convinced Program is not ready (at least for a dependent type, I cannot tell for the rest). For instance, I found at least one bug in Program logic (I still have to report it). Have a look at the following code:

#[program]
Fixpoint map2 {a b c n}
     (u : vector a n) (v : vector b n)
     (f : a -> b -> c) {struct v}
  : vector c n :=
  match u with
  | _ => vnil
  end.

It gives the following error:

Error: Illegal application:
The term "@eq" of type "forall A : Type, A -> A -> Prop"
cannot be applied to the terms
 "nat" : "Set"
 "0" : "nat"
 "wildcard'" : "vector A n'"
The 3rd term has type "vector A n'" which should be
coercible to "nat".

Implementing Strongly-Specified Functions with the refine Tactic

January 11, 2015

Implementing Strongly-Specified Functions with the `refine` Tactic

coq

I started to play with Coq, the interactive theorem prover developed by Inria, a few weeks ago. It is a very powerful tool, yet hard to master. Fortunately, there are some very good readings if you want to learn (I recommend the Coq'Art). This article is not one of them.

In this article, we will see how to implement strongly specified list manipulation functions in Coq. Strong specifications are used to ensure some properties on functions' arguments and return value. It makes Coq type system very expressive. Thus, it is possible to specify in the type of the function pop that the return value is the list passed as an argument in which the first element has been removed, for example.

Is This List Empty?

It's the first question to deal with when manipulating lists. There are some functions that require their arguments not to be empty. It's the case for the pop function, for instance it is not possible to remove the first element of a list that does not have any elements in the first place.

When one wants to answer such a question as “Is this list empty?”, he has to keep in mind that there are two ways to do it: by a predicate or by a boolean function. Indeed, Prop and bool are two different worlds that do not mix easily. One solution is to write two definitions and to prove their equivalence. That is forall args, predicate args <-> bool_function args = true.

Another solution is to use the sumbool type as middlemen. The scheme is the following:

Defining predicate : args → Prop
Defining predicate_dec : args -> { predicate args } + { ~predicate args }
Defining predicate_b:

Definition predicate_b (args) :=
  if predicate_dec args then true else false.

Defining the `empty` Predicate

A list is empty if it is [] (nil). It's as simple as that!

Definition empty {a} (l : list a) : Prop := l = [].

Defining a decidable version of `empty`

A decidable version of empty is a function which takes a list l as its argument and returns either a proof that l is empty, or a proof that l is not empty. This is encoded in the Coq standard library with the sumbool type, and is written as follows: { empty l } + { ~ empty l }.

Definition empty_dec {a} (l : list a)
  : { empty l } + { ~ empty l }.
Proof.
  refine (match l with
          | [] => left _ _
          | _ => right _ _
          end);
    unfold empty; trivial.
  unfold not; intro H; discriminate H.
Defined.

In this example, I decided to use the refine tactic which is convenient when we manipulate the Set and Prop sorts at the same time.

Defining `empty_b`

With empty_dec, we can define empty_b.

Definition empty_b {a} (l : list a) : bool :=
  if empty_dec l then true else false.

Let's try to extract empty_b:

type bool =
| True
| False

type sumbool =
| Left
| Right

type 'a list =
| Nil
| Cons of 'a * 'a list

(** val empty_dec : 'a1 list -> sumbool **)

let empty_dec = function
| Nil -> Left
| Cons (a, l0) -> Right

(** val empty_b : 'a1 list -> bool **)

let empty_b l =
  match empty_dec l with
  | Left -> True
  | Right -> False

In addition to 'a list, Coq has created the sumbool and bool types and empty_b is basically a translation from the former to the latter. We could have stopped with empty_dec, but Left and Right are less readable that True and False. Note that it is possible to configure the Extraction mechanism to use primitive OCaml types instead, but this is out of the scope of this article.

Defining Some Utility Functions

Defining `pop`

There are several ways to write a function that removes the first element of a list. One is to return nil if the given list was already empty:

Definition pop {a} ( l :list a) :=
  match l with
  | _ :: l => l
  | [] => []
  end.

But it's not really satisfying. A pop call over an empty list should not be possible. It can be done by adding an argument to pop: the proof that the list is not empty.

Definition pop {a} (l : list a) (h : ~ empty l)
  : list a.

There are, as usual when it comes to lists, two cases to consider.

l = x :: rst, and therefore pop (x :: rst) h is rst
l = [], which is not possible since we know l is not empty.

The challenge is to convince Coq that our reasoning is correct. There are, again, several approaches to achieve that. We can, for instance, use the refine tactic again, but this time we need to know a small trick to succeed as using a “regular” match will not work.

From the following goal:

  a : Type
  l : list a
  h : ~ empty l
  ============================
  list a

Using the refine tactic naively, for instance, this way:

  refine (match l with
          | _ :: rst => rst
          | [] => _
          end).

leaves us the following goal to prove:

  a : Type
  l : list a
  h : ~ empty l
  ============================
  list a

Nothing has changed! Well, not exactly. See, refine has taken our incomplete Gallina term, found a hole, done some type-checking, found that the type of the missing piece of our implementation is list a and therefore has generated a new goal of this type. What refine has not done, however, is remembering that we are in the case where l = [].

We need to generate a goal from a hole wherein this information is available. It is possible to use a long form of match. The general approach is this: rather than returning a value of type list a, our match will return a function of type l = ?l' -> list a, where ?l is a value of l for a given case (that is, either x :: rst or []). Of course and as a consequence, the type of the match in now a function which awaits a proof to return the expected result. Fortunately, this proof is trivial: it is eq_refl.

  refine (match l as l'
                return l = l' -> list a
          with
          | _ :: rst => fun _ => rst
          | [] => fun equ => _
          end eq_refl).

For us to conclude the proof, this is way better.

  a : Type
  l : list a
  h : ~ empty l
  equ : l = []
  ============================
  list a

We conclude the proof, and therefore the definition of pop.

  rewrite equ in h.
  exfalso.
  now apply h.
Defined.

It's better and yet it can still be improved. Indeed, according to its type, pop returns “some list.” As a matter of fact, pop returns “the same list without its first argument.” It is possible to write such precise definition thanks to sigma types, defined as:

Inductive sig (A : Type) (P : A -> Prop) : Type :=
  exist : forall (x : A), P x -> sig P.

Rather than sig A p, sigma-types can be written using the notation { a | P }. They express subsets, and can be used to constraint arguments and results of functions.

We finally propose a strongly specified definition of pop.

Definition pop {a} (l : list a | ~ empty l)
  : { l' | exists a, proj1_sig l = cons a l' }.

If you think the previous use of match term was ugly, brace yourselves.

  refine (match proj1_sig l as l'
                return proj1_sig l = l'
                       -> { l' | exists a, proj1_sig l = cons a l' }
          with
          | [] => fun equ => _
          | (_ :: rst) => fun equ => exist _ rst _
          end eq_refl).

This leaves us two goals to tackle.

First, we need to discard the case where l is the empty list.

  a : Type
  l : {l : list a | ~ empty l}
  equ : proj1_sig l = []
  ============================
  {l' : list a | exists a0 : a, proj1_sig l = a0 :: l'}

  + destruct l as [l nempty]; cbn in *.
    rewrite equ in nempty.
    exfalso.
    now apply nempty.

Then, we need to prove that the result we provide (rst) when the list is not empty is correct with respect to the specification of pop.

  a : Type
  l : {l : list a | ~ empty l}
  a0 : a
  rst : list a
  equ : proj1_sig l = a0 :: rst
  ============================
  exists a1 : a, proj1_sig l = a1 :: rst

  + destruct l as [l nempty]; cbn in *.
    rewrite equ.
    now exists a0.
Defined.

Let's have a look at the extracted code:

(** val pop : 'a1 list -> 'a1 list **)

let pop = function
| Nil -> assert false (* absurd case *)
| Cons (a, l0) -> l0

If one tries to call pop nil, the assert ensures the call fails. Extra information given by the sigma type has been stripped away. It can be confusing, and in practice it means that, we you rely on the extraction mechanism to provide a certified OCaml module, you cannot expose strongly specified functions in its public interface because nothing in the OCaml type system will prevent a misuse which will in practice leads to an assert false. *)

Defining `push`

It is possible to specify push the same way pop has been. The only difference is push accepts lists with no restriction at all. Thus, its definition is a simpler, and we can write it without refine.

Definition push {a} (l : list a) (x : a)
  : { l' | l' = x :: l } :=
  exist _ (x :: l) eq_refl.

And the extracted code is just as straightforward.

let push l a =
  Cons (a, l)

Defining `head`

Same as pop and push, it is possible to add extra information in the type of head, namely the returned value of head is indeed the first value of l.

Definition head {a} (l : list a | ~ empty l)
  : { x | exists r, proj1_sig l = x :: r }.

It's not a surprise its definition is very close to pop.

  refine (match proj1_sig l as l'
                return proj1_sig l = l' -> _
          with
          | [] => fun equ => _
          | x :: _ => fun equ => exist _ x _
          end eq_refl).

The proof is also very similar, and are left to read as an exercise for passionate readers.

  + destruct l as [l falso]; cbn in *.
    rewrite equ in falso.
    exfalso.
    now apply falso.
  + exists l0.
    now rewrite equ.
Defined.

Finally, the extracted code is as straightforward as it can get.

let head = function
| Nil -> assert false (* absurd case *)
| Cons (a, l0) -> a

Conclusion

Writing strongly specified functions allows for reasoning about the result correctness while computing it. This can help in practice. However, writing these functions with the refine tactic does not enable a very idiomatic Coq code.

To improve the situation, the Program framework distributed with the Coq standard library helps, but it is better to understand what Program achieves under its hood, which is basically what we have done in this article.

A Series on Strongly-Specified Functions in Coq

Implementing Strongly-Specified Functions with the Program Framework

Implementing Strongly-Specified Functions with the Program Framework

The Theory

Invariants

Pre and Post Conditions

The Practice

Is It Usable?

Implementing Strongly-Specified Functions with the refine Tactic

Implementing Strongly-Specified Functions with the refine Tactic

Is This List Empty?

Defining the empty Predicate

Defining a decidable version of empty

Defining empty_b

Defining Some Utility Functions

Defining pop

Defining push

Defining head

Conclusion

Implementing Strongly-Specified Functions with the `Program` Framework

Implementing Strongly-Specified Functions with the `refine` Tactic

Defining the `empty` Predicate

Defining a decidable version of `empty`

Defining `empty_b`

Defining `pop`

Defining `push`

Defining `head`