Program Verification with F*

Verifying Stateful Programs with F*

Danel Ahman, Inria Paris

EUTypes Summer School

Ohrid, Macedonia, 11 August, 2018

Recap of yesterday: Functional core of F*

Variant of dependent type theory
- $\lambda$ , $\Pi$ , inductives, matches, universe polymorphism
Recursion and semantic termination check
- potential non-termination is an effect
Refinements
- Refined value types:
  - x:t{p}
- Refined computation types:
  - Pure t pre post
  - Div t pre post
- computationally and proof irrelevant, discharged by SMT
Subtyping and sub-effecting (<:)
Extensional equality (=, ==, ===)

Schedule

Yesterday: A Gentle Introduction to F* (Purely Functional Programs)
Today: Verifying Stateful Programs in F*
Tomorrow: Monotonic State in F*
Tomorrow: F*'s Extensible Effect System and Metaprogramming in F*

Verifying stateful programs

The St effect—programming with garbage-collected references

val incr : r:ref int -> St unit

let incr r = r := !r + 1

Hoare logic-style preconditions and postconditions with ST

val incr : r:ref int -> 
  ST unit (requires (fun h0 -> True))                        
          (ensures  (fun h0 _ h2 -> modifies !{r} h0 h2 /\ 
                                    sel h2 r == sel h0 r + 1))

precondition (requires) is a predicate on initial states
postcondition (ensures) relates initial states, results, and final states

St is again just an abbreviation for ST with trivial pre-postconditions
Sub-effecting: Pure <: ST and in fact also Div <: ST
As such, think of ST as having a partial correctness reading

`Heap` and `ST` interfaces (much simplified)

module Heap

  val heap : Type
  val ref  : Type -> Type

  val sel     : #a:Type -> heap -> ref a -> GTot a   (* in Ghost effect *)
  val addr_of : #a:Type -> ref a -> GTot nat         (* in Ghost effect *)    

  let modifies (s:set nat) (h0 h1 : heap) 
  
  = forall a (r:ref a). ~(addr_of r `mem` s) ==> sel h1 r == sel h0 r

module ST

  val (!) : #a:Type -> r:ref a -> 
    ST a (requires (fun _ -> True))
         (ensures  (fun h0 x h1 -> h0 == h1 /\ x == sel h0 r))

  val (:=) : #a:Type -> r:ref a -> v:a -> 
    ST unit (requires (fun _ -> True))
            (ensures (fun h0 _ h1 -> modifies !{r} h0 h1 /\ sel h1 r == v))

Verifying `incr` (intuition)

let incr r = r := !r + 1

val incr : r:ref int -> 
  ST unit (requires (fun _ -> True))
          (ensures  (fun h0 _ h2 -> modifies !{r} h0 h2 /\ 
                                    sel h2 r == sel h0 r + 1))

val incr : r:ref int -> 
  ST unit 
   (requires (fun _ -> True))
   (ensures  (fun h0 _ h2 -> 
               exists h1 x. h0 == h1 /\ x == sel h0 r /\             //(!)
                            modifies !{r} h1 h2 /\ sel h2 r == x+1)) //(:=)
let incr r = 
  let x = !r in 
  r := x + 1

  val (!) : #a:Type -> r:ref a -> 
    ST a (requires (fun _ -> True))
         (ensures  (fun h0 x h1 -> h0 == h1 /\ x == sel h0 r))

  val (:=) : #a:Type -> r:ref a -> v:a -> 
    ST unit (requires (fun _ -> True))
            (ensures (fun h0 _ h1 -> modifies !{r} h0 h1 /\ sel h1 r == v))

Typing rule for let / sequencing (intuition)

val incr : r:ref int -> 
  ST unit 
   (requires (fun _ -> True))
   (ensures  (fun h0 _ h2 -> 
               exists h1 x. h0 == h1 /\ x == sel h0 r /\             //(!)
                            modifies !{r} h1 h2 /\ sel h2 r == x+1)) //(:=)
let incr r = 
  let x = !r in 
  r := x + 1

G |- e1 : ST t1 (requires (fun h0 -> pre))
                (ensures  (fun h0 x1 h1 -> post))
                  
G, x1:t1 |- e2 : ST t2 (requires (fun h1 -> exists h0. post))
                       (ensures  (fun h1 x2 h2 -> post'))
--------------------------------------------------------------------------
G |- let x1 = e1 in e2 : ST t2 (requires (fun h0 -> pre))
                               (ensures  (fun h x2 h2 ->
                                             exists x1 h1. post /\ post'))

Reference swapping (hand proof sketch)

val swap : r1:ref int -> r2:ref int -> 
  ST unit (requires (fun _ -> True))
          (ensures  (fun h0 _ h3 -> modifies !{r1,r2} h0 h3 /\
                                    sel h3 r2 == sel h0 r1 /\ 
                                    sel h3 r1 == sel h0 r2))
let swap r1 r2 =
  let t = !r1 in
   (* Know (P1): exists h1 t. h0 == h1 /\ t == sel h0 r1 *)
  r1 := !r2;
   (* Know (P2): exists h2. modifies !{r1} h1 h2 /\ sel h2 r1 == sel h1 r2 *)
  r2 := t
   (* Know (P3): modifies !{r2} h2 h3 /\ sel h3 r2 == t *)

(* `modifies !{r1,r2} h0 h3` follows directly from transitivity of modifies *)

(* `sel h3 r2 == sel h0 r1` follows immediately from (P1) and (P3) *)

(* Still to show: `sel h3 r1 == sel h0 r2`
   From (P2) we know that  `sel h2 r1 == sel h1 r2` (A)

   From (P1) we know that  h0 == h1
     which directly gives us  sel h1 r2 == sel h0 r2 (B)

   From (P3) we know that  modifies !{r2} h2 h3
     which by definition gives us  sel h2 r1 == sel h3 r1 (C)

   We conclude by transitivity from (A)+(B)+(C) *)

Integer reference swapping (the funny way)

val swap_add_sub : r1:ref int -> r2:ref int -> 
  ST unit (requires (fun _ -> addr_of r1 <> addr_of r2 ))
          (ensures  (fun h0 _ h1 -> modifies !{r1,r2} h0 h1 /\
                                    sel h1 r1 == sel h0 r2 /\ 
                                    sel h1 r2 == sel h0 r1))
let swap_add_sub r1 r2 =
  r1 := !r1 + !r2;
  r2 := !r1 - !r2;
  r1 := !r1 - !r2

Correctness of this variant relies on r1 and r2 not being aliased
… and on int being unbounded (mathematical) integers
Exercise: Sketch a hand proof that this code is correct

Stateful count: 1 + 1 + 1 + …

let rec count_st' (r:ref nat) (n:nat) 
  : ST unit (requires (fun _ -> True))
            (ensures  (fun h0 _ h1 -> sel h1 r == sel h0 r + n /\ 
                                      modifies !{r} h0 h1)) 
= if n > 0 then (r := !r + 1; 
                 count_st' r (n - 1))

let rec count_st (n:nat) 
  : ST nat (requires (fun _ -> True))
           (ensures  (fun h0 x h1 -> x == n /\ modifies !{} h0 h1)) 
= let r = alloc 0 in 
  count_st' r n; 
  !r

The truth about modifies and allocation (kind of, still simplified)

let modifies (s:FStar.TSet.set nat) (h0 h1 : heap) 
= forall a (r:ref a). (~(addr_of r `mem` s) /\ h0 `contains` r)
                                                  ==> sel h1 r == sel h0 r

val alloc : #a:Type -> init:a -> 
  ST (ref a) (requires (fun _ -> True))
             (ensures  (fun h0 r h1 -> 
                          modifies !{} h0 h1 /\ sel h1 r == init /\
                          ~(h0 `contains` r) /\ h1 `contains` r))

Stateful sum: 1 + 2 + 3 + …

let sum_tot (n:nat) = ((n+1) * n) / 2  (* equal to sum_rec, see lect. 1 *)

let rec sum_st' (r:ref nat) (n:nat) 
  : ST unit (requires (fun _ -> True))
            (ensures  (fun _ _ _ -> True)) 
            
= if n > 0 then (r := !r + n; 
                 sum_st' r (n - 1))


let rec sum_st (n:nat) 
  : ST nat (requires (fun _ -> True))
           (ensures  (fun h0 x h1 -> x == sum_tot n /\ 
                                     modifies !{} h0 h1))                                    
= let r = alloc 0 in 
  sum_st' r n; 
  admit (); 
  !r

Exercise: Strengthen the spec of sum_st' to remove admit in sum_st

Stateful Fibonacci: 1 + 1 + 2 + 3 + 5 + 8 + …

let rec fibonacci (n:nat) : Tot nat 
  = if n <= 1 then 1 else fibonacci (n - 1) + fibonacci (n - 2)

let rec fibonacci_st' (i:pos) (n:nat{n >= i}) (r1 r2:ref nat) 
  : ST unit (requires (fun h0 -> addr_of r1 <> addr_of r2 /\
                                 sel h0 r1 = fibonacci (i - 1) /\
                                 sel h0 r2 = fibonacci i ))
            (ensures  (fun h0 a h1 -> sel h1 r1 = fibonacci (n - 1) /\
                                      sel h1 r2 = fibonacci n /\
                                      modifies !{r1,r2} h0 h1)) 
= if i < n then
   (let temp = !r2 in
    r2 := !r1 + !r2; (* fibonacci (i+1) = fibonacci i + fibonacci (i-1) *)
    r1 := temp;                          (* fibonacci i we already have *)
    fibonacci_st' (i+1) n r1 r2)  (* tail-recursion to compute the rest *)

let fibonacci_st (n:nat) 
  : ST nat (requires (fun _ -> True))
           (ensures  (fun h0 x h1 -> x = fibonacci n /\ 
                                     modifies !{} h0 h1)) 
= if n <= 1 
  then 1
  else (let r1 = alloc 1 in
        let r2 = alloc 1 in
        fibonacci_st' 1 n r1 r2;
        !r2)

Exercise: Stateful Factorial

FactorialST.fst

(* A purely-functional factorial function *)

val factorial_tot : nat -> Tot nat
let rec factorial_tot x = 
  if x = 0 then 1 else x * factorial_tot (x - 1)

(* Below is a stateful factorial function, where 
     a) r1 is a reference to a number whose factorial is computed 
     b) r2 is a reference where we will store the factorial of !r1 
     c) the factorial of !r1 stored in r2 agrees with factorial_tot
               
   Exercise: 1) give a precise spec to factorial according to a), b), c)
             2) remove the admit() clause with a real implementation    *)

val factorial : r1:ref nat -> r2:ref nat -> 
                                  ST unit (requires (fun h0      -> True))
                                          (ensures  (fun h0 _ h1 -> True))
let rec factorial r1 r2 =
  admit()

Stateful invariants (mutable non-empty lists)

module NList
  abstract type nlist = xs:list int{Cons? xs}

  let create (x:int) : St (ref nlist) = alloc #nlist [x]

  let add (x:int) (r:ref nlist) : St unit =  r := x :: !r

  let read (r:ref nlist) : St nlist = !r

let f (r:ref nlist) = r := [] (* fails: expected nlist; got type list int *)

module NListClient
  let complex_procedure (r:ref nlist) : St unit = ...

  let main () : St unit =
    let r = create 1 in
    add 2 r;
    complex_procedure r;
    let l = read r in 
    assert ([2,1] `is_suffix_of` l)  (* fails, even though we know c_p can
                                        only use `add` and `read` on r *)

Tomorrow we'll see how monotonicity helps us prove such assertions

Summary: Verifying Stateful Programs

ML-style garbage-collected memory model

val heap : Type          val ref  : Type -> Type

val sel     : #a:Type -> heap -> ref a -> GTot a
val addr_of : #a:Type -> ref a -> GTot nat

val modifies : s:set nat -> h0:heap -> h1:heap -> prop

St effect for simple ML-style programming

let incr (r:ref int) : St unit = r := !r + 1

ST effect for pre- and postcondition based (intrinsic) reasoning

ST unit (requires (fun h0 -> True))                        
        (ensures  (fun h0 _ h2 -> modifies !{r} h0 h2 /\ sel h2 r == n))

Refinement types can enforce (some) stateful invariants
But what about verifying low-level (e.g., C) code, I hear you say?

Low*: programming and verifying low-level C code

Low*: a subset of F* that
- enjoys compilation to C through its companion compiler KreMLin
- provides F* libraries that model a curated set of C features:
  - C memory model
  - stack- and heap-allocated arrays
  - machine integers
  - few system-level functions from the C standard library
- see https://fstarlang.github.io/lowstar/html/ for Low*'s own tutorial
- get KreMLin from https://github.com/FStarLang/kremlin

The code (Low*) is low-level, but the verification (F*) is not

Vale (Verified Assembly Language for Everest)
- for even lower level programming and verification within F*
- an embedding of x64 assembly language in F*
- supports interop with Low*
- see https://github.com/project-everest/vale for more details

Low*: the low-level memory model

HyperStack
- hierarchical memory model that divides the heap into a tree of regions
- a distinguished set of regions that model the C call stack
- (low-level) programs may use stack allocation, heap allocation, or both

Stack effect for stack-allocating programs (intuitively, ST on HS's mem)

module HyperStack.ST

  effect Stack (a:Type) (requires pre) (ensures post)
    = ST a (requires pre)
           (ensures  (fun m0 x m1 -> post m0 x m1 /\ equal_domains m0 m1))

let equal_domains (m0 m1: mem) =
  get_tip m0 == get_tip m1 /\         (* leaves the C call stack intact *)
  Set.equal (Map.domain (get_hmap m0))
            (Map.domain (get_hmap m1)) /\
                              (* does not (de)allocate any heap regions *)
  same_refs_in_all_regions m0 m1
                               (* does not allocate in existing regions *)

Additional effects for heap-allocating and arbitrary low-level code

Low*: a small example

let f (): Stack UInt64.t (requires (fun _ -> True))
                         (ensures  (fun _ _ _ -> True))
                         
  = push_frame ();                         (* pushing a new stack frame *)
    
    let b = LowStar.Buffer.alloca 1UL 64ul in
    assert (b.(42ul) = 1UL);      (* high-level reasoning in F*'s logic *)

    b.(42ul) <- b.(42ul) +^ 42UL;
    let r = b.(42ul) in
      
    pop_frame ();           (* popping the stack frame we pushed above, *)
                            (* so as to ensure that equal_domains holds *)
    assert (r = 43UL);                    
    r

uint64_t f()
{
  uint64_t b[64U];
    
  for (uint32_t _i = 0U; _i < (uint32_t)64U; ++_i)
    b[_i] = (uint64_t)1U;
      
  b[42U] = b[42U] + (uint64_t)42U;
  uint64_t r = b[42U];
  return r;
}

Next steps in this course

Yesterday: A Gentle Introduction to F* (Purely Functional Programs)
Today: Verifying Stateful Programs in F*
Tomorrow: Monotonic State in F*
Tomorrow: F*'s Extensible Effect System and Metaprogramming in F*