Keep calm and use Coq

Alexander Tchitchigin

Typeable.io

Typical Coq

Dependent types are extension

Do not pay for what you do not use!

Translation to ML

• Definition ==> let
• Fixpoint ==> let rec
• fun ==> fn
• fix ==> fn rec
• Inductive ==> datatype

The most functional program :)

Require Import Init.
Require Import Coq.Arith.PeanoNat.

Fixpoint fact (n : nat) : nat :=
  match n with
  | 0   => 1
  | S m => n * (fact m)
  end.

Compute (fact 5).
(*
     = 120
     : nat
*)

Extraction Language Haskell.

Extraction fact.
(*
  fact :: Nat -> Nat
  fact n =
    case n of {
     O -> S O;
     S m -> mul n (fact m)}
*)

The lists

Require Import Lists.List.
Import ListNotations.

Fixpoint append {A} (xs ys : list A) : list A :=
  match xs with
  | [] => ys
  | x :: xs1 => x :: append xs1 ys
  end.

Compute (append [1; 2; 3] [4; 5]).
(*
     = [1; 2; 3; 4; 5]
     : list nat
*)

Extraction append.
(*
  append :: (List A) -> (List A) -> List A
  append xs ys =
    case xs of {
     Nil -> ys;
     Cons x xs1 -> Cons x (append xs1 ys)}
*)

The lists reversed

Definition reverse {A} : list A -> list A.
refine(
  fix F (xs : list A) :=
  match xs with
  | [] => _
  | x :: xs1 => append (F _) (_ :: [])
  end
);
auto.
Defined.

Compute (reverse (append [1; 2; 3] [4; 5])).
(*
     = [5; 4; 3; 2; 1]
     : list nat
*)

Extraction reverse.
(*
  reverse :: (List A) -> List A
  reverse xs =
    case xs of {
     Nil -> xs;
     Cons x xs1 -> append (reverse xs1) (Cons x Nil)}
*)

The proofs! :)

Lemma append_nil : forall (A : Type) (xs : list A), append xs [] = xs.
Proof.
  intros.
  induction xs; simpl.
  - reflexivity.
  - rewrite IHxs. reflexivity.
Qed.

Lemma append_assoc :
  forall (A : Type) (xs ys zs : list A),
    append (append xs ys) zs = append xs (append ys zs).
Proof.
  intros.
  induction xs; simpl.
  - reflexivity.
  - rewrite IHxs. reflexivity.
Qed.

The spec! :)

Lemma rev_append :
  forall (A : Type) (xs ys : list A),
    reverse (append xs ys) = append (reverse ys) (reverse xs).
Proof.
  intros.
  induction xs; simpl.
  - rewrite append_nil. reflexivity.
  - rewrite IHxs. rewrite append_assoc. reflexivity.
Qed.

Theorem rev_rev : forall (A : Type) (xs : list A), reverse (reverse xs) = xs.
Proof.
  intros.
  induction xs; simpl.
  - reflexivity.
  - rewrite rev_append. rewrite IHxs. simpl. reflexivity.
Qed.

Trie

Inductive trie (A V : Type) :=
  | Trie : option V -> list (A * trie A V) -> trie A V.

Definition value {A} {V} (t : trie A V) : option V :=
  match t with
  | Trie _ _ ov _ => ov
  end.

Definition alist {A} {V} (t : trie A V) : list (A * trie A V) :=
  match t with
  | Trie _ _ _ al => al
  end.

Definition assoc {K} {V} : (K -> K -> bool) -> list (K * V) -> K -> option V.
refine(
  fix F (eqb : K -> K -> bool) (l : list (K * V)) (k : K) :=
  match l with
  | [] => None
  | p :: ps => if eqb (fst p) k then Some (snd p) else _
  end
); auto.
Defined.

Operations

Definition lookup {A} {V} : (A -> A -> bool) -> trie A V -> list A -> option V.
refine(
  fix F (eqb : A -> A -> bool) (t : trie A V) (l : list A) :=
  match l with
  | [] => None
  | x :: xs => match assoc _ (alist _) x with
               | None => None
               | Some t1 => F _ t1 _
               end
  end
); auto.
Defined.

Definition update {A} {V} :
  (A -> A -> bool) -> trie A V -> list A -> V -> trie A V.
simple refine(
  fix F (eqb : A -> A -> bool) (t : trie A V) (l : list A) (v : V) {struct l} :=
  match l with
  | [] => Trie _ _ (Some v) (alist t)
  | x :: xs =>
    let tt := match assoc _ (alist t) _ with
              | None => Trie _ _ None []
              | Some t1 => t1
              end
    in Trie _ _ (value t) ( (_, F _ _ _ _) :: alist t)
  end
); auto.
Defined.

Extraction

Extract Inductive bool => "Bool" [ "True" "False" ].
Extract Inductive prod => "(,)"  [ "(,)" ].
Extract Inductive list => "List" [ "[]" "(:)" ].
Extract Inductive option => "Maybe" [ "Just" "Nothing" ].
Extract Constant fst => "fst".
Extract Constant snd => "snd".

Recursive Extraction lookup update.

Extraction

module Main where

import qualified Prelude

fst :: ((,) a1 a2) -> a1
fst = fst

snd :: ((,) a1 a2) -> a2
snd = snd

data Trie a v =
   Trie0 (Maybe v) (List ((,) a (Trie a v)))

value :: (Trie a1 a2) -> Maybe a2
value t =
  case t of {
   Trie0 ov _ -> ov}

alist :: (Trie a1 a2) -> List ((,) a1 (Trie a1 a2))
alist t =
  case t of {
   Trie0 _ al -> al}

assoc :: (a1 -> a1 -> Bool) -> (List ((,) a1 a2)) -> a1 -> Maybe a2
assoc eqb l k =
  case l of {
   [] -> Nothing;
   (:) p ps ->
    case eqb (fst p) k of {
     True -> Just (snd p);
     False -> assoc eqb ps k}}

Extraction

lookup :: (a1 -> a1 -> Bool) -> (Trie a1 a2) -> (List a1) -> Maybe a2
lookup eqb t l =
  case l of {
   [] -> Nothing;
   (:) x xs ->
    case assoc eqb (alist t) x of {
     Just t1 -> lookup eqb t1 xs;
     Nothing -> Nothing}}

update :: (a1 -> a1 -> Bool) -> (Trie a1 a2) -> (List a1) -> a2 -> Trie a1 a2
update eqb t l v =
  case l of {
   [] -> Trie0 (Just v) (alist t);
   (:) x xs ->
    let {
     tt = case assoc eqb (alist t) x of {
           Just t1 -> t1;
           Nothing -> Trie0 Nothing []}}
    in
    Trie0 (value t) ((:) ((,) x (update eqb tt xs v)) (alist t))}

Inspiring examples

• http://compcert.inria.fr/
  • Verified C compiler
  • x86, x86_64, ARM, PowerPC (32 and 64)
  • Detects undefined behaviours
• https://deepspec.org/
  • Verified everything: ISA, compiler, OS, apps
  • Microsoft, Intel, Google, Facebook, Amazon
• https://github.com/uhub/awesome-coq
  • EVM for instance :)

Literature

• Software Foundations
  • https://softwarefoundations.cis.upenn.edu/current/index.html
  • 3 Volumes + 2 in work
• Certified Programming with Dependent Types
  • http://adam.chlipala.net/cpdt/