From fa316e4f37137897af803f6ab0f7761f9026f9a2 Mon Sep 17 00:00:00 2001 From: Mark Gritter Date: Sun, 7 Nov 2021 02:18:21 -0600 Subject: [PATCH 1/3] New documentation from fstardoc. --- docs/FStar.Algebra.CommMonoid.Equiv.html | 50 + docs/FStar.Algebra.CommMonoid.html | 38 +- docs/FStar.Algebra.Monoid.html | 224 ++- docs/FStar.All.html | 47 +- docs/FStar.BV.html | 219 ++- docs/FStar.BaseTypes.html | 33 +- docs/FStar.BigOps.html | 289 +++- docs/FStar.BitVector.html | 251 ++- docs/FStar.Bytes.html | 327 +++- docs/FStar.Calc.html | 90 +- docs/FStar.Char.html | 79 +- docs/FStar.Classical.Sugar.html | 181 ++ docs/FStar.Classical.html | 400 ++++- docs/FStar.Date.html | 32 +- docs/FStar.DependentMap.html | 269 ++- docs/FStar.Dyn.html | 37 +- docs/FStar.Endianness.html | 345 +++- docs/FStar.Exn.html | 23 +- docs/FStar.Fin.html | 91 +- docs/FStar.Float.html | 24 +- docs/FStar.FunctionalExtensionality.html | 244 ++- docs/FStar.GSet.html | 142 +- docs/FStar.Ghost.html | 165 +- docs/FStar.Heap.html | 24 +- docs/FStar.HyperStack.All.html | 40 +- docs/FStar.HyperStack.ST.html | 607 ++++++- docs/FStar.HyperStack.html | 41 +- docs/FStar.IFC.html | 182 +- docs/FStar.IO.html | 69 +- docs/FStar.IndefiniteDescription.html | 106 +- docs/FStar.Int.Cast.Full.html | 36 +- docs/FStar.Int.Cast.html | 192 ++- docs/FStar.Int.html | 390 ++++- docs/FStar.Int128.html | 195 ++- docs/FStar.Int16.html | 192 ++- docs/FStar.Int32.html | 192 ++- docs/FStar.Int64.html | 192 ++- docs/FStar.Int8.html | 192 ++- docs/FStar.Integers.html | 540 +++++- docs/FStar.LexicographicOrdering.html | 179 ++ docs/FStar.List.Pure.Base.html | 122 +- docs/FStar.List.Pure.Properties.html | 343 +++- docs/FStar.List.Pure.html | 25 +- docs/FStar.List.Tot.Base.html | 755 +++++++-- docs/FStar.List.Tot.Properties.html | 1120 +++++++++++-- docs/FStar.List.Tot.html | 23 +- docs/FStar.List.html | 494 ++++-- docs/FStar.MRef.html | 49 +- docs/FStar.Map.html | 175 +- docs/FStar.MarkovsPrinciple.html | 25 +- docs/FStar.Math.Euclid.html | 112 +- docs/FStar.Math.Fermat.html | 44 +- docs/FStar.Math.Lemmas.html | 856 +++++++++- docs/FStar.Math.Lib.html | 162 +- docs/FStar.Modifies.html | 811 ++++++++- docs/FStar.ModifiesGen.html | 1132 ++++++++++++- docs/FStar.Monotonic.DependentMap.html | 309 +++- docs/FStar.Monotonic.Heap.html | 389 ++++- docs/FStar.Monotonic.HyperHeap.html | 156 +- docs/FStar.Monotonic.HyperStack.html | 567 ++++++- docs/FStar.Monotonic.Map.html | 116 +- docs/FStar.Monotonic.Pure.html | 59 + docs/FStar.Monotonic.Seq.html | 439 ++++- docs/FStar.Monotonic.Witnessed.html | 74 +- docs/FStar.Mul.html | 20 +- docs/FStar.Option.html | 50 +- docs/FStar.OrdSetProps.html | 47 +- docs/FStar.Order.html | 65 +- docs/FStar.PCM.html | 248 +++ docs/FStar.Pervasives.Native.html | 163 +- docs/FStar.Pervasives.html | 1133 +++++++++++-- docs/FStar.PredicateExtensionality.html | 31 +- docs/FStar.Preorder.html | 29 +- docs/FStar.Printf.html | 218 ++- docs/FStar.PropositionalExtensionality.html | 47 +- docs/FStar.Range.html | 19 +- docs/FStar.Real.html | 81 +- docs/FStar.Ref.html | 69 +- docs/FStar.Reflection.Arith.html | 246 ++- docs/FStar.Reflection.Builtins.html | 92 + docs/FStar.Reflection.Const.html | 70 +- docs/FStar.Reflection.Derived.Lemmas.html | 77 +- docs/FStar.Reflection.Derived.html | 314 +++- docs/FStar.Reflection.Formula.html | 219 ++- docs/FStar.Reflection.Types.html | 35 +- docs/FStar.Reflection.html | 31 +- docs/FStar.ReflexiveTransitiveClosure.html | 101 +- docs/FStar.ST.html | 154 +- docs/FStar.Seq.Base.html | 157 +- docs/FStar.Seq.Permutation.html | 93 + docs/FStar.Seq.Properties.html | 659 +++++++- docs/FStar.Seq.Sorted.html | 121 +- docs/FStar.Seq.html | 23 +- docs/FStar.Set.html | 137 +- docs/FStar.Squash.html | 99 +- docs/FStar.SquashProperties.html | 153 +- docs/FStar.String.html | 148 +- docs/FStar.StrongExcludedMiddle.html | 19 +- docs/FStar.TSet.html | 102 +- docs/FStar.Tactics.Arith.html | 55 +- docs/FStar.Tactics.BV.html | 192 ++- docs/FStar.Tactics.Builtins.html | 572 +++++-- docs/FStar.Tactics.Canon.html | 239 ++- docs/FStar.Tactics.CanonCommSemiring.html | 1675 ++++++++++++++++++- docs/FStar.Tactics.CanonCommSwaps.html | 133 +- docs/FStar.Tactics.CanonMonoid.html | 121 +- docs/FStar.Tactics.Common.html | 19 + docs/FStar.Tactics.Derived.html | 1050 ++++++++++-- docs/FStar.Tactics.Effect.html | 173 +- docs/FStar.Tactics.Logic.html | 270 ++- docs/FStar.Tactics.PatternMatching.html | 913 +++++++++- docs/FStar.Tactics.Print.html | 89 + docs/FStar.Tactics.Result.html | 35 +- docs/FStar.Tactics.Simplifier.html | 244 ++- docs/FStar.Tactics.SyntaxHelpers.html | 81 +- docs/FStar.Tactics.Typeclasses.html | 187 ++- docs/FStar.Tactics.Types.html | 55 +- docs/FStar.Tactics.Util.html | 106 +- docs/FStar.Tactics.html | 62 +- docs/FStar.Tcp.html | 49 +- docs/FStar.UInt.html | 516 +++++- docs/FStar.UInt128.html | 145 +- docs/FStar.UInt16.html | 380 ++++- docs/FStar.UInt32.html | 380 ++++- docs/FStar.UInt64.html | 380 ++++- docs/FStar.UInt8.html | 381 ++++- docs/FStar.Udp.html | 44 +- docs/FStar.Universe.html | 98 +- docs/FStar.Util.html | 30 +- docs/FStar.VConfig.html | 48 + docs/FStar.Vector.Base.html | 413 ++++- docs/FStar.Vector.Properties.html | 104 +- docs/FStar.Vector.html | 23 +- docs/FStar.WellFounded.html | 148 +- docs/index.html | 108 +- 135 files changed, 26560 insertions(+), 3554 deletions(-) create mode 100644 docs/FStar.Algebra.CommMonoid.Equiv.html create mode 100644 docs/FStar.Classical.Sugar.html create mode 100644 docs/FStar.LexicographicOrdering.html create mode 100644 docs/FStar.Monotonic.Pure.html create mode 100644 docs/FStar.PCM.html create mode 100644 docs/FStar.Reflection.Builtins.html create mode 100644 docs/FStar.Seq.Permutation.html create mode 100644 docs/FStar.Tactics.Common.html create mode 100644 docs/FStar.Tactics.Print.html create mode 100644 docs/FStar.VConfig.html diff --git a/docs/FStar.Algebra.CommMonoid.Equiv.html b/docs/FStar.Algebra.CommMonoid.Equiv.html new file mode 100644 index 0000000..2bbe1be --- /dev/null +++ b/docs/FStar.Algebra.CommMonoid.Equiv.html @@ -0,0 +1,50 @@ + + + + + FStar.Algebra.CommMonoid.Equiv + + + +

+FStar.Algebra.CommMonoid.Equiv

+ +
unopteq
+type equiv (a:Type) =
+  | EQ :
+    eq:(a -> a -> Type0) ->
+    reflexivity:(x:a -> Lemma (x `eq` x)) ->
+    symmetry:(x:a -> y:a -> Lemma (requires (x `eq` y)) (ensures (y `eq` x))) ->
+    transitivity:(x:a -> y:a -> z:a -> Lemma (requires (x `eq` y /\ y `eq` z)) (ensures (x `eq` z))) ->
+    equiv a
+
let equality_equiv (a:Type) : equiv a =
+  EQ (fun x y -> x == y) (fun x -> ()) (fun x y -> ()) (fun x y z -> ())
+
unopteq
+type cm (a:Type) (eq:equiv a) =
+  | CM :
+    unit:a ->
+    mult:(a -> a -> a) ->
+    identity : (x:a -> Lemma ((unit `mult` x) `EQ?.eq eq` x)) ->
+    associativity : (x:a -> y:a -> z:a ->
+                      Lemma ((x `mult` y `mult` z) `EQ?.eq eq` (x `mult` (y `mult` z)))) ->
+    commutativity:(x:a -> y:a -> Lemma ((x `mult` y) `EQ?.eq eq` (y `mult` x))) ->
+    congruence:(x:a -> y:a -> z:a -> w:a -> Lemma (requires (x `EQ?.eq eq` z /\ y `EQ?.eq eq` w)) (ensures ((mult x y) `EQ?.eq eq` (mult z w)))) ->
+    cm a eq
+

temporarily fixing the universe of this lemma to u#1 because +otherwise tactics for LowStar.Resource canonicalization fails +by picking up an incorrect universe u#0 for resource type

+
let right_identity (#a:Type u#aa) (eq:equiv a) (m:cm a eq) (x:a)
+  : Lemma (x `CM?.mult m` (CM?.unit m) `EQ?.eq eq` x) =
+  CM?.commutativity m x (CM?.unit m);
+  CM?.identity m x;
+  EQ?.transitivity eq (x `CM?.mult m` (CM?.unit m)) ((CM?.unit m) `CM?.mult m` x) x
+
let int_plus_cm : cm int (equality_equiv int) =
+  CM 0 (+) (fun _ -> ()) (fun _ _ _ -> ()) (fun _ _ -> ()) (fun _ _ _ _ -> ())
+
let int_multiply_cm : cm int (equality_equiv int) =
+  CM 1 ( * ) (fun _ -> ()) (fun _ _ _ -> ()) (fun _ _ -> ()) (fun _ _ _ _ -> ())
+ + + diff --git a/docs/FStar.Algebra.CommMonoid.html b/docs/FStar.Algebra.CommMonoid.html index 9ad4d82..b2d6308 100644 --- a/docs/FStar.Algebra.CommMonoid.html +++ b/docs/FStar.Algebra.CommMonoid.html @@ -1,16 +1,34 @@ - - + + - - - - - + FStar.Algebra.CommMonoid + -

module FStar.Algebra.CommMonoid

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Algebra.CommMonoid

+ +
unopteq
+type cm (a:Type) =
+  | CM :
+    unit:a ->
+    mult:(a -> a -> a) ->
+    identity : (x:a -> Lemma (unit `mult` x == x)) ->
+    associativity : (x:a -> y:a -> z:a ->
+                      Lemma (x `mult` y `mult` z == x `mult` (y `mult` z))) ->
+    commutativity:(x:a -> y:a -> Lemma (x `mult` y == y `mult` x)) ->
+    cm a
+
let right_identity (#a:Type) (m:cm a) (x:a) :
+    Lemma (CM?.mult m x (CM?.unit m) == x) =
+  CM?.commutativity m x (CM?.unit m); CM?.identity m x
+
let int_plus_cm : cm int =
+  CM 0 (+) (fun x -> ()) (fun x y z -> ()) (fun x y -> ())
+
let int_multiply_cm : cm int =
+  CM 1 ( * ) (fun x -> ()) (fun x y z -> ()) (fun x y -> ())
+ diff --git a/docs/FStar.Algebra.Monoid.html b/docs/FStar.Algebra.Monoid.html index 5025187..171b130 100644 --- a/docs/FStar.Algebra.Monoid.html +++ b/docs/FStar.Algebra.Monoid.html @@ -1,55 +1,181 @@ - - + + - - - - - - + FStar.Algebra.Monoid + -

module FStar.Algebra.Monoid

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
 Definition of a monoid
-
 Some monoid structures
+

+FStar.Algebra.Monoid

+ +

Definition of a monoid

+
let right_unitality_lemma (m:Type) (u:m) (mult:m -> m -> m) =
+  forall (x:m). x `mult` u == x
+
let left_unitality_lemma (m:Type) (u:m) (mult:m -> m -> m) =
+  forall (x:m). u `mult` x == x
+
let associativity_lemma (m:Type) (mult:m -> m -> m) =
+  forall (x y z:m). x `mult` y `mult` z == x `mult` (y `mult` z)
+
unopteq
+type monoid (m:Type) =
+  | Monoid :
+    unit:m ->
+    mult:(m -> m -> m) ->
+    right_unitality:squash (right_unitality_lemma m unit mult) ->
+    left_unitality:squash (left_unitality_lemma m unit mult) ->
+    associativity:squash (associativity_lemma m mult) ->
+    monoid m
+
let intro_monoid (m:Type) (u:m) (mult:m -> m -> m)
+  : Pure (monoid m)
+    (requires (right_unitality_lemma m u mult /\ left_unitality_lemma m u mult /\ associativity_lemma m mult))
+    (ensures (fun mm -> Monoid?.unit mm == u /\ Monoid?.mult mm == mult))
+=
+  Monoid u mult () () ()
+

Some monoid structures

+
let nat_plus_monoid : monoid nat =
+  let add (x y : nat) : nat = x + y in
+  intro_monoid nat 0 add
+
let int_plus_monoid : monoid int =
+  intro_monoid int 0 (+)
+

let int_mul_monoid : monoid int =

+

intro_monoid int 1 op_Multiply

+
let conjunction_monoid : monoid prop =
+  let u : prop = singleton True in
+  let mult (p q : prop) : prop = p /\ q in
+
let left_unitality_helper (p:prop) : Lemma ((u `mult` p) == p) =
+  assert ((u `mult` p) <==> p) ;
+  PropExt.apply (u `mult` p) p
+in
+
let right_unitality_helper (p:prop) : Lemma ((p `mult` u) == p) =
+  assert ((p `mult` u) <==> p) ;
+  PropExt.apply (p `mult` u) p
+in
+
let associativity_helper (p1 p2 p3 : prop) : Lemma (p1 `mult` p2 `mult` p3 == p1 `mult` (p2 `mult` p3)) =
+  assert (p1 `mult` p2 `mult` p3 <==> p1 `mult` (p2 `mult` p3)) ;
+  PropExt.apply (p1 `mult` p2 `mult` p3) (p1 `mult` (p2 `mult` p3))
+in
+
forall_intro right_unitality_helper ;
+assert (right_unitality_lemma prop u mult) ;
+forall_intro left_unitality_helper ;
+assert (left_unitality_lemma prop u mult) ;
+forall_intro_3 associativity_helper;
+assert (associativity_lemma prop mult) ;
+intro_monoid prop u mult
+
let disjunction_monoid : monoid prop =
+  let u : prop = singleton False in
+  let mult (p q : prop) : prop = p \/ q in
+
let left_unitality_helper (p:prop) : Lemma ((u `mult` p) == p) =
+  assert ((u `mult` p) <==> p) ;
+  PropExt.apply (u `mult` p) p
+in
+
let right_unitality_helper (p:prop) : Lemma ((p `mult` u) == p) =
+  assert ((p `mult` u) <==> p) ;
+  PropExt.apply (p `mult` u) p
+in
+
let associativity_helper (p1 p2 p3 : prop) : Lemma (p1 `mult` p2 `mult` p3 == p1 `mult` (p2 `mult` p3)) =
+  assert (p1 `mult` p2 `mult` p3 <==> p1 `mult` (p2 `mult` p3)) ;
+  PropExt.apply (p1 `mult` p2 `mult` p3) (p1 `mult` (p2 `mult` p3))
+in
+
forall_intro right_unitality_helper ;
+assert (right_unitality_lemma prop u mult) ;
+forall_intro left_unitality_helper ;
+assert (left_unitality_lemma prop u mult) ;
+forall_intro_3 associativity_helper;
+assert (associativity_lemma prop mult) ;
+intro_monoid prop u mult
+
let bool_and_monoid : monoid bool =
+  let and_ b1 b2 = b1 && b2 in
+  intro_monoid bool true and_
+
let bool_or_monoid : monoid bool =
+  let or_ b1 b2 = b1 || b2 in
+  intro_monoid bool false or_
+
let bool_xor_monoid : monoid bool =
+  let xor b1 b2 = (b1 || b2) && not (b1 && b2) in
+  intro_monoid bool false xor
+
let lift_monoid_option (#a:Type) (m:monoid a) : monoid (option a) =
+  let mult (x y:option a) =
+    match x, y with
+    | Some x0, Some y0 -> Some (m.mult x0 y0)
+    | _, _ -> None
+  in
+  intro_monoid (option a) (Some m.unit) mult
+

Definition of a morphism of monoid

+
let monoid_morphism_unit_lemma (#a #b:Type) (f:a -> b) (ma:monoid a) (mb:monoid b) =
+  f (Monoid?.unit ma) == Monoid?.unit mb
+
let monoid_morphism_mult_lemma (#a #b:Type) (f:a -> b) (ma:monoid a) (mb:monoid b) =
+  forall (x y:a). Monoid?.mult mb (f x) (f y) == f (Monoid?.mult ma x y)
+
type monoid_morphism (#a #b:Type) (f:a -> b) (ma:monoid a) (mb:monoid b) =
+  | MonoidMorphism :
+    unit:squash (monoid_morphism_unit_lemma f ma mb) ->
+    mult:squash (monoid_morphism_mult_lemma f ma mb) ->
+    monoid_morphism f ma mb
+
let intro_monoid_morphism (#a #b:Type) (f:a -> b) (ma:monoid a) (mb:monoid b)
+  : Pure (monoid_morphism f ma mb)
+    (requires (monoid_morphism_unit_lemma f ma mb /\ monoid_morphism_mult_lemma f ma mb))
+    (ensures (fun _ -> True))
+=
+  MonoidMorphism () ()
+
let embed_nat_int (n:nat) : int = n
+let _ = intro_monoid_morphism embed_nat_int nat_plus_monoid int_plus_monoid
+
let neg (p:prop) : prop = ~p
+let _ =
+  assert (neg True <==> False) ;
+  PropExt.apply (neg True) False ;
+  let mult_lemma_helper (p q:prop) : Lemma (neg (p /\ q) == (neg p \/ neg q)) =
+    assert (neg (p /\ q) <==> (neg p \/ neg q)) ;
+    PropExt.apply (neg (p /\ q)) (neg p \/ neg q)
+  in
+  forall_intro_2 mult_lemma_helper ;
+  intro_monoid_morphism neg conjunction_monoid disjunction_monoid
+
let _ =
+  assert (neg False <==> True) ;
+  PropExt.apply (neg False) True ;
+  let mult_lemma_helper (p q:prop) : Lemma (neg (p \/ q) == (neg p /\ neg q)) =
+    assert (neg (p \/ q) <==> (neg p /\ neg q)) ;
+    PropExt.apply (neg (p \/ q)) (neg p /\ neg q)
+  in
+  forall_intro_2 mult_lemma_helper ;
+  intro_monoid_morphism neg disjunction_monoid conjunction_monoid
+

Definition of a left action

+
let mult_act_lemma (m a:Type) (mult:m -> m -> m) (act:m -> a -> a) =
+  forall (x x':m) (y:a). (x `mult` x') `act` y == x `act` (x' `act` y)
+
let unit_act_lemma (m a:Type) (u:m) (act:m -> a -> a) =
+  forall (y:a). u `act` y == y
+
unopteq
+type left_action (#m:Type) (mm:monoid m) (a:Type) =
+  | LAct :
+    act:(m -> a -> a) ->
+    mult_lemma: squash (mult_act_lemma m a (Monoid?.mult mm) act) ->
+    unit_lemma: squash (unit_act_lemma m a (Monoid?.unit mm) act) ->
+    left_action mm a
+
let left_action_morphism
+    (#a #b #ma #mb:Type)
+    (f:a -> b)
+

mf ought to be a monoid morphism but we don't use this fact in the property

+
    (mf: ma -> mb)
+    (#mma:monoid ma)
+    (#mmb:monoid mb)
+    (la:left_action mma a)
+    (lb:left_action mmb b)
+= forall (g:ma) (x:a). LAct?.act lb (mf g) (f x) == f (LAct?.act la g x)
+ diff --git a/docs/FStar.All.html b/docs/FStar.All.html index 07a5302..916873b 100644 --- a/docs/FStar.All.html +++ b/docs/FStar.All.html @@ -1,16 +1,43 @@ - - + + - - - - - + FStar.All + -

module FStar.All

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.All

+ +
let all_pre = all_pre_h heap
+let all_post' (a : Type) (pre:Type) = all_post_h' heap a pre
+let all_post (a : Type) = all_post_h heap a
+let all_wp (a : Type) = all_wp_h heap a
+new_effect ALL  = ALL_h heap
+
unfold let lift_state_all (a : Type) (wp : st_wp a) (p : all_post a) = wp (fun a -> p (V a))
+sub_effect STATE ~> ALL { lift_wp = lift_state_all }
+
unfold
+let lift_exn_all (a : Type) (wp : ex_wp a) (p : all_post a) (h : heap) = wp (fun ra -> p ra h)
+sub_effect EXN ~> ALL { lift_wp = lift_exn_all }
+
effect All (a:Type) (pre:all_pre) (post:(h:heap -> Tot (all_post' a (pre h)))) =
+  ALL a
+    (fun (p : all_post a) (h : heap) -> pre h /\ (forall ra h1. post h ra h1 ==> p ra h1))
+effect ML (a:Type) = ALL a (fun (p:all_post a) (_:heap) -> forall (a:result a) (h:heap). p a h)
+
let ( |> ) (x : 'a) (f : ('a -> ML 'b)) : ML 'b = f x
+let pipe_right = ( |> )
+
let ( <| ) (f : ('a -> ML 'b)) (x : 'a) : ML 'b = f x
+let pipe_left = ( <| )
+
assume val exit : int -> ML 'a
+assume val try_with : (unit -> ML 'a) -> (exn -> ML 'a) -> ML 'a
+
assume exception Failure of string
+assume val failwith : string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h == h')
+ diff --git a/docs/FStar.BV.html b/docs/FStar.BV.html index 9dc5199..fd67022 100644 --- a/docs/FStar.BV.html +++ b/docs/FStar.BV.html @@ -1,16 +1,215 @@ - - + + - - - - - + FStar.BV + -

module FStar.BV

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.BV

+
+

This module defines an abstract type of length-indexed bit +vectors. The type and its operations are handled primitively in +F*'s SMT encoding, which maps them to the SMT sort of bit vectors +and operations on that sort.

+

One way to use this module is in conjuction with +FStar.Tactics.BV. Its main tactic, bv_tac, converts bitwise +operations on unsigned integers to operations on bit vectors and +back using the int2bv / bv2int isomorphism. This can be an +effective way of discharging such proof obligations for bitwise +operatoins on integers using the SMT solver's theory of +bitvectors.

+
+ +

for now just opening this for logand, logxor, etc. but we need a better solution.

+

+bv_t

+

The main type of this module, bit vectors of length n, with +decidable equality

+
val bv_t (n: nat) : eqtype
+

Experimental: +Redefining basic type from UInt to avoid importing UInt +Reduces verification time by 50% in small examples +// let max_int (n:nat) : Tot int = pow2 n - 1 +// let min_int (n:nat) : Tot int = 0 +// let fits (x:int) (n:nat) : Tot bool = min_int n <= x && x <= max_int n +// let size (x:int) (n:nat) : Tot Type0 = b2t(fits x n) +// type uint_t' (n:nat) = x:int{size x n}

+

+bv_uext

+

Extending a bit vector of length n to a larger vector of size +m+n, filling the extra bits with 0

+
val bv_uext (#n #m: pos) (a: bv_t n) : Tot (normalize (bv_t (m + n)))
+

+Relating unsigned integers to bitvectors

+

+int2bv

+

Mapping a bounded unsigned integer of size < 2^n, to a n-length +bit vector

+
val int2bv (#n: pos) (num: uint_t n) : Tot (bv_t n)
+

+bv2int

+

Mapping a bit vector back to a bounded unsigned integer of size [< +2^n]

+
val bv2int (#n: pos) (vec: bv_t n) : Tot (uint_t n)
+
val int2bv_lemma_1 (#n: pos) (a b: uint_t n)
+    : Lemma (requires a = b) (ensures (int2bv #n a = int2bv #n b))
+
val int2bv_lemma_2 (#n: pos) (a b: uint_t n)
+    : Lemma (requires (int2bv a = int2bv b)) (ensures a = b)
+
val inverse_vec_lemma (#n: pos) (vec: bv_t n)
+    : Lemma (requires True) (ensures vec = (int2bv (bv2int vec))) [SMTPat (int2bv (bv2int vec))]
+
val inverse_num_lemma (#n: pos) (num: uint_t n)
+    : Lemma (requires True)
+      (ensures num = bv2int #n (int2bv #n num))
+      [SMTPat (bv2int #n (int2bv #n num))]
+

+Relating lists to bitvectors

+

+list2bv

+

Mapping a list of booleans to a bitvector

+
val list2bv (#n: pos) (l: list bool {List.length l = n}) : Tot (bv_t n)
+

+bv2list

+

Mapping a bitvector to a list of booleans

+
val bv2list: #n: pos -> bv_t n -> Tot (l: list bool {List.length l = n})
+
val list2bv_bij (#n: pos) (a: list bool {List.length a = n})
+    : Lemma (requires (True)) (ensures (bv2list (list2bv #n a) = a))
+
val bv2list_bij (#n: pos) (a: bv_t n)
+    : Lemma (requires (True)) (ensures (list2bv (bv2list #n a) = a))
+

+Bitwise logical operators

+

+bvand

+

Bitwise conjunction

+
val bvand (#n: pos) (a b: bv_t n) : Tot (bv_t n)
+
val int2bv_logand:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvand #n (int2bv #n x) (int2bv #n y) == z)
+  -> Lemma (int2bv #n (logand #n x y) == z)
+

+bvxor

+

Bitwise exclusive or

+
val bvxor (#n: pos) (a b: bv_t n) : Tot (bv_t n)
+
val int2bv_logxor:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvxor #n (int2bv #n x) (int2bv #n y) == z)
+  -> Lemma (int2bv #n (logxor #n x y) == z)
+

+bvor

+

Bitwise disjunction

+
val bvor (#n: pos) (a b: bv_t n) : Tot (bv_t n)
+
val int2bv_logor:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvor #n (int2bv #n x) (int2bv #n y) == z)
+  -> Lemma (int2bv #n (logor #n x y) == z)
+

+bvnot

+

Bitwise negation

+
val bvnot (#n: pos) (a: bv_t n) : Tot (bv_t n)
+
val int2bv_lognot: #n: pos -> #x: uint_t n -> #z: bv_t n -> squash (bvnot #n (int2bv #n x) == z)
+  -> Lemma (int2bv #n (lognot #n x) == z)
+

+bvshl

+

Bitwise shift left

+
val bvshl (#n: pos) (a: bv_t n) (s: nat) : Tot (bv_t n)
+
val int2bv_shl:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvshl #n (int2bv #n x) y == z)
+  -> Lemma (int2bv #n (shift_left #n x y) == z)
+

+bvshr

+

Bitwise shift right

+
val bvshr (#n: pos) (a: bv_t n) (s: nat) : Tot (bv_t n)
+
val int2bv_shr:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvshr #n (int2bv #n x) y == z)
+  -> Lemma (int2bv #n (shift_right #n x y) == z)
+

+Arithmetic operations

+
unfold
+let bv_zero #n = int2bv #n 0
+

+bvult

+

Inequality on bitvectors

+
val bvult (#n: pos) (a b: bv_t n) : Tot (bool)
+
val int2bv_lemma_ult_1 (#n: pos) (a b: uint_t n)
+    : Lemma (requires a < b) (ensures (bvult #n (int2bv #n a) (int2bv #n b)))
+
val int2bv_lemma_ult_2 (#n: pos) (a b: uint_t n)
+    : Lemma (requires (bvult #n (int2bv #n a) (int2bv #n b))) (ensures a < b)
+

+bvadd

+

Addition

+
val bvadd (#n: pos) (a b: bv_t n) : Tot (bv_t n)
+
val int2bv_add:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvadd #n (int2bv #n x) (int2bv #n y) == z)
+  -> Lemma (int2bv #n (add_mod #n x y) == z)
+

+bvsub

+

Subtraction

+
val bvsub (#n: pos) (a b: bv_t n) : Tot (bv_t n)
+
val int2bv_sub:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvsub #n (int2bv #n x) (int2bv #n y) == z)
+  -> Lemma (int2bv #n (sub_mod #n x y) == z)
+

+bvdiv

+

Division

+
val bvdiv (#n: pos) (a: bv_t n) (b: uint_t n {b <> 0}) : Tot (bv_t n)
+
val int2bv_div:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n {y <> 0} ->
+    #z: bv_t n ->
+    squash (bvdiv #n (int2bv #n x) y == z)
+  -> Lemma (int2bv #n (udiv #n x y) == z)
+

+bvmod

+

Modulus

+
val bvmod (#n: pos) (a: bv_t n) (b: uint_t n {b <> 0}) : Tot (bv_t n)
+
val int2bv_mod:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n {y <> 0} ->
+    #z: bv_t n ->
+    squash (bvmod #n (int2bv #n x) y == z)
+  -> Lemma (int2bv #n (mod #n x y) == z)
+

+bvmul

+

Multiplication modulo

+
val bvmul (#n: pos) (a: bv_t n) (b: uint_t n) : Tot (bv_t n)
+
val int2bv_mul:
+    #n: pos ->
+    #x: uint_t n ->
+    #y: uint_t n ->
+    #z: bv_t n ->
+    squash (bvmul #n (int2bv #n x) y == z)
+  -> Lemma (int2bv #n (mul_mod #n x y) == z)
+ diff --git a/docs/FStar.BaseTypes.html b/docs/FStar.BaseTypes.html index de0c11a..9032e2c 100644 --- a/docs/FStar.BaseTypes.html +++ b/docs/FStar.BaseTypes.html @@ -1,16 +1,29 @@ - - + + - - - - - + FStar.BaseTypes + -

module FStar.BaseTypes

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.BaseTypes

+
+

This module aggregates commonly used primitive type constants into +a single module, providing abbreviations for them.

+
+
type char = FStar.Char.char
+type float = FStar.Float.float
+type double = FStar.Float.double
+type byte = FStar.UInt8.byte
+type int8 = FStar.Int8.t
+type uint8 = FStar.UInt8.t
+type int16 = FStar.Int16.t
+type uint16 = FStar.UInt16.t
+type int32 = FStar.Int32.t
+type uint32 = FStar.UInt32.t
+type int64 = FStar.Int64.t
+type uint64 = FStar.UInt64.t
+ diff --git a/docs/FStar.BigOps.html b/docs/FStar.BigOps.html index 65cfda6..ec8cf93 100644 --- a/docs/FStar.BigOps.html +++ b/docs/FStar.BigOps.html @@ -1,16 +1,285 @@ - - + + - - - - - + FStar.BigOps + -

module FStar.BigOps

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.BigOps

+
+

This library provides propositional connectives over finite sets +expressed as lists, aka "big operators", in analogy with LaTeX +usage for \bigand, \bigor, etc.

+

The library is designed with a dual usage in mind:

+
1. Normalization: When applied to a list literal, we want
+   ```FStarbig_and f [a;b;c]``` to implicilty reduce to [f a /\ f b /\ f c]
+
+2. Symbolic manipulation: We provide lemmas of the form
+
+   `big_and f l <==> forall x. L.memP x l ==> f x`
+
+

In this latter form, partially computing big_and as a fold over +a list is cumbersome for proof. So, we provide variants big_and' +etc., that do not reduce implicitly.

+
+ +

+reduce +

+

We control reduction using the delta_attr feature of the +normalizer. See FStar.Pervasives for how that works. Every term +that is to be reduced is with the __reduce__ attribute

+
let __reduce__ = ()
+

We wrap norm with a module-specific custom usage, triggering +specific reduction steps

+
[@@ __reduce__]
+unfold
+let normal (#a: Type) (x: a) : a =
+  FStar.Pervasives.norm [
+      iota;
+      zeta;
+      delta_only [`%L.fold_right_gtot; `%L.map_gtot];
+      delta_attr [`%__reduce__];
+      primops;
+      simplify
+    ]
+    x
+

+normal_eq

+

A useful lemma to relate terms to their implicilty reducing variants

+
val normal_eq (#a: Type) (f: a) : Lemma (f == normal f)
+

+Map and fold

+

+map_op'

+

A utility that combines map and fold: map_op' op f l z maps each +element of l by f and then combines them using op

+
[@@ __reduce__]
+let map_op' #a #b #c (op: (b -> c -> GTot c)) (f: (a -> GTot b)) (l: list a) (z: c) : GTot c =
+  L.fold_right_gtot #a #c l (fun x acc -> (f x) `op` acc) z
+

+map_op'_nil

+

Equations for map_op' showing how it folds over the empty list

+
val map_op'_nil (#a #b #c: Type) (op: (b -> c -> GTot c)) (f: (a -> GTot b)) (z: c)
+    : Lemma (map_op' op f [] z == z)
+

+map_op'_cons

+

Equations for map_op' showing how it folds over a cons cell

+
val map_op'_cons
+      (#a #b #c: Type)
+      (op: (b -> c -> GTot c))
+      (f: (a -> GTot b))
+      (hd: a)
+      (tl: list a)
+      (z: c)
+    : Lemma (map_op' op f (hd :: tl) z == (f hd) `op` (map_op' op f tl z))
+

+Conjunction

+

+big_and'

+

big_and' f l = /\_{x in l} f x

+
[@@ __reduce__]
+let big_and' #a (f: (a -> Type)) (l: list a) : Type = map_op' l_and f l True
+

+big_and'_nil

+

Equations for big_and' showing it to be trivial over the empty list

+
val big_and'_nil (#a: Type) (f: (a -> Type)) : Lemma (big_and' f [] == True)
+

+big_and'_cons

+

Equations for big_and' showing it to be a fold over a list with /\

+
val big_and'_cons (#a: Type) (f: (a -> Type)) (hd: a) (tl: list a)
+    : Lemma (big_and' f (hd :: tl) == (f hd /\ big_and' f tl))
+

+big_and'_prop

+

big_and' f l is a prop, i.e., it is proof irrelevant.

+
val big_and'_prop (#a: Type) (f: (a -> Type)) (l: list a) : Lemma ((big_and' f l) `subtype_of` unit)
+

Note: defining big_and' to intrinsically be in prop +is also possible, but it's much more tedious in proofs.

+

This is in part because the /\ is not defined in prop, +though one can prove that a /\ b is a prop.

+

The discrepancy means that I preferred to prove these +operators in prop extrinsically.

+

+big_and'_forall

+

Interpreting the finite conjunction big_and f l +as an infinite conjunction forall

+
val big_and'_forall (#a: Type) (f: (a -> Type)) (l: list a)
+    : Lemma (big_and' f l <==> (forall x. L.memP x l ==> f x))
+

big_and f l is an implicitly reducing variant of big_and' +It is defined in prop

+
[@@ __reduce__]
+unfold
+let big_and #a (f: (a -> Type)) (l: list a) : prop =
+  big_and'_prop f l;
+  normal (big_and' f l)
+

+Disjunction

+

+big_or'

+

big_or f l = \/_{x in l} f x

+
[@@ __reduce__]
+let big_or' #a (f: (a -> Type)) (l: list a) : Type = map_op' l_or f l False
+

+big_or'_nil

+

Equations for big_or showing it to be False on the empty list

+
val big_or'_nil (#a: Type) (f: (a -> Type)) : Lemma (big_or' f [] == False)
+

+big_or'_cons

+

Equations for big_or showing it to fold over a list

+
val big_or'_cons (#a: Type) (f: (a -> Type)) (hd: a) (tl: list a)
+    : Lemma (big_or' f (hd :: tl) == (f hd \/ big_or' f tl))
+

+big_or'_prop

+

big_or f l is a prop +See the remark above on the style of proof for prop

+
val big_or'_prop (#a: Type) (f: (a -> Type)) (l: list a) : Lemma ((big_or' f l) `subtype_of` unit)
+

+big_or'_exists

+

Interpreting the finite disjunction big_or f l +as an infinite disjunction exists

+
val big_or'_exists (#a: Type) (f: (a -> Type)) (l: list a)
+    : Lemma (big_or' f l <==> (exists x. L.memP x l /\ f x))
+

big_or f l is an implicitly reducing variant of big_or' +It is defined in prop

+
[@@ __reduce__]
+unfold
+let big_or #a (f: (a -> Type)) (l: list a) : prop =
+  big_or'_prop f l;
+  normal (big_or' f l)
+

+Pairwise operators

+
+

We provide functions to apply a reflexive, symmetric binary +operator to elements in a list l pairwise, in a triangle of +elements in the square matrix of l X l. To illustrate, for a +list of n elements, we fold the operator over the pairwise +elements of the list in top-down, left-to-right order of the +diagram below

+
 0 1 2 3 ... n
+0
+1 x
+2 x x
+3 x x x
+. x x x x
+ n x x x x  ```
+
+

+pairwise_op'

+

Mapping pairs of elements of l using f and combining them with +op.

+
[@@ __reduce__]
+let rec pairwise_op' #a #b (op: (b -> b -> GTot b)) (f: (a -> a -> b)) (l: list a) (z: b) : GTot b =
+  match l with
+  | [] -> z
+  | hd :: tl -> (map_op' op (f hd) tl z) `op` (pairwise_op' op f tl z)
+

+symmetric

+

f is a symmetric relation

+
let symmetric (#a: Type) (f: (a -> a -> Type)) = forall x y. f x y <==> f y x
+

+reflexive

+

f is a reflexive relation

+
let reflexive (#a: Type) (f: (a -> a -> Type)) = forall x. f x x
+

+anti_reflexive

+

f is a anti-reflexive relation

+
let anti_reflexive (#a: Type) (f: (a -> a -> Type)) = forall x. ~(f x x)
+

+Pairwise conjunction

+

+pairwise_and'

+

pairwise_and f l conjoins f on all pairs excluding the diagonal +i.e.,

+
[@@ __reduce__]
+let pairwise_and' #a (f: (a -> a -> Type)) (l: list a) : Type = pairwise_op' l_and f l True
+

FStar pairwise_and f [a; b; c] = f a b /\ f a c /\ f b c

+

+pairwise_and'_nil

+

Equations for pairwise_and showing it to be a fold with big_and

+
val pairwise_and'_nil (#a: Type) (f: (a -> a -> Type0)) : Lemma (pairwise_and' f [] == True)
+

+pairwise_and'_cons

+

Equations for pairwise_and showing it to be a fold with big_and

+
val pairwise_and'_cons (#a: Type) (f: (a -> a -> Type0)) (hd: a) (tl: list a)
+    : Lemma (pairwise_and' f (hd :: tl) == (big_and' (f hd) tl /\ pairwise_and' f tl))
+

+pairwise_and'_prop

+

pairwise_and' f l is a prop +See the remark above on the style of proof for prop

+
val pairwise_and'_prop (#a: Type) (f: (a -> a -> Type)) (l: list a)
+    : Lemma ((pairwise_and' f l) `subtype_of` unit)
+

+pairwise_and'_forall

+

pairwise_and' f l for symmetric reflexive relations f +is interpreted as universal quantification over pairs of list elements *

+
val pairwise_and'_forall (#a: Type) (f: (a -> a -> Type)) (l: list a)
+    : Lemma (requires symmetric f /\ reflexive f)
+      (ensures (pairwise_and' f l <==> (forall x y. L.memP x l /\ L.memP y l ==> f x y)))
+

+pairwise_and'_forall_no_repeats

+

pairwise_and' f l for symmetric relations f interpreted as +universal quantification over pairs of list of unique elements

+
val pairwise_and'_forall_no_repeats (#a: Type) (f: (a -> a -> Type)) (l: list a)
+    : Lemma (requires symmetric f /\ L.no_repeats_p l)
+      (ensures (pairwise_and' f l <==> (forall x y. L.memP x l /\ L.memP y l /\ x =!= y ==> f x y)))
+

pairwise_and f l is an implicitly reducing variant of pairwise_and' +It is defined in prop

+
[@@ __reduce__]
+unfold
+let pairwise_and #a (f: (a -> a -> Type)) (l: list a) : prop =
+  pairwise_and'_prop f l;
+  normal (pairwise_and' f l)
+

+Pairwise disjunction

+

+pairwise_or'

+

pairwise_or f l disjoins f on all pairs excluding the diagonal +i.e., pairwise_or f a; b; c = f a b \/ f a c \/ f b c

+
[@@ __reduce__]
+let pairwise_or' #a (f: (a -> a -> Type)) (l: list a) : Type = pairwise_op' l_or f l False
+

+pairwise_or'_nil

+

Equations for pairwise_or' showing it to be a fold with big_or'

+
val pairwise_or'_nil (#a: Type) (f: (a -> a -> Type0)) : Lemma (pairwise_or' f [] == False)
+

+pairwise_or'_cons

+

Equations for pairwise_or' showing it to be a fold with big_or'

+
val pairwise_or'_cons (#a: Type) (f: (a -> a -> Type0)) (hd: a) (tl: list a)
+    : Lemma (pairwise_or' f (hd :: tl) == (big_or' (f hd) tl \/ pairwise_or' f tl))
+

+pairwise_or'_prop

+

pairwise_or' f l is a prop +See the remark above on the style of proof for prop

+
val pairwise_or'_prop (#a: Type) (f: (a -> a -> Type)) (l: list a)
+    : Lemma ((pairwise_or' f l) `subtype_of` unit)
+

+pairwise_or'_exists

+

pairwise_or' f l for symmetric, anti-reflexive relations f +interpreted as existential quantification over +pairs of list elements

+
val pairwise_or'_exists (#a: Type) (f: (a -> a -> Type)) (l: list a)
+    : Lemma (requires symmetric f /\ anti_reflexive f)
+      (ensures (pairwise_or' f l <==> (exists x y. L.memP x l /\ L.memP y l /\ f x y)))
+

+pairwise_or'_exists_no_repeats

+

pairwise_or' f l for symmetric, anti-reflexive relations f +interpreted as existential quantification over +pairs of list elements

+
val pairwise_or'_exists_no_repeats (#a: Type) (f: (a -> a -> Type)) (l: list a)
+    : Lemma (requires symmetric f /\ L.no_repeats_p l)
+      (ensures (pairwise_or' f l <==> (exists x y. L.memP x l /\ L.memP y l /\ x =!= y /\ f x y)))
+

pairwise_or f l is an implicitly reducing variant of pairwise_or' +It is defined in prop

+
[@@ __reduce__]
+unfold
+let pairwise_or #a (f: (a -> a -> Type)) (l: list a) : prop =
+  pairwise_or'_prop f l;
+  normal (pairwise_or' f l)
+ diff --git a/docs/FStar.BitVector.html b/docs/FStar.BitVector.html index 36d94b5..5eebfc4 100644 --- a/docs/FStar.BitVector.html +++ b/docs/FStar.BitVector.html @@ -1,61 +1,202 @@ - - + + - - - - - - + FStar.BitVector + -

module FStar.BitVector

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let (is_subset_vec (#n:pos) (a:bv_t n) (b:bv_t n)):forall i:nat.{:pattern } ==>(<(i, n), ==>(=(index b i, false), =(index a i, false)))
-

is_subset_vec is the property that the zero bits of b are also zero in a. I.e. that a is a subset of b.

-
let (is_superset_vec (#n:pos) (a:bv_t n) (b:bv_t n)):forall i:nat.{:pattern } ==>(<(i, n), ==>(=(index b i, true), =(index a i, true)))
-

is_superset_vec is the property that the non-zero bits of b are also non-zero in a. I.e. that a is a superset of b.

-
val lemma_slice_subset_vec:Unidentified product: [#n:pos] Unidentified product: [a:bv_t n] Unidentified product: [b:bv_t n] Unidentified product: [i:nat] Unidentified product: [j:j:nat:{&&(<(i, j), <=(j, n))}] (Lemma ((requires is_subset_vec a b)) ((ensures (match n with 1  -> True | _  -> is_subset_vec #(-(j, i)) (slice a i j) (slice b i j)))))
-

lemma_slice_subset_vec proves that the subset property is conserved in subslices.

-
val lemma_slice_superset_vec:Unidentified product: [#n:pos] Unidentified product: [a:bv_t n] Unidentified product: [b:bv_t n] Unidentified product: [i:nat] Unidentified product: [j:j:nat:{&&(<(i, j), <=(j, n))}] (Lemma ((requires is_superset_vec a b)) ((ensures (match n with 1  -> True | _  -> is_superset_vec #(-(j, i)) (slice a i j) (slice b i j)))))
-

lemma_slice_superset_vec proves that the superset property is conserved in subslices.

+

+FStar.BitVector

+
+

This module defines a bit vector as a sequence of booleans of a +given length, and provides various utilities.

+

NOTE: THE TYPE bv_t DEFINED IS UNRELATED TO THE SMT SOLVER'S +THEORY OF BIT VECTORS. SEE FStar.BV FOR THAT.

+

TODO: We might rename this module to FStar.Seq.Boolean?

+
+ +

+bv_t

+

bv_t n is just a sequence of booleans of length n

+
type bv_t (n: nat) = vec: seq bool {length vec = n}
+

+Common constants

+

+zero_vec

+

A length n zero vector

+
let zero_vec (#n: pos) : bv_t n = create n false
+

+elem_vec

+

A vector of length n whose ith bit is set, only

+
let elem_vec (#n: pos) (i: nat{i < n}) : bv_t n = upd (create n false) i true
+

+ones_vec

+

A length n vector all of whose bits are set

+
let ones_vec (#n: pos) : bv_t n = create n true
+

+logand_vec

+

Bitwise logical and

+
let rec logand_vec (#n: pos) (a b: bv_t n) : Tot (bv_t n) =
+  if n = 1
+  then create 1 (index a 0 && index b 0)
+  else append (create 1 (index a 0 && index b 0)) (logand_vec #(n - 1) (slice a 1 n) (slice b 1 n))
+

+logand_vec_definition

+

logand defined in terms of its indexing behavior

+
let rec logand_vec_definition (#n: pos) (a b: bv_t n) (i: nat{i < n})
+    : Lemma (ensures index (logand_vec #n a b) i = (index a i && index b i))
+      [SMTPat (index (logand_vec #n a b) i)] =
+  if i = 0 then () else logand_vec_definition #(n - 1) (slice a 1 n) (slice b 1 n) (i - 1)
+

+logxor_vec

+

Bitwise logical exclusive or

+
let rec logxor_vec (#n: pos) (a b: bv_t n) : Tot (bv_t n) =
+  if n = 1
+  then create 1 (index a 0 <> index b 0)
+  else append (create 1 (index a 0 <> index b 0)) (logxor_vec #(n - 1) (slice a 1 n) (slice b 1 n))
+

+logxor_vec_definition

+

logxor defined in terms of its indexing behavior

+
let rec logxor_vec_definition (#n: pos) (a b: bv_t n) (i: nat{i < n})
+    : Lemma (ensures index (logxor_vec #n a b) i = (index a i <> index b i))
+      [SMTPat (index (logxor_vec #n a b) i)] =
+  if i = 0 then () else logxor_vec_definition #(n - 1) (slice a 1 n) (slice b 1 n) (i - 1)
+

+logor_vec

+

Bitwise logical or

+
let rec logor_vec (#n: pos) (a b: bv_t n) : Tot (bv_t n) =
+  if n = 1
+  then create 1 (index a 0 || index b 0)
+  else append (create 1 (index a 0 || index b 0)) (logor_vec #(n - 1) (slice a 1 n) (slice b 1 n))
+

+logor_vec_definition

+

logor defined in terms of its indexing behavior

+
let rec logor_vec_definition (#n: pos) (a b: bv_t n) (i: nat{i < n})
+    : Lemma (ensures index (logor_vec #n a b) i = (index a i || index b i))
+      [SMTPat (index (logor_vec #n a b) i)] =
+  if i = 0 then () else logor_vec_definition #(n - 1) (slice a 1 n) (slice b 1 n) (i - 1)
+

+lognot_vec

+

Bitwise negation

+
let rec lognot_vec (#n: pos) (a: bv_t n) : Tot (bv_t n) =
+  if n = 1
+  then create 1 (not (index a 0))
+  else append (create 1 (not (index a 0))) (lognot_vec #(n - 1) (slice a 1 n))
+

+lognot_vec_definition

+

lognot defined in terms of its indexing behavior

+
let rec lognot_vec_definition (#n: pos) (a: bv_t n) (i: nat{i < n})
+    : Lemma (ensures index (lognot_vec #n a) i = not (index a i))
+      [SMTPat (index (lognot_vec #n a) i)] =
+  if i = 0 then () else lognot_vec_definition #(n - 1) (slice a 1 n) (i - 1)
+

Bitwise lemmas

+

+lemma_xor_bounded

+

If both x and y are false at a given index i, then so is they logical xor at i

+
let lemma_xor_bounded (m: pos) (n: nat) (x y: bv_t m)
+    : Lemma
+      (requires
+        (forall (i: nat).
+            (i < m /\ i >= n) ==>
+            (Seq.index x (m - 1 - i) = false /\ Seq.index y (m - 1 - i) = false)))
+      (ensures
+        (forall (i: nat). (i < m /\ i >= n) ==> (Seq.index (logxor_vec x y) (m - 1 - i) = false))) =
+  ()
+

+is_subset_vec

+

The property that the zero bits of b are also zero in a. +I.e. that a is a subset of b.

+
let is_subset_vec (#n: pos) (a b: bv_t n) =
+  forall (i: nat). i < n ==> index b i = false ==> index a i = false
+

+is_superset_vec

+

The property that the non-zero bits of b are also non-zero in a. +I.e. that a is a superset of b.

+
let is_superset_vec (#n: pos) (a b: bv_t n) =
+  forall (i: nat). i < n ==> index b i = true ==> index a i = true
+

+lemma_slice_subset_vec

+

Proves that the subset property is conserved in subslices.

+
let lemma_slice_subset_vec (#n: pos) (a b: bv_t n) (i: nat) (j: nat{i < j && j <= n})
+    : Lemma (requires is_subset_vec a b)
+      (ensures
+        (match n with
+          | 1 -> True
+          | _ -> is_subset_vec #(j - i) (slice a i j) (slice b i j))) = ()
+

+lemma_slice_superset_vec

+

Proves that the superset property is conserved in subslices.

+
let lemma_slice_superset_vec (#n: pos) (a b: bv_t n) (i: nat) (j: nat{i < j && j <= n})
+    : Lemma (requires is_superset_vec a b)
+      (ensures
+        (match n with
+          | 1 -> True
+          | _ -> is_superset_vec #(j - i) (slice a i j) (slice b i j))) = ()
+

+Shift operators

+

Note: the shift amount is extracted as a bitvector +NS: Not sure what this remark means.

+

+shift_left_vec

+

Shift a left by s bits, filling with zeroes

+
let shift_left_vec (#n: pos) (a: bv_t n) (s: nat) : bv_t n =
+  if s >= n then zero_vec #n else if s = 0 then a else append (slice a s n) (zero_vec #s)
+

+shift_left_vec_lemma_1

+

The fill bits of a shift left are zero

+
let shift_left_vec_lemma_1 (#n: pos) (a: bv_t n) (s: nat) (i: nat{i < n && i >= n - s})
+    : Lemma (ensures index (shift_left_vec #n a s) i = false)
+      [SMTPat (index (shift_left_vec #n a s) i)] = ()
+

+shift_left_vec_lemma_2

+

Relating the indexes of the shifted vector to the original

+
let shift_left_vec_lemma_2 (#n: pos) (a: bv_t n) (s: nat) (i: nat{i < n && i < n - s})
+    : Lemma (ensures index (shift_left_vec #n a s) i = index a (i + s))
+      [SMTPat (index (shift_left_vec #n a s) i)] = ()
+

+shift_right_vec

+

Shift a right by s bits, filling with zeroes

+
let shift_right_vec (#n: pos) (a: bv_t n) (s: nat) : bv_t n =
+  if s >= n then zero_vec #n else if s = 0 then a else append (zero_vec #s) (slice a 0 (n - s))
+

+shift_right_vec_lemma_1

+

The fill bits of a shift right are zero

+
let shift_right_vec_lemma_1 (#n: pos) (a: bv_t n) (s: nat) (i: nat{i < n && i < s})
+    : Lemma (ensures index (shift_right_vec #n a s) i = false)
+      [SMTPat (index (shift_right_vec #n a s) i)] = ()
+

+shift_right_vec_lemma_2

+

Relating the indexes of the shifted vector to the original

+
let shift_right_vec_lemma_2 (#n: pos) (a: bv_t n) (s: nat) (i: nat{i < n && i >= s})
+    : Lemma (ensures index (shift_right_vec #n a s) i = index a (i - s))
+      [SMTPat (index (shift_right_vec #n a s) i)] = ()
+

+shift_arithmetic_right_vec

+

Arithmetic shift right of a, interpreting position 0 as the +most-significant bit, and using its value to fill

+
let shift_arithmetic_right_vec (#n: pos) (a: bv_t n) (s: nat) : bv_t n =
+  if index a 0
+  then if s >= n then ones_vec #n else if s = 0 then a else append (ones_vec #s) (slice a 0 (n - s))
+  else shift_right_vec a s
+

+shift_arithmetic_right_vec_lemma_1

+

The fill bits of arithmetic shift right is the value of its +most-significant bit (position zero)

+
let shift_arithmetic_right_vec_lemma_1 (#n: pos) (a: bv_t n) (s: nat) (i: nat{i < n && i < s})
+    : Lemma (ensures index (shift_arithmetic_right_vec #n a s) i = index a 0)
+      [SMTPat (index (shift_arithmetic_right_vec #n a s) i)] = ()
+

+shift_arithmetic_right_vec_lemma_2

+

Relating the indexes of the shifted vector to the original

+
let shift_arithmetic_right_vec_lemma_2 (#n: pos) (a: bv_t n) (s: nat) (i: nat{i < n && i >= s})
+    : Lemma (ensures index (shift_arithmetic_right_vec #n a s) i = index a (i - s))
+      [SMTPat (index (shift_arithmetic_right_vec #n a s) i)] = ()
+ diff --git a/docs/FStar.Bytes.html b/docs/FStar.Bytes.html index ead489d..58c57fb 100644 --- a/docs/FStar.Bytes.html +++ b/docs/FStar.Bytes.html @@ -1,70 +1,283 @@ - - + + - - - - - - + FStar.Bytes + -

module FStar.Bytes

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
typeabbrev
+

+FStar.Bytes

+

A standard library for manipulation of value bytes.

+

This model is realized by Bytes.bytes in OCaml and by +struct {uintX_t size; char *bytes} (or similar) in C.

+

This file is essentially a specialized version of FStar.Seq, +with lemmas and refinements taylored for typical operations on +bytes, and with support for machine integers and C-extractible versions +(which Seq does not provide.)

+

@summary Value bytes standard library

+ +
unfold let u8 = U8.t
+unfold let u16 = U16.t
+unfold let u32 = U32.t
+

+byte

Realized by uint8_t in C and int in OCaml (char does not have necessary operators...)

-
val bytes:t:Type0:{hasEq t}
-

Realized in C by a pair of a length field and uint8_t* in C Realized in OCaml by a string

-
val reveal:Unidentified product: [bytes] (GTot (S.seq byte))
+
unfold type byte = u8
+

+bytes

+

Realized in C by a pair of a length field and uint8_t* in C +Realized in OCaml by a string

+
val bytes : t:Type0{hasEq t}
+val len : bytes -> u32
+
unfold let length b = FStar.UInt32.v (len b)
+

+reveal

representation for specs that need lemmas not defined here.

-
val get:Unidentified product: [b:bytes] Unidentified product: [pos:pos:u32:{<(U32.v pos, length b)}] (Pure byte ((requires True)) ((ensures ((fun y -> ==(y, S.index (reveal b) (U32.v pos)))))))
+
val reveal:
+    bytes
+  -> GTot (S.seq byte)
+
val length_reveal:
+    x:bytes
+  -> Lemma (ensures (S.length (reveal x) = length x))
+          [SMTPatOr [[SMTPat (S.length (reveal x))];
+                     [SMTPat (len x)]]]
+
val hide:
+    s:S.seq byte{S.length s < pow2 32}
+  -> GTot bytes
+
val hide_reveal:
+    x:bytes
+  -> Lemma (ensures (hide (reveal x) = x))
+          [SMTPat (reveal x)]
+
val reveal_hide:
+    x:S.seq byte{S.length x < pow2 32}
+  -> Lemma (ensures (reveal (hide x) == x))
+          [SMTPat (hide x)]
+
type lbytes (l:nat) = b:bytes{length b = l}
+type kbytes (k:nat) = b:bytes{length b < pow2 k}
+
let lbytes32 (l:UInt32.t) = b:bytes{len b = l}
+
val empty_bytes : lbytes 0
+val empty_unique:
+    b:bytes
+  -> Lemma (length b = 0 ==> b = empty_bytes)
+    [SMTPat (len b)]
+

+get

If you statically know the length, it is OK to read at arbitrary indexes

-
val create:Unidentified product: [len:u32] Unidentified product: [v:byte] b:lbytes (U32.v len):{forall i:i:u32:{let open U32 in <^(i, len)}.{:pattern .[](b, i)} ==(.[](b, i), v)}
+
val get:
+    b:bytes
+  -> pos:u32{U32.v pos < length b}
+  -> Pure byte
+    (requires True)
+    (ensures (fun y -> y == S.index (reveal b) (U32.v pos)))
+
unfold let op_String_Access = get
+
unfold let index (b:bytes) (i:nat{i < length b}) = get b (U32.uint_to_t i)
+
let equal b1 b2 =
+  length b1 = length b2 /\
+  (forall (i:u32{U32.v i < length b1}).{:pattern (b1.[i]); (b2.[i])} b1.[i] == b2.[i])
+
val extensionality:
+    b1:bytes
+  -> b2:bytes
+  -> Lemma (requires (equal b1 b2))
+          (ensures (b1 = b2))
+

+create

creating byte values *

-
val append:Unidentified product: [b1:bytes] Unidentified product: [b2:bytes] (Pure bytes ((requires (UInt.size (+(length b1, length b2)) U32.n))) ((ensures ((fun b -> ==(reveal b, S.append (reveal b1) (reveal b2)))))))
+
val create:
+    len:u32
+  -> v:byte
+  -> b:lbytes (U32.v len){forall (i:u32{U32.(i <^ len)}).{:pattern b.[i]} b.[i] == v}
+
unfold
+let create_ (n:nat{FStar.UInt.size n U32.n}) v = create (U32.uint_to_t n) v
+
val init:
+    len:u32
+  -> f:(i:u32{U32.(i <^ len)} -> byte)
+  -> b:lbytes (U32.v len){forall (i:u32{U32.(i <^ len)}).{:pattern b.[i]} b.[i] == f i}
+

this is a hack JROESCH +admit () create 1ul b

+
val abyte (b:byte) : lbytes 1
+
val twobytes (b:byte*byte) : lbytes 2
+

init 2ul (fun i -> if i = 0ul then fst b else snd b)

+

+append

appending bytes *

-
let (fits_in_k_bytes (n:nat) (k:nat)):FStar.UInt.size n (op_Multiply 8 k)
+
val append:
+    b1:bytes
+  -> b2:bytes
+  -> Pure bytes
+         (requires (UInt.size (length b1 + length b2) U32.n))
+         (ensures (fun b -> reveal b == S.append (reveal b1) (reveal b2)))
+unfold let op_At_Bar = append
+
val slice:
+    b:bytes
+  -> s:u32
+  -> e:u32{U32.(s <=^ e) /\ U32.v e <= length b}
+  -> r:bytes{reveal r == Seq.slice (reveal b) (U32.v s) (U32.v e)}
+let slice_ b (s:nat) (e:nat{s <= e /\ e <= length b}) = slice b (U32.uint_to_t s) (U32.uint_to_t e)
+
val sub:
+    b:bytes
+  -> s:u32
+  -> l:u32{U32.v s + U32.v l <= length b}
+  -> r:bytes{reveal r == Seq.slice (reveal b) (U32.v s) (U32.v s + U32.v l)}
+
val split:
+    b:bytes
+  -> k:u32{U32.v k <= length b}
+  -> p:(bytes*bytes){
+     let x, y = p in
+     (reveal x, reveal y) == Seq.split (reveal b) (U32.v k)}
+
unfold let split_ b (k:nat{FStar.UInt.size k U32.n /\ k < length b}) = split b (U32.uint_to_t k)
+

+fits_in_k_bytes

Interpret a sequence of bytes as a mathematical integer encoded in big endian *

-
val repr_bytes:Unidentified product: [n:nat] k:pos:{fits_in_k_bytes n k}
+
let fits_in_k_bytes (n:nat) (k:nat) = FStar.UInt.size n (op_Multiply 8 k)
+type uint_k (k:nat) = n:nat{fits_in_k_bytes n k}
+

+repr_bytes

repr_bytes n: The number of bytes needed to represent a nat *

-
 A better implementation of BufferBytes, formerly found in miTLS
+
val repr_bytes:
+    n:nat
+  -> k:pos{fits_in_k_bytes n k}
+
val lemma_repr_bytes_values:
+    n:nat
+  -> Lemma (ensures ( let k = repr_bytes n in
+                     if n < 256 then k==1
+                     else if n < 65536 then k==2
+                     else if n < 16777216 then k==3
+                     else if n < 4294967296 then k==4
+                     else if n < 1099511627776 then k==5
+                     else if n < 281474976710656 then k==6
+                     else if n < 72057594037927936 then k==7
+                     else if n < 18446744073709551616 then k==8
+                     else True ))
+          [SMTPat (repr_bytes n)]
+
val repr_bytes_size:
+    k:nat
+  -> n:uint_k k
+  -> Lemma (ensures (repr_bytes n <= k))
+          [SMTPat (fits_in_k_bytes n k)]
+
val int_of_bytes:
+    b:bytes
+  -> Tot (uint_k (length b))
+
val bytes_of_int:
+    k:nat
+  -> n:nat{repr_bytes n <= k /\ k < pow2 32}
+  -> lbytes k
+
val int_of_bytes_of_int:
+  #k:nat{k <= 32}
+  -> n:uint_k k
+  -> Lemma (ensures (int_of_bytes (bytes_of_int k n) == n))
+          [SMTPat (bytes_of_int k n)]
+
val bytes_of_int_of_bytes:
+    b:bytes{length b <= 32}
+  -> Lemma (ensures (bytes_of_int (length b) (int_of_bytes b) == b))
+          [SMTPat (int_of_bytes b)]
+

18-02-25 use uint32 instead of int32 etc?

+
val int32_of_bytes:
+    b:bytes{length b <= 4}
+  -> n:u32{U32.v n == int_of_bytes b}
+
val int16_of_bytes:
+    b:bytes{length b <= 2}
+  -> n:u16{U16.v n == int_of_bytes b}
+
val int8_of_bytes:
+    b:bytes{length b = 1}
+  -> n:u8{U8.v n = int_of_bytes b}
+
val bytes_of_int32:
+    n:U32.t
+  -> b:lbytes 4{b == bytes_of_int 4 (U32.v n)}
+
val bytes_of_int16:
+    n:U16.t
+  -> b:lbytes 2{b == bytes_of_int 2 (U16.v n)}
+
val bytes_of_int8:
+    n:U8.t
+  -> b:lbytes 1{b == bytes_of_int 1 (U8.v n)}
+

//////////////////////////////////////////////////////////////////////////////

+
type minbytes (n:nat) = b:bytes{length b >= n}
+
val xor:
+    n:u32
+  -> b1:minbytes (U32.v n)
+  -> b2:minbytes (U32.v n)
+  -> b:bytes{len b = n}
+
unfold let xor_ (#n:nat{FStar.UInt.size n U32.n}) (b1:minbytes n) (b2:minbytes n) = xor (U32.uint_to_t n) b1 b2
+
val xor_commutative:
+    n:u32
+  -> b1:minbytes (U32.v n)
+  -> b2:minbytes (U32.v n)
+  -> Lemma (ensures (xor n b1 b2 == xor n b2 b1))
+          [SMTPat (xor n b1 b2)]
+
val xor_append:
+    b1:bytes
+  -> b2:bytes{FStar.UInt.size (length b1 + length b2) U32.n}
+  -> x1:bytes{len x1 = len b1}
+  -> x2:bytes{len x2 = len b2}
+  -> Lemma (ensures (xor U32.(len b1 +^ len b2)
+                        (b1 @| b2)
+                        (x1 @| x2)
+                    ==
+                    xor (len b1) b1 x1 @| xor (len b2) b2 x2))
+
val xor_idempotent:
+    n:u32
+  -> b1:lbytes (U32.v n)
+  -> b2:lbytes (U32.v n)
+  -> Lemma (ensures (xor n (xor n b1 b2) b2 == b1))
+
val utf8_encode:
+    s:string{Str.maxlen s (pow2 30)}
+  -> b:bytes{length b <= op_Multiply 4 (Str.length s)}
+
val iutf8_opt:
+    m:bytes
+  -> (option (s:string{Str.maxlen s (pow2 30) /\ utf8_encode s == m}))
+
val string_of_hex: string -> Tot string
+

missing post on the length of the results (exact on constant arguments)

+
val bytes_of_hex: string -> Tot bytes
+val hex_of_string: string -> Tot string
+val hex_of_bytes: bytes -> Tot string
+val print_bytes: bytes -> Tot string
+val bytes_of_string: string -> bytes //abytes
+

A better implementation of BufferBytes, formerly found in miTLS

+ +
type lbuffer (l:UInt32.t) = b:B.buffer UInt8.t {B.length b == U32.v l}
+
val of_buffer (l:UInt32.t) (#p #q:_) (buf:B.mbuffer UInt8.t p q{B.length buf == U32.v l})
+  : Stack (b:bytes{length b = UInt32.v l})
+  (requires fun h0 ->
+    B.live h0 buf)
+  (ensures  fun h0 b h1 ->
+    B.(modifies loc_none h0 h1) /\
+    b = hide (B.as_seq h0 buf))
+
val store_bytes: src:bytes { length src <> 0 } ->
+  dst:lbuffer (len src) ->
+  Stack unit
+    (requires (fun h0 -> B.live h0 dst))
+    (ensures  (fun h0 r h1 ->
+      M.(modifies (loc_buffer dst) h0 h1) /\
+      Seq.equal (reveal src) (B.as_seq h1 dst)))
+

JP: let's not add from_bytes here because we want to leave it up to the +caller to allocate on the stack or on the heap

+ diff --git a/docs/FStar.Calc.html b/docs/FStar.Calc.html index 3c303b5..e7f28b4 100644 --- a/docs/FStar.Calc.html +++ b/docs/FStar.Calc.html @@ -1,16 +1,86 @@ - - + + - - - - - + FStar.Calc + -

module FStar.Calc

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Calc

+ +
noeq
+type calc_proof #t : list (relation t) -> t -> t -> Type =
+  | CalcRefl : #x:t -> calc_proof [] x x
+  | CalcStep : rs:(list (relation t)) -> #p:(relation t) ->
+               #x:t -> #y:t -> #z:t -> calc_proof rs x y -> squash (p y z) -> calc_proof (p::rs) x z
+
noeq
+type calc_pack #t (x y : t) = {
+  rels  : list (relation t);
+  proof : calc_proof rels x y
+}
+
[@@"opaque_to_smt"]
+let pk_rels #t #x #y (pk : calc_pack #t x y) = pk.rels
+
let rec calc_chain_related (#t : Type) (rs : list (relation t)) (x y : t) : Tot Type0 (decreases rs) =
+  match rs with
+  | [] -> x == y
+

GM: The :t annotation below matters a lot for compactness of the formula!

+
| r1::rs -> exists (w:t). calc_chain_related rs x w /\ r1 w y
+

Every chain of t's related by rs (reversed!) has its endpoints related by p

+
[@@"opaque_to_smt"]
+let calc_chain_compatible (#t : Type) (rs : list (relation t)) (p : relation t) : Tot Type0 =
+  forall x y. calc_chain_related rs x y ==> p x y
+
[@@"opaque_to_smt"]
+let rec elim_calc_proof #t rs (#x #y : t) (pf : calc_proof rs x y)
+    : Lemma (ensures (calc_chain_related rs x y))
+            (decreases pf) =
+  match pf with
+  | CalcRefl -> ()
+  | CalcStep rs #p' #x #y #z pf p'xy -> elim_calc_proof rs pf
+
[@@"opaque_to_smt"]
+let _calc_init (#t:Type) (x : t) : calc_proof [] x x = CalcRefl
+
[@@"opaque_to_smt"]
+let calc_init (#t:Type) (x : t) : calc_pack x x = { rels = []; proof = _calc_init x }
+
[@@"opaque_to_smt"]
+let _calc_step (#t:Type) (#rs : list (relation t)) (#x #y : t)
+         (p : relation t)                         (* Relation for this step *)
+         (z : t)                                  (* Next expression *)
+         (pf : unit -> GTot (calc_proof rs x y))  (* Rest of the proof *)
+         (j : unit -> Tot (squash (p y z)))       (* Justification, thunked to avoid confusion such as #1397 *)
+         : GTot (calc_proof (p::rs) x z)
+

Need to annotate #p seemingly due to #1486

+
= CalcStep rs #p (pf ()) (j ())
+
[@@"opaque_to_smt"]
+let calc_step (#t:Type) (#x #y : t) (p : relation t)
+         (z : t)
+         (pf : unit -> GTot (calc_pack x y))
+         (j : unit -> Tot (squash (p y z)))
+         : GTot (calc_pack x z)
+         =
+         let pk = pf () in
+         { rels = p::pk.rels ; proof = _calc_step p z (fun () -> pk.proof) j }
+

let _calc_finish (#t:Type) (#rs : list (relation t)) (p : relation t) (#x #y : t) (pf : unit -> calc_proof rs x y)

+

: Lemma (requires (norm delta_only ``%calc_chain_compatible; %calc_chain_related`;

+

iota;

+

zeta] (calc_chain_compatible rs p)))

+

(ensures (p x y))

+

= elim_calc_proof rs (pf ())

+
[@@"opaque_to_smt"]
+let calc_finish (#t:Type) (p : relation t) (#x #y : t) (pf : unit -> GTot (calc_pack x y))
+  : Lemma (requires (norm [delta_only [`%calc_chain_compatible; `%calc_chain_related;
+                                       "FStar.Calc.__proj__Mkcalc_pack__item__rels";
+                                       `%calc_step; `%_calc_step;
+                                       `%calc_init; `%_calc_init; `%pk_rels];
+                           iota;
+                           zeta] (labeled range_0 "Could not prove that this calc-chain is compatible"
+                                            (calc_chain_compatible (pk_rels (pf ())) p))))
+          (ensures (p x y))
+  = let pk = pf () in
+    elim_calc_proof pk.rels pk.proof
+
val calc_push_impl (#p #q : Type) (f : squash p -> GTot (squash q)) : GTot (squash (p ==> q))
+let calc_push_impl #p #q f = Classical.arrow_to_impl f
+ diff --git a/docs/FStar.Char.html b/docs/FStar.Char.html index ebc9e68..ea8528e 100644 --- a/docs/FStar.Char.html +++ b/docs/FStar.Char.html @@ -1,16 +1,75 @@ - - + + - - - - - + FStar.Char + -

module FStar.Char

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Char

+
+

This module provides the char type, an abstract type +representing UTF-8 characters.

+

UTF-8 characters are representing in a variable-length encoding of +between 1 and 4 bytes, with a maximum of 21 bits used to represent +a code.

+

See https://en.wikipedia.org/wiki/UTF-8 and +https://erratique.ch/software/uucp/doc/unicode.html

+
+ +

+char:eqtype

+

char is a new primitive type with decidable equality

+
new
+val char:eqtype
+

+char_code

+

A char_code is the representation of a UTF-8 char code in +an unsigned 32-bit integer whose value is at most 2^21

+
type char_code = n: U32.t{U32.v n < pow2 21}
+

+u32_of_char

+

A primitive to extract the char_code of a char

+
val u32_of_char: char -> Tot char_code
+

+char_of_u32

+

A primitive to promote a char_code to a char

+
val char_of_u32: char_code -> Tot char
+

+char_of_u32_of_char

+

Encoding and decoding from char to char_code is the identity

+
val char_of_u32_of_char (c: char)
+    : Lemma (ensures (char_of_u32 (u32_of_char c) == c)) [SMTPat (u32_of_char c)]
+

+u32_of_char_of_u32

+

Encoding and decoding from char to char_code is the identity

+
val u32_of_char_of_u32 (c: char_code)
+    : Lemma (ensures (u32_of_char (char_of_u32 c) == c)) [SMTPat (char_of_u32 c)]
+

+int_of_char

+

A couple of utilities to use mathematical integers rather than U32.t +to represent a char_code

+
let int_of_char (c: char) : nat = U32.v (u32_of_char c)
+let char_of_int (i: nat{i < pow2 21}) : char = char_of_u32 (U32.uint_to_t i)
+

+lowercase

+

Case conversion

+
val lowercase: char -> Tot char
+val uppercase: char -> Tot char
+
#set-options "--lax"
+

This private primitive is used internally by the compiler to +translate character literals with a desugaring-time check of the +size of the number, rather than an expensive verifiation check. +Since it is marked private, client programs cannot call it +directly Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private unfold
+let __char_of_int (x: int) : char = char_of_int x
+#reset-options
+ diff --git a/docs/FStar.Classical.Sugar.html b/docs/FStar.Classical.Sugar.html new file mode 100644 index 0000000..71eb3ef --- /dev/null +++ b/docs/FStar.Classical.Sugar.html @@ -0,0 +1,181 @@ + + + + + FStar.Classical.Sugar + + + +

Copyright 2021 Microsoft Research

+

Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at

+
http://www.apache.org/licenses/LICENSE-2.0
+
+

Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License.

+

+FStar.Classical.Sugar

+
+

This module provides a few combinators that are targeted +by the desugaring phase of the F* front end

+

The combinators it provides are fairly standard, except for one +subtlety. In F*, the typechecking of terms formed using the +logical connectives is biased from left to right. That is:

+ +

So, many of these combinators reflect that bias by taking as +instantiations for q functions that depend on squash p or +squash (~p).

+

The other subtlety is that the when using these combinators, we +encapsulate any proof terms provided by the caller within a +thunk. This is to ensure that if, for instance, the caller simply +admits a goal, that they do not inadvertently discard any proof +obligations in the remainder of their programs.

+

For example, consider the difference between

+
    +
  1. exists_intro a p v (admit()); rest
    2. +
+

and

+
    +
  1. exists_intro a p v (fun _ -> admit()); rest
    2. +
+

In (1) the proof of rest is admitted also.

+
+

+forall_elim

+

Eliminate a universal quantifier by providing an instantiation

+
val forall_elim
+       (#a:Type)
+       (#p:a -> Type)
+       (v:a)
+       (f:squash (forall (x:a). p x))
+  : Tot (squash (p v))
+

+exists_elim

+

Eliminate an existential quantifier into a proof of a goal q

+
val exists_elim
+     (#t:Type)
+     (#p:t -> Type)
+     (#q:Type)
+     ($s_ex_p: squash (exists (x:t). p x))
+     (f: (x:t -> squash (p x) -> Tot (squash q)))
+  : Tot (squash q)
+

+implies_elim

+

Eliminate an implication, by providing a proof of the hypothesis +Note, the proof is thunked

+
let implies_elim
+        (p:Type)
+        (q:Type)
+        (_:squash (p ==> q))
+        (f:unit -> squash p)
+  : squash q
+  = f()
+

+or_elim

+

Eliminate a disjunction

+ +
val or_elim
+        (p:Type)
+        (q:squash (~p) -> Type)
+        (r:Type)
+        (p_or:squash (p \/ q()))
+        (left:squash p -> Tot (squash r))
+        (right:squash (~p) -> squash (q()) -> Tot (squash r))
+  : Tot (squash r)
+

+and_elim

+

Eliminate a conjunction

+ +
val and_elim
+        (p:Type)
+        (q:squash p -> Type)
+        (r:Type)
+        (_:squash (p /\ q()))
+        (f:squash p -> squash (q()) -> Tot (squash r))
+  : Tot (squash r)
+

+forall_intro

+

Introduce a universal quantifier

+
val forall_intro
+      (a:Type)
+      (p:a -> Type)
+      (f: (x:a -> Tot (squash (p x))))
+  : Tot (squash (forall x. p x))
+

+exists_intro

+

Introduce an existential quantifier

+
val exists_intro
+        (a:Type)
+        (p:a -> Type)
+        (v:a)
+        (x: unit -> squash (p v))
+  : Tot (squash (exists x. p x))
+

+implies_intro

+

Introduce an implication

+ +
val implies_intro
+        (p:Type)
+        (q:squash p -> Type)
+        (f:(squash p -> Tot (squash (q()))))
+  : Tot (squash (p ==> q()))
+

+or_intro_left

+

Introduce an disjunction on the left

+ +
val or_intro_left
+        (p:Type)
+        (q:squash (~p) -> Type)
+        (f:unit -> squash p)
+  : Tot (squash (p \/ q()))
+

+or_intro_right

+

Introduce an disjunction on the right

+ +
val or_intro_right
+        (p:Type)
+        (q:squash (~p) -> Type)
+        (f:squash (~p) -> squash (q()))
+  : Tot (squash (p \/ q()))
+

+and_intro

+

Introduce a conjunction

+ +
val and_intro
+        (p:Type)
+        (q:squash p -> Type)
+        (left:unit -> squash p)
+        (right:squash p -> squash (q()))
+  : Tot (squash (p /\ q()))
+ + + diff --git a/docs/FStar.Classical.html b/docs/FStar.Classical.html index 0c71dfc..ca66208 100644 --- a/docs/FStar.Classical.html +++ b/docs/FStar.Classical.html @@ -1,16 +1,396 @@ - - + + - - - - - + FStar.Classical + -

module FStar.Classical

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Classical

+
+

This module provides various utilities to manipulate the squashed +logical connectives ==>, /\, \/, forall, exists and ==, +defined in Prims in terms of the squash type. See Prims and +FStar.Squash for basic explanations of the squash type.

+

In summary:

+ +

We provide several utilities to turn proofs of various +propositions with non-trivial proof terms into proof-irrelevant, +classical proofs.

+
+

+give_witness

+

give_witness x transforms a constructive proof x:a into a +proof-irrelevant postcondition. It is similar to +FStar.Squash.return_squash

+
val give_witness (#a: Type) (_: a) : Lemma (ensures a)
+

+give_witness_from_squash

+

give_witness_from_squash s moves from a unit-refinement to a +postcondition. It is similar to FStar.Squash.give_proof

+
val give_witness_from_squash (#a: Type) (_: squash a) : Lemma (ensures a)
+

+lemma_to_squash_gtot

+

This turns a proof-irrelevant postcondition into a squashed proof

+
val lemma_to_squash_gtot (#a: Type) (#p: (a -> GTot Type)) ($_: (x: a -> Lemma (p x))) (x: a)
+    : GTot (squash (p x))
+

+Equality

+

+get_equality

+

Turning an equality precondition into returned squash proof, +similar to FStar.Squash.get_proof, but avoiding an extra squash, +since == is already squashed.

+
val get_equality (#t: Type) (a b: t) : Pure (a == b) (requires (a == b)) (ensures (fun _ -> True))
+

+Implication

+

+impl_to_arrow

+

Turning an a ==> b into a squash a -> squash b. Note a ==> b is +defined as squash (a -> b), so this distributes the squash over the arrow.

+
val impl_to_arrow (#a #b: Type0) (_: (a ==> b)) (_: squash a) : Tot (squash b)
+

+arrow_to_impl

+

The converse of impl_to_arrow

+
val arrow_to_impl (#a #b: Type0) (_: (squash a -> GTot (squash b))) : GTot (a ==> b)
+

+impl_intro_gtot

+

Similar to arrow_to_impl, but without squashing proofs on the left

+
val impl_intro_gtot (#p #q: Type0) ($_: (p -> GTot q)) : GTot (p ==> q)
+

+impl_intro

+

Similar to arrow_to_impl, but not squashing the proof of p on the LHS.

+
val impl_intro (#p #q: Type0) ($_: (p -> Lemma q)) : Lemma (p ==> q)
+

+move_requires

+

A lemma with a precondition can also be treated as a proof a quantified implication.

+
val move_requires
+      (#a: Type)
+      (#p #q: (a -> Type))
+      ($_: (x: a -> Lemma (requires (p x)) (ensures (q x))))
+      (x: a)
+    : Lemma (p x ==> q x)
+

See the remark at the top of this section comparing nested lemmas +with SMT pattern to move_requires and forall_intro

+

+move_requires_2

+

The arity 2 version of move_requires

+
val move_requires_2
+      (#a #b: Type)
+      (#p #q: (a -> b -> Type))
+      ($_: (x: a -> y: b -> Lemma (requires (p x y)) (ensures (q x y))))
+      (x: a)
+      (y: b)
+    : Lemma (p x y ==> q x y)
+

+move_requires_3

+

The arity 3 version of move_requires

+
val move_requires_3
+      (#a #b #c: Type)
+      (#p #q: (a -> b -> c -> Type))
+      ($_: (x: a -> y: b -> z: c -> Lemma (requires (p x y z)) (ensures (q x y z))))
+      (x: a)
+      (y: b)
+      (z: c)
+    : Lemma (p x y z ==> q x y z)
+

+impl_intro_gen

+

When proving predicate q whose well-formedness depends on the +predicate p, it is convenient to have q appear only under a +context where p is know to be valid.

+
val impl_intro_gen (#p: Type0) (#q: (squash p -> Tot Type0)) (_: (squash p -> Lemma (q ())))
+    : Lemma (p ==> q ())
+

+Universal quantification

+
+

Many of the utilities for universal quantification are designed to +help in the proofs of lemmas that ensure quantified +postconditions. For example, in order to prove [Lemma (forall +(x:a). p x)] it is often useful to "get your hands" on a freshly +introduced variable x and to prove p x for it, i.e., to prove +x:a -> Lemma (p x) and to turn this into a proof for forall x. p x. Functions like forall_intro in this module let you do +just that.

+

That said, it may often be more convenient to prove such +properties using local lemmas in inner scopes. For example, here +are two proof sketches for forall x. p x.

+
assume
+val p : nat -> prop
+
+let proof1 =
+  let lem (x:nat)
+    : Lemma (ensures p x)
+    = admit()
+  in
+  forall_intro lem;
+  assert (forall x. p x)
+
+let proof2 =
+  let lem (x:nat)
+    : Lemma (ensures p x)
+            `SMTPat (p x)`
+    = admit()
+  in
+  assert (forall x. p x)
+

In proof1, we prove an auxiliary lemma lem and then use +forall_intro to turn it into a proof of forall x. p x.

+

In proof2, we simply decorate lem with an SMT pattern to +allow the solver to use that lemma to prove forall x. p x +directly.

+

The style of proof2 is often more robust for several reasons:

+ +

That said, there may still be cases where forall_intro etc. are +more suitable.

+
+

+get_forall

+

Turning an universally quantified precondition into returned +squash proof, similar to FStar.Squash.get_proof, but avoiding an +extra squash, since forall is already squashed.

+
val get_forall (#a: Type) (p: (a -> GTot Type0))
+    : Pure (forall (x: a). p x) (requires (forall (x: a). p x)) (ensures (fun _ -> True))
+

+forall_intro_gtot

+

This introduces a squash proof of a universal +quantifier. forall_intro_gtot f is equivalent to `return_squash +(return_squash f)].

+
val forall_intro_gtot (#a: Type) (#p: (a -> GTot Type)) ($_: (x: a -> GTot (p x)))
+    : Tot (squash (forall (x: a). p x))
+

TODO: Perhaps remove this? It seems redundant

+

+lemma_forall_intro_gtot

+

This turns a dependent arrow into a proof-irrelevant postcondition +of a universal quantifier.

+
val lemma_forall_intro_gtot (#a: Type) (#p: (a -> GTot Type)) ($_: (x: a -> GTot (p x)))
+    : Lemma (forall (x: a). p x)
+

+gtot_to_lemma

+

This turns a dependent arrow producing a proof a p into a lemma +ensuring p, effectively squashing the proof of p, while still +retaining the arrow.

+
val gtot_to_lemma (#a: Type) (#p: (a -> GTot Type)) ($_: (x: a -> GTot (p x))) (x: a) : Lemma (p x)
+

+forall_intro_squash_gtot

+

This is the analog of lemma_forall_intro_gtot but with squashed +proofs on both sides, including a redundant extra squash on the result.

+
val forall_intro_squash_gtot (#a: Type) (#p: (a -> GTot Type)) ($_: (x: a -> GTot (squash (p x))))
+    : Tot (squash (forall (x: a). p x))
+

TODO: perhaps remove this?

+

+forall_intro_squash_gtot_join

+

This is the analog of lemma_forall_intro_gtot but with squashed +proofs on both sides

+
val forall_intro_squash_gtot_join
+      (#a: Type)
+      (#p: (a -> GTot Type))
+      ($_: (x: a -> GTot (squash (p x))))
+    : Tot (forall (x: a). p x)
+

+forall_intro

+

The main workhorse for introducing universally quantified postconditions, at arity 1.

+
val forall_intro (#a: Type) (#p: (a -> GTot Type)) ($_: (x: a -> Lemma (p x)))
+    : Lemma (forall (x: a). p x)
+

See the remark at the start of this section for guidelines on its +use. You may prefer to use a local lemma with an SMT pattern.

+

+forall_intro_with_pat

+

The main workhorse for introducing universally quantified +postconditions, at arity 1, including a provision for a single +pattern.

+
val forall_intro_with_pat
+      (#a: Type)
+      (#c: (x: a -> Type))
+      (#p: (x: a -> GTot Type0))
+      ($pat: (x: a -> Tot (c x)))
+      ($_: (x: a -> Lemma (p x)))
+    : Lemma (forall (x: a). {:pattern (pat x)} p x)
+

See the remark at the start of this section for guidelines on its +use. You may prefer to use a local lemma with an SMT pattern.

+

+forall_intro_sub

+

This function is almost identical to forall_intro. The only +difference is that rather in forall_intro f the type of f is +unified with expected type of that argument, leading to better +resolution of implicit variables.

+
val forall_intro_sub (#a: Type) (#p: (a -> GTot Type)) (_: (x: a -> Lemma (p x)))
+    : Lemma (forall (x: a). p x)
+

However, sometimes it is convenient to introduce a quantifier from +a lemma while relying on subtyping---forall_intro_sub f allows +the use of subtyping when comparing the type of f to the +expected type of the argument. This will likely mean that the +implicit arguments, notably p, will have to be provided +explicilty.

+

+forall_intro_2

+

The arity 2 version of forall_intro

+
val forall_intro_2
+      (#a: Type)
+      (#b: (a -> Type))
+      (#p: (x: a -> b x -> GTot Type0))
+      ($_: (x: a -> y: b x -> Lemma (p x y)))
+    : Lemma (forall (x: a) (y: b x). p x y)
+

+forall_intro_2_with_pat

+

The arity 2 version of forall_intro_with_pat

+
val forall_intro_2_with_pat
+      (#a: Type)
+      (#b: (a -> Type))
+      (#c: (x: a -> y: b x -> Type))
+      (#p: (x: a -> b x -> GTot Type0))
+      ($pat: (x: a -> y: b x -> Tot (c x y)))
+      ($_: (x: a -> y: b x -> Lemma (p x y)))
+    : Lemma (forall (x: a) (y: b x). {:pattern (pat x y)} p x y)
+

+forall_intro_3

+

The arity 3 version of forall_intro

+
val forall_intro_3
+      (#a: Type)
+      (#b: (a -> Type))
+      (#c: (x: a -> y: b x -> Type))
+      (#p: (x: a -> y: b x -> z: c x y -> Type0))
+      ($_: (x: a -> y: b x -> z: c x y -> Lemma (p x y z)))
+    : Lemma (forall (x: a) (y: b x) (z: c x y). p x y z)
+

+forall_intro_3_with_pat

+

The arity 3 version of forall_intro_with_pat

+
val forall_intro_3_with_pat
+      (#a: Type)
+      (#b: (a -> Type))
+      (#c: (x: a -> y: b x -> Type))
+      (#d: (x: a -> y: b x -> z: c x y -> Type))
+      (#p: (x: a -> y: b x -> z: c x y -> GTot Type0))
+      ($pat: (x: a -> y: b x -> z: c x y -> Tot (d x y z)))
+      ($_: (x: a -> y: b x -> z: c x y -> Lemma (p x y z)))
+    : Lemma (forall (x: a) (y: b x) (z: c x y). {:pattern (pat x y z)} p x y z)
+

+forall_intro_4

+

The arity 4 version of forall_intro

+
val forall_intro_4
+      (#a: Type)
+      (#b: (a -> Type))
+      (#c: (x: a -> y: b x -> Type))
+      (#d: (x: a -> y: b x -> z: c x y -> Type))
+      (#p: (x: a -> y: b x -> z: c x y -> w: d x y z -> Type0))
+      ($_: (x: a -> y: b x -> z: c x y -> w: d x y z -> Lemma (p x y z w)))
+    : Lemma (forall (x: a) (y: b x) (z: c x y) (w: d x y z). p x y z w)
+

+forall_impl_intro

+

This combines th use of arrow_to_impl with forall_intro.

+
val forall_impl_intro
+      (#a: Type)
+      (#p #q: (a -> GTot Type))
+      ($_: (x: a -> squash (p x) -> Lemma (q x)))
+    : Lemma (forall x. p x ==> q x)
+

TODO: Seems overly specific; could be removed?

+

+ghost_lemma

+

This is similar to forall_intro, but with a lemma that has a precondition.

+
val ghost_lemma
+      (#a: Type)
+      (#p: (a -> GTot Type0))
+      (#q: (a -> unit -> GTot Type0))
+      ($_: (x: a -> Lemma (requires p x) (ensures (q x ()))))
+    : Lemma (forall (x: a). p x ==> q x ())
+

Note: It's unclear why q has an additional unit argument.

+

+Existential quantification

+

+exists_intro

+

The most basic way to introduce a squashed existential quantifier +exists x. p x is to present a witness w such that p w.

+
val exists_intro (#a: Type) (p: (a -> Type)) (witness: a)
+    : Lemma (requires (p witness)) (ensures (exists (x: a). p x))
+

While exists_intro is very explicit, as with universal +quantification and forall_intro, it is only available for a +fixed arity.

+

However, unlike with we do not yet provide any conveniences for +higher arities. One workaround is to tuple witnesses together, +e.g., instead of proving exists x y. p x y to prove instead +exists xy. p (fst xy) (snd xy) and to allow the SMT solver to convert +the latter to the former.

+

+exists_intro_not_all_not

+

Introducing an exists via its classical correspondence with a negated universal quantifier

+
val exists_intro_not_all_not
+      (#a: Type)
+      (#p: (a -> Type))
+      ($f: ((x: a -> Lemma (~(p x))) -> Lemma False))
+    : Lemma (exists x. p x)
+

+forall_to_exists

+

If r is true for all x:a{p x}, then one can use +forall_to_exists to establish (exists x. p x) ==> r.

+
val forall_to_exists (#a: Type) (#p: (a -> Type)) (#r: Type) ($_: (x: a -> Lemma (p x ==> r)))
+    : Lemma ((exists (x: a). p x) ==> r)
+

+forall_to_exists_2

+

The arity two variant of forall_to_exists for two separate +existentially quantified hypotheses.

+
val forall_to_exists_2
+      (#a: Type)
+      (#p: (a -> Type))
+      (#b: Type)
+      (#q: (b -> Type))
+      (#r: Type)
+      ($f: (x: a -> y: b -> Lemma ((p x /\ q y) ==> r)))
+    : Lemma (((exists (x: a). p x) /\ (exists (y: b). q y)) ==> r)
+

TODO: overly specific, remove?

+

+exists_elim

+

An eliminator for squashed existentials: If every witnesse can be +eliminated into a squashed proof of the goal, then the goal +postcondition is valid.

+
val exists_elim
+      (goal #a: Type)
+      (#p: (a -> Type))
+      (_: squash (exists (x: a). p x))
+      (_: (x: a{p x} -> GTot (squash goal)))
+    : Lemma goal
+

+Disjunction

+

+or_elim

+

Eliminating l \/ r into a goal whose well-formedness depends on +l \/ r

+
val or_elim
+      (#l #r: Type0)
+      (#goal: (squash (l \/ r) -> Tot Type0))
+      (hl: (squash l -> Lemma (goal ())))
+      (hr: (squash r -> Lemma (goal ())))
+    : Lemma ((l \/ r) ==> goal ())
+

+excluded_middle

+

The law of excluded middle: squashed types are classical

+
val excluded_middle (p: Type) : Lemma (requires (True)) (ensures (p \/ ~p))
+ diff --git a/docs/FStar.Date.html b/docs/FStar.Date.html index 89f0726..479d31f 100644 --- a/docs/FStar.Date.html +++ b/docs/FStar.Date.html @@ -1,16 +1,28 @@ - - + + - - - - - + FStar.Date + -

module FStar.Date

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Date

+
+

A module providing primitives for dates and times

+
+
new
+val dateTime:Type0
+new
+val timeSpan:Type0
+

+now

+

EXT marks an external function

+
val now: unit -> EXT dateTime
+val secondsFromDawn: unit -> EXT (n: nat{n < pow2 32})
+val newTimeSpan: int -> int -> int -> int -> Tot timeSpan
+val addTimeSpan: dateTime -> timeSpan -> Tot dateTime
+val greaterDateTime: dateTime -> dateTime -> Tot bool
+ diff --git a/docs/FStar.DependentMap.html b/docs/FStar.DependentMap.html index 4f4dbbf..dd581ef 100644 --- a/docs/FStar.DependentMap.html +++ b/docs/FStar.DependentMap.html @@ -1,16 +1,265 @@ - - + + - - - - - + FStar.DependentMap + -

module FStar.DependentMap

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.DependentMap

+
+

This module provides an abstract type of maps whose co-domain +depends on the value of each key. i.e., it is an encapsulation +of x:key -> value x, where key supports decidable equality.

+

The main constructors of the type are:

+ +

The main eliminators are:

+ +

The interface is specified in a style that describes the action of +each eliminator over each of the constructors

+

The map also supports an extensional equality principle.

+
+

+t

+

Abstract type of dependent maps, with universe polymorphic values +and keys in universe 0 with decidable equality

+
val t (key: eqtype) (value: (key -> Type u#v)) : Type u#v
+

+create

+

Creating a new map from a function

+
val create (#key: eqtype) (#value: (key -> Tot Type)) (f: (k: key -> Tot (value k)))
+    : Tot (t key value)
+

+sel

+

Querying the map for its value at a given key

+
val sel (#key: eqtype) (#value: (key -> Tot Type)) (m: t key value) (k: key) : Tot (value k)
+

+sel_create

+

Relating create to sel

+
val sel_create (#key: eqtype) (#value: (key -> Tot Type)) (f: (k: key -> Tot (value k))) (k: key)
+    : Lemma (ensures (sel #key #value (create f) k == f k)) [SMTPat (sel #key #value (create f) k)]
+

+upd

+

Updating a map at a point

+
val upd (#key: eqtype) (#value: (key -> Tot Type)) (m: t key value) (k: key) (v: value k)
+    : Tot (t key value)
+

+sel_upd_same

+

The action of selecting a key k a map with an updated value v +at k

+
val sel_upd_same (#key: eqtype) (#value: (key -> Tot Type)) (m: t key value) (k: key) (v: value k)
+    : Lemma (ensures (sel (upd m k v) k == v)) [SMTPat (sel (upd m k v) k)]
+

This is one of the classic McCarthy select/update axioms in the +setting of a dependent map.

+

+sel_upd_other

+

The action of selecting a key k a map with an updated value v +at a different key k'

+
val sel_upd_other
+      (#key: eqtype)
+      (#value: (key -> Tot Type))
+      (m: t key value)
+      (k: key)
+      (v: value k)
+      (k': key)
+    : Lemma (requires (k' <> k))
+      (ensures (sel (upd m k v) k' == sel m k'))
+      [SMTPat (sel (upd m k v) k')]
+

This is one of the classic McCarthy select/update axioms in the +setting of a dependent map.

+

+equal

+

Extensional propositional equality on maps

+
val equal (#key: eqtype) (#value: (key -> Tot Type)) (m1 m2: t key value) : prop
+

+equal_intro

+

Introducing extensional equality by lifting equality on the map, pointwise

+
val equal_intro (#key: eqtype) (#value: (key -> Tot Type)) (m1 m2: t key value)
+    : Lemma (requires (forall k. sel m1 k == sel m2 k))
+      (ensures (equal m1 m2))
+      [SMTPat (equal m1 m2)]
+

+equal_refl

+

equal is reflexive

+
val equal_refl (#key: eqtype) (#value: (key -> Tot Type)) (m: t key value)
+    : Lemma (ensures (equal m m)) [SMTPat (equal m m)]
+

+equal_elim

+

equal can be eliminated into standard propositional equality +(==), also proving that it is an equivalence relation

+
val equal_elim (#key: eqtype) (#value: (key -> Tot Type)) (m1 m2: t key value)
+    : Lemma (requires (equal m1 m2)) (ensures (m1 == m2)) [SMTPat (equal m1 m2)]
+

+Restricting the domain of a map

+

+restrict

+

Restricts the domain of the map to those keys satisfying p

+
val restrict (#key: eqtype) (#value: (key -> Tot Type)) (p: (key -> Tot Type0)) (m: t key value)
+    : Tot (t (k: key{p k}) value)
+

+sel_restrict

+

The action of sel on restrict : the contents of the map isn't changed

+
val sel_restrict
+      (#key: eqtype)
+      (#value: (key -> Tot Type))
+      (p: (key -> Tot Type0))
+      (m: t key value)
+      (k: key{p k})
+    : Lemma (ensures (sel (restrict p m) k == sel m k))
+

+Concatenating maps

+
+

Concatenating t k1 v1 and t k2 v2 produces a map +t (either k1 k2) (concat_value v1 v2)

+

I.e., the key space varies contravariantly, to take the union of +the component key spaces. The co-domain is the dependent product +of the co-domains of the original map

+
+

+concat_value

+

The key space of a concatenated map is the product of the key spaces

+
let concat_value
+      (#key1: eqtype)
+      (value1: (key1 -> Tot Type))
+      (#key2: eqtype)
+      (value2: (key2 -> Tot Type))
+      (k: either key1 key2)
+    : Tot Type =
+  match k with
+  | Inl k1 -> value1 k1
+  | Inr k2 -> value2 k2
+

+concat

+

Concatenating maps

+
val concat
+      (#key1: eqtype)
+      (#value1: (key1 -> Tot (Type u#v)))
+      (#key2: eqtype)
+      (#value2: (key2 -> Tot (Type u#v)))
+      (m1: t key1 value1)
+      (m2: t key2 value2)
+    : Tot (t (either key1 key2) (concat_value value1 value2))
+

+sel_concat_l

+

The action of sel on concat, for a key on the left picks a +value from the left map

+
val sel_concat_l
+      (#key1: eqtype)
+      (#value1: (key1 -> Tot (Type u#v)))
+      (#key2: eqtype)
+      (#value2: (key2 -> Tot (Type u#v)))
+      (m1: t key1 value1)
+      (m2: t key2 value2)
+      (k1: key1)
+    : Lemma (ensures (sel (concat m1 m2) (Inl k1) == sel m1 k1))
+

+sel_concat_r

+

The action of sel on concat, for a key on the right picks a +value from the right map

+
val sel_concat_r
+      (#key1: eqtype)
+      (#value1: (key1 -> Tot Type))
+      (#key2: eqtype)
+      (#value2: (key2 -> Tot Type))
+      (m1: t key1 value1)
+      (m2: t key2 value2)
+      (k2: key2)
+    : Lemma (ensures (sel (concat m1 m2) (Inr k2) == sel m2 k2))
+

+Renamings

+
+

Given a map from key2 to key1, we can revise a map from t key1 v to a map t key2 v, by composing the maps.

+
+

+rename_value

+

The type of the co-domain of the renamed map also involves +transformation along the renaming function

+
let rename_value
+      (#key1: eqtype)
+      (value1: (key1 -> Tot Type))
+      (#key2: eqtype)
+      (ren: (key2 -> Tot key1))
+      (k: key2)
+    : Tot Type = value1 (ren k)
+

+rename

+

Renaming the keys of a map

+
val rename
+      (#key1: eqtype)
+      (#value1: (key1 -> Tot Type))
+      (m: t key1 value1)
+      (#key2: eqtype)
+      (ren: (key2 -> Tot key1))
+    : Tot (t key2 (rename_value value1 ren))
+

+sel_rename

+

The action of sel on rename

+
val sel_rename
+      (#key1: eqtype)
+      (#value1: (key1 -> Tot Type))
+      (m: t key1 value1)
+      (#key2: eqtype)
+      (ren: (key2 -> Tot key1))
+      (k2: key2)
+    : Lemma (ensures (sel (rename m ren) k2 == sel m (ren k2)))
+

+Mapping a function over a dependent map

+

+map

+

map f m applies f to each value in m's co-domain

+
val map
+      (#key: eqtype)
+      (#value1 #value2: (key -> Tot Type))
+      (f: (k: key -> value1 k -> Tot (value2 k)))
+      (m: t key value1)
+    : Tot (t key value2)
+

+sel_map

+

The action of sel on map

+
val sel_map
+      (#key: eqtype)
+      (#value1 #value2: (key -> Tot Type))
+      (f: (k: key -> value1 k -> Tot (value2 k)))
+      (m: t key value1)
+      (k: key)
+    : Lemma (ensures (sel (map f m) k == f k (sel m k)))
+      [SMTPat (sel #key #value2 (map #key #value1 #value2 f m) k)]
+

+map_upd

+

map explained in terms of its action on upd

+
val map_upd
+      (#key: eqtype)
+      (#value1 #value2: (key -> Tot Type))
+      (f: (k: key -> value1 k -> Tot (value2 k)))
+      (m: t key value1)
+      (k: key)
+      (v: value1 k)
+    : Lemma (ensures (map f (upd m k v) == upd (map f m) k (f k v)))
+      [
+

AR: wanted to write an SMTPatOr, but gives some error

+
  SMTPat (map #key #value1 #value2 f (upd #key #value1 m k v))
+]
+
+

We seem to miss lemmas that relate map to the other constructors, +including create, restrict etc.

+
+ diff --git a/docs/FStar.Dyn.html b/docs/FStar.Dyn.html index 509a4a9..277c6bd 100644 --- a/docs/FStar.Dyn.html +++ b/docs/FStar.Dyn.html @@ -1,16 +1,33 @@ - - + + - - - - - + FStar.Dyn + -

module FStar.Dyn

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Dyn

+ +
+

Dynamic casts, realized by OCaml's Obj

+

NOTE: THIS PROVIDES CASTS BETWEEN ARBITRARY TYPES +BUT ONLY IN False CONTEXTS. USE WISELY.

+
+
assume new
+type dyn
+

+mkdyn

+

Promoting a value of type 'a to dyn

+
val mkdyn: 'a -> EXT dyn
+

+undyn

+

This coerces a value of type dyn to any type 'a, +but only with False precondition

+
val undyn (d: dyn{false}) : EXT 'a
+ diff --git a/docs/FStar.Endianness.html b/docs/FStar.Endianness.html index 9636848..54d5efc 100644 --- a/docs/FStar.Endianness.html +++ b/docs/FStar.Endianness.html @@ -1,16 +1,341 @@ - - + + - - - - - + FStar.Endianness + -

module FStar.Endianness

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Endianness

+
+

A library of lemmas for reasoning about sequences of machine integers and +their (little|big)-endian representation as a sequence of bytes.

+

The functions in this module aim to be as generic as possible, in order to +facilitate compatibility with:

+ +

To achieve maximum compatibility, we try to state most lemmas using nat +rather than UIntX.

+

To limit context pollution, the definitions of the recursive functions are +abstract; please add lemmas as you see fit. In extreme cases, friend'ing +might be de rigueur.

+

.. note::

+

This module supersedes the poorly-named FStar.Kremlin.Endianness.

+
+ +
[@@ noextract_to "Kremlin"]
+type bytes = S.seq U8.t
+ +
+

+Definition of little and big-endianness

+

This is our spec, to be audited. From bytes to nat.

+
+
+

lt_to_n interprets a byte sequence as a little-endian natural number

+
+
val le_to_n : b:bytes -> Tot nat
+
+

be_to_n interprets a byte sequence as a big-endian natural number

+
+
val be_to_n : b:bytes -> Tot nat
+
+

Induction for le_to_n and be_to_n

+
+
val reveal_le_to_n (b:bytes)
+  : Lemma
+    (le_to_n b ==
+     (match Seq.length b with
+      | 0 -> 0
+      | _ -> U8.v (S.head b) + pow2 8 * le_to_n (S.tail b)))
+
val reveal_be_to_n (b:bytes)
+  : Lemma
+    (be_to_n b ==
+     (match Seq.length b with
+      | 0 -> 0
+      | _ -> U8.v (S.last b) + pow2 8 * be_to_n (S.slice b 0 (S.length b - 1))))
+
val lemma_le_to_n_is_bounded: b:bytes -> Lemma
+  (requires True)
+  (ensures  (le_to_n b < pow2 (8 * Seq.length b)))
+  (decreases (Seq.length b))
+
val lemma_be_to_n_is_bounded: b:bytes -> Lemma
+  (requires True)
+  (ensures  (be_to_n b < pow2 (8 * Seq.length b)))
+  (decreases (Seq.length b))
+
+

+Inverse operations

+

From nat to bytes, and their functional correctness.

+
+
+

n_to_le encodes a number as a little-endian byte sequence of a fixed, +sufficiently large length.

+
+
val n_to_le : len:nat -> n:nat{n < pow2 (8 * len)} ->
+  Tot (b:bytes{S.length b == len /\ n == le_to_n b})
+  (decreases len)
+
+

n_to_be encodes a numbers as a big-endian byte sequence of a fixed, +sufficiently large length

+
+
val n_to_be:
+  len:nat -> n:nat{n < pow2 (8 * len)} ->
+  Tot (b:bytes{S.length b == len /\ n == be_to_n b})
+  (decreases len)
+
+

+Injectivity

+
+
val n_to_le_inj (len: nat) (n1 n2: (n:nat{n < pow2 (8 * len)})):
+  Lemma (requires (n_to_le len n1 == n_to_le len n2))
+        (ensures (n1 == n2))
+
val n_to_be_inj (len: nat) (n1 n2: (n:nat{n < pow2 (8 * len)})) :
+  Lemma (requires (n_to_be len n1 == n_to_be len n2))
+        (ensures (n1 == n2))
+
val be_to_n_inj
+  (b1 b2: Seq.seq U8.t)
+: Lemma
+  (requires (Seq.length b1 == Seq.length b2 /\ be_to_n b1 == be_to_n b2))
+  (ensures (Seq.equal b1 b2))
+  (decreases (Seq.length b1))
+
val le_to_n_inj
+  (b1 b2: Seq.seq U8.t)
+: Lemma
+  (requires (Seq.length b1 == Seq.length b2 /\ le_to_n b1 == le_to_n b2))
+  (ensures (Seq.equal b1 b2))
+  (decreases (Seq.length b1))
+
+

+Roundtripping

+
+
val n_to_be_be_to_n (len: nat) (s: Seq.seq U8.t) : Lemma
+  (requires (Seq.length s == len))
+  (ensures (
+    be_to_n s < pow2 (8 * len) /\
+    n_to_be len (be_to_n s) == s
+  ))
+  [SMTPat (n_to_be len (be_to_n s))]
+
val n_to_le_le_to_n (len: nat) (s: Seq.seq U8.t) : Lemma
+  (requires (Seq.length s == len))
+  (ensures (
+    le_to_n s < pow2 (8 * len) /\
+    n_to_le len (le_to_n s) == s
+  ))
+  [SMTPat (n_to_le len (le_to_n s))]
+
+

+Specializations for F* machine integers

+

These are useful because they take care of calling the right *_is_bounded lemmas.

+
+
let uint32_of_le (b: bytes { S.length b = 4 }) =
+  let n = le_to_n b in
+  lemma_le_to_n_is_bounded b;
+  UInt32.uint_to_t n
+
let le_of_uint32 (x: UInt32.t): b:bytes{ S.length b = 4 } =
+  n_to_le 4 (UInt32.v x)
+
let uint32_of_be (b: bytes { S.length b = 4 }) =
+  let n = be_to_n b in
+  lemma_be_to_n_is_bounded b;
+  UInt32.uint_to_t n
+
let be_of_uint32 (x: UInt32.t): b:bytes{ S.length b = 4 } =
+  n_to_be 4 (UInt32.v x)
+
let uint64_of_le (b: bytes { S.length b = 8 }) =
+  let n = le_to_n b in
+  lemma_le_to_n_is_bounded b;
+  UInt64.uint_to_t n
+
let le_of_uint64 (x: UInt64.t): b:bytes{ S.length b = 8 } =
+  n_to_le 8 (UInt64.v x)
+
let uint64_of_be (b: bytes { S.length b = 8 }) =
+  let n = be_to_n b in
+  lemma_be_to_n_is_bounded b;
+  UInt64.uint_to_t n
+
let be_of_uint64 (x: UInt64.t): b:bytes{ S.length b = 8 } =
+  n_to_be 8 (UInt64.v x)
+
+

+Lifting {le,be}to_n / n_to{le,be} to sequences

+

TODO: 16-bit (but is it really needed?) +TODO: should these be specializations of generic functions that chop on +N-byte boundaries, and operate on bounded nats instead of uints?

+
+
val seq_uint32_of_le (l: nat) (b: bytes{ S.length b = 4 * l }):
+  s:S.seq UInt32.t { S.length s = l }
+
val le_of_seq_uint32 (s: S.seq UInt32.t):
+  Tot (b:bytes { S.length b = 4 * S.length s })
+    (decreases (S.length s))
+
val seq_uint32_of_be (l: nat) (b: bytes{ S.length b = 4 * l }):
+  s:S.seq UInt32.t { S.length s = l }
+
val be_of_seq_uint32 (s: S.seq UInt32.t):
+  Tot (b:bytes { S.length b = 4 * S.length s })
+    (decreases (S.length s))
+
val seq_uint64_of_le (l: nat) (b: bytes{ S.length b = 8 * l }):
+  s:S.seq UInt64.t { S.length s = l }
+
val le_of_seq_uint64 (s: S.seq UInt64.t):
+  Tot (b:bytes { S.length b = 8 * S.length s })
+    (decreases (S.length s))
+
val seq_uint64_of_be (l: nat) (b: bytes{ S.length b = 8 * l }):
+  s:S.seq UInt64.t { S.length s = l }
+
val be_of_seq_uint64 (s: S.seq UInt64.t):
+  Tot (b:bytes { S.length b = 8 * S.length s })
+    (decreases (S.length s))
+
+

+Complete specification of the combinators above, relating them to {le,be}to / n_to_{le,be}

+
+
val offset_uint32_be (b: bytes) (n: nat) (i: nat):
+  Lemma
+    (requires (
+      S.length b = 4 * n /\
+      i < n))
+    (ensures (
+      S.index (seq_uint32_of_be n b) i == uint32_of_be (S.slice b (4 * i) (4 * i + 4))))
+    (decreases (
+      S.length b))
+    [ SMTPat (S.index (seq_uint32_of_be n b) i) ]
+
val offset_uint32_le (b: bytes) (n: nat) (i: nat):
+  Lemma
+    (requires (
+      S.length b = 4 * n /\
+      i < n))
+    (ensures (
+      S.index (seq_uint32_of_le n b) i == uint32_of_le (S.slice b (4 * i) (4 * i + 4))))
+    (decreases (
+      S.length b))
+    [ SMTPat (S.index (seq_uint32_of_le n b) i) ]
+
val offset_uint64_be (b: bytes) (n: nat) (i: nat):
+  Lemma
+    (requires (
+      S.length b = 8 * n /\
+      i < n))
+    (ensures (
+      S.index (seq_uint64_of_be n b) i == uint64_of_be (S.slice b (8 * i) (8 * i + 8))))
+    (decreases (
+      S.length b))
+    [ SMTPat (S.index (seq_uint64_of_be n b) i) ]
+
val offset_uint64_le (b: bytes) (n: nat) (i: nat):
+  Lemma
+    (requires (
+      S.length b = 8 * n /\
+      i < n))
+    (ensures (
+      S.index (seq_uint64_of_le n b) i == uint64_of_le (S.slice b (8 * i) (8 * i + 8))))
+    (decreases (
+      S.length b))
+    [ SMTPat (S.index (seq_uint64_of_le n b) i) ]
+
+

+Reasoning about appending such sequences

+

TODO: this is fairly incomplete +TODO: the *_base cases seem ad-hoc and derivable trivially from offset above; why have them?

+
+
val be_of_seq_uint32_base (s1: S.seq U32.t) (s2: S.seq U8.t): Lemma
+  (requires (
+    S.length s1 = 1 /\
+    S.length s2 = 4 /\
+    be_to_n s2 = U32.v (S.index s1 0)))
+  (ensures (S.equal s2 (be_of_seq_uint32 s1)))
+  [ SMTPat (be_to_n s2); SMTPat (U32.v (S.index s1 0)) ]
+
val le_of_seq_uint32_base (s1: S.seq U32.t) (s2: S.seq U8.t): Lemma
+  (requires (
+    S.length s1 = 1 /\
+    S.length s2 = 4 /\
+    le_to_n s2 = U32.v (S.index s1 0)))
+  (ensures (S.equal s2 (le_of_seq_uint32 s1)))
+  [ SMTPat (le_to_n s2); SMTPat (U32.v (S.index s1 0)) ]
+
val be_of_seq_uint64_base (s1: S.seq U64.t) (s2: S.seq U8.t): Lemma
+  (requires (
+    S.length s1 = 1 /\
+    S.length s2 = 8 /\
+    be_to_n s2 = U64.v (S.index s1 0)))
+  (ensures (S.equal s2 (be_of_seq_uint64 s1)))
+  [ SMTPat (be_to_n s2); SMTPat (U64.v (S.index s1 0)) ]
+
val be_of_seq_uint32_append (s1 s2: S.seq U32.t): Lemma
+  (ensures (
+    S.equal (be_of_seq_uint32 (S.append s1 s2))
+      (S.append (be_of_seq_uint32 s1) (be_of_seq_uint32 s2))))
+  (decreases (
+    S.length s1))
+  [ SMTPat (S.append (be_of_seq_uint32 s1) (be_of_seq_uint32 s2)) ]
+
val le_of_seq_uint32_append (s1 s2: S.seq U32.t): Lemma
+  (ensures (
+    S.equal (le_of_seq_uint32 (S.append s1 s2))
+      (S.append (le_of_seq_uint32 s1) (le_of_seq_uint32 s2))))
+  (decreases (
+    S.length s1))
+  [ SMTPat (S.append (le_of_seq_uint32 s1) (le_of_seq_uint32 s2)) ]
+
val be_of_seq_uint64_append (s1 s2: S.seq U64.t): Lemma
+  (ensures (
+    S.equal (be_of_seq_uint64 (S.append s1 s2))
+      (S.append (be_of_seq_uint64 s1) (be_of_seq_uint64 s2))))
+  (decreases (
+    S.length s1))
+  [ SMTPat (S.append (be_of_seq_uint64 s1) (be_of_seq_uint64 s2)) ]
+
+

+Roundtripping

+

TODO: also incomplete

+
+
val seq_uint32_of_be_be_of_seq_uint32 (n: nat) (s: S.seq U32.t) : Lemma
+  (requires (n == S.length s))
+  (ensures (seq_uint32_of_be n (be_of_seq_uint32 s) `S.equal` s))
+  (decreases n)
+  [SMTPat (seq_uint32_of_be n (be_of_seq_uint32 s))]
+
val be_of_seq_uint32_seq_uint32_of_be (n: nat) (s: S.seq U8.t) : Lemma
+  (requires (4 * n == S.length s))
+  (ensures (be_of_seq_uint32 (seq_uint32_of_be n s) `S.equal` s))
+  (decreases n)
+  [SMTPat (be_of_seq_uint32 (seq_uint32_of_be n s))]
+
+

+Reasoning about slicing such sequences

+

(Needs SMTPats above for roundtripping in their proof, hence why they're at the end.)

+
+
val slice_seq_uint32_of_be (n: nat) (s: S.seq U8.t) (lo: nat) (hi: nat) : Lemma
+  (requires (4 * n == S.length s /\ lo <= hi /\ hi <= n))
+  (ensures (S.slice (seq_uint32_of_be n s) lo hi) `S.equal` seq_uint32_of_be (hi - lo) (S.slice s (4 * lo) (4 * hi)))
+
val be_of_seq_uint32_slice (s: S.seq U32.t) (lo: nat) (hi: nat) : Lemma
+  (requires (lo <= hi /\ hi <= S.length s))
+  (ensures (be_of_seq_uint32 (S.slice s lo hi) `S.equal` S.slice (be_of_seq_uint32 s) (4 * lo) (4 * hi)))
+
+

Some reasoning about zero bytes

+
+
let rec le_to_n_zeros (s:bytes)
+  : Lemma
+    (requires
+      forall (i:nat). i < Seq.length s ==> Seq.index s i == 0uy)
+    (ensures le_to_n s == 0)
+    (decreases (Seq.length s))
+  = reveal_le_to_n s;
+    if Seq.length s = 0 then ()
+    else le_to_n_zeros (Seq.tail s)
+
let rec be_to_n_zeros (s:bytes)
+  : Lemma
+    (requires
+      forall (i:nat). i < Seq.length s ==> Seq.index s i == 0uy)
+    (ensures be_to_n s == 0)
+    (decreases (Seq.length s))
+  = reveal_be_to_n s;
+    if Seq.length s = 0 then ()
+    else be_to_n_zeros (Seq.slice s 0 (Seq.length s - 1))
+ diff --git a/docs/FStar.Exn.html b/docs/FStar.Exn.html index d1076f4..4dd2f06 100644 --- a/docs/FStar.Exn.html +++ b/docs/FStar.Exn.html @@ -1,16 +1,19 @@ - - + + - - - - - + FStar.Exn + -

module FStar.Exn

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Exn

+

+raise

+

Providing the signature of raise, +that is implemented natively in FStar_Exn.ml as primitive raise

+
assume
+val raise (e: exn) : Exn 'a (requires True) (ensures (fun r -> r == E e))
+ diff --git a/docs/FStar.Fin.html b/docs/FStar.Fin.html index 293c890..79913fc 100644 --- a/docs/FStar.Fin.html +++ b/docs/FStar.Fin.html @@ -1,16 +1,87 @@ - - + + - - - - - + FStar.Fin + -

module FStar.Fin

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Fin

+
+

This module is supposed to contain various lemmas about +finiteness. For now, it mainly provides a basic pigeonhole +principle

+

TODO: We might generalize this to also support general utilities +for reasoning about cardinality, relation with injections and +surjections, etc.

+
+ +

+fin

+

The type of natural numbers bounded by n

+
let fin (n: nat) = k: int{0 <= k /\ k < n}
+

+vect

+

Length-indexed list

+
let vect (n: nat) (a: Type) = l: list a {L.length l = n}
+

+seqn

+

Length-indexed sequence

+
let seqn (n: nat) (a: Type) = s: S.seq a {S.length s = n}
+

+in_

+

in_ s is the type of a valid index into the sequence s

+
let in_ (#a: Type) (s: S.seq a) = n: nat{n < S.length s}
+

+find

+

Find an index of an element in s startig from i that validates p

+
let rec find (#a: Type) (s: S.seq a) (p: (a -> bool)) (i: in_ s)
+    : Pure (option (in_ s))
+      (requires True)
+      (ensures
+        (function
+          | None -> (forall (k: nat{i <= k /\ k < S.length s}). p (S.index s k) == false)
+          | Some j -> i <= j /\ p (S.index s j)))
+      (decreases (S.length s - i)) =
+  if p (S.index s i) then Some i else if i + 1 < S.length s then find #a s p (i + 1) else None
+

+pigeonhole

+

Given a sequence s all of whose elements are at most n, if the +length of s is greater than n, then there are two distinct +indexes in s that contain the same element

+
let rec pigeonhole (#n: nat) (s: S.seq (fin n))
+    : Pure (in_ s * in_ s)
+      (requires S.length s = n + 1)
+      (ensures (fun (i1, i2) -> i1 < i2 /\ S.index s i1 = S.index s i2))
+      (decreases n) =
+  if n = 0
+  then (match S.index s 0 with )
+  else
+    if n = 1
+    then
+      (assert (S.index s 0 = S.index s 1);
+        0, 1)
+    else
+      let k0 = S.index s 0 in
+      match find s (fun k -> k = k0) 1 with
+      | Some i -> 0, i
+      | None ->
+        let reduced_s:S.seq (fin (n - 1)) =
+          S.init #(fin (n - 1))
+            n
+            (fun i ->
+                let k:nat = S.index s (i + 1) in
+                assert (k <> k0);
+                if k < k0 then (k <: fin (n - 1)) else (k - 1 <: fin (n - 1)))
+        in
+        let i1, i2 = pigeonhole reduced_s in
+        i1 + 1, i2 + 1
+ diff --git a/docs/FStar.Float.html b/docs/FStar.Float.html index 5184b50..3556508 100644 --- a/docs/FStar.Float.html +++ b/docs/FStar.Float.html @@ -1,16 +1,20 @@ - - + + - - - - - + FStar.Float + -

module FStar.Float

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Float

+
+

Support for floating point numbers in F* is nearly non-existent. +This module is a placeholder

+
+
assume new
+type float : Type0
+
type double = float
+ diff --git a/docs/FStar.FunctionalExtensionality.html b/docs/FStar.FunctionalExtensionality.html index 7f5d1a8..4700565 100644 --- a/docs/FStar.FunctionalExtensionality.html +++ b/docs/FStar.FunctionalExtensionality.html @@ -1,59 +1,199 @@ - - + + - - - - - - + FStar.FunctionalExtensionality + -

module FStar.FunctionalExtensionality

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
* MAIN AXIOM **
-
*
- * DUPLICATED FOR GHOST FUNCTIONS
- **
-
val extensionality_g:a:Type -> b:Unidentified product: [a] Type -> f:arrow_g a b -> g:arrow_g a b -> (Lemma ((ensures (<==>(feq_g #a #b f g, ==(on_domain_g a f, on_domain_g a g))))) (Prims.Cons (SMTPat (feq_g #a #b f g)) (Prims.Nil )))
+

+FStar.FunctionalExtensionality

+
+

Functional extensionality asserts the equality of pointwise-equal +functions.

+

The formulation of this axiom is particularly subtle in F* because +of its interaction with subtyping. In fact, prior formulations of +this axiom were discovered to be unsound by Aseem Rastogi.

+

The predicate feq #a #b f g asserts that f, g: x:a -> (b x) are +pointwise equal on the domain a.

+

However, due to subtyping f and g may also be defined on some +domain larger than a. We need to be careful to ensure that merely +proving f and g equal on their sub-domain a does not lead us +to conclude that they are equal everywhere.

+

For more context on how functional extensionality works in F*, see

+
    +
  1. tests/micro-benchmarks/Test.FunctionalExtensionality.fst
    2. +
  2. ulib/FStar.Map.fst and ulib/FStar.Map.fsti
    3. +
  3. Issue #1542 on github.com/FStarLang/FStar/issues/1542
    4. +
+
+

+arrow

+

The type of total, dependent functions

+
unfold
+let arrow (a: Type) (b: (a -> Type)) = x: a -> Tot (b x)
+

+efun

+

Using arrow instead

+
[@@ (deprecated "use arrow instead")]
+let efun (a: Type) (b: (a -> Type)) = arrow a b
+

+feq

+

feq #a #b f g: pointwise equality of f and g on domain a

+
let feq (#a: Type) (#b: (a -> Type)) (f g: arrow a b) = forall x. {:pattern (f x)\/(g x)} f x == g x
+

+on_domain

+

on_domain a f:

+
inline_for_extraction
+val on_domain (a: Type) (#b: (a -> Type)) (f: arrow a b) : Tot (arrow a b)
+

This is a key function provided by the module. It has several +features.

+
    +
  1. +

    Intuitively, on_domain a f can be seen as a function whose +maximal domain is a.

    +
    2. +
  2. +

    While, on_domain a f is proven to be pointwise equal to f, +crucially it is not provably equal to f, since f may +actually have a domain larger than a.

    +
    3. +
  3. +

    on_domain is idempotent

    +
    4. +
  4. +

    on_domain a f x has special treatment in F*'s normalizer. It +reduces to f x, reflecting the pointwise equality of +on_domain a f and f.

    +
    5. +
  5. +

    on_domain is marked inline_for_extraction, to eliminate the +overhead of an indirection in extracted code. (This feature +will be exercised as part of cross-module inlining across +interface boundaries)

    +
    6. +
+

+feq_on_domain

+

feq_on_domain: +on_domain a f is pointwise equal to f

+
val feq_on_domain (#a: Type) (#b: (a -> Type)) (f: arrow a b)
+    : Lemma (feq (on_domain a f) f) [SMTPat (on_domain a f)]
+

+idempotence_on_domain

+

on_domain is idempotent

+
val idempotence_on_domain (#a: Type) (#b: (a -> Type)) (f: arrow a b)
+    : Lemma (on_domain a (on_domain a f) == on_domain a f) [SMTPat (on_domain a (on_domain a f))]
+

+is_restricted

+

is_restricted a f:

+
let is_restricted (a: Type) (#b: (a -> Type)) (f: arrow a b) = on_domain a f == f
+

Though stated indirectly, is_restricted a f is valid when f +is a function whose maximal domain is equal to a.

+

Equivalently, one may see its definition as +exists g. f == on_domain a g

+

+restricted_t

+

restricted_t a b: +Lifts the is_restricted predicate into a refinement type

+
let restricted_t (a: Type) (b: (a -> Type)) = f: arrow a b {is_restricted a f}
+

This is the type of functions whose maximal domain is a +and whose (dependent) co-domain is b.

+

+op_Hat_Subtraction_Greater

+

a ^-> b:

+
unfold
+let op_Hat_Subtraction_Greater (a b: Type) = restricted_t a (fun _ -> b)
+

Notation for non-dependent restricted functions from a to b. +The first symbol ^ makes it right associative, as expected for +arrows.

+

+on_dom

+

on_dom a f: +A convenience function to introduce a restricted, dependent function

+
unfold
+let on_dom (a: Type) (#b: (a -> Type)) (f: arrow a b) : restricted_t a b = on_domain a f
+

+on

+

on a f: +A convenience function to introduce a restricted, non-dependent function

+
unfold
+let on (a #b: Type) (f: (a -> Tot b)) : (a ^-> b) = on_dom a f
+

+MAIN AXIOM

+

+extensionality

+

extensionality:

+
val extensionality (a: Type) (b: (a -> Type)) (f g: arrow a b)
+    : Lemma (ensures (feq #a #b f g <==> on_domain a f == on_domain a g)) [SMTPat (feq #a #b f g)]
+

The main axiom of this module states that functions f and g +that are pointwise equal on domain a are provably equal when +restricted to a

+

+DUPLICATED FOR GHOST FUNCTIONS

+

+arrow_g

+

The type of ghost, total, dependent functions

+
unfold
+let arrow_g (a: Type) (b: (a -> Type)) = x: a -> GTot (b x)
+

+efun_g

+

Use arrow_g instead

+
[@@ (deprecated "use arrow_g instead")]
+let efun_g (a: Type) (b: (a -> Type)) = arrow_g a b
+

+feq_g

+

feq_g #a #b f g: pointwise equality of f and g on domain a *

+
let feq_g (#a: Type) (#b: (a -> Type)) (f g: arrow_g a b) =
+  forall x. {:pattern (f x)\/(g x)} f x == g x
+

+on_domain_g

+

The counterpart of on_domain for ghost functions

+
val on_domain_g (a: Type) (#b: (a -> Type)) (f: arrow_g a b) : Tot (arrow_g a b)
+

+feq_on_domain_g

+

on_domain_g a f is pointwise equal to f

+
val feq_on_domain_g (#a: Type) (#b: (a -> Type)) (f: arrow_g a b)
+    : Lemma (feq_g (on_domain_g a f) f) [SMTPat (on_domain_g a f)]
+

+idempotence_on_domain_g

+

on_domain_g is idempotent

+
val idempotence_on_domain_g (#a: Type) (#b: (a -> Type)) (f: arrow_g a b)
+    : Lemma (on_domain_g a (on_domain_g a f) == on_domain_g a f)
+      [SMTPat (on_domain_g a (on_domain_g a f))]
+

+is_restricted_g

+

Counterpart of is_restricted for ghost functions

+
let is_restricted_g (a: Type) (#b: (a -> Type)) (f: arrow_g a b) = on_domain_g a f == f
+

+restricted_g_t

+

Counterpart of restricted_t for ghost functions

+
let restricted_g_t (a: Type) (b: (a -> Type)) = f: arrow_g a b {is_restricted_g a f}
+

+op_Hat_Subtraction_Greater_Greater

+

a ^->> b:

+
unfold
+let op_Hat_Subtraction_Greater_Greater (a b: Type) = restricted_g_t a (fun _ -> b)
+

Notation for ghost, non-dependent restricted functions from a +a to b.

+

+on_dom_g

+

on_dom_g a f: +A convenience function to introduce a restricted, ghost, dependent function

+
unfold
+let on_dom_g (a: Type) (#b: (a -> Type)) (f: arrow_g a b) : restricted_g_t a b = on_domain_g a f
+

+on_g

+

on_g a f: +A convenience function to introduce a restricted, ghost, non-dependent function

+
unfold
+let on_g (a #b: Type) (f: (a -> GTot b)) : (a ^->> b) = on_dom_g a f
+

+extensionality_g

Main axiom for ghost functions *

+
val extensionality_g (a: Type) (b: (a -> Type)) (f g: arrow_g a b)
+    : Lemma (ensures (feq_g #a #b f g <==> on_domain_g a f == on_domain_g a g))
+      [SMTPat (feq_g #a #b f g)]
+ diff --git a/docs/FStar.GSet.html b/docs/FStar.GSet.html index fc7f1c2..5300e72 100644 --- a/docs/FStar.GSet.html +++ b/docs/FStar.GSet.html @@ -1,55 +1,101 @@ - - + + - - - - - - + FStar.GSet + -

module FStar.GSet

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
pragma
+

+FStar.GSet

Computatiional sets (on Types): membership is a boolean function

+
#set-options "--initial_fuel 0 --max_fuel 0 --initial_ifuel 0 --max_ifuel 0"
+ +
[@@must_erase_for_extraction]
+val set (a: Type u#a) : Type u#a
+
val equal (#a:Type) (s1:set a) (s2:set a) : Type0
+

destructors

+
val mem : #a:Type -> a -> set a -> GTot bool
+

constructors

+
val empty      : #a:Type -> Tot (set a)
+val singleton  : #a:Type -> a -> Tot (set a)
+val union      : #a:Type -> set a -> set a -> Tot (set a)
+val intersect  : #a:Type -> set a -> set a -> Tot (set a)
+val complement : #a:Type -> set a -> Tot (set a)
+val comprehend (#a: Type) (f: (a -> GTot bool)) : set a
+val of_set (#a: eqtype) (f: Set.set a) : set a
+

a property about sets

+
let disjoint (#a:Type) (s1: set a) (s2: set a) =
+  equal (intersect s1 s2) empty
+

ops

+
type subset (#a:Type) (s1:set a) (s2:set a) :Type0 = forall x. mem x s1 ==> mem x s2
+

Properties

+
val mem_empty: #a:Type -> x:a -> Lemma
+   (requires True)
+   (ensures (not (mem x empty)))
+   [SMTPat (mem x empty)]
+
val mem_singleton: #a:Type -> x:a -> y:a -> Lemma
+   (requires True)
+   (ensures (mem y (singleton x) <==> (x==y)))
+   [SMTPat (mem y (singleton x))]
+
val mem_union: #a:Type -> x:a -> s1:set a -> s2:set a -> Lemma
+   (requires True)
+   (ensures (mem x (union s1 s2) = (mem x s1 || mem x s2)))
+   [SMTPat (mem x (union s1 s2))]
+
val mem_intersect: #a:Type -> x:a -> s1:set a -> s2:set a -> Lemma
+   (requires True)
+   (ensures (mem x (intersect s1 s2) = (mem x s1 && mem x s2)))
+   [SMTPat (mem x (intersect s1 s2))]
+
val mem_complement: #a:Type -> x:a -> s:set a -> Lemma
+   (requires True)
+   (ensures (mem x (complement s) = not (mem x s)))
+   [SMTPat (mem x (complement s))]
+
val mem_subset: #a:Type -> s1:set a -> s2:set a -> Lemma
+   (requires (forall x. mem x s1 ==> mem x s2))
+   (ensures (subset s1 s2))
+   [SMTPat (subset s1 s2)]
+
val subset_mem: #a:Type -> s1:set a -> s2:set a -> Lemma
+   (requires (subset s1 s2))
+   (ensures (forall x. mem x s1 ==> mem x s2))
+   [SMTPat (subset s1 s2)]
+
val comprehend_mem (#a: Type) (f: (a -> GTot bool)) (x: a)
+  : Lemma (ensures (mem x (comprehend f) == f x))
+          [SMTPat (mem x (comprehend f))]
+
val mem_of_set (#a: eqtype) (f: Set.set a) (x: a)
+  : Lemma (ensures (mem x (of_set f) <==> Set.mem x f))
+          [SMTPat (mem x (of_set f))]
+

extensionality

+
val lemma_equal_intro: #a:Type -> s1:set a -> s2:set a -> Lemma
+    (requires  (forall x. mem x s1 = mem x s2))
+    (ensures (equal s1 s2))
+    [SMTPat (equal s1 s2)]
+
val lemma_equal_elim: #a:Type -> s1:set a -> s2:set a -> Lemma
+    (requires (equal s1 s2))
+    (ensures  (s1 == s2))
+    [SMTPat (equal s1 s2)]
+
val lemma_equal_refl: #a:Type -> s1:set a -> s2:set a -> Lemma
+    (requires (s1 == s2))
+    (ensures  (equal s1 s2))
+    [SMTPat (equal s1 s2)]
+
let disjoint_not_in_both (a:Type) (s1:set a) (s2:set a) :
+  Lemma
+    (requires (disjoint s1 s2))
+    (ensures (forall (x:a).{:pattern (mem x s1) \/ (mem x s2)} mem x s1 ==> ~(mem x s2)))
+  [SMTPat (disjoint s1 s2)]
+= let f (x:a) : Lemma (~(mem x (intersect s1 s2))) = () in
+  FStar.Classical.forall_intro f
+

Converting lists to sets

+
#reset-options //restore fuel usage here
+
let rec as_set' (#a:Type) (l:list a) : set a =
+  match l with
+  | [] -> empty
+  | hd::tl -> union (singleton hd) (as_set' tl)
+
let lemma_disjoint_subset (#a:Type) (s1:set a) (s2:set a) (s3:set a)
+  : Lemma (requires (disjoint s1 s2 /\ subset s3 s1))
+          (ensures  (disjoint s3 s2))
+  = ()
+ diff --git a/docs/FStar.Ghost.html b/docs/FStar.Ghost.html index 7b78a50..705e1b2 100644 --- a/docs/FStar.Ghost.html +++ b/docs/FStar.Ghost.html @@ -1,16 +1,161 @@ - - + + - - - - - + FStar.Ghost + -

module FStar.Ghost

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Ghost

+
+

This module provides an erased type to abstract computationally +irrelevant values.

+

It relies on the GHOST effect defined in Prims.

+

erased a is decorated with the erasable attribute. As such,

+
    +
  1. +

    The type is considered non-informative.

    +

    So, Ghost (erased a) can be subsumed to Pure (erased a)

    +
    2. +
  2. +

    The compiler extracts erased a to unit

    +

    The type is erased a is in a bijection with a, as +witnessed by the hide and reveal function.

    +
    3. +
+

Importantly, computationally relevant code cannot use reveal +(it's marked GTot)

+

Just like Coq's prop, it is okay to use erased types +freely as long as we produce an erased type.

+

reveal and hide are coercions: the typechecker will +automatically insert them when required. That is, if the type of +an expression is erased X, and the expected type is NOT an +erased Y, it will insert reveal, and viceversa for hide.

+
+

+erased

+

erased t is the computationally irrelevant counterpart of t

+
[@@ erasable]
+val erased: Type u#a -> Type u#a
+

+reveal

+

erased t is in a bijection with t, as witnessed by reveal +and hide

+
val reveal: #a: Type u#a -> erased a -> GTot a
+
val hide: #a: Type u#a -> a -> Tot (erased a)
+
val hide_reveal (#a: Type) (x: erased a)
+    : Lemma (ensures (hide (reveal x) == x)) [SMTPat (reveal x)]
+
val reveal_hide (#a: Type) (x: a) : Lemma (ensures (reveal (hide x) == x)) [SMTPat (hide x)]
+
+

The rest of this module includes several well-defined defined +notions. They are not trusted.

+
+

+tot_to_gtot

+

Tot is a sub-effect of GTot F* will usually subsume Tot +computations to GTot computations, though, occasionally, it may +be useful to apply this coercion explicitly.

+
let tot_to_gtot (f: ('a -> Tot 'b)) (x: 'a) : GTot 'b = f x
+

+return

+

erased: Injecting a value into erased; just an alias of hide

+
let return (#a: Type) (x: a) : erased a = hide x
+

+bind

+

Sequential composition of erased

+
let bind (#a #b: Type) (x: erased a) (f: (a -> Tot (erased b))) : Tot (erased b) =
+  let y = reveal x in
+  f y
+

+elift1

+

Unary map

+
irreducible
+let elift1 (#a #b: Type) (f: (a -> GTot b)) (x: erased a)
+    : Tot (y: erased b {reveal y == f (reveal x)}) = xx <-- x ; return (f xx)
+

+elift2

+

Binary map

+
irreducible
+let elift2 (#a #b #c: Type) (f: (a -> b -> GTot c)) (x: erased a) (y: erased b)
+    : Tot (z: erased c {reveal z == f (reveal x) (reveal y)}) =
+  xx <-- x ; yy <-- y ; return (f xx yy)
+

+elift3

+

Ternary map

+
irreducible
+let elift3
+      (#a #b #c #d: Type)
+      (f: (a -> b -> c -> GTot d))
+      (ga: erased a)
+      (gb: erased b)
+      (gc: erased c)
+    : Tot (gd: erased d {reveal gd == f (reveal ga) (reveal gb) (reveal gc)}) =
+  a <-- ga ; b <-- gb ; c <-- gc ; return (f a b c)
+

+push_refinement

+

Pushing a refinement type under the erased constructor

+
let push_refinement #a (#p: (a -> Type0)) (r: erased a {p (reveal r)})
+    : erased (x: a{p x /\ x == reveal r}) =
+  let x:(x: a{p x}) = reveal r in
+  return x
+

+elift1_p

+

Mapping a function with a refined domain over a refined erased value

+
irreducible
+let elift1_p
+      (#a #b: Type)
+      (#p: (a -> Type))
+      ($f: (x: a{p x} -> GTot b))
+      (r: erased a {p (reveal r)})
+    : Tot (z: erased b {reveal z == f (reveal r)}) =
+  let x:(x: a{p x}) = reveal r in
+  return (f x)
+

+elift2_p

+

Mapping a binary function with a refined domain over a pair of +refined erased values

+
irreducible
+let elift2_p
+      (#a #b #c: Type)
+      (#p: (a -> b -> Type))
+      ($f: (xa: a -> xb: b{p xa xb} -> GTot c))
+      (ra: erased a)
+      (rb: erased b {p (reveal ra) (reveal rb)})
+    : Tot (rc: erased c {reveal rc == f (reveal ra) (reveal rb)}) =
+  let x = reveal ra in
+  let y:(y: b{p x y}) = reveal rb in
+  return (f x y)
+

+elift1_pq

+

Mapping a function with a refined domain and co-domain over a +refined erased value producing a refined erased value

+
irreducible
+let elift1_pq
+      (#a #b: Type)
+      (#p: (a -> Type))
+      (#q: (x: a{p x} -> b -> Type))
+      ($f: (x: a{p x} -> GTot (y: b{q x y})))
+      (r: erased a {p (reveal r)})
+    : Tot (z: erased b {reveal z == f (reveal r)}) =
+  let x:(x: a{p x}) = reveal r in
+  return (f x)
+

+elift2_pq

+

Mapping a binary function with a refined domain and co-domain over +a pair of refined erased values producing a refined erased value

+
irreducible
+let elift2_pq
+      (#a #b #c: Type)
+      (#p: (a -> b -> Type))
+      (#q: (x: a -> y: b{p x y} -> c -> Type))
+      ($f: (x: a -> y: b{p x y} -> GTot (z: c{q x y z})))
+      (ra: erased a)
+      (rb: erased b {p (reveal ra) (reveal rb)})
+    : Tot (z: erased c {reveal z == f (reveal ra) (reveal rb)}) =
+  let x = reveal ra in
+  let y:(y: b{p x y}) = reveal rb in
+  return (f x y)
+ diff --git a/docs/FStar.Heap.html b/docs/FStar.Heap.html index 0f8f76d..e2025e6 100644 --- a/docs/FStar.Heap.html +++ b/docs/FStar.Heap.html @@ -1,16 +1,20 @@ - - + + - - - - - + FStar.Heap + -

module FStar.Heap

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Heap

+ +
let trivial_rel (a:Type0) :Preorder.relation a = fun x y -> True
+
let trivial_preorder (a:Type0) :Preorder.preorder a = trivial_rel a
+
type ref (a:Type0) = mref a (trivial_preorder a)
+ diff --git a/docs/FStar.HyperStack.All.html b/docs/FStar.HyperStack.All.html index 8e5b511..c45c628 100644 --- a/docs/FStar.HyperStack.All.html +++ b/docs/FStar.HyperStack.All.html @@ -1,16 +1,36 @@ - - + + - - - - - + FStar.HyperStack.All + -

module FStar.HyperStack.All

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.HyperStack.All

+ +
let all_pre = all_pre_h HyperStack.mem
+let all_post' (a:Type) (pre:Type) = all_post_h' HyperStack.mem a pre
+let all_post  (a:Type) = all_post_h HyperStack.mem a
+let all_wp (a:Type) = all_wp_h HyperStack.mem a
+new_effect ALL = ALL_h HyperStack.mem
+
unfold let lift_state_all (a:Type) (wp:st_wp a) (p:all_post a) =  wp (fun a -> p (V a))
+sub_effect STATE ~> ALL = lift_state_all
+
unfold let lift_exn_all (a:Type) (wp:ex_wp a)   (p:all_post a) (h:HyperStack.mem) = wp (fun ra -> p ra h)
+sub_effect EXN   ~> ALL = lift_exn_all
+
effect All (a:Type) (pre:all_pre) (post: (h0:HyperStack.mem -> Tot (all_post' a (pre h0)))) =
+       ALL a
+           (fun (p:all_post a) (h:HyperStack.mem) -> pre h /\ (forall ra h1. post h ra h1 ==> p ra h1)) (* WP  *)
+effect ML (a:Type) =
+  ALL a (fun (p:all_post a) (_:HyperStack.mem) -> forall (a:result a) (h:HyperStack.mem). p a h)
+
assume val pipe_right: 'a -> ('a -> ML 'b) -> ML 'b
+assume val pipe_left: ('a -> ML 'b) -> 'a -> ML 'b
+assume val failwith: string -> All 'a (fun h -> True) (fun h a h' -> Err? a /\ h==h')
+assume val exit: int -> ML 'a
+assume val try_with: (unit -> ML 'a) -> (exn -> ML 'a) -> ML 'a
+ diff --git a/docs/FStar.HyperStack.ST.html b/docs/FStar.HyperStack.ST.html index 38288ef..ba0b85e 100644 --- a/docs/FStar.HyperStack.ST.html +++ b/docs/FStar.HyperStack.ST.html @@ -1,106 +1,280 @@ - - + + - - - - - - + FStar.HyperStack.ST + -

module FStar.HyperStack.ST

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
*** Global ST (GST) effect with put, get, witness, and recall ****
-
typeabbrev
-
WARNING: this effect is unsafe, for C/C++ extraction it shall only be used by
-code that would later extract to OCaml or by library functions
-
**** defining predicates for equal refs in some regions *****
-
typeabbrev
+

+FStar.HyperStack.ST

+ +

Setting up the preorder for mem

+

Starting the predicates that constitute the preorder

+
[@@"opaque_to_smt"]
+private unfold let contains_region (m:mem) (r:rid) = get_hmap m `Map.contains` r
+

The preorder is the conjunction of above predicates

+
val mem_rel :preorder mem
+
type mem_predicate = mem -> Type0
+

Predicates that we will witness with regions and refs

+
val region_contains_pred (r:HS.rid) :mem_predicate
+
val ref_contains_pred (#a:Type) (#rel:preorder a) (r:HS.mreference a rel) :mem_predicate
+

+Global ST (GST) effect with put, get, witness, and recall ****

+
new_effect GST = STATE_h mem
+
let gst_pre           = st_pre_h mem
+let gst_post' (a:Type) (pre:Type) = st_post_h' mem a pre
+let gst_post (a:Type) = st_post_h mem a
+let gst_wp (a:Type)   = st_wp_h mem a
+
unfold let lift_div_gst (a:Type) (wp:pure_wp a) (p:gst_post a) (h:mem) = wp (fun a -> p a h)
+sub_effect DIV ~> GST = lift_div_gst
+ +
val stable (p:mem_predicate) :Type0
+
val witnessed (p:mem_predicate) :Type0
+

TODO: we should derive these using DM4F

+
private val gst_get: unit    -> GST mem (fun p h0 -> p h0 h0)
+private val gst_put: h1:mem -> GST unit (fun p h0 -> mem_rel h0 h1 /\ p () h1)
+
private val gst_witness: p:mem_predicate -> GST unit (fun post h0 -> p h0 /\ stable p /\ (witnessed p ==> post () h0))
+private val gst_recall:  p:mem_predicate -> GST unit (fun post h0 -> witnessed p /\ (p h0 ==> post () h0))
+
val lemma_functoriality (p:mem_predicate{witnessed p}) (q:mem_predicate{(forall (h:mem). p h ==> q h)})
+  : Lemma (witnessed q)
+
let st_pre   = gst_pre
+let st_post' = gst_post'
+let st_post  = gst_post
+let st_wp    = gst_wp
+
new_effect STATE = GST
+
unfold let lift_gst_state (a:Type) (wp:gst_wp a) = wp
+sub_effect GST ~> STATE = lift_gst_state
+

effect State (a:Type) (wp:st_wp a) =

+

STATE a wp

+

+Unsafe

+

WARNING: this effect is unsafe, for C/C++ extraction it shall only be used by +code that would later extract to OCaml or by library functions

+
effect Unsafe (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) =
+       STATE a
+             (fun (p:st_post a) (h:mem) -> pre h /\ (forall a h1. pre h /\ post h a h1 ==> p a h1)) (* WP *)
+

***** defining predicates for equal refs in some regions *****

+

// * AR: (may be this is an overkill) +// * various effects below talk about refs being equal in some regions (all regions, stack regions, etc.) +// * this was done by defining, for example, an equal_dom predicate with a (forall (r:rid)) quantifier +// * this quantifier was only guarded with Map.contains (HS.get_hmap m) r +// * which meant it could fire for all the contained regions +// * +// * instead now we define abstract predicates, e.g. same_refs_in_all_regions, and provide intro and elim forms +// * the advantage is that, the (lemma) quantifiers are now guarded additionally by same_refs_in_all_regions kind +// * of predicates, and hence should fire more contextually +// * should profile the queries to see if it actually helps +//

+

// * marking these opaque, since expect them to be unfolded away beforehand +//

+
[@@"opaque_to_smt"]
+unfold private let equal_heap_dom (r:rid) (m0 m1:mem) :Type0
+  = Heap.equal_dom (get_hmap m0 `Map.sel` r) (get_hmap m1 `Map.sel` r)
+
[@@"opaque_to_smt"]
+unfold private let contained_region :mem -> mem -> rid -> Type0
+  = fun m0 m1 r -> m0 `contains_region` r /\ m1 `contains_region` r
+
[@@"opaque_to_smt"]
+unfold private let contained_stack_region :mem -> mem -> rid -> Type0
+  = fun m0 m1 r -> is_stack_region r /\ contained_region m0 m1 r
+
[@@"opaque_to_smt"]
+unfold private let contained_non_tip_region :mem -> mem -> rid -> Type0
+  = fun m0 m1 r -> r =!= get_tip m0 /\ r =!= get_tip m1 /\ contained_region m0 m1 r
+
[@@"opaque_to_smt"]
+unfold private let contained_non_tip_stack_region :mem -> mem -> rid -> Type0
+  = fun m0 m1 r -> is_stack_region r /\ contained_non_tip_region m0 m1 r
+
[@@"opaque_to_smt"]
+unfold private let same_refs_common (p:mem -> mem -> rid -> Type0) (m0 m1:mem) =
+  forall (r:rid). p m0 m1 r ==> equal_heap_dom r m0 m1
+

predicates

+
val same_refs_in_all_regions (m0 m1:mem) :Type0
+val same_refs_in_stack_regions (m0 m1:mem) :Type0
+val same_refs_in_non_tip_regions (m0 m1:mem) :Type0
+val same_refs_in_non_tip_stack_regions (m0 m1:mem) :Type0
+

intro and elim forms

+
val lemma_same_refs_in_all_regions_intro (m0 m1:mem)
+  :Lemma (requires (same_refs_common contained_region m0 m1)) (ensures  (same_refs_in_all_regions m0 m1))
+     [SMTPat (same_refs_in_all_regions m0 m1)]
+val lemma_same_refs_in_all_regions_elim (m0 m1:mem) (r:rid)
+  :Lemma (requires (same_refs_in_all_regions m0 m1 /\ contained_region m0 m1 r)) (ensures  (equal_heap_dom r m0 m1))
+     [SMTPatOr [[SMTPat (same_refs_in_all_regions m0 m1); SMTPat (m0 `contains_region` r)];
+                    [SMTPat (same_refs_in_all_regions m0 m1); SMTPat (m1 `contains_region` r)]]]
+
val lemma_same_refs_in_stack_regions_intro (m0 m1:mem)
+  :Lemma (requires (same_refs_common contained_stack_region m0 m1)) (ensures  (same_refs_in_stack_regions m0 m1))
+     [SMTPat  (same_refs_in_stack_regions m0 m1)]
+val lemma_same_refs_in_stack_regions_elim (m0 m1:mem) (r:rid)
+  :Lemma (requires (same_refs_in_stack_regions m0 m1 /\ contained_stack_region m0 m1 r)) (ensures  (equal_heap_dom r m0 m1))
+     [SMTPatOr [[SMTPat (same_refs_in_stack_regions m0 m1); SMTPat (is_stack_region r); SMTPat (m0 `contains_region` r)];
+                    [SMTPat (same_refs_in_stack_regions m0 m1); SMTPat (is_stack_region r); SMTPat (m1 `contains_region` r)]]]
+
val lemma_same_refs_in_non_tip_regions_intro (m0 m1:mem)
+  :Lemma (requires (same_refs_common contained_non_tip_region m0 m1)) (ensures (same_refs_in_non_tip_regions m0 m1))
+         [SMTPat (same_refs_in_non_tip_regions m0 m1)]
+
val lemma_same_refs_in_non_tip_regions_elim (m0 m1:mem) (r:rid)
+  :Lemma (requires (same_refs_in_non_tip_regions m0 m1 /\ contained_non_tip_region m0 m1 r)) (ensures  (equal_heap_dom r m0 m1))
+     [SMTPatOr [[SMTPat (same_refs_in_non_tip_regions m0 m1); SMTPat (m0 `contains_region` r)];
+                    [SMTPat (same_refs_in_non_tip_regions m0 m1); SMTPat (m1 `contains_region` r)]]]
+
val lemma_same_refs_in_non_tip_stack_regions_intro (m0 m1:mem)
+  :Lemma (requires (same_refs_common contained_non_tip_stack_region m0 m1)) (ensures (same_refs_in_non_tip_stack_regions m0 m1))
+         [SMTPat (same_refs_in_non_tip_stack_regions m0 m1)]
+val lemma_same_refs_in_non_tip_stack_regions_elim (m0 m1:mem) (r:rid)
+  :Lemma (requires (same_refs_in_non_tip_stack_regions m0 m1 /\ contained_non_tip_stack_region m0 m1 r))
+         (ensures  (equal_heap_dom r m0 m1))
+     [SMTPatOr [[SMTPat (same_refs_in_non_tip_stack_regions m0 m1); SMTPat (is_stack_region r); SMTPat (m0 `contains_region` r);];
+                    [SMTPat (same_refs_in_non_tip_stack_regions m0 m1); SMTPat (is_stack_region r); SMTPat (m1 `contains_region` r)]]]
+
+
let equal_domains (m0 m1:mem) =
+  get_tip m0 == get_tip m1 /\
+  Set.equal (Map.domain (get_hmap m0)) (Map.domain (get_hmap m1)) /\
+  same_refs_in_all_regions m0 m1
+
val lemma_equal_domains_trans (m0 m1 m2:mem)
+  :Lemma (requires (equal_domains m0 m1 /\ equal_domains m1 m2))
+         (ensures  (equal_domains m0 m2))
+         [SMTPat (equal_domains m0 m1); SMTPat (equal_domains m1 m2)]
+

+Stack

+
effect Stack (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) =
+       STATE a
+             (fun (p:st_post a) (h:mem) -> pre h /\ (forall a h1. (pre h /\ post h a h1 /\ equal_domains h h1) ==> p a h1)) (* WP *)
+

+Heap

+
effect Heap (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) =
+       STATE a
+             (fun (p:st_post a) (h:mem) -> pre h /\ (forall a h1. (pre h /\ post h a h1 /\ get_tip h = HS.root /\ get_tip h1 = HS.root ) ==> p a h1)) (* WP *)
+
let equal_stack_domains (m0 m1:mem) =
+  get_tip m0 == get_tip m1 /\
+  same_refs_in_stack_regions m0 m1
+

+ST

+
effect ST (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) =
+       STATE a
+             (fun (p:st_post a) (h:mem) -> pre h /\ (forall a h1. (pre h /\ post h a h1 /\ equal_stack_domains h h1) ==> p a h1)) (* WP *)
+
effect St (a:Type) = ST a (fun _ -> True) (fun _ _ _ -> True)
+
let inline_stack_inv h h' : GTot Type0 =
+

The frame invariant is enforced

+
get_tip h == get_tip h' /\
+

The heap structure is unchanged

+
Map.domain (get_hmap h) == Map.domain (get_hmap h') /\
+

Any region that is not the tip has no seen any allocation

+
same_refs_in_non_tip_regions h h'
+

+StackInline

-
typeabbrev
+
effect StackInline (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) =
+       STATE a
+             (fun (p:st_post a) (h:mem) -> pre h /\ is_stack_region (get_tip h) /\ (forall a h1. (pre h /\ post h a h1 /\ inline_stack_inv h h1) ==> p a h1)) (* WP *)
+
let inline_inv h h' : GTot Type0 =
+

The stack invariant is enforced

+
get_tip h == get_tip h' /\
+

No frame may have received an allocation but the tip

+
same_refs_in_non_tip_stack_regions h h'
+

+Inline

-
typeabbrev
+
effect Inline (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) =
+       STATE a
+             (fun (p:st_post a) (h:mem) -> pre h /\ (forall a h1. (pre h /\ post h a h1 /\ inline_inv h h1) ==> p a h1)) (* WP *)
+

+STL

-
val push_frame:uu___80:unit -> (Unsafe unit ((requires ((fun m -> True)))) ((ensures ((fun (m0:mem) _ (m1:mem) -> fresh_frame m0 m1)))))
+
effect STL (a:Type) (pre:st_pre) (post: (m0:mem -> Tot (st_post' a (pre m0)))) = Stack a pre post
+
sub_effect
+  DIV   ~> STATE = fun (a:Type) (wp:pure_wp a) (p:st_post a) (h:mem) -> wp (fun a -> p a h)
+ +
type mreference (a:Type) (rel:preorder a) =
+  r:HS.mreference a rel{witnessed (ref_contains_pred r) /\
+                        witnessed (region_contains_pred (HS.frameOf r))}
+type mstackref (a:Type) (rel:preorder a) =
+  r:HS.mstackref a rel{witnessed (ref_contains_pred r) /\
+                       witnessed (region_contains_pred (HS.frameOf r))}
+type mref (a:Type) (rel:preorder a) =
+  r:HS.mref a rel{witnessed (ref_contains_pred r) /\
+                  witnessed (region_contains_pred (HS.frameOf r))}
+type mmmstackref (a:Type) (rel:preorder a) =
+  r:HS.mmmstackref a rel{witnessed (ref_contains_pred r) /\
+                         witnessed (region_contains_pred (HS.frameOf r))}
+type mmmref (a:Type) (rel:preorder a) =
+  r:HS.mmmref a rel{witnessed (ref_contains_pred r) /\
+                    witnessed (region_contains_pred (HS.frameOf r))}
+type s_mref (i:rid) (a:Type) (rel:preorder a) =
+  r:HS.s_mref i a rel{witnessed (ref_contains_pred r) /\
+                      witnessed (region_contains_pred (HS.frameOf r))}
+type reference (a:Type) = mreference a (Heap.trivial_preorder a)
+type stackref (a:Type) = mstackref a (Heap.trivial_preorder a)
+type ref (a:Type) = mref a (Heap.trivial_preorder a)
+type mmstackref (a:Type) = mmmstackref a (Heap.trivial_preorder a)
+type mmref (a:Type) = mmmref a (Heap.trivial_preorder a)
+type s_ref (i:rid) (a:Type) = s_mref i a (Heap.trivial_preorder a)
+
let is_eternal_region (r:rid) :Type0
+  = HS.is_eternal_region_hs r /\ (r == HS.root \/ witnessed (region_contains_pred r))
+ +

+push_frame

Pushes a new empty frame on the stack *

-
val pop_frame:uu___81:unit -> (Unsafe unit ((requires ((fun m -> poppable m)))) ((ensures ((fun (m0:mem) _ (m1:mem) -> /\(/\(poppable m0, ==(m1, pop m0)), popped m0 m1))))))
+
val push_frame (_:unit) :Unsafe unit (requires (fun m -> True)) (ensures (fun (m0:mem) _ (m1:mem) -> fresh_frame m0 m1))
+

+pop_frame

Removes old frame from the stack *

-
val salloc:#a:Type -> #rel:preorder a -> init:a -> (StackInline (mstackref a rel) ((requires ((fun m -> is_stack_region (get_tip m))))) ((ensures salloc_post init)))
+
val pop_frame (_:unit)
+  :Unsafe unit (requires (fun m -> poppable m))
+               (ensures (fun (m0:mem) _ (m1:mem) -> poppable m0 /\ m1 == pop m0 /\ popped m0 m1))
+
let salloc_post (#a:Type) (#rel:preorder a) (init:a) (m0:mem)
+                (s:mreference a rel{is_stack_region (frameOf s)}) (m1:mem)
+  = is_stack_region (get_tip m0)                          /\
+    Map.domain (get_hmap m0) == Map.domain (get_hmap m1)  /\
+    get_tip m0 == get_tip m1                              /\
+    frameOf s   = get_tip m1                              /\
+    HS.fresh_ref s m0 m1                                  /\  //it's a fresh reference in the top frame
+    m1 == HyperStack.upd m0 s init  //and it's been initialized
+

+salloc

-
val op_Colon_Equals:#a:Type -> #rel:preorder a -> r:mreference a rel -> v:a -> (STL unit ((requires ((fun m -> /\(is_live_for_rw_in r m, rel (HS.sel m r) v))))) ((ensures (assign_post r v))))
+
val salloc (#a:Type) (#rel:preorder a) (init:a)
+  :StackInline (mstackref a rel) (requires (fun m -> is_stack_region (get_tip m)))
+                                 (ensures  salloc_post init)
+

JP, AR: these are not supported in C, and salloc already benefits from +automatic memory management.

+
[@@ (deprecated "use salloc instead") ]
+val salloc_mm (#a:Type) (#rel:preorder a) (init:a)
+  :StackInline (mmmstackref a rel) (requires (fun m -> is_stack_region (get_tip m)))
+                                   (ensures  salloc_post init)
+
[@@ (deprecated "use salloc instead") ]
+val sfree (#a:Type) (#rel:preorder a) (r:mmmstackref a rel)
+  :StackInline unit (requires (fun m0 -> frameOf r = get_tip m0 /\ m0 `contains` r))
+                    (ensures (fun m0 _ m1 -> m0 `contains` r /\ m1 == HS.free r m0))
+
unfold
+let new_region_post_common (r0 r1:rid) (m0 m1:mem) =
+  r1 `HS.extends` r0 /\
+  HS.fresh_region r1 m0 m1 /\
+  get_hmap m1 == Map.upd (get_hmap m0) r1 Heap.emp /\
+  get_tip m1 == get_tip m0 /\
+  HS.live_region m0 r0
+
val new_region (r0:rid)
+  :ST rid
+      (requires (fun m        -> is_eternal_region r0))
+      (ensures  (fun m0 r1 m1 ->
+                 new_region_post_common r0 r1 m0 m1               /\
+         HS.color r1 = HS.color r0                        /\
+         is_eternal_region r1                             /\
+                 (r1, m1) == HS.new_eternal_region m0 r0 None))
+
val new_colored_region (r0:rid) (c:int)
+  :ST rid
+      (requires (fun m       -> HS.is_heap_color c /\ is_eternal_region r0))
+      (ensures (fun m0 r1 m1 ->
+                new_region_post_common r0 r1 m0 m1               /\
+            HS.color r1 = c                                  /\
+        is_eternal_region r1                             /\
+                (r1, m1) == HS.new_eternal_region m0 r0 (Some c)))
+
let ralloc_post (#a:Type) (#rel:preorder a) (i:rid) (init:a) (m0:mem)
+                       (x:mreference a rel) (m1:mem) =
+  let region_i = get_hmap m0 `Map.sel` i in
+  as_ref x `Heap.unused_in` region_i /\
+  i `is_in` get_hmap m0              /\
+  i = frameOf x                      /\
+  m1 == upd m0 x init
+
val ralloc (#a:Type) (#rel:preorder a) (i:rid) (init:a)
+  :ST (mref a rel) (requires (fun m -> is_eternal_region i))
+                   (ensures  (ralloc_post i init))
+
val ralloc_mm (#a:Type) (#rel:preorder a) (i:rid) (init:a)
+  :ST (mmmref a rel) (requires (fun m -> is_eternal_region i))
+                     (ensures  (ralloc_post i init))
+ +
let is_live_for_rw_in (#a:Type) (#rel:preorder a) (r:mreference a rel) (m:mem) :Type0 =
+  (m `contains` r) \/
+    (let i = HS.frameOf r in
+     (is_eternal_region i \/ i `HS.is_above` get_tip m) /\
+     (not (is_mm r)       \/ m `HS.contains_ref_in_its_region` r))
+
val rfree (#a:Type) (#rel:preorder a) (r:mreference a rel{HS.is_mm r /\ HS.is_heap_color (HS.color (HS.frameOf r))})
+  :ST unit (requires (fun m0     -> r `is_live_for_rw_in` m0))
+           (ensures (fun m0 _ m1 -> m0 `contains` r /\ m1 == HS.free r m0))
+
unfold let assign_post (#a:Type) (#rel:preorder a) (r:mreference a rel) (v:a) (m0:mem) (_:unit) (m1:mem) =
+  m0 `contains` r /\ m1 == HyperStack.upd m0 r v
+

+op_Colon_Equals

-
val op_Bang:#a:Type -> #rel:preorder a -> r:mreference a rel -> (Stack a ((requires ((fun m -> is_live_for_rw_in r m)))) ((ensures (deref_post r))))
+
val op_Colon_Equals (#a:Type) (#rel:preorder a) (r:mreference a rel) (v:a)
+  :STL unit (requires (fun m -> r `is_live_for_rw_in` m /\ rel (HS.sel m r) v))
+            (ensures  (assign_post r v))
+
unfold let deref_post (#a:Type) (#rel:preorder a) (r:mreference a rel) (m0:mem) (x:a) (m1:mem) =
+  m1 == m0 /\ m0 `contains` r /\ x == HyperStack.sel m0 r
+

+op_Bang

-
val get:uu___82:unit -> (Stack mem ((requires ((fun m -> True)))) ((ensures ((fun m0 x m1 -> /\(==(m0, x), ==(m1, m0)))))))
+
val op_Bang (#a:Type) (#rel:preorder a) (r:mreference a rel)
+  :Stack a (requires (fun m -> r `is_live_for_rw_in` m))
+           (ensures  (deref_post r))
+
let modifies_none (h0:mem) (h1:mem) = modifies Set.empty h0 h1
+

NS: This version is just fine; all the operation on mem are ghost +and we can rig it so that mem just get erased at the end

+

+get

-
val recall:#a:Type -> #rel:preorder a -> r:r:mreference a rel:{not (HS.is_mm r)} -> (Stack unit ((requires ((fun m -> \/(is_eternal_region (HS.frameOf r), contains_region m (HS.frameOf r)))))) ((ensures ((fun m0 _ m1 -> /\(==(m0, m1), contains m1 r))))))
+
val get (_:unit)
+  :Stack mem (requires (fun m -> True))
+             (ensures (fun m0 x m1 -> m0 == x /\ m1 == m0))
+

+recall

-
val recall_region:i:i:rid:{is_eternal_region i} -> (Stack unit ((requires ((fun m -> True)))) ((ensures ((fun m0 _ m1 -> /\(==(m0, m1), is_in i get_hmap m1))))))
+
val recall (#a:Type) (#rel:preorder a) (r:mreference a rel{not (HS.is_mm r)})
+  :Stack unit (requires (fun m -> is_eternal_region (HS.frameOf r) \/ m `contains_region` (HS.frameOf r)))
+              (ensures  (fun m0 _ m1 -> m0 == m1 /\ m1 `contains` r))
+

+recall_region

-
 MR witness etc. *
-
**** Begin: preferred API for witnessing and recalling predicates *****
-
**** End: preferred API for witnessing and recalling predicates *****
-
**** logical properties of witnessed *****
-
* Support for dynamic regions **
+
val recall_region (i:rid{is_eternal_region i})
+  :Stack unit (requires (fun m -> True))
+              (ensures (fun m0 _ m1 -> m0 == m1 /\ i `is_in` get_hmap m1))
+
val witness_region (i:rid)
+  :Stack unit (requires (fun m0      -> HS.is_eternal_region_hs i ==> i `is_in` get_hmap m0))
+              (ensures  (fun m0 _ m1 -> m0 == m1 /\ witnessed (region_contains_pred i)))
+
val witness_hsref (#a:Type) (#rel:preorder a) (r:HS.mreference a rel)
+  :ST unit (fun h0      -> h0 `HS.contains` r)
+           (fun h0 _ h1 -> h0 == h1 /\ witnessed (ref_contains_pred r))
+

MR witness etc. *

+
type erid = r:rid{is_eternal_region r}
+
type m_rref (r:erid) (a:Type) (b:preorder a) = x:mref a b{HS.frameOf x = r}
+

states that p is preserved by any valid updates on r; note that h0 and h1 may differ arbitrarily elsewhere, hence proving stability usually requires that p depends only on r's content.

+
unfold type stable_on (#a:Type0) (#rel:preorder a) (p:mem_predicate) (r:mreference a rel)
+  = forall (h0 h1:mem).{:pattern (p h0); rel (HS.sel h0 r) (HS.sel h1 r)}
+                  (p h0 /\ rel (HS.sel h0 r) (HS.sel h1 r)) ==> p h1
+ +
unfold type stable_on_t (#i:erid) (#a:Type) (#b:preorder a)
+                        (r:m_rref i a b) (p:mem_predicate)
+  = stable_on p r
+
val mr_witness (#r:erid) (#a:Type) (#b:preorder a)
+               (m:m_rref r a b) (p:mem_predicate)
+  :ST unit (requires (fun h0      -> p h0   /\ stable_on_t m p))
+           (ensures  (fun h0 _ h1 -> h0==h1 /\ witnessed p))
+
val weaken_witness (p q:mem_predicate)
+  :Lemma ((forall h. p h ==> q h) /\ witnessed p ==> witnessed q)
+
val testify (p:mem_predicate)
+  :ST unit (requires (fun _      ->  witnessed p))
+           (ensures (fun h0 _ h1 -> h0==h1 /\ p h1))
+
val testify_forall (#c:Type) (#p:(c -> mem -> Type0))
+  ($s:squash (forall (x:c). witnessed (p x)))
+  :ST unit (requires (fun h      -> True))
+           (ensures (fun h0 _ h1 -> h0==h1 /\ (forall (x:c). p x h1)))
+
val testify_forall_region_contains_pred (#c:Type) (#p:(c -> GTot rid))
+  ($s:squash (forall (x:c). witnessed (region_contains_pred (p x))))
+  :ST unit (requires (fun _       -> True))
+           (ensures  (fun h0 _ h1 -> h0 == h1 /\
+                              (forall (x:c). HS.is_eternal_region_hs (p x) ==> h1 `contains_region` (p x))))
+

***** Begin: preferred API for witnessing and recalling predicates *****

+
val token_p (#a:Type0) (#rel:preorder a) (r:mreference a rel) (p:mem_predicate) :Type0
+
val witness_p (#a:Type0) (#rel:preorder a) (r:mreference a rel) (p:mem_predicate)
+  :ST unit (fun h0      -> p h0 /\ p `stable_on` r)
+           (fun h0 _ h1 -> h0 == h1 /\ token_p r p)
+
val recall_p (#a:Type0) (#rel:preorder a) (r:mreference a rel) (p:mem_predicate)
+  :ST unit (fun h0      -> ((is_eternal_region (HS.frameOf r) /\ not (HS.is_mm r)) \/ h0 `HS.contains` r) /\ token_p r p)
+           (fun h0 _ h1 -> h0 == h1 /\ h0 `HS.contains` r /\ p h0)
+
val token_functoriality
+  (#a:Type0) (#rel:preorder a) (r:mreference a rel)
+  (p:mem_predicate{token_p r p}) (q:mem_predicate{forall (h:mem). p h ==> q h})
+  : Lemma (token_p r q)
+

***** End: preferred API for witnessing and recalling predicates *****

+
type ex_rid = erid
+

***** logical properties of witnessed *****

+
val lemma_witnessed_constant (p:Type0)
+  :Lemma (witnessed (fun (m:mem) -> p) <==> p)
+
val lemma_witnessed_nested (p:mem_predicate)
+  : Lemma (witnessed (fun (m:mem) -> witnessed p) <==> witnessed p)
+
val lemma_witnessed_and (p q:mem_predicate)
+  :Lemma (witnessed (fun s -> p s /\ q s) <==> (witnessed p /\ witnessed q))
+
val lemma_witnessed_or (p q:mem_predicate)
+  :Lemma ((witnessed p \/ witnessed q) ==> witnessed (fun s -> p s \/ q s))
+
val lemma_witnessed_impl (p q:mem_predicate)
+  :Lemma ((witnessed (fun s -> p s ==> q s) /\ witnessed p) ==> witnessed q)
+
val lemma_witnessed_forall (#t:Type) (p:(t -> mem_predicate))
+  :Lemma ((witnessed (fun s -> forall x. p x s)) <==> (forall x. witnessed (p x)))
+
val lemma_witnessed_exists (#t:Type) (p:(t -> mem_predicate))
+  :Lemma ((exists x. witnessed (p x)) ==> witnessed (fun s -> exists x. p x s))
+

+Support for dynamic regions **

+
let is_freeable_heap_region (r:rid) : Type0 =
+  HS.is_heap_color (color r) /\ HS.rid_freeable r /\ witnessed (region_contains_pred r)
+
type d_hrid = r:rid{is_freeable_heap_region r}
+
val drgn : Type0
+
val rid_of_drgn (d:drgn) : d_hrid
+
val new_drgn (r0:rid)
+: ST drgn
+  (requires fun m -> is_eternal_region r0)
+  (ensures fun m0 d m1 ->
+    let r1 = rid_of_drgn d in
+    new_region_post_common r0 r1 m0 m1 /\
+    HS.color r1 == HS.color r0 /\
+    (r1, m1) == HS.new_freeable_heap_region m0 r0)
+
val free_drgn (d:drgn)
+: ST unit
+  (requires fun m -> contains_region m (rid_of_drgn d))
+  (ensures fun m0 _ m1 -> m1 == HS.free_heap_region m0 (rid_of_drgn d))
+
val ralloc_drgn (#a:Type) (#rel:preorder a) (d:drgn) (init:a)
+: ST (mreference a rel)
+  (requires fun m -> m `contains_region` (rid_of_drgn d))
+  (ensures fun m0 r m1 ->
+    not (HS.is_mm r) /\
+    ralloc_post (rid_of_drgn d) init m0 r m1)
+
val ralloc_drgn_mm (#a:Type) (#rel:preorder a) (d:drgn) (init:a)
+: ST (mreference a rel)
+  (requires fun m -> m `contains_region` (rid_of_drgn d))
+  (ensures fun m0 r m1 ->
+    HS.is_mm r /\
+    ralloc_post (rid_of_drgn d) init m0 r m1)
+ diff --git a/docs/FStar.HyperStack.html b/docs/FStar.HyperStack.html index 68e07cd..5abd4b6 100644 --- a/docs/FStar.HyperStack.html +++ b/docs/FStar.HyperStack.html @@ -1,16 +1,37 @@ - - + + - - - - - + FStar.HyperStack + -

module FStar.HyperStack

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.HyperStack

+ +
type reference (a:Type) = mreference a (Heap.trivial_preorder a)
+
let stackref (a:Type) = mstackref a (Heap.trivial_preorder a)
+let ref (a:Type) = mref a (Heap.trivial_preorder a)
+
let mmstackref (a:Type) = mmmstackref a (Heap.trivial_preorder a)
+let mmref (a:Type) = mmmref a (Heap.trivial_preorder a)
+type s_ref (i:rid) (a:Type) = s_mref i a (Heap.trivial_preorder a)
+

Two references with different reads are disjoint.

+
let reference_distinct_sel_disjoint
+  (#a:Type0) (h: mem) (r1: reference a) (r2: reference a)
+: Lemma
+  (requires (
+    h `contains` r1 /\
+    h `contains` r2 /\
+    frameOf r1 == frameOf r2 /\
+    as_addr r1 == as_addr r2
+  ))
+  (ensures (
+    sel h r1 == sel h r2
+  ))
+= mreference_distinct_sel_disjoint h r1 r2
+ diff --git a/docs/FStar.IFC.html b/docs/FStar.IFC.html index d533a70..7c87b52 100644 --- a/docs/FStar.IFC.html +++ b/docs/FStar.IFC.html @@ -1,58 +1,136 @@ - - + + - - - - - - + FStar.IFC + -

module FStar.IFC

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-

- * FStar.IFC provides a simple, generic abstraction
- * for monadic information-flow control
- * based on a user-defined (semi-)lattice of information flow labels
- *
+

+FStar.IFC

+
+

FStar.IFC provides a simple, generic abstraction for monadic +information-flow control based on a user-defined (semi-)lattice of +information flow labels.

+

The main idea is to provide an abstract type protected a l, +encapsulating values of type a carrying information at +confidentiality level l. Operations that compute on the +underlying a are instrumented to reflect the sensitivity of +their arguments on their results.

+

Several papers develop this idea, ranging from

+

Fable: A language for enforcing user-defined security policies +http://www.cs.umd.edu/~nswamy/papers/fable-tr.pdf

+

To more modern variants like +https://hackage.haskell.org/package/lio

+
+

+Basic definitions for a join semilattice

+

+associative

+

The lub is associative

+
let associative #a (f: (a -> a -> a)) = forall x y z. f (f x y) z == f x (f y z)
+

+commutative

+

The lub is commutative

+
let commutative #a (f: (a -> a -> a)) = forall x y. f x y == f y x
+

+idempotent

+

The lub is idempotent

+
let idempotent #a (f: (a -> a -> a)) = forall x. f x x == x
+

+semilattice

+

A semilattice has a top element and a +associative-commutative-idempotent least upper bound operator. +This is effectvely the typeclass of a semilattice, however, we +program explicitly with semilattice, rather than use typeclass +instantiation.

+
noeq
+type semilattice : Type u#(c + 1) =
+  | SemiLattice :
+      #carrier: Type u#c ->
+      top: carrier ->
+      lub: (f: (carrier -> carrier -> carrier){associative f /\ commutative f /\ idempotent f})
+    -> semilattice
+

+sl:Type

+

For most of the rest of this development, we'll use an erased +counterpart of a semilattice

+
let sl:Type u#(c + 1) = FStar.Ghost.erased semilattice
+

+lattice_element

+

A lattice element is just an element of the carrier type

+
let lattice_element (sl: sl) = Ghost.erased (SemiLattice?.carrier (Ghost.reveal sl))
+

+lub

+

A convenience for joining elements in the lattice

+
unfold
+let lub #sl (x: lattice_element sl) (y: lattice_element sl) : Tot (lattice_element sl) =
+  Ghost.hide (SemiLattice?.lub (Ghost.reveal sl) (Ghost.reveal x) (Ghost.reveal y))
+

+protected

+

The main type provided by this module is protected l b i.e,, a +b-typed value protected at IFC level l.

+
val protected (#sl: sl u#c) (l: lattice_element sl) (b: Type u#b) : Type u#b
+

protected b l is in a bijection with b, as shown by reveal +and hide below

+

+reveal

+

reveal projects a b from a protected b l, but incurs a ghost effect

+
val reveal (#sl: _) (#l: lattice_element sl) (#b: _) (x: protected l b) : GTot b
+

+hide

+

hide injects a b into a protected b l.

+
val hide (#sl: _) (#l: lattice_element sl) (#b: _) (x: b) : Tot (protected l b)
+

Note, any b can be promoted to a protected l b i.e., +protected l b is only meant to enforce confidentiality

+

+reveal_hide

+

The next pair of lemmas show that reveal/hide are inverses

+
val reveal_hide (#l #t #b: _) (x: b) : Lemma (reveal (hide #l #t x) == x) [SMTPat (hide #l #t x)]
+
val hide_reveal (#sl: _) (#l: lattice_element sl) (#b: _) (x: protected l b)
+    : Lemma (hide (reveal x) == x) [SMTPat (reveal x)]
+
+

protected l b is a form of parameterized monad +It provides: +-- return (via hide) +-- map (i.e., it's a functor) +-- join (so it's also a monad) +Which we package up as a bind

+
+
unfold
+let return #sl #a (l: lattice_element sl) (x: a) : protected l a = hide x
+

+map

+

This is just a map of f over x But, notice the order of +arguments is flipped We write map x f instead of map f x so +that f's type can depend on x

+
val map (#a #b #sl: _) (#l: lattice_element sl) (x: protected l a) (f: (y: a{y == reveal x} -> b))
+    : Tot (y: protected l b {reveal y == f (reveal x)})
+

+join

+

This is almost a regular monadic join +Except notice that the label of the result is the lub +of the both the labels in the argument

+
val join (#sl: _) (#l1 #l2: lattice_element sl) (#a: _) (x: protected l1 (protected l2 a))
+    : Tot (y: protected (l1 `lub` l2) a {reveal y == reveal (reveal x)})
+

+bind

+

This is almost like a regular bind, except like map the type of +the continuation's argument depends on the argument x; and, like +join, the indexes on the result are at least as high as the +indexes of the argument

+
unfold
+let bind
+      #sl
+      (#l1: lattice_element sl)
+      #a
+      (x: protected l1 a)
+      (#l2: lattice_element sl)
+      #b
+      (f: (y: a{y == reveal x} -> protected l2 b))
+    : Tot (protected (l1 `lub` l2) b) = join (map x f)
+

As such, any computation that observes the protected value held in +x has a secrecy level at least as secret as x itself

+ diff --git a/docs/FStar.IO.html b/docs/FStar.IO.html index 2a100da..5d54ddf 100644 --- a/docs/FStar.IO.html +++ b/docs/FStar.IO.html @@ -1,16 +1,65 @@ - - + + - - - - - + FStar.IO + -

module FStar.IO

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.IO

+ +
exception EOF
+assume new type fd_read : Type0
+assume new type fd_write : Type0
+
assume val stdin : fd_read
+assume val stdout : fd_write
+assume val stderr : fd_write
+
assume val print_newline : unit -> ML unit
+assume val print_string : string -> ML unit
+

assume val print_nat_hex : nat -> ML unit

+

assume val print_nat_dec : nat -> ML unit

+

Print as hexadecimal with a leading 0x

+
assume val print_uint8 : FStar.UInt8.t -> ML unit
+assume val print_uint16 : FStar.UInt16.t -> ML unit
+assume val print_uint32 : FStar.UInt32.t -> ML unit
+assume val print_uint64 : FStar.UInt64.t -> ML unit
+

Print as decimal

+
assume val print_uint8_dec : FStar.UInt8.t -> ML unit
+assume val print_uint16_dec : FStar.UInt16.t -> ML unit
+assume val print_uint32_dec : FStar.UInt32.t -> ML unit
+assume val print_uint64_dec : FStar.UInt64.t -> ML unit
+

Print as hex in fixed width, no leading 0x

+
assume val print_uint8_hex_pad : FStar.UInt8.t -> ML unit
+assume val print_uint16_hex_pad : FStar.UInt16.t -> ML unit
+assume val print_uint32_hex_pad : FStar.UInt32.t -> ML unit
+assume val print_uint64_hex_pad : FStar.UInt64.t -> ML unit
+

Print as decimal, zero padded to maximum possible length

+
assume val print_uint8_dec_pad : FStar.UInt8.t -> ML unit
+assume val print_uint16_dec_pad : FStar.UInt16.t -> ML unit
+assume val print_uint32_dec_pad : FStar.UInt32.t -> ML unit
+assume val print_uint64_dec_pad : FStar.UInt64.t -> ML unit
+
assume val print_any : 'a -> ML unit
+assume val input_line : unit -> ML string
+assume val input_int : unit -> ML int
+assume val input_float : unit -> ML FStar.Float.float
+assume val open_read_file : string -> ML fd_read
+assume val open_write_file : string -> ML fd_write
+assume val close_read_file : fd_read -> ML unit
+assume val close_write_file : fd_write -> ML unit
+assume val read_line : fd_read -> ML string
+assume val write_string : fd_write -> string -> ML unit
+

An UNSOUND escape hatch for printf-debugging; +Although it always returns false, we mark it +as returning a bool, so that extraction doesn't +erase this call.

+

Note: no guarantees are provided regarding the order +of eassume valuation of this function; since it is marked as pure, +the compiler may re-order or replicate it.

+
assume val debug_print_string : string -> Tot bool
+ diff --git a/docs/FStar.IndefiniteDescription.html b/docs/FStar.IndefiniteDescription.html index 1985b98..9815091 100644 --- a/docs/FStar.IndefiniteDescription.html +++ b/docs/FStar.IndefiniteDescription.html @@ -1,16 +1,102 @@ - - + + - - - - - + FStar.IndefiniteDescription + -

module FStar.IndefiniteDescription

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.IndefiniteDescription

+
+

Indefinite description is an axiom that allows picking a witness +for existentially quantified predicate.

+

Many other axioms can be derived from this one: Use it with care!

+

For some background on the axiom, see:

+

https://github.com/coq/coq/wiki/CoqAndAxioms#indefinite-description--hilberts-epsilon-operator +https://en.wikipedia.org/wiki/Theory_of_descriptions#Indefinite_descriptions

+
+

+indefinite_description_tot

+

The main axiom:

+
assume
+val indefinite_description_tot (a:Type) (p:(a -> prop) { exists x. p x })
+  : Tot (w:Ghost.erased a{ p w })
+

Given a classical proof of exists x. p x, we can exhibit an erased +(computationally irrelevant) a witness x:erased a validating +p x.

+

+indefinite_description_ghost

+

A version in ghost is easily derivable

+
let indefinite_description_ghost (a: Type) (p: (a -> prop) { exists x. p x })
+  : GTot (x: a { p x })
+  = let w = indefinite_description_tot a p in
+    let x = Ghost.reveal w in
+    x
+

+indefinite_description

+

An alternate formulation, mainly for legacy reasons.

+
[@@deprecated "Consider using indefinite_description_ghost instead"]
+assume
+val indefinite_description (a: Type) (p: (a -> GTot Type0))
+  : Ghost (x: a & p x) (requires (exists x. p x)) (ensures (fun _ -> True))
+

Given a classical proof of exists x. p x, we can exhibit (ghostly) a +witness x:a validating p x.

+

We should take p to be a -> prop. However, see +Prims.prop for a description of the ongoing work on more +systematically using prop in the libraries

+ +

+strong_excluded_middle

+

Indefinite description entails the a strong form of the excluded +middle, i.e., one can case-analyze the truth of a proposition +(only in Ghost)

+
let strong_excluded_middle (p: Type0) : GTot (b: bool{b = true <==> p}) =
+  let aux (p: Type0) : Lemma (exists b. b = true <==> p) =
+    give_proof (bind_squash (get_proof (l_or p (~p)))
+          (fun (b: l_or p (~p)) ->
+              bind_squash b
+                (fun (b': c_or p (~p)) ->
+                    match b' with
+                    | Left hp ->
+                      give_witness hp;
+                      exists_intro (fun b -> b = true <==> p) true;
+                      get_proof (exists b. b = true <==> p)
+                    | Right hnp ->
+                      give_witness hnp;
+                      exists_intro (fun b -> b = true <==> p) false;
+                      get_proof (exists b. b = true <==> p))))
+  in
+  aux p;
+  indefinite_description_ghost bool (fun b -> b = true <==> p)
+

+stronger_markovs_principle

+

We also can combine this with a the classical tautology converting +with a forall and an exists to extract a witness of validity of p from +a classical proof that p is not universally invalid.

+
let stronger_markovs_principle (p: (nat -> GTot bool))
+    : Ghost nat (requires (~(forall (n: nat). ~(p n)))) (ensures (fun n -> p n)) =
+    indefinite_description_ghost _ (fun n -> p n==true)
+

Note, F*+SMT can easily prove, since it is just classical logic: +(~(forall n. ~(p n))) ==> (exists n. p n)

+

+stronger_markovs_principle_prop

+

A variant of the previous lemma, but for a prop rather than a +boolean predicate

+
let stronger_markovs_principle_prop (p: (nat -> GTot prop))
+    : Ghost nat (requires (~(forall (n: nat). ~(p n)))) (ensures (fun n -> p n)) =
+    indefinite_description_ghost _ p
+

A proof for squash p can be eliminated to get p in the Ghost effect

+
let elim_squash (#p:Type u#a) (s:squash p) : GTot p =
+  let uu : squash (x:p & squash c_True) =
+    bind_squash s (fun x -> return_squash (| x, return_squash T |)) in
+  give_proof (return_squash uu);
+  indefinite_description_ghost p (fun _ -> squash c_True)
+ diff --git a/docs/FStar.Int.Cast.Full.html b/docs/FStar.Int.Cast.Full.html index 499863c..ef9402b 100644 --- a/docs/FStar.Int.Cast.Full.html +++ b/docs/FStar.Int.Cast.Full.html @@ -1,16 +1,32 @@ - - + + - - - - - + FStar.Int.Cast.Full + -

module FStar.Int.Cast.Full

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Int.Cast.Full

+ +
inline_for_extraction noextract
+val uint64_to_uint128: a:U64.t -> b:U128.t{U128.v b == U64.v a}
+inline_for_extraction noextract
+let uint64_to_uint128 a = U128.uint64_to_uint128 a
+
inline_for_extraction noextract
+val uint128_to_uint64: a:U128.t -> b:U64.t{U64.v b == U128.v a % pow2 64}
+inline_for_extraction noextract
+let uint128_to_uint64 a = U128.uint128_to_uint64 a
+ diff --git a/docs/FStar.Int.Cast.html b/docs/FStar.Int.Cast.html index a8f2ff3..4228bd7 100644 --- a/docs/FStar.Int.Cast.html +++ b/docs/FStar.Int.Cast.html @@ -1,16 +1,188 @@ - - + + - - - - - + FStar.Int.Cast + -

module FStar.Int.Cast

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Int.Cast

+ +
let op_At_Percent = FStar.Int.op_At_Percent
+
+

Unsigned to unsigned

+
+
val uint8_to_uint64: a:U8.t -> Tot (b:U64.t{U64.v b = U8.v a})
+let uint8_to_uint64 a = U64.uint_to_t (U8.v a)
+
val uint8_to_uint32: a:U8.t -> Tot (b:U32.t{U32.v b = U8.v a})
+let uint8_to_uint32 x = U32.uint_to_t (U8.v x)
+
val uint8_to_uint16: a:U8.t -> Tot (b:U16.t{U16.v b = U8.v a})
+let uint8_to_uint16 x = U16.uint_to_t (U8.v x)
+
val uint16_to_uint64: a:U16.t -> Tot (b:U64.t{U64.v b = U16.v a})
+let uint16_to_uint64 x = U64.uint_to_t (U16.v x)
+
val uint16_to_uint32: a:U16.t -> Tot (b:U32.t{U32.v b = U16.v a})
+let uint16_to_uint32 x = U32.uint_to_t (U16.v x)
+
val uint16_to_uint8 : a:U16.t -> Tot (b:U8.t{U8.v b = U16.v a % pow2 8})
+let uint16_to_uint8 x = U8.uint_to_t (U16.v x % pow2 8)
+
val uint32_to_uint64: a:U32.t -> Tot (b:U64.t{U64.v b = U32.v a})
+let uint32_to_uint64 x = U64.uint_to_t (U32.v x)
+
val uint32_to_uint16: a:U32.t -> Tot (b:U16.t{U16.v b = U32.v a % pow2 16})
+let uint32_to_uint16 x = U16.uint_to_t (U32.v x % pow2 16)
+
val uint32_to_uint8 : a:U32.t -> Tot (b:U8.t{U8.v b = U32.v a % pow2 8})
+let uint32_to_uint8 x = U8.uint_to_t (U32.v x % pow2 8)
+
val uint64_to_uint32: a:U64.t -> Tot (b:U32.t{U32.v b = U64.v a % pow2 32})
+let uint64_to_uint32 x = U32.uint_to_t (U64.v x % pow2 32)
+
val uint64_to_uint16: a:U64.t -> Tot (b:U16.t{U16.v b = U64.v a % pow2 16})
+let uint64_to_uint16 x = U16.uint_to_t (U64.v x % pow2 16)
+
val uint64_to_uint8 : a:U64.t -> Tot (b:U8.t{U8.v b = U64.v a % pow2 8})
+let uint64_to_uint8 x = U8.uint_to_t (U64.v x % pow2 8)
+
+

Signed to signed

+
+
val int8_to_int64: a:I8.t -> Tot (b:I64.t{I64.v b = I8.v a})
+let int8_to_int64 x = I64.int_to_t (I8.v x)
+
val int8_to_int32: a:I8.t -> Tot (b:I32.t{I32.v b = I8.v a})
+let int8_to_int32 x = I32.int_to_t (I8.v x)
+
val int8_to_int16: a:I8.t -> Tot (b:I16.t{I16.v b = I8.v a})
+let int8_to_int16 x = I16.int_to_t (I8.v x)
+
val int16_to_int64: a:I16.t -> Tot (b:I64.t{I64.v b = I16.v a})
+let int16_to_int64 x = I64.int_to_t (I16.v x @% pow2 64)
+
val int16_to_int32: a:I16.t -> Tot (b:I32.t{I32.v b = I16.v a})
+let int16_to_int32 x = I32.int_to_t (I16.v x @% pow2 32)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val int16_to_int8 : a:I16.t -> Tot (b:I8.t {I8.v b  = (I16.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let int16_to_int8 x = I8.int_to_t (I16.v x @% pow2 8)
+
val int32_to_int64: a:I32.t -> Tot (b:I64.t{I64.v b = I32.v a})
+let int32_to_int64 x = I64.int_to_t (I32.v x @% pow2 64)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val int32_to_int16: a:I32.t -> Tot (b:I16.t{I16.v b = (I32.v a @% pow2 16)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let int32_to_int16 x = I16.int_to_t (I32.v x @% pow2 16)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val int32_to_int8 : a:I32.t -> Tot (b:I8.t {I8.v b  = (I32.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let int32_to_int8 x = I8.int_to_t (I32.v x @% pow2 8)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val int64_to_int32: a:I64.t -> Tot (b:I32.t{I32.v b = (I64.v a @% pow2 32)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let int64_to_int32 x = I32.int_to_t (I64.v x @% pow2 32)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val int64_to_int16: a:I64.t -> Tot (b:I16.t{I16.v b = (I64.v a @% pow2 16)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let int64_to_int16 x = I16.int_to_t (I64.v x @% pow2 16)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val int64_to_int8 : a:I64.t -> Tot (b:I8.t {I8.v b  = (I64.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let int64_to_int8 x = I8.int_to_t (I64.v x @% pow2 8)
+
+

Unsigned to signed

+
+
val uint8_to_int64: a:U8.t -> Tot (b:I64.t{I64.v b = U8.v a})
+let uint8_to_int64 x = I64.int_to_t (U8.v x)
+
val uint8_to_int32: a:U8.t -> Tot (b:I32.t{I32.v b = U8.v a})
+let uint8_to_int32 x = I32.int_to_t (U8.v x)
+
val uint8_to_int16: a:U8.t -> Tot (b:I16.t{I16.v b = U8.v a})
+let uint8_to_int16 x = I16.int_to_t (U8.v x)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint8_to_int8 : a:U8.t -> Tot (b:I8.t {I8.v b  = (U8.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint8_to_int8 x = I8.int_to_t (U8.v x @% pow2 8)
+
val uint16_to_int64: a:U16.t -> Tot (b:I64.t{I64.v b = U16.v a})
+let uint16_to_int64 x = I64.int_to_t (U16.v x)
+
val uint16_to_int32: a:U16.t -> Tot (b:I32.t{I32.v b = U16.v a})
+let uint16_to_int32 x = I32.int_to_t (U16.v x)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint16_to_int16: a:U16.t -> Tot (b:I16.t{I16.v b = (U16.v a @% pow2 16)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint16_to_int16 x = I16.int_to_t (U16.v x @% pow2 16)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint16_to_int8 : a:U16.t -> Tot (b:I8.t {I8.v b  = (U16.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint16_to_int8 x = I8.int_to_t (U16.v x @% pow2 8)
+
val uint32_to_int64: a:U32.t -> Tot (b:I64.t{I64.v b = U32.v a})
+let uint32_to_int64 x = I64.int_to_t (U32.v x)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint32_to_int32: a:U32.t -> Tot (b:I32.t{I32.v b = (U32.v a @% pow2 32)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint32_to_int32 x = I32.int_to_t (U32.v x @% pow2 32)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint32_to_int16: a:U32.t -> Tot (b:I16.t{I16.v b = (U32.v a @% pow2 16)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint32_to_int16 x = I16.int_to_t (U32.v x @% pow2 16)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint32_to_int8 : a:U32.t -> Tot (b:I8.t {I8.v b  = (U32.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint32_to_int8 x = I8.int_to_t (U32.v x @% pow2 8)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint64_to_int64: a:U64.t -> Tot (b:I64.t{I64.v b = (U64.v a @% pow2 64)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint64_to_int64 x = I64.int_to_t (U64.v x @% pow2 64)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint64_to_int32: a:U64.t -> Tot (b:I32.t{I32.v b = (U64.v a @% pow2 32)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint64_to_int32 x = I32.int_to_t (U64.v x @% pow2 32)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint64_to_int16: a:U64.t -> Tot (b:I16.t{I16.v b = (U64.v a @% pow2 16)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint64_to_int16 x = I16.int_to_t (U64.v x @% pow2 16)
+
[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+val uint64_to_int8 : a:U64.t -> Tot (b:I8.t {I8.v b  = (U64.v a @% pow2 8)})
+[@@(deprecated "with care; in C the result is implementation-defined when not representable")]
+let uint64_to_int8 x = I8.int_to_t (U64.v x @% pow2 8)
+
+

Signed to unsigned

+
+
val int8_to_uint64: a:I8.t -> Tot (b:U64.t{U64.v b = I8.v a % pow2 64})
+let int8_to_uint64 x = U64.uint_to_t (I8.v x % pow2 64)
+
val int8_to_uint32: a:I8.t -> Tot (b:U32.t{U32.v b = I8.v a % pow2 32})
+let int8_to_uint32 x = U32.uint_to_t (I8.v x % pow2 32)
+
val int8_to_uint16: a:I8.t -> Tot (b:U16.t{U16.v b = I8.v a % pow2 16})
+let int8_to_uint16 x = U16.uint_to_t (I8.v x % pow2 16)
+
val int8_to_uint8 : a:I8.t -> Tot (b:U8.t {U8.v b  = I8.v a % pow2 8})
+let int8_to_uint8 x = U8.uint_to_t (I8.v x % pow2 8)
+
val int16_to_uint64: a:I16.t -> Tot (b:U64.t{U64.v b = I16.v a % pow2 64})
+let int16_to_uint64 x = U64.uint_to_t (I16.v x % pow2 64)
+
val int16_to_uint32: a:I16.t -> Tot (b:U32.t{U32.v b = I16.v a % pow2 32})
+let int16_to_uint32 x = U32.uint_to_t (I16.v x % pow2 32)
+
val int16_to_uint16: a:I16.t -> Tot (b:U16.t{U16.v b = I16.v a % pow2 16})
+let int16_to_uint16 x = U16.uint_to_t (I16.v x % pow2 16)
+
val int16_to_uint8 : a:I16.t -> Tot (b:U8.t {U8.v b  = I16.v a % pow2 8})
+let int16_to_uint8 x = U8.uint_to_t (I16.v x % pow2 8)
+
val int32_to_uint64: a:I32.t -> Tot (b:U64.t{U64.v b = I32.v a % pow2 64})
+let int32_to_uint64 x = U64.uint_to_t (I32.v x % pow2 64)
+
val int32_to_uint32: a:I32.t -> Tot (b:U32.t{U32.v b = I32.v a % pow2 32})
+let int32_to_uint32 x = U32.uint_to_t (I32.v x % pow2 32)
+
val int32_to_uint16: a:I32.t -> Tot (b:U16.t{U16.v b = I32.v a % pow2 16})
+let int32_to_uint16 x = U16.uint_to_t (I32.v x % pow2 16)
+
val int32_to_uint8 : a:I32.t -> Tot (b:U8.t {U8.v b  = I32.v a % pow2 8})
+let int32_to_uint8 x = U8.uint_to_t (I32.v x % pow2 8)
+
val int64_to_uint64: a:I64.t -> Tot (b:U64.t{U64.v b = I64.v a % pow2 64})
+let int64_to_uint64 x = U64.uint_to_t (I64.v x % pow2 64)
+
val int64_to_uint32: a:I64.t -> Tot (b:U32.t{U32.v b = I64.v a % pow2 32})
+let int64_to_uint32 x = U32.uint_to_t (I64.v x % pow2 32)
+
val int64_to_uint16: a:I64.t -> Tot (b:U16.t{U16.v b = I64.v a % pow2 16})
+let int64_to_uint16 x = U16.uint_to_t (I64.v x % pow2 16)
+
val int64_to_uint8 : a:I64.t -> Tot (b:U8.t {U8.v b  = I64.v a % pow2 8})
+let int64_to_uint8 x = U8.uint_to_t (I64.v x % pow2 8)
+ diff --git a/docs/FStar.Int.html b/docs/FStar.Int.html index 9cd59d2..b03ef94 100644 --- a/docs/FStar.Int.html +++ b/docs/FStar.Int.html @@ -1,57 +1,349 @@ - - + + - - - - - - + FStar.Int + -

module FStar.Int

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
val shift_left:Unidentified product: [#n:pos] Unidentified product: [a:a:int_t n:{<=(0, a)}] Unidentified product: [s:nat] (Tot (int_t n))
+

+FStar.Int

+

NOTE: anything that you fix/update here should be reflected in FStar.UInt.fsti, which is mostly

+ +
val pow2_values: x:nat -> Lemma
+  (let p = pow2 x in
+   match x with
+   | 0  -> p=1
+   | 1  -> p=2
+   | 8  -> p=256
+   | 16 -> p=65536
+   | 31 -> p=2147483648
+   | 32 -> p=4294967296
+   | 63 -> p=9223372036854775808
+   | 64 -> p=18446744073709551616
+   | _  -> True)
+  [SMTPat (pow2 x)]
+
+

Specs

+
+
let max_int (n:pos) : Tot int = pow2 (n-1) - 1
+let min_int (n:pos) : Tot int = - (pow2 (n-1))
+
let fits (x:int) (n:pos) : Tot bool = min_int n <= x && x <= max_int n
+let size (x:int) (n:pos) : Tot Type0 = b2t(fits x n)
+

Machine integer type

+
type int_t (n:pos) = x:int{size x n}
+
+

Multiplicative operator semantics, see C11 6.5.5

+
+

Truncation towards zero division

+
let op_Slash (a:int) (b:int{b <> 0}) : Tot int =
+  if (a >= 0 && b < 0) || (a < 0 && b >= 0) then - (abs a / abs b)
+  else abs a / abs b
+

Wrap-around modulo: wraps into [-p/2; p/2[

+
let op_At_Percent (v:int) (p:int{p>0/\ p%2=0}) : Tot int =
+  let m = v % p in if m >= p/2 then m - p else m
+
+

Constants

+
+
let zero (n:pos) : Tot (int_t n) = 0
+
#push-options "--initial_fuel 1 --max_fuel 1"
+
let pow2_n (#n:pos) (p:nat{p < n-1}) : Tot (int_t n) =
+  pow2_le_compat (n - 2) p; pow2 p
+
let pow2_minus_one (#n:pos{1 < n}) (m:nat{m < n}) : Tot (int_t n) =
+  pow2_le_compat (n - 1) m;
+  pow2 m - 1
+
let one (n:pos{1 < n}) : Tot (int_t n) = 1
+
#pop-options
+
let ones (n:pos) : Tot (int_t n) = -1
+

Increment and decrement

+
let incr (#n:pos) (a:int_t n)
+    : Pure (int_t n)
+      (requires (b2t (a < max_int n))) (ensures (fun _ -> True))
+  = a + 1
+
let decr (#n:pos) (a:int_t n)
+    : Pure (int_t n)
+      (requires (b2t (a > min_int n))) (ensures (fun _ -> True))
+  = a - 1
+
val incr_underspec: #n:pos -> a:int_t n -> Pure (int_t n)
+  (requires (b2t (a < max_int n)))
+  (ensures (fun b -> a + 1 = b))
+
val decr_underspec: #n:pos -> a:int_t n -> Pure (int_t n)
+  (requires (b2t (a > min_int n)))
+  (ensures (fun b -> a - 1 = b))
+
let incr_mod (#n:pos) (a:int_t n) : Tot (int_t n) =
+  (a + 1) % (pow2 (n-1))
+
let decr_mod (#n:pos) (a:int_t n) : Tot (int_t n) =
+  (a - 1) % (pow2 (n-1))
+

Addition primitives

+
let add (#n:pos) (a:int_t n) (b:int_t n)
+    : Pure (int_t n)
+      (requires (size (a + b) n))
+      (ensures (fun _ -> True))
+  = a + b
+
val add_underspec: #n:pos -> a:int_t n -> b:int_t n -> Pure (int_t n)
+  (requires True)
+  (ensures (fun c ->
+    size (a + b) n ==> a + b = c))
+
#push-options "--initial_fuel 1 --max_fuel 1"
+
let add_mod (#n:pos) (a:int_t n) (b:int_t n) : Tot (int_t n) =
+  (a + b) @% (pow2 n)
+

Subtraction primitives

+
let sub (#n:pos) (a:int_t n) (b:int_t n)
+    : Pure (int_t n)
+      (requires (size (a - b) n))
+      (ensures (fun _ -> True))
+  = a - b
+
val sub_underspec: #n:pos -> a:int_t n -> b:int_t n -> Pure (int_t n)
+  (requires True)
+  (ensures (fun c ->
+    size (a - b) n ==> a - b = c))
+
let sub_mod (#n:pos) (a:int_t n) (b:int_t n) : Tot (int_t n) =
+  (a - b) @% (pow2 n)
+

Multiplication primitives

+
let mul (#n:pos) (a:int_t n) (b:int_t n)
+    : Pure (int_t n)
+      (requires (size (a * b) n))
+      (ensures (fun _ -> True))
+  = a * b
+
val mul_underspec: #n:pos -> a:int_t n -> b:int_t n -> Pure (int_t n)
+  (requires True)
+  (ensures (fun c ->
+    size (a * b) n ==> a * b = c))
+
let mul_mod (#n:pos) (a:int_t n) (b:int_t n) : Tot (int_t n) =
+  (a * b) @% (pow2 n)
+
#pop-options
+

Division primitives

+
let div (#n:pos) (a:int_t n) (b:int_t n{b <> 0})
+    : Pure (int_t n)
+      (requires (size (a / b) n))
+      (ensures (fun c -> b <> 0 ==> a / b = c))
+= a / b
+
val div_underspec: #n:pos -> a:int_t n -> b:int_t n{b <> 0} -> Pure (int_t n)
+  (requires True)
+  (ensures (fun c ->
+    (b <> 0 /\ size (a / b) n) ==> a / b = c))
+
val div_size: #n:pos -> a:int_t n{min_int n < a} -> b:int_t n{b <> 0} ->
+  Lemma (requires (size a n)) (ensures (size (a / b) n))
+
let udiv (#n:pos) (a:int_t n{min_int n < a}) (b:int_t n{b <> 0})
+    : Tot (c:int_t n{b <> 0 ==> a / b = c})
+  = div_size #n a b;
+    a / b
+

Modulo primitives

+
let mod (#n:pos) (a:int_t n) (b:int_t n{b <> 0}) : Tot (int_t n) =
+  a - ((a/b) * b)
+

Comparison operators

+
let eq #n (a:int_t n) (b:int_t n) : Tot bool = a = b
+let gt #n (a:int_t n) (b:int_t n) : Tot bool = a > b
+let gte #n (a:int_t n) (b:int_t n) : Tot bool = a >= b
+let lt #n (a:int_t n) (b:int_t n) : Tot bool = a < b
+let lte #n (a:int_t n) (b:int_t n) : Tot bool = a <= b
+
#push-options "--initial_fuel 1 --max_fuel 1"
+
+

Casts

+
+
let to_uint (#n:pos) (x:int_t n) : Tot (UInt.uint_t n) =
+  if 0 <= x then x else x + pow2 n
+
let from_uint (#n:pos) (x:UInt.uint_t n) : Tot (int_t n) =
+  if x <= max_int n then x else x - pow2 n
+
val to_uint_injective: #n:pos -> x:int_t n
+  -> Lemma (ensures from_uint (to_uint x) == x) [SMTPat (to_uint x)]
+
let to_int_t (m:pos) (a:int) : Tot (int_t m) = a @% pow2 m
+ +

WARNING: Mind the big endian vs little endian definition

+
let to_vec (#n:pos) (num:int_t n) : Tot (bv_t n) =
+  UInt.to_vec (to_uint num)
+
let from_vec (#n:pos) (vec:bv_t n) : Tot (int_t n) =
+  let x = UInt.from_vec vec in
+  if max_int n < x then x - pow2 n else x
+
val to_vec_lemma_1: #n:pos -> a:int_t n -> b:int_t n ->
+  Lemma (requires a = b) (ensures equal (to_vec a) (to_vec b))
+
val to_vec_lemma_2: #n:pos -> a:int_t n -> b:int_t n ->
+  Lemma (requires equal (to_vec a) (to_vec b)) (ensures a = b)
+
val inverse_aux: #n:nat -> vec:bv_t n -> i:nat{i < n} ->
+  Lemma (requires True) (ensures index vec i = index (to_vec (from_vec vec)) i)
+        [SMTPat (index (to_vec (from_vec vec)) i)]
+
val inverse_vec_lemma: #n:pos -> vec:bv_t n ->
+  Lemma (requires True) (ensures equal vec (to_vec (from_vec vec)))
+        [SMTPat (to_vec (from_vec vec))]
+
val inverse_num_lemma: #n:pos -> num:int_t n ->
+  Lemma (requires True) (ensures num = from_vec (to_vec num))
+        [SMTPat (from_vec (to_vec num))]
+
val from_vec_lemma_1: #n:pos -> a:bv_t n -> b:bv_t n ->
+  Lemma (requires equal a b) (ensures from_vec a = from_vec b)
+
val from_vec_lemma_2: #n:pos -> a:bv_t n -> b:bv_t n ->
+  Lemma (requires from_vec a = from_vec b) (ensures equal a b)
+

Relations between constants in BitVector and in UInt.

+
val zero_to_vec_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True) (ensures index (to_vec (zero n)) i = index (zero_vec #n) i)
+        [SMTPat (index (to_vec (zero n)) i)]
+
val zero_from_vec_lemma: #n:pos ->
+  Lemma (requires True) (ensures from_vec (zero_vec #n) = zero n)
+        [SMTPat (from_vec (zero_vec #n))]
+
val one_to_vec_lemma: #n:pos{1 < n} -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures index (to_vec (one n)) i = index (elem_vec #n (n - 1)) i)
+    [SMTPat (index (to_vec (one n)) i)]
+
val pow2_to_vec_lemma: #n:pos -> p:nat{p < n-1} -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures index (to_vec (pow2_n #n p)) i = index (elem_vec #n (n - p - 1)) i)
+    [SMTPat (index (to_vec (pow2_n #n p)) i)]
+
val pow2_from_vec_lemma: #n:pos -> p:pos{p < n-1} ->
+  Lemma (requires True) (ensures from_vec (elem_vec #n p) = pow2_n #n (n - p - 1))
+        [SMTPat (from_vec (elem_vec #n p))]
+
val ones_to_vec_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures index (to_vec (ones n)) i = index (ones_vec #n) i)
+    [SMTPat (index (to_vec (ones n)) i)]
+
val ones_from_vec_lemma: #n:pos ->
+  Lemma (requires True) (ensures from_vec (ones_vec #n) = ones n)
+        [SMTPat (from_vec (ones_vec #n))]
+

(nth a i) returns a boolean indicating the i-th bit of a.

+
let nth (#n:pos) (a:int_t n) (i:nat{i < n}) : Tot bool = index (to_vec #n a) i
+
val nth_lemma: #n:pos -> a:int_t n -> b:int_t n ->
+  Lemma (requires forall (i:nat{i < n}). nth a i = nth b i)
+        (ensures a = b)
+

Lemmas for constants

+
val zero_nth_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True) (ensures nth (zero n) i = false)
+        [SMTPat (nth (zero n) i)]
+
val one_nth_lemma: #n:pos{1 < n} -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (i = n - 1 ==> nth (one n) i = true) /\
+             (i < n - 1 ==> nth (one n) i = false))
+        [SMTPat (nth (one n) i)]
+
val ones_nth_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True) (ensures (nth (ones n) i) = true)
+        [SMTPat (nth (ones n) i)]
+

Bitwise operators

+
let logand (#n:pos) (a:int_t n) (b:int_t n) : Tot (int_t n) =
+  from_vec #n (logand_vec #n (to_vec #n a) (to_vec #n b))
+
let logxor (#n:pos) (a:int_t n) (b:int_t n) : Tot (int_t n) =
+  from_vec #n (logxor_vec #n (to_vec #n a) (to_vec #n b))
+
let logor (#n:pos) (a:int_t n) (b:int_t n) : Tot (int_t n) =
+  from_vec #n (logor_vec #n (to_vec #n a) (to_vec #n b))
+
let lognot (#n:pos) (a:int_t n) : Tot (int_t n)=
+  from_vec #n (lognot_vec #n (to_vec #n a))
+

Bitwise operators definitions

+
val logand_definition: #n:pos -> a:int_t n -> b:int_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+    (ensures (nth (logand a b) i = (nth a i && nth b i)))
+    [SMTPat (nth (logand a b) i)]
+
val logxor_definition: #n:pos -> a:int_t n -> b:int_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+    (ensures (nth (logxor a b) i = (nth a i <> nth b i)))
+    [SMTPat (nth (logxor a b) i)]
+
val logor_definition: #n:pos -> a:int_t n -> b:int_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+    (ensures (nth (logor a b) i = (nth a i || nth b i)))
+    [SMTPat (nth (logor a b) i)]
+
val lognot_definition: #n:pos -> a:int_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+    (ensures (nth (lognot a) i = not(nth a i)))
+    [SMTPat (nth (lognot a) i)]
+

Two's complement unary minus

+
inline_for_extraction
+let minus (#n:pos{1 < n}) (a:int_t n) : Tot (int_t n) =
+  add_mod (lognot a) 1
+

Bitwise operators lemmas

+

TODO: lemmas about the relations between different operators

+

Bitwise AND operator

+
val logand_commutative: #n:pos -> a:int_t n -> b:int_t n ->
+  Lemma (requires True) (ensures (logand #n a b = logand #n b a))
+
val logand_associative: #n:pos -> a:int_t n -> b:int_t n -> c:int_t n ->
+  Lemma (logand #n (logand #n a b) c = logand #n a (logand #n b c))
+
val logand_self: #n:pos -> a:int_t n ->
+  Lemma (logand #n a a = a)
+
val logand_lemma_1: #n:pos -> a:int_t n ->
+  Lemma (requires True) (ensures (logand #n a (zero n) = zero n))
+
val logand_lemma_2: #n:pos -> a:int_t n ->
+  Lemma (logand #n a (ones n) = a)
+
val sign_bit_negative: #n:pos{1 < n} -> a:int_t n ->
+  Lemma (nth a 0 = true <==> a < 0)
+
val sign_bit_positive: #n:pos{1 < n} -> a:int_t n ->
+  Lemma (nth a 0 = false <==> 0 <= a)
+
val logand_pos_le: #n:pos{1 < n} -> a:int_t n{0 <= a} -> b:int_t n{0 <= b} ->
+  Lemma (0 <= logand a b /\ logand a b <= a /\ logand a b <= b)
+
val logand_pow2_minus_one: #n:pos{1 < n} -> a:int_t n -> m:pos{m < n} ->
+  Lemma (0 <= logand a (pow2_minus_one m) /\
+    logand a (pow2_minus_one m) <= pow2_minus_one #n m)
+
val logand_max: #n:pos{1 < n} -> a:int_t n{0 <= a} ->
+  Lemma (0 <= logand a (max_int n) /\ a = logand a (max_int n))
+

Bitwise XOR operator

+
val logxor_commutative: #n:pos -> a:int_t n -> b:int_t n ->
+  Lemma (requires True) (ensures (logxor #n a b = logxor #n b a))
+
val logxor_associative: #n:pos -> a:int_t n -> b:int_t n -> c:int_t n ->
+  Lemma (requires True) (ensures (logxor #n (logxor #n a b) c = logxor #n a (logxor #n b c)))
+
val logxor_self: #n:pos -> a:int_t n ->
+  Lemma (requires True) (ensures (logxor #n a a = zero n))
+
val logxor_lemma_1: #n:pos -> a:int_t n ->
+  Lemma (requires True) (ensures (logxor #n a (zero n) = a))
+
val logxor_lemma_2: #n:pos -> a:int_t n ->
+  Lemma (requires True) (ensures (logxor #n a (ones n) = lognot #n a))
+
val logxor_inv: #n:pos -> a:int_t n -> b:int_t n -> Lemma
+  (a = logxor #n (logxor #n a b) b)
+
val logxor_neq_nonzero: #n:pos -> a:int_t n -> b:int_t n -> Lemma
+   (a <> b ==> logxor a b <> 0)
+
val lognot_negative: #n:pos -> a:int_t n -> Lemma
+  (requires a < 0)
+  (ensures  lognot a == UInt.lognot #n (a + pow2 n))
+

Shift operators

+

+shift_left

If a is negative the result is undefined behaviour

-
val shift_right:Unidentified product: [#n:pos] Unidentified product: [a:a:int_t n:{<=(0, a)}] Unidentified product: [s:nat] (Tot (int_t n))
+
let shift_left (#n:pos) (a:int_t n{0 <= a}) (s:nat) : Tot (int_t n) =
+  from_vec (shift_left_vec #n (to_vec #n a) s)
+

+shift_right

If a is negative the result is implementation defined

+
let shift_right (#n:pos) (a:int_t n{0 <= a}) (s:nat) : Tot (int_t n) =
+  from_vec (shift_right_vec #n (to_vec #n a) s)
+
let shift_arithmetic_right (#n:pos) (a:int_t n) (s:nat) : Tot (int_t n) =
+  from_vec (shift_arithmetic_right_vec #n (to_vec #n a) s)
+

Shift operators lemmas

+
val shift_left_lemma_1: #n:pos -> a:int_t n{0 <= a} -> s:nat -> i:nat{i < n && i >= n - s} ->
+  Lemma (requires True)
+    (ensures (nth (shift_left #n a s) i = false))
+    [SMTPat (nth (shift_left #n a s) i)]
+
val shift_left_lemma_2: #n:pos -> a:int_t n{0 <= a} -> s:nat -> i:nat{i < n && i < n - s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_left #n a s) i = nth #n a (i + s)))
+    [SMTPat (nth (shift_left #n a s) i)]
+
val shift_left_value_lemma: #n:pos -> a:int_t n{0 <= a} -> s:nat ->
+  Lemma (requires True)
+        (ensures shift_left #n a s = (a * pow2 s) @% pow2 n)
+    [SMTPat (shift_left #n a s)]
+
val shift_right_lemma_1: #n:pos -> a:int_t n{0 <= a} -> s:nat -> i:nat{i < n && i < s} ->
+  Lemma (requires True)
+    (ensures (nth (shift_right #n a s) i = false))
+    [SMTPat (nth (shift_right #n a s) i)]
+
val shift_right_lemma_2: #n:pos -> a:int_t n{0 <= a} -> s:nat -> i:nat{i < n && i >= s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_right #n a s) i = nth #n a (i - s)))
+    [SMTPat (nth (shift_right #n a s) i)]
+
val shift_arithmetic_right_lemma_1: #n:pos -> a:int_t n -> s:nat -> i:nat{i < n && i < s} ->
+  Lemma (requires True)
+    (ensures (nth (shift_arithmetic_right #n a s) i = nth a 0))
+    [SMTPat (nth (shift_arithmetic_right #n a s) i)]
+
val shift_arithmetic_right_lemma_2: #n:pos -> a:int_t n -> s:nat -> i:nat{i < n && i >= s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_arithmetic_right #n a s) i = nth #n a (i - s)))
+    [SMTPat (nth (shift_arithmetic_right #n a s) i)]
+ diff --git a/docs/FStar.Int128.html b/docs/FStar.Int128.html index 34ee9b4..662453b 100644 --- a/docs/FStar.Int128.html +++ b/docs/FStar.Int128.html @@ -1,57 +1,154 @@ - - + + - - - - - - + FStar.Int128 + -

module FStar.Int128

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((shift_right (a:t) (s:UInt32.t)):(Pure t ((requires (/\(<=(0, v a), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_right (v a) (UInt32.v s), v c))))))):(Mk (shift_right (v a) (UInt32.v s)))
+

+FStar.Int128

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 128
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

NOTE: anything that you fix/update here should be reflected in FStar.UIntN.fstp, which is mostly

+ +
new val t : eqtype
+
val v (x:t) : Tot (int_t n)
+
val int_to_t: x:int_t n -> Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+
val uv_inv (x : t) : Lemma
+  (ensures (int_to_t (v x) == x))
+  [SMTPat (v x)]
+
val vu_inv (x : int_t n) : Lemma
+  (ensures (v (int_to_t x) == x))
+  [SMTPat (int_to_t x)]
+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

Subtraction primitives

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

Multiplication primitives

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

Division primitives

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+

division overflows on INT_MIN / -1

+
(requires (size (v a / v b) n))
+(ensures (fun c -> v a / v b = v c))
+

Modulo primitives

+

If a/b is not representable the result of a%b is undefind

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (size (v a / v b) n))
+  (ensures (fun c -> FStar.Int.mod (v a) (v b) = v c))
+

Bitwise operators

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

Shift operators

+

+shift_right

If a is negative the result is implementation-defined

-
let ((shift_left (a:t) (s:UInt32.t)):(Pure t ((requires (/\(/\(<=(0, v a), <=(*(v a, pow2 (UInt32.v s)), max_int n)), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_left (v a) (UInt32.v s), v c))))))):(Mk (shift_left (v a) (UInt32.v s)))
+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

If a is negative or a * pow2 s is not representable the result is undefined

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ v a * pow2 (UInt32.v s) <= max_int n /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_left (v a) (UInt32.v s) = v c))
+
val shift_arithmetic_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_arithmetic_right (v a) (UInt32.v s) = v c))
+

Comparison operators

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Subtraction_Hat = sub
+unfold let op_Star_Hat = mul
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Greater_Greater_Greater_Hat = shift_arithmetic_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+
inline_for_extraction
+let ct_abs (a:t{min_int n < v a}) : Tot (b:t{v b = abs (v a)}) =
+  let mask = a >>>^ UInt32.uint_to_t (n - 1) in
+  if 0 <= v a then
+    begin
+    sign_bit_positive (v a);
+    nth_lemma (v mask) (FStar.Int.zero _);
+    logxor_lemma_1 (v a)
+    end
+  else
+    begin
+    sign_bit_negative (v a);
+    nth_lemma (v mask) (ones _);
+    logxor_lemma_2 (v a);
+    lognot_negative (v a);
+    UInt.lemma_lognot_value #n (to_uint (v a))
+    end;
+  (a ^^ mask) -^ mask
+

To input / output constants

+

.. in decimal representation

+
val to_string: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __int_to_t (x:int) : Tot t
+    = int_to_t x
+#reset-options
+
val mul_wide: a:Int64.t -> b:Int64.t -> Pure t
+  (requires True)
+  (ensures (fun c -> v c = Int64.v a * Int64.v b))
+ diff --git a/docs/FStar.Int16.html b/docs/FStar.Int16.html index 6cfd1ec..47356e3 100644 --- a/docs/FStar.Int16.html +++ b/docs/FStar.Int16.html @@ -1,57 +1,151 @@ - - + + - - - - - - + FStar.Int16 + -

module FStar.Int16

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((shift_right (a:t) (s:UInt32.t)):(Pure t ((requires (/\(<=(0, v a), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_right (v a) (UInt32.v s), v c))))))):(Mk (shift_right (v a) (UInt32.v s)))
+

+FStar.Int16

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 16
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

NOTE: anything that you fix/update here should be reflected in FStar.UIntN.fstp, which is mostly

+ +
new val t : eqtype
+
val v (x:t) : Tot (int_t n)
+
val int_to_t: x:int_t n -> Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+
val uv_inv (x : t) : Lemma
+  (ensures (int_to_t (v x) == x))
+  [SMTPat (v x)]
+
val vu_inv (x : int_t n) : Lemma
+  (ensures (v (int_to_t x) == x))
+  [SMTPat (int_to_t x)]
+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

Subtraction primitives

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

Multiplication primitives

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

Division primitives

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+

division overflows on INT_MIN / -1

+
(requires (size (v a / v b) n))
+(ensures (fun c -> v a / v b = v c))
+

Modulo primitives

+

If a/b is not representable the result of a%b is undefind

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (size (v a / v b) n))
+  (ensures (fun c -> FStar.Int.mod (v a) (v b) = v c))
+

Bitwise operators

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

Shift operators

+

+shift_right

If a is negative the result is implementation-defined

-
let ((shift_left (a:t) (s:UInt32.t)):(Pure t ((requires (/\(/\(<=(0, v a), <=(*(v a, pow2 (UInt32.v s)), max_int n)), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_left (v a) (UInt32.v s), v c))))))):(Mk (shift_left (v a) (UInt32.v s)))
+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

If a is negative or a * pow2 s is not representable the result is undefined

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ v a * pow2 (UInt32.v s) <= max_int n /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_left (v a) (UInt32.v s) = v c))
+
val shift_arithmetic_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_arithmetic_right (v a) (UInt32.v s) = v c))
+

Comparison operators

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Subtraction_Hat = sub
+unfold let op_Star_Hat = mul
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Greater_Greater_Greater_Hat = shift_arithmetic_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+
inline_for_extraction
+let ct_abs (a:t{min_int n < v a}) : Tot (b:t{v b = abs (v a)}) =
+  let mask = a >>>^ UInt32.uint_to_t (n - 1) in
+  if 0 <= v a then
+    begin
+    sign_bit_positive (v a);
+    nth_lemma (v mask) (FStar.Int.zero _);
+    logxor_lemma_1 (v a)
+    end
+  else
+    begin
+    sign_bit_negative (v a);
+    nth_lemma (v mask) (ones _);
+    logxor_lemma_2 (v a);
+    lognot_negative (v a);
+    UInt.lemma_lognot_value #n (to_uint (v a))
+    end;
+  (a ^^ mask) -^ mask
+

To input / output constants

+

.. in decimal representation

+
val to_string: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __int_to_t (x:int) : Tot t
+    = int_to_t x
+#reset-options
+ diff --git a/docs/FStar.Int32.html b/docs/FStar.Int32.html index 91252d5..8b0dedc 100644 --- a/docs/FStar.Int32.html +++ b/docs/FStar.Int32.html @@ -1,57 +1,151 @@ - - + + - - - - - - + FStar.Int32 + -

module FStar.Int32

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((shift_right (a:t) (s:UInt32.t)):(Pure t ((requires (/\(<=(0, v a), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_right (v a) (UInt32.v s), v c))))))):(Mk (shift_right (v a) (UInt32.v s)))
+

+FStar.Int32

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 32
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

NOTE: anything that you fix/update here should be reflected in FStar.UIntN.fstp, which is mostly

+ +
new val t : eqtype
+
val v (x:t) : Tot (int_t n)
+
val int_to_t: x:int_t n -> Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+
val uv_inv (x : t) : Lemma
+  (ensures (int_to_t (v x) == x))
+  [SMTPat (v x)]
+
val vu_inv (x : int_t n) : Lemma
+  (ensures (v (int_to_t x) == x))
+  [SMTPat (int_to_t x)]
+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

Subtraction primitives

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

Multiplication primitives

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

Division primitives

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+

division overflows on INT_MIN / -1

+
(requires (size (v a / v b) n))
+(ensures (fun c -> v a / v b = v c))
+

Modulo primitives

+

If a/b is not representable the result of a%b is undefind

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (size (v a / v b) n))
+  (ensures (fun c -> FStar.Int.mod (v a) (v b) = v c))
+

Bitwise operators

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

Shift operators

+

+shift_right

If a is negative the result is implementation-defined

-
let ((shift_left (a:t) (s:UInt32.t)):(Pure t ((requires (/\(/\(<=(0, v a), <=(*(v a, pow2 (UInt32.v s)), max_int n)), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_left (v a) (UInt32.v s), v c))))))):(Mk (shift_left (v a) (UInt32.v s)))
+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

If a is negative or a * pow2 s is not representable the result is undefined

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ v a * pow2 (UInt32.v s) <= max_int n /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_left (v a) (UInt32.v s) = v c))
+
val shift_arithmetic_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_arithmetic_right (v a) (UInt32.v s) = v c))
+

Comparison operators

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Subtraction_Hat = sub
+unfold let op_Star_Hat = mul
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Greater_Greater_Greater_Hat = shift_arithmetic_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+
inline_for_extraction
+let ct_abs (a:t{min_int n < v a}) : Tot (b:t{v b = abs (v a)}) =
+  let mask = a >>>^ UInt32.uint_to_t (n - 1) in
+  if 0 <= v a then
+    begin
+    sign_bit_positive (v a);
+    nth_lemma (v mask) (FStar.Int.zero _);
+    logxor_lemma_1 (v a)
+    end
+  else
+    begin
+    sign_bit_negative (v a);
+    nth_lemma (v mask) (ones _);
+    logxor_lemma_2 (v a);
+    lognot_negative (v a);
+    UInt.lemma_lognot_value #n (to_uint (v a))
+    end;
+  (a ^^ mask) -^ mask
+

To input / output constants

+

.. in decimal representation

+
val to_string: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __int_to_t (x:int) : Tot t
+    = int_to_t x
+#reset-options
+ diff --git a/docs/FStar.Int64.html b/docs/FStar.Int64.html index 156bfab..ae29068 100644 --- a/docs/FStar.Int64.html +++ b/docs/FStar.Int64.html @@ -1,57 +1,151 @@ - - + + - - - - - - + FStar.Int64 + -

module FStar.Int64

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((shift_right (a:t) (s:UInt32.t)):(Pure t ((requires (/\(<=(0, v a), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_right (v a) (UInt32.v s), v c))))))):(Mk (shift_right (v a) (UInt32.v s)))
+

+FStar.Int64

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 64
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

NOTE: anything that you fix/update here should be reflected in FStar.UIntN.fstp, which is mostly

+ +
new val t : eqtype
+
val v (x:t) : Tot (int_t n)
+
val int_to_t: x:int_t n -> Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+
val uv_inv (x : t) : Lemma
+  (ensures (int_to_t (v x) == x))
+  [SMTPat (v x)]
+
val vu_inv (x : int_t n) : Lemma
+  (ensures (v (int_to_t x) == x))
+  [SMTPat (int_to_t x)]
+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

Subtraction primitives

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

Multiplication primitives

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

Division primitives

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+

division overflows on INT_MIN / -1

+
(requires (size (v a / v b) n))
+(ensures (fun c -> v a / v b = v c))
+

Modulo primitives

+

If a/b is not representable the result of a%b is undefind

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (size (v a / v b) n))
+  (ensures (fun c -> FStar.Int.mod (v a) (v b) = v c))
+

Bitwise operators

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

Shift operators

+

+shift_right

If a is negative the result is implementation-defined

-
let ((shift_left (a:t) (s:UInt32.t)):(Pure t ((requires (/\(/\(<=(0, v a), <=(*(v a, pow2 (UInt32.v s)), max_int n)), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_left (v a) (UInt32.v s), v c))))))):(Mk (shift_left (v a) (UInt32.v s)))
+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

If a is negative or a * pow2 s is not representable the result is undefined

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ v a * pow2 (UInt32.v s) <= max_int n /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_left (v a) (UInt32.v s) = v c))
+
val shift_arithmetic_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_arithmetic_right (v a) (UInt32.v s) = v c))
+

Comparison operators

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Subtraction_Hat = sub
+unfold let op_Star_Hat = mul
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Greater_Greater_Greater_Hat = shift_arithmetic_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+
inline_for_extraction
+let ct_abs (a:t{min_int n < v a}) : Tot (b:t{v b = abs (v a)}) =
+  let mask = a >>>^ UInt32.uint_to_t (n - 1) in
+  if 0 <= v a then
+    begin
+    sign_bit_positive (v a);
+    nth_lemma (v mask) (FStar.Int.zero _);
+    logxor_lemma_1 (v a)
+    end
+  else
+    begin
+    sign_bit_negative (v a);
+    nth_lemma (v mask) (ones _);
+    logxor_lemma_2 (v a);
+    lognot_negative (v a);
+    UInt.lemma_lognot_value #n (to_uint (v a))
+    end;
+  (a ^^ mask) -^ mask
+

To input / output constants

+

.. in decimal representation

+
val to_string: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __int_to_t (x:int) : Tot t
+    = int_to_t x
+#reset-options
+ diff --git a/docs/FStar.Int8.html b/docs/FStar.Int8.html index c240379..31a6be1 100644 --- a/docs/FStar.Int8.html +++ b/docs/FStar.Int8.html @@ -1,57 +1,151 @@ - - + + - - - - - - + FStar.Int8 + -

module FStar.Int8

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((shift_right (a:t) (s:UInt32.t)):(Pure t ((requires (/\(<=(0, v a), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_right (v a) (UInt32.v s), v c))))))):(Mk (shift_right (v a) (UInt32.v s)))
+

+FStar.Int8

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 8
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

NOTE: anything that you fix/update here should be reflected in FStar.UIntN.fstp, which is mostly

+ +
new val t : eqtype
+
val v (x:t) : Tot (int_t n)
+
val int_to_t: x:int_t n -> Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+
val uv_inv (x : t) : Lemma
+  (ensures (int_to_t (v x) == x))
+  [SMTPat (v x)]
+
val vu_inv (x : int_t n) : Lemma
+  (ensures (v (int_to_t x) == x))
+  [SMTPat (int_to_t x)]
+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

Subtraction primitives

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

Multiplication primitives

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

Division primitives

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+

division overflows on INT_MIN / -1

+
(requires (size (v a / v b) n))
+(ensures (fun c -> v a / v b = v c))
+

Modulo primitives

+

If a/b is not representable the result of a%b is undefind

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (size (v a / v b) n))
+  (ensures (fun c -> FStar.Int.mod (v a) (v b) = v c))
+

Bitwise operators

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

Shift operators

+

+shift_right

If a is negative the result is implementation-defined

-
let ((shift_left (a:t) (s:UInt32.t)):(Pure t ((requires (/\(/\(<=(0, v a), <=(*(v a, pow2 (UInt32.v s)), max_int n)), <(UInt32.v s, n))))) ((ensures ((fun c -> =(FStar.Int.shift_left (v a) (UInt32.v s), v c))))))):(Mk (shift_left (v a) (UInt32.v s)))
+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

If a is negative or a * pow2 s is not representable the result is undefined

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (0 <= v a /\ v a * pow2 (UInt32.v s) <= max_int n /\ UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_left (v a) (UInt32.v s) = v c))
+
val shift_arithmetic_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.Int.shift_arithmetic_right (v a) (UInt32.v s) = v c))
+

Comparison operators

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Subtraction_Hat = sub
+unfold let op_Star_Hat = mul
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Greater_Greater_Greater_Hat = shift_arithmetic_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+
inline_for_extraction
+let ct_abs (a:t{min_int n < v a}) : Tot (b:t{v b = abs (v a)}) =
+  let mask = a >>>^ UInt32.uint_to_t (n - 1) in
+  if 0 <= v a then
+    begin
+    sign_bit_positive (v a);
+    nth_lemma (v mask) (FStar.Int.zero _);
+    logxor_lemma_1 (v a)
+    end
+  else
+    begin
+    sign_bit_negative (v a);
+    nth_lemma (v mask) (ones _);
+    logxor_lemma_2 (v a);
+    lognot_negative (v a);
+    UInt.lemma_lognot_value #n (to_uint (v a))
+    end;
+  (a ^^ mask) -^ mask
+

To input / output constants

+

.. in decimal representation

+
val to_string: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __int_to_t (x:int) : Tot t
+    = int_to_t x
+#reset-options
+ diff --git a/docs/FStar.Integers.html b/docs/FStar.Integers.html index 3d9d2a4..1a1659a 100644 --- a/docs/FStar.Integers.html +++ b/docs/FStar.Integers.html @@ -1,16 +1,536 @@ - - + + - - - - - + FStar.Integers + -

module FStar.Integers

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Integers

+
#set-options "--initial_ifuel 2 --max_ifuel 2 --initial_fuel 0 --max_fuel 0"
+
irreducible
+let mark_for_norm = ()
+
unfold
+let norm (#a:Type) (x:a) = norm [iota; delta_attr [`%mark_for_norm]] x
+
type width =
+  | W8
+  | W16
+  | W32
+  | W64
+  | W128
+  | Winfinite
+
[@@mark_for_norm]
+let nat_of_width = function
+  | W8   -> Some 8
+  | W16  -> Some 16
+  | W32  -> Some 32
+  | W64  -> Some 64
+  | W128 -> Some 128
+  | Winfinite -> None
+
let fixed_width = w:width{w <> Winfinite}
+
[@@mark_for_norm]
+let nat_of_fixed_width (w:fixed_width) =
+  match nat_of_width w with
+  | Some v -> v
+
type signed_width =
+  | Signed of width
+  | Unsigned of fixed_width //We don't support (Unsigned WInfinite); use nat instead
+
[@@mark_for_norm]
+let width_of_sw = function
+  | Signed w -> w
+  | Unsigned w -> w
+
[@@mark_for_norm]
+noextract
+inline_for_extraction
+let int_t sw : Tot Type0 =
+  match sw with
+  | Unsigned W8 -> FStar.UInt8.t
+  | Unsigned W16 -> FStar.UInt16.t
+  | Unsigned W32 -> FStar.UInt32.t
+  | Unsigned W64 -> FStar.UInt64.t
+  | Unsigned W128 -> FStar.UInt128.t
+  | Signed Winfinite -> int
+  | Signed W8 -> FStar.Int8.t
+  | Signed W16 -> FStar.Int16.t
+  | Signed W32 -> FStar.Int32.t
+  | Signed W64 -> FStar.Int64.t
+  | Signed W128 -> FStar.Int128.t
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let within_bounds' sw (x:int) =
+  match sw, nat_of_width (width_of_sw sw) with
+  | Signed _,   None   -> True
+  | Signed _,   Some n -> FStar.Int.size x n
+  | Unsigned _, Some n -> FStar.UInt.size x n
+
unfold
+let within_bounds sw x = norm (within_bounds' sw x)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let v #sw (x:int_t sw)
+  : Tot (y:int_t (Signed Winfinite){within_bounds sw y})
+  = match sw with
+    | Unsigned w ->
+      (match w with
+       | W8 -> FStar.UInt8.v x
+       | W16 -> FStar.UInt16.v x
+       | W32 -> FStar.UInt32.v x
+       | W64 -> FStar.UInt64.v x
+       | W128 -> FStar.UInt128.v x)
+    | Signed w ->
+      (match w with
+       | Winfinite -> x
+       | W8 -> FStar.Int8.v x
+       | W16 -> FStar.Int16.v x
+       | W32 -> FStar.Int32.v x
+       | W64 -> FStar.Int64.v x
+       | W128 -> FStar.Int128.v x)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let u    #sw
+        (x:int_t (Signed Winfinite){within_bounds sw x})
+  : Tot (y:int_t sw{norm (v x == v y)})
+  = match sw with
+    | Unsigned w ->
+      (match w with
+       | W8 -> FStar.UInt8.uint_to_t x
+       | W16 -> FStar.UInt16.uint_to_t x
+       | W32 -> FStar.UInt32.uint_to_t x
+       | W64 -> FStar.UInt64.uint_to_t x
+       | W128 -> FStar.UInt128.uint_to_t x)
+    | Signed w ->
+      (match w with
+       | Winfinite -> x
+       | W8 -> FStar.Int8.int_to_t x
+       | W16 -> FStar.Int16.int_to_t x
+       | W32 -> FStar.Int32.int_to_t x
+       | W64 -> FStar.Int64.int_to_t x
+       | W128 -> FStar.Int128.int_to_t x)
+
irreducible
+noextract
+let cast #sw #sw'
+         (from:int_t sw{within_bounds sw' (v from)})
+   : Tot (to:int_t sw'{norm (v from == v to)})
+   = u (v from)
+
[@@mark_for_norm]
+unfold
+noextract
+let cast_ok #from to (x:int_t from) = within_bounds to (v x)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( + ) #sw
+          (x:int_t sw)
+          (y:int_t sw{within_bounds sw (v x + v y)})
+  : Tot   (int_t sw)
+  = match sw with
+    | Signed Winfinite -> x + y
+    | Unsigned W8   -> FStar.UInt8.(x +^ y)
+    | Unsigned W16  -> FStar.UInt16.(x +^ y)
+    | Unsigned W32  -> FStar.UInt32.(x +^ y)
+    | Unsigned W64  -> FStar.UInt64.(x +^ y)
+    | Unsigned W128 -> FStar.UInt128.(x +^ y)
+    | Signed W8   -> FStar.Int8.(x +^ y)
+    | Signed W16  -> FStar.Int16.(x +^ y)
+    | Signed W32  -> FStar.Int32.(x +^ y)
+    | Signed W64  -> FStar.Int64.(x +^ y)
+    | Signed W128 -> FStar.Int128.(x +^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( +? ) (#w:fixed_width)
+           (x:int_t (Unsigned w))
+           (y:int_t (Unsigned w))
+  : Tot    (int_t (Unsigned w))
+  = match w with
+    | W8 -> FStar.UInt8.(x +?^ y)
+    | W16 -> FStar.UInt16.(x +?^ y)
+    | W32 -> FStar.UInt32.(x +?^ y)
+    | W64 -> FStar.UInt64.(x +?^ y)
+    | W128 -> FStar.UInt128.(x +?^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+noextract
+let modulo sw (x:int) (y:pos{Signed? sw ==> y%2=0}) =
+  match sw with
+  | Unsigned _ ->  x % y
+  | _ -> FStar.Int.(x @% y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( +% ) (#sw:_{Unsigned? sw})
+           (x:int_t sw)
+           (y:int_t sw)
+  : Tot    (int_t sw)
+  = let Unsigned w = sw in
+    match w with
+    | W8 -> FStar.UInt8.(x +%^ y)
+    | W16 -> FStar.UInt16.(x +%^ y)
+    | W32 -> FStar.UInt32.(x +%^ y)
+    | W64 -> FStar.UInt64.(x +%^ y)
+    | W128 -> FStar.UInt128.(x +%^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let op_Subtraction #sw
+                   (x:int_t sw)
+                   (y:int_t sw{within_bounds sw (v x - v y)})
+    : Tot          (int_t sw)
+  = match sw with
+    | Signed Winfinite -> x - y
+    | Unsigned W8 -> FStar.UInt8.(x -^ y)
+    | Unsigned W16 -> FStar.UInt16.(x -^ y)
+    | Unsigned W32 -> FStar.UInt32.(x -^ y)
+    | Unsigned W64 -> FStar.UInt64.(x -^ y)
+    | Unsigned W128 -> FStar.UInt128.(x -^ y)
+    | Signed W8 -> FStar.Int8.(x -^ y)
+    | Signed W16 -> FStar.Int16.(x -^ y)
+    | Signed W32 -> FStar.Int32.(x -^ y)
+    | Signed W64 -> FStar.Int64.(x -^ y)
+    | Signed W128 -> FStar.Int128.(x -^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let op_Subtraction_Question
+        (#sw:_{Unsigned? sw})
+        (x:int_t sw)
+        (y:int_t sw)
+  : Tot (int_t sw)
+  = let Unsigned w = sw in
+    match w with
+    | W8 -> FStar.UInt8.(x -?^ y)
+    | W16 -> FStar.UInt16.(x -?^ y)
+    | W32 -> FStar.UInt32.(x -?^ y)
+    | W64 -> FStar.UInt64.(x -?^ y)
+    | W128 -> FStar.UInt128.(x -?^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let op_Subtraction_Percent
+         (#sw:_{Unsigned? sw})
+         (x:int_t sw)
+         (y:int_t sw)
+  : Tot  (int_t sw)
+  = let Unsigned w = sw in
+    match w with
+    | W8 -> FStar.UInt8.(x -%^ y)
+    | W16 -> FStar.UInt16.(x -%^ y)
+    | W32 -> FStar.UInt32.(x -%^ y)
+    | W64 -> FStar.UInt64.(x -%^ y)
+    | W128 -> FStar.UInt128.(x -%^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let op_Minus
+         (#sw:_{Signed? sw})
+         (x:int_t sw{within_bounds sw (0 - v x)})
+  : Tot  (int_t sw)
+  = let Signed w = sw in
+    match w with
+    | Winfinite -> 0 - x
+    | W8 -> FStar.Int8.(0y -^ x)
+    | W16 -> FStar.Int16.(0s -^ x)
+    | W32 -> FStar.Int32.(0l -^ x)
+    | W64 -> FStar.Int64.(0L -^ x)
+    | W128 -> FStar.Int128.(int_to_t 0 -^ x)
+ +
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( * ) (#sw:signed_width{width_of_sw sw <> W128})
+          (x:int_t sw)
+          (y:int_t sw{within_bounds sw (v x * v y)})
+  : Tot   (int_t sw)
+  = match sw with
+    | Signed Winfinite -> x * y
+    | Unsigned W8 -> FStar.UInt8.(x *^ y)
+    | Unsigned W16 -> FStar.UInt16.(x *^ y)
+    | Unsigned W32 -> FStar.UInt32.(x *^ y)
+    | Unsigned W64 -> FStar.UInt64.(x *^ y)
+    | Signed W8 -> FStar.Int8.(x *^ y)
+    | Signed W16 -> FStar.Int16.(x *^ y)
+    | Signed W32 -> FStar.Int32.(x *^ y)
+    | Signed W64 -> FStar.Int64.(x *^ y)
+    | Signed W128 -> FStar.Int128.(x *^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( *? ) (#sw:_{Unsigned? sw /\ width_of_sw sw <> W128})
+           (x:int_t sw)
+           (y:int_t sw)
+  : Tot    (int_t sw)
+  = let Unsigned w = sw in
+    match w with
+    | W8 -> FStar.UInt8.(x *?^ y)
+    | W16 -> FStar.UInt16.(x *?^ y)
+    | W32 -> FStar.UInt32.(x *?^ y)
+    | W64 -> FStar.UInt64.(x *?^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( *% ) (#sw:_{Unsigned? sw /\ width_of_sw sw <> W128})
+           (x:int_t sw)
+           (y:int_t sw)
+  : Tot    (int_t sw)
+  = let Unsigned w = sw in
+    match w with
+    | W8 -> FStar.UInt8.(x *%^ y)
+    | W16 -> FStar.UInt16.(x *%^ y)
+    | W32 -> FStar.UInt32.(x *%^ y)
+    | W64 -> FStar.UInt64.(x *%^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( > ) #sw (x:int_t sw) (y:int_t sw) : bool =
+    match sw with
+    | Signed Winfinite -> x > y
+    | Unsigned W8 -> FStar.UInt8.(x >^ y)
+    | Unsigned W16 -> FStar.UInt16.(x >^ y)
+    | Unsigned W32 -> FStar.UInt32.(x >^ y)
+    | Unsigned W64 -> FStar.UInt64.(x >^ y)
+    | Unsigned W128 -> FStar.UInt128.(x >^ y)
+    | Signed W8 -> FStar.Int8.(x >^ y)
+    | Signed W16 -> FStar.Int16.(x >^ y)
+    | Signed W32 -> FStar.Int32.(x >^ y)
+    | Signed W64 -> FStar.Int64.(x >^ y)
+    | Signed W128 -> FStar.Int128.(x >^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( >= ) #sw (x:int_t sw) (y:int_t sw) : bool =
+    match sw with
+    | Signed Winfinite -> x >= y
+    | Unsigned W8 -> FStar.UInt8.(x >=^ y)
+    | Unsigned W16 -> FStar.UInt16.(x >=^ y)
+    | Unsigned W32 -> FStar.UInt32.(x >=^ y)
+    | Unsigned W64 -> FStar.UInt64.(x >=^ y)
+    | Unsigned W128 -> FStar.UInt128.(x >=^ y)
+    | Signed W8 -> FStar.Int8.(x >=^ y)
+    | Signed W16 -> FStar.Int16.(x >=^ y)
+    | Signed W32 -> FStar.Int32.(x >=^ y)
+    | Signed W64 -> FStar.Int64.(x >=^ y)
+    | Signed W128 -> FStar.Int128.(x >=^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( < ) #sw (x:int_t sw) (y:int_t sw) : bool =
+    match sw with
+    | Signed Winfinite -> x < y
+    | Unsigned W8 -> FStar.UInt8.(x <^ y)
+    | Unsigned W16 -> FStar.UInt16.(x <^ y)
+    | Unsigned W32 -> FStar.UInt32.(x <^ y)
+    | Unsigned W64 -> FStar.UInt64.(x <^ y)
+    | Unsigned W128 -> FStar.UInt128.(x <^ y)
+    | Signed W8 -> FStar.Int8.(x <^ y)
+    | Signed W16 -> FStar.Int16.(x <^ y)
+    | Signed W32 -> FStar.Int32.(x <^ y)
+    | Signed W64 -> FStar.Int64.(x <^ y)
+    | Signed W128 -> FStar.Int128.(x <^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( <= ) #sw (x:int_t sw) (y:int_t sw) : bool =
+    match sw with
+    | Signed Winfinite -> x <= y
+    | Unsigned W8 -> FStar.UInt8.(x <=^ y)
+    | Unsigned W16 -> FStar.UInt16.(x <=^ y)
+    | Unsigned W32 -> FStar.UInt32.(x <=^ y)
+    | Unsigned W64 -> FStar.UInt64.(x <=^ y)
+    | Unsigned W128 -> FStar.UInt128.(x <=^ y)
+    | Signed W8 -> FStar.Int8.(x <=^ y)
+    | Signed W16 -> FStar.Int16.(x <=^ y)
+    | Signed W32 -> FStar.Int32.(x <=^ y)
+    | Signed W64 -> FStar.Int64.(x <=^ y)
+    | Signed W128 -> FStar.Int128.(x <=^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( / ) (#sw:signed_width{sw <> Unsigned W128})
+          (x:int_t sw)
+          (y:int_t sw{0 <> (v y <: Prims.int) /\
+                      (match sw with
+                       | Unsigned _ -> within_bounds sw (v x / v y)
+                       | Signed _ -> within_bounds sw (v x `FStar.Int.op_Slash` v y))})
+   : Tot (int_t sw)
+   = match sw with
+     | Signed Winfinite -> x / y
+     | Unsigned W8 -> FStar.UInt8.(x /^ y)
+     | Unsigned W16 -> FStar.UInt16.(x /^ y)
+     | Unsigned W32 -> FStar.UInt32.(x /^ y)
+     | Unsigned W64 -> FStar.UInt64.(x /^ y)
+     | Signed W8 -> FStar.Int8.(x /^ y)
+     | Signed W16 -> FStar.Int16.(x /^ y)
+     | Signed W32 -> FStar.Int32.(x /^ y)
+     | Signed W64 -> FStar.Int64.(x /^ y)
+     | Signed W128 -> FStar.Int128.(x /^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( % ) (#sw:signed_width{sw <> Unsigned W128})
+          (x:int_t sw)
+          (y:int_t sw{0 <> (v y <: Prims.int) /\
+                      (match sw with
+                       | Unsigned _ -> within_bounds sw (FStar.UInt.mod #(nat_of_fixed_width (width_of_sw sw)) (v x) (v y))
+                       | Signed Winfinite -> True
+                       | Signed _ -> within_bounds sw (FStar.Int.mod #(nat_of_fixed_width (width_of_sw sw)) (v x) (v y))) /\
+                       within_bounds sw (FStar.Int.op_Slash (v x) (v y))})
+   : Tot (int_t sw)
+   = match sw with
+     | Signed Winfinite -> x % y
+     | Unsigned W8 -> FStar.UInt8.(x %^ y)
+     | Unsigned W16 -> FStar.UInt16.(x %^ y)
+     | Unsigned W32 -> FStar.UInt32.(x %^ y)
+     | Unsigned W64 -> FStar.UInt64.(x %^ y)
+     | Signed W8 -> FStar.Int8.(x %^ y)
+     | Signed W16 -> FStar.Int16.(x %^ y)
+     | Signed W32 -> FStar.Int32.(x %^ y)
+     | Signed W64 -> FStar.Int64.(x %^ y)
+     | Signed W128 -> FStar.Int128.(x %^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( ^^ ) #sw (x:int_t sw) (y:int_t sw{width_of_sw sw <> Winfinite})
+    : Tot (int_t sw)
+    = match sw with
+      | Unsigned W8 -> FStar.UInt8.(x ^^ y)
+      | Unsigned W16 -> FStar.UInt16.(x ^^ y)
+      | Unsigned W32 -> FStar.UInt32.(x ^^ y)
+      | Unsigned W64 -> FStar.UInt64.(x ^^ y)
+      | Unsigned W128 -> FStar.UInt128.(x ^^ y)
+      | Signed W8 -> FStar.Int8.(x ^^ y)
+      | Signed W16 -> FStar.Int16.(x ^^ y)
+      | Signed W32 -> FStar.Int32.(x ^^ y)
+      | Signed W64 -> FStar.Int64.(x ^^ y)
+      | Signed W128 -> FStar.Int128.(x ^^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( &^ ) #sw (x:int_t sw) (y:int_t sw{width_of_sw sw <> Winfinite})
+    : Tot (int_t sw)
+    = match sw with
+      | Unsigned W8 -> FStar.UInt8.(x &^ y)
+      | Unsigned W16 -> FStar.UInt16.(x &^ y)
+      | Unsigned W32 -> FStar.UInt32.(x &^ y)
+      | Unsigned W64 -> FStar.UInt64.(x &^ y)
+      | Unsigned W128 -> FStar.UInt128.(x &^ y)
+      | Signed W8 -> FStar.Int8.(x &^ y)
+      | Signed W16 -> FStar.Int16.(x &^ y)
+      | Signed W32 -> FStar.Int32.(x &^ y)
+      | Signed W64 -> FStar.Int64.(x &^ y)
+      | Signed W128 -> FStar.Int128.(x &^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( |^ ) #sw (x:int_t sw) (y:int_t sw{width_of_sw sw <> Winfinite})
+    : Tot (int_t sw)
+    = match sw with
+      | Unsigned W8 -> FStar.UInt8.(x |^ y)
+      | Unsigned W16 -> FStar.UInt16.(x |^ y)
+      | Unsigned W32 -> FStar.UInt32.(x |^ y)
+      | Unsigned W64 -> FStar.UInt64.(x |^ y)
+      | Unsigned W128 -> FStar.UInt128.(x |^ y)
+      | Signed W8 -> FStar.Int8.(x |^ y)
+      | Signed W16 -> FStar.Int16.(x |^ y)
+      | Signed W32 -> FStar.Int32.(x |^ y)
+      | Signed W64 -> FStar.Int64.(x |^ y)
+      | Signed W128 -> FStar.Int128.(x |^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( <<^ ) #sw (x:int_t sw{0 <= v x})
+                (y:int_t (Unsigned W32){width_of_sw sw <> Winfinite /\ v y < nat_of_fixed_width (width_of_sw sw) /\ (Signed? sw ==> within_bounds sw (v x * pow2 (v y)))})
+    : Tot (int_t sw)
+    = match sw with
+      | Unsigned W8 -> FStar.UInt8.(x <<^ y)
+      | Unsigned W16 -> FStar.UInt16.(x <<^ y)
+      | Unsigned W32 -> FStar.UInt32.(x <<^ y)
+      | Unsigned W64 -> FStar.UInt64.(x <<^ y)
+      | Unsigned W128 -> FStar.UInt128.(x <<^ y)
+      | Signed W8 -> FStar.Int8.(x <<^ y)
+      | Signed W16 -> FStar.Int16.(x <<^ y)
+      | Signed W32 -> FStar.Int32.(x <<^ y)
+      | Signed W64 -> FStar.Int64.(x <<^ y)
+      | Signed W128 -> FStar.Int128.(x <<^ y)
+
[@@mark_for_norm; strict_on_arguments [0]]
+unfold
+noextract
+let ( >>^ ) #sw (x:int_t sw{0 <= v x})
+                (y:int_t (Unsigned W32){width_of_sw sw <> Winfinite /\ v y < nat_of_fixed_width (width_of_sw sw)})
+    : Tot (int_t sw)
+    = match sw with
+      | Unsigned W8 -> FStar.UInt8.(x >>^ y)
+      | Unsigned W16 -> FStar.UInt16.(x >>^ y)
+      | Unsigned W32 -> FStar.UInt32.(x >>^ y)
+      | Unsigned W64 -> FStar.UInt64.(x >>^ y)
+      | Unsigned W128 -> FStar.UInt128.(x >>^ y)
+      | Signed W8 -> FStar.Int8.(x >>^ y)
+      | Signed W16 -> FStar.Int16.(x >>^ y)
+      | Signed W32 -> FStar.Int32.(x >>^ y)
+      | Signed W64 -> FStar.Int64.(x >>^ y)
+      | Signed W128 -> FStar.Int128.(x >>^ y)
+
[@@mark_for_norm]
+unfold
+let uint_8   = int_t (Unsigned W8)
+
[@@mark_for_norm]
+unfold
+let uint_16  = int_t (Unsigned W16)
+
[@@mark_for_norm]
+unfold
+let uint_32  = int_t (Unsigned W32)
+
[@@mark_for_norm]
+unfold
+let uint_64  = int_t (Unsigned W64)
+
[@@mark_for_norm]
+unfold
+let int       = int_t (Signed Winfinite)
+
[@@mark_for_norm]
+unfold
+let int_8   = int_t (Signed W8)
+
[@@mark_for_norm]
+unfold
+let int_16  = int_t (Signed W16)
+
[@@mark_for_norm]
+unfold
+let int_32  = int_t (Signed W32)
+
[@@mark_for_norm]
+unfold
+let int_64  = int_t (Signed W64)
+
[@@mark_for_norm]
+unfold
+let int_128 = int_t (Signed W128)
+
[@@mark_for_norm]
+unfold
+let ok #sw
+       (op:(int_t (Signed Winfinite)
+          -> int_t (Signed Winfinite)
+          -> int_t (Signed Winfinite)))
+       (x:int_t sw)
+       (y:int_t sw)
+   = within_bounds sw (op (v x) (v y))
+
[@@mark_for_norm]
+unfold
+let nat = i:int{ i >= 0 }
+
[@@mark_for_norm]
+unfold
+let pos = i:nat{ 0 < i }
+

////////////////////////////////////////////////////////////////////////////// +Test +//////////////////////////////////////////////////////////////////////////////

+
let f_int (x:int) (y:int) = x + y
+let f_nat (x:nat) (y:nat) = x + y
+let f_nat_int_pos (x:nat) (y:int) (z:pos) = x + y + z
+let f_uint_8 (x:uint_8) (y:uint_8{ok (+) x y}) = x + y
+let f_int_16 (x:int_16) (y:int_16{ok (+) x y}) = x + y
+let g (x:uint_32) (y:uint_32{ok ( * ) y y /\ ok (+) x (y * y)}) = x + y * y
+let h (x:Prims.nat) (y:Prims.nat): nat  = u x + u y
+let i (x:Prims.nat) (y:Prims.nat) = x + y
+let j (x:Prims.int) (y:Prims.nat) = x - y
+let k (x:Prims.int) (y:Prims.int) = x * y
+ diff --git a/docs/FStar.LexicographicOrdering.html b/docs/FStar.LexicographicOrdering.html new file mode 100644 index 0000000..e5b1fa1 --- /dev/null +++ b/docs/FStar.LexicographicOrdering.html @@ -0,0 +1,179 @@ + + + + + FStar.LexicographicOrdering + + + +

Copyright 2021 Microsoft Research

+

Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at

+
http://www.apache.org/licenses/LICENSE-2.0
+
+

Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License.

+

Authors: Aseem Rastogi and Nikhil Swamy

+

+FStar.LexicographicOrdering

+
+

This module proves that lexicographic ordering is well-founded +(i.e. every element is accessible)

+

It defines the lex relation as an inductive, and prove its well-foundedness

+

Since SMT proofs in F* are more amenable to squashed definitions, +the module also defines a squashed version of the lex relation, +and prove its well-foundedness, reusing the proof for the constructive version

+

See tests/micro-benchmarks/Test.WellFoundedRecursion.fst for +how we use squashed lex to prove termination for the ackermann function

+

Finally, the module defines a non-dependent version of lex +(in-terms of dependent lex), and uses it to prove well-foundedness of symmetric products too

+

Some references:

+ +
+ +
+

Definition of lexicographic ordering as a relation over dependent tuples

+

Two elements are related if:

+ +
+
noeq
+type lex_t (#a:Type) (#b:a -> Type) (r_a:relation a) (r_b:(x:a -> relation (b x)))
+  : (x:a & b x) -> (x:a & b x) -> Type =
+  | Left_lex:
+    x1:a -> x2:a ->
+    y1:b x1 -> y2:b x2 ->
+    r_a x1 x2 ->
+    lex_t r_a r_b (| x1, y1 |) (| x2, y2 |)
+  | Right_lex:
+    x:a ->
+    y1:b x -> y2:b x ->
+    r_b x y1 y2 ->
+    lex_t r_a r_b (| x, y1 |) (| x, y2 |)
+
+

Given two well-founded relations r_a and r_b, +their lexicographic ordering is also well-founded

+
+
val lex_t_wf (#a:Type) (#b:a -> Type)
+  (#r_a:relation a)
+  (#r_b:(x:a -> relation (b x)))
+  (wf_a:well_founded r_a)
+  (wf_b:(x:a -> well_founded (r_b x)))
+  : well_founded (lex_t r_a r_b)
+
+

We can also define a squashed version of lex relation

+
+
unfold
+let lex_aux (#a:Type) (#b:a -> Type)
+  (r_a:relation a)
+  (r_b:(x:a -> relation (b x)))
+  : relation (x:a & b x)
+  = fun (| x1, y1 |) (| x2, y2 |) ->
+    (squash (r_a x1 x2)) \/
+    (x1 == x2 /\ squash ((r_b x1) y1 y2))
+
+

Provide a mapping from a point in lex_aux to a squashed point in lex

+
+
val lex_to_lex_t (#a:Type) (#b:a -> Type)
+  (r_a:relation a)
+  (r_b:(x:a -> relation (b x)))
+  (t1 t2:(x:a & b x))
+  (p:lex_aux r_a r_b t1 t2)
+  : squash (lex_t r_a r_b t1 t2)
+
+

And prove that is it is well-founded

+
+
let lex_wf (#a:Type) (#b:a -> Type)
+  (#r_a:relation a)
+  (#r_b:(x:a -> relation (b x)))
+  (wf_a:well_founded r_a)
+  (wf_b:(x:a -> well_founded (r_b x)))
+  : Lemma (is_well_founded (lex_aux r_a r_b))
+  = subrelation_squash_wf (lex_to_lex_t r_a r_b) (lex_t_wf wf_a wf_b)
+
+

A user-friendly lex_wf that returns a well-founded relation

+
+
unfold
+let lex (#a:Type) (#b:a -> Type)
+  (#r_a:relation a)
+  (#r_b:(x:a -> relation (b x)))
+  (wf_a:well_founded r_a)
+  (wf_b:(x:a -> well_founded (r_b x)))
+  : well_founded_relation (x:a & b x)
+  = lex_wf wf_a wf_b;
+    lex_aux r_a r_b
+
+

We can also define a non-dependent version of the lex ordering, +in terms of the dependent lex tuple, +and prove its well-foundedness

+
+
let tuple_to_dep_tuple (#a #b:Type) (x:a & b) : dtuple2 a (fun _ -> b) =
+  (| fst x, snd x |)
+
+

The non-dependent lexicographic ordering +and its well-foundedness

+
+
let lex_t_non_dep (#a #b:Type) (r_a:relation a) (r_b:relation b)
+  : relation (a & b)
+  = fun x y ->
+    lex_t r_a (fun _ -> r_b) (tuple_to_dep_tuple x) (tuple_to_dep_tuple y)
+
val lex_t_non_dep_wf (#a #b:Type) (#r_a:relation a) (#r_b:relation b)
+  (wf_a:well_founded r_a)
+  (wf_b:well_founded r_b)
+  : well_founded (lex_t_non_dep r_a r_b)
+
+

Symmetric product relation +we can prove its well-foundedness by showing that it is a subrelation of non-dep lex

+
+
noeq
+type sym (#a:Type) (#b:Type) (r_a:relation a) (r_b:relation b)
+  : (a & b) -> (a & b) -> Type =
+  | Left_sym:
+    x1:a -> x2:a ->
+    y:b ->
+    r_a x1 x2 ->
+    sym r_a r_b (x1, y) (x2, y)
+  | Right_sym:
+    x:a ->
+    y1:b -> y2:b ->
+    r_b y1 y2 ->
+    sym r_a r_b (x, y1) (x, y2)
+
+

sym is a subrelation of non-dependent lex

+
+
let sym_sub_lex (#a #b:Type) (#r_a:relation a) (#r_b:relation b)
+  (t1 t2:a & b)
+  (p:sym r_a r_b t1 t2)
+  : lex_t_non_dep r_a r_b t1 t2
+  = match p with
+    | Left_sym x1 x2 y p ->
+      Left_lex #a #(fun _ -> b) #r_a #(fun _ -> r_b) x1 x2 y y p
+    | Right_sym x y1 y2 p ->
+      Right_lex #a #(fun _ -> b) #r_a #(fun _ -> r_b) x y1 y2 p
+
+

Theorem for symmetric product

+
+
let sym_wf (#a #b:Type)
+  (#r_a:relation a)
+  (#r_b:relation b)
+  (wf_a:well_founded r_a)
+  (wf_b:well_founded r_b)
+  : well_founded (sym r_a r_b)
+  = subrelation_wf sym_sub_lex (lex_t_non_dep_wf wf_a wf_b)
+ + + diff --git a/docs/FStar.List.Pure.Base.html b/docs/FStar.List.Pure.Base.html index 4e6c867..1e37e76 100644 --- a/docs/FStar.List.Pure.Base.html +++ b/docs/FStar.List.Pure.Base.html @@ -1,62 +1,72 @@ - - + + - - - - - - + FStar.List.Pure.Base + -

module FStar.List.Pure.Base

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
 Functions on list with a pure specification
-
val map2:#a1:Type -> #a2:Type -> #b:Type -> f:Unidentified product: [a1] Unidentified product: [a2] b -> l1:list a1 -> l2:list a2 -> (Pure (list b) ((requires (==(length l1, length l2)))) ((ensures ((fun _ -> True)))) (decreases l1))
-

[map2] takes a pair of list of the same length [x1; ...; xn] [y1; ... ; yn] and return the list [f x1 y1; ... ; f xn yn]

-
val map3:#a1:Type -> #a2:Type -> #a3:Type -> #b:Type -> f:Unidentified product: [a1] Unidentified product: [a2] Unidentified product: [a3] b -> l1:list a1 -> l2:list a2 -> l3:list a3 -> (Pure (list b) ((requires (let  n = length l1 in (/\(==(n, length l2), ==(n, length l3)))))) ((ensures ((fun _ -> True)))) (decreases l1))
-

[map3] takes three lists of the same length [x1; ...; xn][y1; ... ; yn] [z1; ... ; zn] and return the list [f x1 y1 z1; ... ; f xn yn zn]

-
val zip:#a1:Type -> #a2:Type -> l1:list a1 -> l2:list a2 -> (Pure (list (*(a1, a2))) ((requires (let  n = length l1 in ==(n, length l2)))) ((ensures ((fun _ -> True)))))
-

[zip] takes a pair of list of the same length and returns the list of index-wise pairs

-
val zip3:#a1:Type -> #a2:Type -> #a3:Type -> l1:list a1 -> l2:list a2 -> l3:list a3 -> (Pure (list (*(*(a1, a2), a3))) ((requires (let  n = length l1 in /\(==(n, length l2), ==(n, length l3))))) ((ensures ((fun _ -> True)))))
-

[zip3] takes a 3-tuple of list of the same length and returns the list of index-wise 3-tuples

+

+FStar.List.Pure.Base

+ +

Functions on list with a pure specification

+

+map2

+

map2 takes a pair of list of the same length x1; ...; xn y1; ... ; yn +and return the list f x1 y1; ... ; f xn yn

+
val map2 (#a1 #a2 #b: Type)
+  (f: a1 -> a2 -> b)
+  (l1:list a1)
+  (l2:list a2)
+  : Pure (list b)
+    (requires (length l1 == length l2))
+    (ensures (fun _ -> True))
+    (decreases l1)
+let rec map2 #a1 #a2 #b f l1 l2 =
+  match l1, l2 with
+  | [], [] -> []
+  | x1::xs1, x2::xs2 -> f x1 x2 :: map2 f xs1 xs2
+

+map3

+

map3 takes three lists of the same length x1; ...; xn +y1; ... ; yn z1; ... ; zn and return the list +f x1 y1 z1; ... ; f xn yn zn

+
val map3 (#a1 #a2 #a3 #b: Type)
+  (f: a1 -> a2 -> a3 -> b)
+  (l1:list a1)
+  (l2:list a2)
+  (l3:list a3)
+  : Pure (list b)
+    (requires (let n = length l1 in
+      (n == length l2 /\
+        n == length l3)))
+    (ensures (fun _ -> True))
+    (decreases l1)
+let rec map3 #a1 #a2 #a3 #b f l1 l2 l3 =
+  match l1, l2, l3 with
+  | [], [], [] -> []
+  | x1::xs1, x2::xs2, x3::xs3 -> f x1 x2 x3 :: map3 f xs1 xs2 xs3
+

+zip

+

zip takes a pair of list of the same length and returns +the list of index-wise pairs

+
val zip (#a1 #a2:Type) (l1:list a1) (l2:list a2)
+  : Pure (list (a1 * a2))
+    (requires (let n = length l1 in n == length l2))
+    (ensures (fun _ -> True))
+let zip #a1 #a2 l1 l2 = map2 (fun x y -> x, y) l1 l2
+

+zip3

+

zip3 takes a 3-tuple of list of the same length and returns +the list of index-wise 3-tuples

+
val zip3 (#a1 #a2 #a3:Type) (l1:list a1) (l2:list a2) (l3:list a3)
+  : Pure (list (a1 * a2 * a3))
+    (requires (let n = length l1 in n == length l2 /\ n == length l3))
+    (ensures (fun _ -> True))
+let zip3 #a1 #a2 #a3 l1 l2 l3 = map3 (fun x y z -> x,y,z) l1 l2 l3
+ diff --git a/docs/FStar.List.Pure.Properties.html b/docs/FStar.List.Pure.Properties.html index 5e07ddb..5dd24b3 100644 --- a/docs/FStar.List.Pure.Properties.html +++ b/docs/FStar.List.Pure.Properties.html @@ -1,84 +1,271 @@ - - + + - - - - - - + FStar.List.Pure.Properties + -

module FStar.List.Pure.Properties

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
 Properties of splitAt
-
let ((lemma_splitAt_append (#a:Type) (n:nat) (l:list a)):(Lemma ((requires <=(n, length l))) ((ensures (let  (l1, l2) = splitAt n l in /\(==(append l1 l2, l), =(length l1, n))))))):match n with 0  -> () | _  -> match l with []  -> () | (Prims.Cons x xs)  -> lemma_splitAt_append (-(n, 1)) xs
-

If we [append] the two lists produced using a [splitAt], then we get back the original list

-
let ((lemma_append_splitAt (#t:Type) (l1:list t) (l2:list t)):(Lemma ((ensures (==(splitAt (length l1) (append l1 l2), ((FStar.Pervasives.Native.Mktuple2 l1 l2)))))))):match l1 with []  -> () | _  -> lemma_append_splitAt (tl l1) l2
-

If we [splitAt] the point at which two lists have been [append]ed, then we get back the original lists.

-
let ((lemma_splitAt (#t:Type) (l:list t) (l1:list t) (l2:list t) (n:n:nat:{<=(n, length l)})):(Lemma (<==>(==(splitAt n l, ((FStar.Pervasives.Native.Mktuple2 l1 l2))), /\(==(l, @(l1, l2)), =(length l1, n)))))):lemma_splitAt_append n l; lemma_append_splitAt l1 l2
-

Fully characterize behavior of [splitAt] in terms of more standard list concepts

-
let ((lemma_splitAt_index_hd (#t:Type) (n:nat) (l:list t)):(Lemma ((requires (<(n, length l)))) ((ensures (let  (l1, l2) = splitAt n l in splitAt_length n l; /\(>(length l2, 0), ==(hd l2, index l n))))))):let  (Prims.Cons x xs) = l in match n with 0  -> () | _  -> lemma_splitAt_index_hd (-(n, 1)) (tl l)
-

The [hd] of the second list returned via [splitAt] is the [n]th element of the original list

-
let ((lemma_splitAt_shorten_left (#t:Type) (l1:list t) (l2:list t) (i:i:nat:{/\(<=(i, length l1), <=(i, length l2))}) (j:j:nat:{<=(j, i)})):(Lemma ((requires (==(fst (splitAt i l1), fst (splitAt i l2))))) ((ensures (==(fst (splitAt j l1), fst (splitAt j l2))))))):match j with 0  -> () | _  -> lemma_splitAt_shorten_left (tl l1) (tl l2) (-(i, 1)) (-(j, 1))
-

If two lists have the same left prefix, then shorter left prefixes are also the same.

-
let ((lemma_splitAt_reindex_left (#t:Type) (i:nat) (l:list t) (j:nat)):(Lemma ((requires /\(<=(i, length l), <(j, i)))) ((ensures (let  (left, right) = splitAt i l in splitAt_length i l; /\(<(j, length left), ==(index left j, index l j))))))):match (FStar.Pervasives.Native.Mktuple2 i j) with (1, _)|
- (_, 0)  -> () | _  -> lemma_splitAt_reindex_left (-(i, 1)) (tl l) (-(j, 1))
-

Doing an [index] on the left-part of a [splitAt] is same as doing it on the original list

-
let ((lemma_splitAt_reindex_right (#t:Type) (i:nat) (l:list t) (j:nat)):(Lemma ((requires /\(<=(i, length l), <(+(j, i), length l)))) ((ensures (let  (left, right) = splitAt i l in splitAt_length i l; /\(<(j, length right), ==(index right j, index l (+(j, i))))))))):match i with 0  -> () | _  -> lemma_splitAt_reindex_right (-(i, 1)) (tl l) j
-

Doing an [index] on the right-part of a [splitAt] is same as doing it on the original list, but shifted

-
 Properties of split3
-
let ((lemma_split3_append (#t:Type) (l:list t) (n:n:nat:{<(n, length l)})):(Lemma ((requires True)) ((ensures (let  (a, b, c) = split3 l n in ==(l, append a ((Prims.Cons b c)))))))):lemma_splitAt_append n l
-

The 3 pieces returned via [split3] can be joined together via an [append] and a [cons]

-
let ((lemma_split3_index (#t:Type) (l:list t) (n:n:nat:{<(n, length l)})):(Lemma ((requires True)) ((ensures (let  (a, b, c) = split3 l n in ==(b, index l n)))))):lemma_splitAt_index_hd n l
-

The middle element returned via [split3] is the [n]th [index]ed element

-
let ((lemma_split3_length (#t:Type) (l:list t) (n:n:nat:{<(n, length l)})):(Lemma ((requires True)) ((ensures (let  (a, b, c) = split3 l n in /\(=(length a, n), =(length c, -(-(length l, n), 1)))))))):splitAt_length n l
-

The lengths of the left and right parts of a [split3] are as expected.

-
let ((lemma_split3_on_same_leftprefix (#t:Type) (l1:list t) (l2:list t) (n:n:nat:{/\(<(n, length l1), <(n, length l2))})):(Lemma ((requires (==(fst (splitAt (+(n, 1)) l1), fst (splitAt (+(n, 1)) l2))))) ((ensures (let  (a1, b1, c1) = split3 l1 n in let  (a2, b2, c2) = split3 l2 n in /\(==(a1, a2), ==(b1, b2))))))):let  (a1, b1, c1) = split3 l1 n in let  (a2, b2, c2) = split3 l2 n in lemma_split3_append l1 n; lemma_split3_append l2 n; lemma_split3_length l1 n; lemma_split3_length l2 n; append_l_cons b1 c1 a1; append_l_cons b2 c2 a2; let  (x1, y1) = splitAt (+(n, 1)) l1 in let  (x2, y2) = splitAt (+(n, 1)) l2 in lemma_splitAt_append (+(n, 1)) l1; lemma_splitAt_append (+(n, 1)) l2; splitAt_length (+(n, 1)) l1; splitAt_length (+(n, 1)) l2; append_length_inv_head x1 y1 (append a1 (Prims.Cons b1 (Prims.Nil ))) c1; append_length_inv_head x2 y2 (append a2 (Prims.Cons b2 (Prims.Nil ))) c2; append_length_inv_tail a1 (Prims.Cons b1 (Prims.Nil )) a2 (Prims.Cons b2 (Prims.Nil )); ()
-

If we [split3] on lists with the same left prefix, we get the same element and left prefix.

-
let ((lemma_split3_unsnoc (#t:Type) (l:list t) (n:n:nat:{<(n, length l)})):(Lemma ((requires (<>(n, -(length l, 1))))) ((ensures (let  (a, b, c) = split3 l n in lemma_split3_length l n; /\(>(length c, 0), (let  (xs, x) = unsnoc l in let  (ys, y) = unsnoc c in ==(append a ((Prims.Cons b ys)), xs)))))))):match n with 0  -> () | _  -> lemma_split3_unsnoc (tl l) (-(n, 1))
-

If we perform an [unsnoc] on a list, then the left part is the same as an [append]+[cons] on the list after [split3].

-
let ((lemma_unsnoc_split3 (#t:Type) (l:list t) (i:i:nat:{<(i, length l)})):(Lemma ((requires (<>(i, -(length l, 1))))) ((ensures (let  (xs, x) = unsnoc l in /\(<(i, length xs), (let  (a0, b0, c0) = split3 l i in let  (a1, b1, c1) = split3 xs i in /\(==(a0, a1), ==(b0, b1))))))))):let  (xs, x) = unsnoc l in lemma_unsnoc_length l; let  (a0, b0, c0) = split3 l i in let  (a1, b1, c1) = split3 xs i in splitAt_length_total xs; lemma_splitAt_shorten_left xs l (length xs) (+(i, 1)); lemma_split3_on_same_leftprefix l xs i
-

Doing [unsnoc] and [split3] in either order leads to the same left part, and element.

-
let ((lemma_split3_r_hd (#t:Type) (l:list t) (i:i:nat:{<(i, length l)})):(Lemma ((ensures (let  (a, b, c) = split3 l i in lemma_split3_length l i; ==>(>(length c, 0), /\(<(+(i, 1), length l), ==(hd c, index l (+(i, 1)))))))))):match i with 0  -> () | _  -> lemma_split3_r_hd (tl l) (-(i, 1))
-

The head of the right side of a [split3] can be [index]ed from original list.

+

+FStar.List.Pure.Properties

+ +

Properties of splitAt

+
let rec splitAt_length
+  (#a:Type)
+  (n:nat)
+  (l:list a)
+  : Lemma (requires True)
+    (ensures begin
+      let l_1, l_2 = splitAt n l in
+      if length l < n then
+        length l_1 == length l /\ length l_2 == 0
+      else
+        length l_1 == n /\ length l_2 = length l - n
+    end)
+    (decreases n)
+=
+  if n = 0 then ()
+  else
+    match l with
+    | [] -> ()
+    | _::xs -> splitAt_length (n-1) xs
+
let rec splitAt_assoc
+  (#a:Type)
+  (n1 n2:nat)
+  (l:list a)
+  : Lemma (requires True)
+    (ensures begin
+      let l1, l2 = splitAt n1 l in
+      let l2, l3 = splitAt n2 l2 in
+      let l1', l2' = splitAt (n1+n2) l in
+      l1' ==  l1 @ l2 /\ l2' == l3
+    end)
+    (decreases n1)
+=
+  if n1 = 0 then ()
+  else
+    match l with
+    | [] -> ()
+    | x :: xs -> splitAt_assoc (n1-1) n2 xs
+
let rec splitAt_length_total (#a:Type) (l:list a)
+  : Lemma (requires True) (ensures (splitAt (length l) l == (l, []))) (decreases l)
+=
+  match l with
+  | [] -> ()
+  | x :: xs -> splitAt_length_total xs
+

+lemma_splitAt_append

+

If we append the two lists produced using a splitAt, then we +get back the original list

+
let rec lemma_splitAt_append (#a:Type) (n:nat) (l:list a) :
+  Lemma
+    (requires n <= length l)
+    (ensures (let l1, l2 = splitAt n l in
+              append l1 l2 == l /\ length l1 = n)) =
+  match n with
+  | 0 -> ()
+  | _ ->
+    match l with
+    | [] -> ()
+    | x :: xs -> lemma_splitAt_append (n-1) xs
+

+lemma_append_splitAt

+

If we splitAt the point at which two lists have been appended, then we +get back the original lists.

+
let rec lemma_append_splitAt (#t:Type) (l1 l2:list t) :
+  Lemma
+    (ensures (splitAt (length l1) (append l1 l2) == (l1, l2))) =
+  match l1 with
+  | [] -> ()
+  | _ -> lemma_append_splitAt (tl l1) l2
+

+lemma_splitAt

+

Fully characterize behavior of splitAt in terms of more standard list concepts

+
let lemma_splitAt (#t: Type) (l l1 l2:list t) (n:nat{n <= length l}) :
+  Lemma (splitAt n l == (l1, l2) <==> l == l1 @ l2 /\ length l1 = n) =
+  lemma_splitAt_append n l;
+  lemma_append_splitAt l1 l2
+

+lemma_splitAt_index_hd

+

The hd of the second list returned via splitAt is the nth element of +the original list

+
let rec lemma_splitAt_index_hd (#t:Type) (n:nat) (l:list t) :
+  Lemma
+    (requires (n < length l))
+    (ensures (let l1, l2 = splitAt n l in
+              splitAt_length n l;
+              length l2 > 0 /\ hd l2 == index l n)) =
+  let x :: xs = l in
+  match n with
+  | 0 -> ()
+  | _ -> lemma_splitAt_index_hd (n - 1) (tl l)
+

+lemma_splitAt_shorten_left

+

If two lists have the same left prefix, then shorter left prefixes are +also the same.

+
let rec lemma_splitAt_shorten_left
+    (#t:Type) (l1 l2:list t) (i:nat{i <= length l1 /\ i <= length l2}) (j:nat{j <= i}) :
+  Lemma
+    (requires (fst (splitAt i l1) == fst (splitAt i l2)))
+    (ensures (fst (splitAt j l1) == fst (splitAt j l2))) =
+  match j with
+  | 0 -> ()
+  | _ ->
+    lemma_splitAt_shorten_left (tl l1) (tl l2) (i-1) (j-1)
+

+lemma_splitAt_reindex_left

+

Doing an index on the left-part of a splitAt is same as doing it on +the original list

+
let rec lemma_splitAt_reindex_left (#t:Type) (i:nat) (l:list t) (j:nat) :
+  Lemma
+    (requires i <= length l /\ j < i)
+    (ensures (
+        let left, right = splitAt i l in
+        splitAt_length i l;
+        j < length left /\ index left j == index l j)) =
+  match i, j with
+  | 1, _ | _, 0 -> ()
+  | _ -> lemma_splitAt_reindex_left (i - 1) (tl l) (j - 1)
+

+lemma_splitAt_reindex_right

+

Doing an index on the right-part of a splitAt is same as doing it on +the original list, but shifted

+
let rec lemma_splitAt_reindex_right (#t:Type) (i:nat) (l:list t) (j:nat) :
+  Lemma
+    (requires i <= length l /\ j + i < length l)
+    (ensures (
+        let left, right = splitAt i l in
+        splitAt_length i l;
+        j < length right /\ index right j == index l (j + i))) =
+  match i with
+  | 0 -> ()
+  | _ -> lemma_splitAt_reindex_right (i - 1) (tl l) j
+

Properties of split3

+

+lemma_split3_append

+

The 3 pieces returned via split3 can be joined together via an +append and a cons

+
let lemma_split3_append (#t:Type) (l:list t) (n:nat{n < length l}) :
+  Lemma
+    (requires True)
+    (ensures (
+        let a, b, c = split3 l n in
+        l == append a (b :: c))) =
+  lemma_splitAt_append n l
+

+lemma_split3_index

+

The middle element returned via split3 is the nth indexed element

+
let lemma_split3_index (#t:Type) (l:list t) (n:nat{n < length l}) :
+  Lemma
+    (requires True)
+    (ensures (
+        let a, b, c = split3 l n in
+        b == index l n)) =
+  lemma_splitAt_index_hd n l
+

+lemma_split3_length

+

The lengths of the left and right parts of a split3 are as expected.

+
let lemma_split3_length (#t:Type) (l:list t) (n:nat{n < length l}) :
+  Lemma
+    (requires True)
+    (ensures (
+        let a, b, c = split3 l n in
+        length a = n /\ length c = length l - n - 1)) =
+  splitAt_length n l
+

+lemma_split3_on_same_leftprefix

+

If we split3 on lists with the same left prefix, we get the same +element and left prefix.

+
let lemma_split3_on_same_leftprefix
+    (#t:Type) (l1 l2:list t) (n:nat{n < length l1 /\ n < length l2}) :
+  Lemma
+    (requires (fst (splitAt (n+1) l1) == fst (splitAt (n+1) l2)))
+    (ensures (let a1, b1, c1 = split3 l1 n in
+              let a2, b2, c2 = split3 l2 n in
+              a1 == a2 /\ b1 == b2)) =
+  let a1, b1, c1 = split3 l1 n in
+  let a2, b2, c2 = split3 l2 n in
+  lemma_split3_append l1 n;
+  lemma_split3_append l2 n;
+  lemma_split3_length l1 n;
+  lemma_split3_length l2 n;
+  append_l_cons b1 c1 a1;
+  append_l_cons b2 c2 a2;
+

assert ((a1 @ b1) @ c1 == l1); +assert ((a2 @ b2) @ c2 == l2); +assert (x1 @ y1 == (a1 @ b1) @ c1); +assert (x2 @ y2 == (a2 @ b2) @ c2); +assert (a1 @ b1 == a2 @ b2); +assert (a1 == a2 /\ b1 == b2);

+
let x1, y1 = splitAt (n+1) l1 in
+let x2, y2 = splitAt (n+1) l2 in
+lemma_splitAt_append (n+1) l1;
+lemma_splitAt_append (n+1) l2;
+splitAt_length (n+1) l1;
+splitAt_length (n+1) l2;
+append_length_inv_head x1 y1 (append a1 [b1]) c1;
+append_length_inv_head x2 y2 (append a2 [b2]) c2;
+append_length_inv_tail a1 [b1] a2 [b2];
+()
+

+lemma_split3_unsnoc

+

If we perform an unsnoc on a list, then the left part is the same +as an append+cons on the list after split3.

+
let rec lemma_split3_unsnoc (#t:Type) (l:list t) (n:nat{n < length l}) :
+  Lemma
+    (requires (n <> length l - 1))
+    (ensures (
+        let a, b, c = split3 l n in
+        lemma_split3_length l n;
+        length c > 0 /\ (
+          let xs, x = unsnoc l in
+          let ys, y = unsnoc c in
+          append a (b :: ys) == xs))) =
+  match n with
+  | 0 -> ()
+  | _ -> lemma_split3_unsnoc (tl l) (n-1)
+

+lemma_unsnoc_split3

+

Doing unsnoc and split3 in either order leads to the same left +part, and element.

+
let lemma_unsnoc_split3 (#t:Type) (l:list t) (i:nat{i < length l}) :
+  Lemma
+    (requires (i <> length l - 1))
+    (ensures (
+        let xs, x = unsnoc l in
+        i < length xs /\ (
+            let a0, b0, c0 = split3 l i in
+            let a1, b1, c1 = split3 xs i in
+            a0 == a1 /\ b0 == b1))) =
+  let xs, x = unsnoc l in
+  lemma_unsnoc_length l;
+  let a0, b0, c0 = split3 l i in
+  let a1, b1, c1 = split3 xs i in
+  splitAt_length_total xs;
+

assert (fst (splitAt (length xs) xs) == xs); +assert (fst (splitAt (length xs) xs) == fst (splitAt (length xs) l)); +assert (i+1 <= length xs); +assert (fst (splitAt (i+1) xs) == fst (splitAt (i+1) l));

+
lemma_splitAt_shorten_left xs l (length xs) (i+1);
+lemma_split3_on_same_leftprefix l xs i
+

+lemma_split3_r_hd

+

The head of the right side of a split3 can be indexed from original list.

+
let rec lemma_split3_r_hd (#t:Type) (l:list t) (i:nat{i < length l}) :
+  Lemma
+    (ensures (let a, b, c = split3 l i in
+              lemma_split3_length l i;
+              length c > 0 ==> i + 1 < length l /\ hd c == index l (i + 1))) =
+  match i with
+  | 0 -> ()
+  | _ -> lemma_split3_r_hd (tl l) (i - 1)
+ diff --git a/docs/FStar.List.Pure.html b/docs/FStar.List.Pure.html index f81f463..0979a24 100644 --- a/docs/FStar.List.Pure.html +++ b/docs/FStar.List.Pure.html @@ -1,16 +1,21 @@ - - + + - - - - - + FStar.List.Pure + -

module FStar.List.Pure

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.List.Pure

+ + diff --git a/docs/FStar.List.Tot.Base.html b/docs/FStar.List.Tot.Base.html index 956f9bf..f3193ca 100644 --- a/docs/FStar.List.Tot.Base.html +++ b/docs/FStar.List.Tot.Base.html @@ -1,180 +1,595 @@ - - + + - - - - - - + FStar.List.Tot.Base + -

module FStar.List.Tot.Base

-

Pure total operations on lists

-

This module defines all pure and total operations on lists that can be used in specifications.

-

-Base operations
-
val isEmpty:Unidentified product: [list 'a] (Tot bool)
-

[isEmpty l] returns [true] if and only if [l] is empty

-
val hd:Unidentified product: [l:l:list 'a:{Cons? l}] (Tot 'a)
-

[hd l] returns the first element of [l]. Requires [l] to be nonempty, at type-checking time. Named as in: OCaml, F#, Coq

-
val tail:Unidentified product: [l:l:list 'a:{Cons? l}] (Tot (list 'a))
-

[tail l] returns [l] without its first element. Requires, at type-checking time, that [l] be nonempty. Similar to: tl in OCaml, F#, Coq

-
val tl:Unidentified product: [l:l:list 'a:{Cons? l}] (Tot (list 'a))
-

[tl l] returns [l] without its first element. Requires, at type-checking time, that [l] be nonempty. Named as in: OCaml, F#, Coq

-
val last:Unidentified product: [l:l:list 'a:{Cons? l}] (Tot 'a)
-

[last l] returns the last element of [l]. Requires, at type-checking time, that [l] be nonempty. Named as in: Haskell

-
val init:Unidentified product: [l:l:list 'a:{Cons? l}] (Tot (list 'a))
-

[init l] returns [l] without its last element. Requires, at type-checking time, that [l] be nonempty. Named as in: Haskell

-
val length:Unidentified product: [list 'a] (Tot nat)
-

[length l] returns the total number of elements in [l]. Named as in: OCaml, F#, Coq

-
val nth:Unidentified product: [list 'a] Unidentified product: [nat] (Tot (option 'a))
-

[nth l n] returns the [n]-th element in list [l] (with the first element being the 0-th) if [l] is long enough, or [None] otherwise. Named as in: OCaml, F#, Coq

-
val index:Unidentified product: [#a:Type] Unidentified product: [l:list a] Unidentified product: [i:i:nat:{<(i, length l)}] (Tot a)
-

[index l n] returns the [n]-th element in list [l] (with the first element being the 0-th). Requires, at type-checking time, that [l] be of length at least [n+1].

-
val count:Unidentified product: [#a:eqtype] Unidentified product: [a] Unidentified product: [list a] (Tot nat)
-

[count x l] returns the number of occurrences of [x] in [l]. Requires, at type-checking time, the type of [a] to have equality defined. Similar to: [List.count_occ] in Coq.

-
val rev_acc:Unidentified product: [list 'a] Unidentified product: [list 'a] (Tot (list 'a))
-

[rev_acc l1 l2] appends the elements of [l1] to the beginning of [l2], in reverse order. It is equivalent to [append (rev l1) l2], but is tail-recursive. Similar to: [List.rev_append] in OCaml, Coq.

-
val rev:Unidentified product: [list 'a] (Tot (list 'a))
-

[rev l] returns the list [l] in reverse order. Named as in: OCaml, F#, Coq.

-
val append:Unidentified product: [list 'a] Unidentified product: [list 'a] (Tot (list 'a))
-

[append l1 l2] appends the elements of [l2] to the end of [l1]. Named as: OCaml, F#. Similar to: [List.app] in Coq.

-
let (op_At x y):append x y
-

Defines notation [@] for [append], as in OCaml, F# .

-
val snoc:Unidentified product: [(*(list 'a, 'a))] (Tot (list 'a))
-

[snoc (l, x)] adds [x] to the end of the list [l].

-
Note: We use an uncurried [snoc (l, x)] instead of the curried
-[snoc l x]. This is intentional. If [snoc] takes a pair instead
+

+FStar.List.Tot.Base

+
This module defines all pure and total operations on lists that can be
+used in specifications. It is implemented by FStar_List_Tot_Base.ml, any
+functional change and/or the addition of new functions MUST be reflected
+there.

+
@summary Pure total operations on lists

+
Base operations

+

+isEmpty

+
isEmpty l returns true if and only if l is empty

+
val isEmpty: list 'a -> Tot bool
+let isEmpty l = match l with
+  | [] -> true
+  | _ -> false

+

+hd

+
hd l returns the first element of l. Requires l to be
+nonempty, at type-checking time. Named as in: OCaml, F#, Coq

+
val hd: l:list 'a{Cons? l} -> Tot 'a
+let hd = function
+  | hd::_ -> hd

+

+tail

+
tail l returns l without its first element. Requires, at
+type-checking time, that l be nonempty. Similar to: tl in OCaml, F#, Coq

+
val tail: l:list 'a {Cons? l} -> Tot (list 'a)
+let tail = function
+  | _::tl -> tl

+

+tl

+
tl l returns l without its first element. Requires, at
+type-checking time, that l be nonempty. Named as in: OCaml, F#, Coq

+
val tl: l:list 'a {Cons? l} -> Tot (list 'a)
+let tl = tail

+

+last

+
last l returns the last element of l. Requires, at
+type-checking time, that l be nonempty. Named as in: Haskell

+
val last: l:list 'a {Cons? l} -> Tot 'a
+let rec last = function
+  | [hd] -> hd
+  | _::tl -> last tl

+

+init

+
init l returns l without its last element. Requires, at
+type-checking time, that l be nonempty. Named as in: Haskell

+
val init: l:list 'a {Cons? l} -> Tot (list 'a)
+let rec init = function
+  | [_] -> []
+  | hd::tl -> hd::(init tl)

+

+length

+
length l returns the total number of elements in l. Named as
+in: OCaml, F#, Coq

+
val length: list 'a -> Tot nat
+let rec length = function
+  | [] -> 0
+  | _::tl -> 1 + length tl

+

+nth

+
nth l n returns the n-th element in list l (with the first
+element being the 0-th) if l is long enough, or None
+otherwise. Named as in: OCaml, F#, Coq

+
val nth: list 'a -> nat -> Tot (option 'a)
+let rec nth l n = match l with
+  | []     -> None
+  | hd::tl -> if n = 0 then Some hd else nth tl (n - 1)

+

+index

+
index l n returns the n-th element in list l (with the first
+element being the 0-th). Requires, at type-checking time, that l be
+of length at least n+1.

+
val index: #a:Type -> l:list a -> i:nat{i < length l} -> Tot a
+let rec index #a (l: list a) (i:nat{i < length l}): Tot a =
+  if i = 0 then
+    hd l
+  else
+    index (tl l) (i - 1)

+

+count

+
count x l returns the number of occurrences of x in
+l. Requires, at type-checking time, the type of a to have equality
+defined. Similar to: List.count_occ in Coq.

+
val count: #a:eqtype -> a -> list a -> Tot nat
+let rec count #a x = function
+  | [] -> 0
+  | hd::tl -> if x=hd then 1 + count x tl else count x tl

+

+rev_acc

+
rev_acc l1 l2 appends the elements of l1 to the beginning of
+l2, in reverse order. It is equivalent to append (rev l1) l2, but
+is tail-recursive. Similar to: List.rev_append in OCaml, Coq.

+
val rev_acc: list 'a -> list 'a -> Tot (list 'a)
+let rec rev_acc l acc = match l with
+    | [] -> acc
+    | hd::tl -> rev_acc tl (hd::acc)

+

+rev

+
rev l returns the list l in reverse order. Named as in: OCaml,
+F#, Coq.

+
val rev: list 'a -> Tot (list 'a)
+let rev l = rev_acc l []

+

+append

+
append l1 l2 appends the elements of l2 to the end of l1. Named as: OCaml, F#. Similar to: List.app in Coq.

+
val append: list 'a -> list 'a -> Tot (list 'a)
+let rec append x y = match x with
+  | [] -> y
+  | a::tl -> a::append tl y

+

+op_At

+
Defines notation @@ for append, as in OCaml, F# .

+
let op_At x y = append x y

+

+snoc

+
snoc (l, x) adds x to the end of the list l.

+
val snoc: (list 'a * 'a) -> Tot (list 'a)
+let snoc (l, x) = append l [x]

+
Note: We use an uncurried snoc (l, x) instead of the curried
+snoc l x. This is intentional. If snoc takes a pair instead
 of 2 arguments, it allows for a better pattern on
-[lemma_unsnoc_snoc], which connects [snoc] and [unsnoc]. In
+lemma_unsnoc_snoc, which connects snoc and unsnoc. In
 particular, if we had two arguments, then either the pattern would
 either be too restrictive or would lead to over-triggering. More
 context for this can be seen in the (collapsed and uncollapsed)
-comments at https://github.com/FStarLang/FStar/pull/1560
-
val flatten:Unidentified product: [list (list 'a)] (Tot (list 'a))
-

[flatten l], where [l] is a list of lists, returns the list of the elements of the lists in [l], preserving their order. Named as in: OCaml, Coq.

-
val map:Unidentified product: [(Unidentified product: ['a] (Tot 'b))] Unidentified product: [list 'a] (Tot (list 'b))
-

[map f l] applies [f] to each element of [l] and returns the list of results, in the order of the original elements in [l]. Requires, at type-checking time, [f] to be a pure total function. Named as in: OCaml, Coq, F#

-
val mapi_init:Unidentified product: [(Unidentified product: [int] Unidentified product: ['a] (Tot 'b))] Unidentified product: [list 'a] Unidentified product: [int] (Tot (list 'b))
-

[mapi_init f n l] applies, for each [k], [f (n+k)] to the [k]-th element of [l] and returns the list of results, in the order of the original elements in [l]. Requires, at type-checking time, [f] to be a pure total function.

-
val mapi:Unidentified product: [(Unidentified product: [int] Unidentified product: ['a] (Tot 'b))] Unidentified product: [list 'a] (Tot (list 'b))
-

[mapi f l] applies, for each [k], [f k] to the [k]-th element of [l] and returns the list of results, in the order of the original elements in [l]. Requires, at type-checking time, [f] to be a pure total function. Named as in: OCaml

-
val concatMap:Unidentified product: [(Unidentified product: ['a] (Tot (list 'b)))] Unidentified product: [list 'a] (Tot (list 'b))
-

[concatMap f l] applies [f] to each element of [l] and returns the concatenation of the results, in the order of the original elements of [l]. This is equivalent to [flatten (map f l)]. Requires, at type-checking time, [f] to be a pure total function.

-
val fold_left:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] (Tot 'a))] Unidentified product: ['a] Unidentified product: [l:list 'b] (Tot 'a (decreases l))
-

[fold_left f x [y1; y2; ...; yn]] computes (f (... (f x y1) y2) ... yn). Requires, at type-checking time, [f] to be a pure total function. Named as in: OCaml, Coq.

-
val fold_right:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] (Tot 'b))] Unidentified product: [list 'a] Unidentified product: ['b] (Tot 'b)
-

[fold_right f [x1; x2; ...; xn] y] computes (f x1 (f x2 (... (f xn y)) ... )). Requires, at type-checking time, [f] to be a pure total function. Named as in: OCaml, Coq

-
let ((fold_right_gtot (#a:Type) (#b:Type) (l:list a) (f:Unidentified product: [a] Unidentified product: [b] (GTot b)) (x:b)):(GTot b)):match l with []  -> x | (Prims.Cons hd tl)  -> f hd (fold_right_gtot tl f x)
-

[fold_right_gtot] is just like [fold_right], except f is a ghost function *

-
val fold_left2:Unidentified product: [f:(Unidentified product: ['a] Unidentified product: ['b] Unidentified product: ['c] (Tot 'a))] Unidentified product: [accu:'a] Unidentified product: [l1:(list 'b)] Unidentified product: [l2:(list 'c)] (Pure 'a ((requires (==(length l1, length l2)))) ((ensures ((fun _ -> True)))) (decreases l1))
-

[fold_left2 f x [y1; y2; ...; yn] [z1; z2; ...; zn]] computes (f (... (f x y1 z1) y2 z2) ... yn zn). Requires, at type-checking time, [f] to be a pure total function, and the lists [y1; y2; ...; yn] and [z1; z2; ...; zn] to have the same lengths. Named as in: OCaml

-
 List searching *
-
val mem:Unidentified product: [#a:eqtype] Unidentified product: [a] Unidentified product: [list a] (Tot bool)
-

[mem x l] returns [true] if, and only if, [x] appears as an element of [l]. Requires, at type-checking time, the type of elements of [l] to have decidable equality. Named as in: OCaml. See also: List.In in Coq, which is propositional.

-
 Propositional membership (as in Coq). Does not require decidable
-equality.
-
let ((memP (#a:Type) (x:a) (l:list a)):(Tot Type0)):match l with []  -> False | (Prims.Cons y q)  -> \/(==(x, y), memP x q)
-

[memP x l] holds if, and only if, [x] appears as an element of [l]. Similar to: List.In in Coq.

-
let contains:mem
-

[contains x l] returns [true] if, and only if, [x] appears as an element of [l]. Requires, at type-checking time, the type of elements of [l] to have decidable equality. It is equivalent to: [mem x l]. TODO: should we rather swap the order of arguments?

-
val existsb:Unidentified product: [#a:Type] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [list a] (Tot bool)
-

[existsb f l] returns [true] if, and only if, there exists some element [x] in [l] such that [f x] holds.

-
val find:Unidentified product: [#a:Type] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [list a] (Tot (option (x:a:{f x})))
-

[find f l] returns [Some x] for some element [x] appearing in [l] such that [f x] holds, or [None] only if no such [x] exists.

-
 Filtering elements of a list [l] through a Boolean pure total
-predicate [f]
-
let ((mem_filter_spec (#a:Type) (f:(Unidentified product: [a] (Tot bool))) (m:list a) (u:option (x:unit:{hasEq a}))):(Tot Type0)):match u with None  -> True | (Some z)  -> forall x.{:pattern } ==>(mem x m, f x)
-

We would like to have a postcondition for [filter f l] saying that, for any element [x] of [filter f l], [f x] holds. To this end, we need to use [mem] as defined above, which would require the underlying type [a] of list elements to have decidable equality. However, we would still like to define [filter] on all element types, even those that do not have decidable equality. Thus, we define our postcondition as [mem_filter_spec f m u] below, where [m] is the intended [filter f l] and [u] indicates whether [a] has decidable equality ([None] if not). Requires, at type-checking time, [f] to be a pure total function.

-
val filter:Unidentified product: [#a:Type] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [l:list a] (Tot (m:list a:{forall u.{:pattern } mem_filter_spec f m u}))
-

[filter f l] returns [l] with all elements [x] such that [f x] does not hold removed. Requires, at type-checking time, [f] to be a pure total function. Named as in: OCaml, Coq

-
val mem_filter:#a:eqtype -> f:(Unidentified product: [a] (Tot bool)) -> l:list a -> x:a -> (Lemma ((requires (mem #a x (filter f l)))) ((ensures (f x))))
-

Postcondition on [filter f l] for types with decidable equality: for any element [x] of [filter f l], [f x] holds. Requires, at type-checking time, [f] to be a pure total function.

-
val mem_filter_forall:#a:eqtype -> f:(Unidentified product: [a] (Tot bool)) -> l:list a -> (Lemma ((requires True)) ((ensures (forall x.{:pattern } ==>(mem #a x (filter f l), f x)))) (Prims.Cons (SMTPat (filter f l)) (Prims.Nil )))
-

Postcondition on [filter f l] for types with decidable equality, stated with [forall]: for any element [x] of [filter f l], [f x] holds. Requires, at type-checking time, [f] to be a pure total function.

-
val for_all:Unidentified product: [(Unidentified product: ['a] (Tot bool))] Unidentified product: [list 'a] (Tot bool)
-

[for_all f l] returns [true] if, and only if, for all elements [x] appearing in [l], [f x] holds. Requires, at type-checking time, [f] to be a pure total function. Named as in: OCaml. Similar to: List.forallb in Coq

-
let ((for_all_mem (#a:eqtype) (f:(Unidentified product: [a] (Tot bool))) (l:list a)):(Lemma (<==>(for_all f l, (forall x.{:pattern } ==>(mem x l, f x)))))):match l with []  -> () | (Prims.Cons _ q)  -> for_all_mem f q
-

Specification for [for_all f l] vs. mem

-
val collect:Unidentified product: [(Unidentified product: ['a] (Tot (list 'b)))] Unidentified product: [list 'a] (Tot (list 'b))
-

[collect f l] applies [f] to each element of [l] and returns the concatenation of the results, in the order of the original elements of [l]. It is equivalent to [flatten (map f l)]. Requires, at type-checking time, [f] to be a pure total function. TODO: what is the difference with [concatMap]?

-
val tryFind:Unidentified product: [(Unidentified product: ['a] (Tot bool))] Unidentified product: [list 'a] (Tot (option 'a))
-

[tryFind f l] returns [Some x] for some element [x] appearing in [l] such that [f x] holds, or [None] only if no such [x] exists. Requires, at type-checking time, [f] to be a pure total function. Contrary to [find], [tryFind] provides no postcondition on its result.

-
val tryPick:Unidentified product: [(Unidentified product: ['a] (Tot (option 'b)))] Unidentified product: [list 'a] (Tot (option 'b))
-

[tryPick f l] returns [y] for some element [x] appearing in [l] such that [f x = Some y] for some y, or [None] only if [f x = None] for all elements [x] of [l]. Requires, at type-checking time, [f] to be a pure total function.

-
val choose:Unidentified product: [(Unidentified product: ['a] (Tot (option 'b)))] Unidentified product: [list 'a] (Tot (list 'b))
-

[choose f l] returns the list of [y] for all elements [x] appearing in [l] such that [f x = Some y] for some [y]. Requires, at type-checking time, [f] to be a pure total function.

-
val partition:Unidentified product: [f:(Unidentified product: ['a] (Tot bool))] Unidentified product: [list 'a] (Tot (*(list 'a, list 'a)))
-

[partition f l] returns the pair of lists [(l1, l2)] where all elements [x] of [l] are in [l1] if [f x] holds, and in [l2] otherwise. Both [l1] and [l2] retain the original order of [l]. Requires, at type-checking time, [f] to be a pure total function.

-
val subset:Unidentified product: [#a:eqtype] Unidentified product: [list a] Unidentified product: [list a] (Tot bool)
-

[subset la lb] is true if and only if all the elements from [la] are also in [lb]. Requires, at type-checking time, the type of elements of [la] and [lb] to have decidable equality.

-
val noRepeats:Unidentified product: [#a:eqtype] Unidentified product: [list a] (Tot bool)
-

[noRepeats l] returns [true] if, and only if, no element of [l] appears in [l] more than once. Requires, at type-checking time, the type of elements of [la] and [lb] to have decidable equality.

-
val no_repeats_p:Unidentified product: [#a:Type] Unidentified product: [list a] (Tot prop)
-

[no_repeats_p l] valid if, and only if, no element of [l] appears in [l] more than once.

-
 List of tuples *
-
val assoc:Unidentified product: [#a:eqtype] Unidentified product: [#b:Type] Unidentified product: [a] Unidentified product: [list (*(a, b))] (Tot (option b))
-

[assoc x l] returns [Some y] where [(x, y)] is the first element of [l] whose first element is [x], or [None] only if no such element exists. Requires, at type-checking time, the type of [x] to have decidable equality. Named as in: OCaml.

-
val split:Unidentified product: [list (*('a, 'b))] (Tot (*(list 'a, list 'b)))
-

[split] takes a list of pairs [(x1, y1), ..., (xn, yn)] and returns the pair of lists ([x1, ..., xn], [y1, ..., yn]). Named as in: OCaml

-
let unzip:split
-

[unzip] takes a list of pairs [(x1, y1), ..., (xn, yn)] and returns the pair of lists ([x1, ..., xn], [y1, ..., yn]). Named as in: Haskell

-
val unzip3:Unidentified product: [list (*(*('a, 'b), 'c))] (Tot (*(*(list 'a, list 'b), list 'c)))
-

[unzip3] takes a list of triples [(x1, y1, z1), ..., (xn, yn, zn)] and returns the triple of lists ([x1, ..., xn], [y1, ..., yn], [z1, ..., zn]). Named as in: Haskell

-
 Splitting a list at some index *
-
let ((splitAt (#a:Type) (n:nat) (l:list a)):*(list a, list a)):if =(n, 0) then (FStar.Pervasives.Native.Mktuple2 (Prims.Nil ) l) else match l with []  -> (FStar.Pervasives.Native.Mktuple2 (Prims.Nil ) l) | (Prims.Cons x xs)  -> let  (l1, l2) = splitAt (-(n, 1)) xs in (FStar.Pervasives.Native.Mktuple2 (Prims.Cons x l1) l2)
-

[splitAt] takes a natural number n and a list and returns a pair of the maximal prefix of l of size smaller than n and the rest of the list

-
val unsnoc:Unidentified product: [#a:Type] Unidentified product: [l:l:list a:{>(length l, 0)}] (Tot (*(list a, a)))
-

[unsnoc] is an inverse of [snoc]. It splits a list into all-elements-except-last and last element.

-
val split3:Unidentified product: [#a:Type] Unidentified product: [l:list a] Unidentified product: [i:i:nat:{<(i, length l)}] (Tot (*(*(list a, a), list a)))
-

[split3] splits a list into 3 parts. This allows easy access to the part of the list before and after the element, as well as the element itself.

-
 Sorting (implemented as quicksort) *
-
val partition_length:Unidentified product: [f:(Unidentified product: ['a] (Tot bool))] Unidentified product: [l:list 'a] (Lemma ((requires True)) ((ensures (=(+(length (fst (partition f l)), length (snd (partition f l))), length l)))))
-

[partition] splits a list [l] into two lists, the sum of whose lengths is the length of [l].

-
val bool_of_compare:Unidentified product: [#a:Type] Unidentified product: [(Unidentified product: [a] Unidentified product: [a] (Tot int))] Unidentified product: [a] Unidentified product: [a] (Tot bool)
-

[bool_of_compare] turns a comparison function into a strict order. More precisely, [bool_of_compare compare x y] returns true if, and only if, [compare x y] is positive. Inspired from OCaml, where polymorphic comparison using both the [compare] function and the (>) infix operator are such that [compare x y] is positive if, and only if, x > y. Requires, at type-checking time, [compare] to be a pure total function.

-
val compare_of_bool:Unidentified product: [#a:eqtype] Unidentified product: [(Unidentified product: [a] Unidentified product: [a] (Tot bool))] Unidentified product: [a] Unidentified product: [a] (Tot int)
-

[compare_of_bool] turns a strict order into a comparison function. More precisely, [compare_of_bool rel x y] returns a positive number if, and only if, x rel y holds. Inspired from OCaml, where polymorphic comparison using both the [compare] function and the (>) infix operator are such that [compare x y] is positive if, and only if, x > y. Requires, at type-checking time, [rel] to be a pure total function.

-
val sortWith:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['a] (Tot int))] Unidentified product: [l:list 'a] (Tot (list 'a) (decreases (length l)))
-

[sortWith compare l] returns the list [l'] containing the elements of [l] sorted along the comparison function [compare], in such a way that if [compare x y > 0], then [x] appears before [y] in [l']. Requires, at type-checking time, [compare] to be a pure total function.

-
 A l1 is a strict prefix of l2.
+comments at https://github.com/FStarLang/FStar/pull/1560

+

+flatten

+

flatten l, where l is a list of lists, returns the list of the +elements of the lists in l, preserving their order. Named as in: +OCaml, Coq.

+
val flatten: list (list 'a) -> Tot (list 'a)
+let rec flatten l = match l with
+    | [] -> []
+    | hd::tl -> append hd (flatten tl)
+

+map

+

map f l applies f to each element of l and returns the list +of results, in the order of the original elements in l. Requires, at +type-checking time, f to be a pure total function. Named as in: OCaml, Coq, F#

+
val map: ('a -> Tot 'b) -> list 'a -> Tot (list 'b)
+let rec map f x = match x with
+  | [] -> []
+  | a::tl -> f a::map f tl
+

+mapi_init

+

mapi_init f n l applies, for each k, f (n+k) to the k-th +element of l and returns the list of results, in the order of the +original elements in l. Requires, at type-checking time, f to be a +pure total function.

+
val mapi_init: (int -> 'a -> Tot 'b) -> list 'a -> int -> Tot (list 'b)
+let rec mapi_init f l i = match l with
+    | [] -> []
+    | hd::tl -> (f i hd)::(mapi_init f tl (i+1))
+

+mapi

+

mapi f l applies, for each k, f k to the k-th element of +l and returns the list of results, in the order of the original +elements in l. Requires, at type-checking time, f to be a pure +total function. Named as in: OCaml

+
val mapi: (int -> 'a -> Tot 'b) -> list 'a -> Tot (list 'b)
+let mapi f l = mapi_init f l 0
+

+concatMap

+

concatMap f l applies f to each element of l and returns the +concatenation of the results, in the order of the original elements of +l. This is equivalent to flatten (map f l). Requires, at +type-checking time, f to be a pure total function.

+
val concatMap: ('a -> Tot (list 'b)) -> list 'a -> Tot (list 'b)
+let rec concatMap f = function
+  | [] -> []
+  | a::tl ->
+    let fa = f a in
+    let ftl = concatMap f tl in
+    append fa ftl
+

+fold_left

+

fold_left f x y1; y2; ...; yn`` computes (f (... (f x y1) y2) +... yn). Requires, at type-checking time, f to be a pure total +function. Named as in: OCaml, Coq.

+
val fold_left: ('a -> 'b -> Tot 'a) -> 'a -> l:list 'b -> Tot 'a (decreases l)
+let rec fold_left f x l = match l with
+  | [] -> x
+  | hd::tl -> fold_left f (f x hd) tl
+

+fold_right

+

fold_right f x1; x2; ...; xn y computes (f x1 (f x2 (... (f xn +y)) ... )). Requires, at type-checking time, f to be a pure total +function. Named as in: OCaml, Coq

+
val fold_right: ('a -> 'b -> Tot 'b) -> list 'a -> 'b -> Tot 'b
+let rec fold_right f l x = match l with
+  | [] -> x
+  | hd::tl -> f hd (fold_right f tl x)
+

+fold_right_gtot

+

fold_right_gtot is just like fold_right, except f is +a ghost function *

+
let rec fold_right_gtot (#a:Type) (#b:Type) (l:list a) (f:a -> b -> GTot b) (x:b)
+  : GTot b
+  = match l with
+    | [] -> x
+    | hd::tl -> f hd (fold_right_gtot tl f x)
+

We define map in terms of fold, to share simple lemmas

+
let map_gtot #a #b (f:a -> GTot b) (x:list a)
+  : GTot (list b)
+  = fold_right_gtot x (fun x tl -> f x :: tl) []
+

+fold_left2

+

fold_left2 f x y1; y2; ...; yn z1; z2; ...; zn`` computes (f +(... (f x y1 z1) y2 z2) ... yn zn). Requires, at type-checking time, +f to be a pure total function, and the lists `y1; y2; ...; yn` and +`z1; z2; ...; zn` to have the same lengths. Named as in: OCaml

+
val fold_left2 : f:('a -> 'b -> 'c -> Tot 'a) -> accu:'a -> l1:(list 'b) -> l2:(list 'c) ->
+  Pure 'a (requires (length l1 == length l2)) (ensures (fun _ -> True)) (decreases l1)
+let rec fold_left2 f accu l1 l2 =
+  match (l1, l2) with
+  | ([], []) -> accu
+  | (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2) l1 l2
+

Propositional membership (as in Coq). Does not require decidable +equality.

+

+memP

+

memP x l holds if, and only if, x appears as an +element of l. Similar to: List.In in Coq.

+
let rec memP (#a: Type) (x: a) (l: list a) : Tot Type0 =
+  match l with
+  | [] -> False
+  | y :: q -> x == y \/ memP x q
+

List searching *

+

+mem

+

mem x l returns true if, and only if, x appears as an +element of l. Requires, at type-checking time, the type of elements +of l to have decidable equality. Named as in: OCaml. See also: +List.In in Coq, which is propositional.

+
val mem: #a:eqtype -> a -> list a -> Tot bool
+let rec mem #a x = function
+  | [] -> false
+  | hd::tl -> if hd = x then true else mem x tl
+

+contains

+

contains x l returns true if, and only if, x appears as an +element of l. Requires, at type-checking time, the type of elements +of l to have decidable equality. It is equivalent to: `mem x +l]. TODO: should we rather swap the order of arguments?

+
let contains = mem
+

+existsb

+

existsb f l returns true if, and only if, there exists some +element x in l such that f x holds.

+
val existsb: #a:Type
+       -> f:(a -> Tot bool)
+       -> list a
+       -> Tot bool
+let rec existsb #a f l = match l with
+ | [] -> false
+ | hd::tl -> if f hd then true else existsb f tl
+

+find

+

find f l returns Some x for some element x appearing in l +such that f x holds, or None only if no such x exists.

+
val find: #a:Type
+        -> f:(a -> Tot bool)
+        -> list a
+        -> Tot (option (x:a{f x}))
+let rec find #a f l = match l with
+  | [] -> None #(x:a{f x}) //These type annotations are only present because it makes bootstrapping go much faster
+  | hd::tl -> if f hd then Some #(x:a{f x}) hd else find f tl
+

Filtering elements of a list l through a Boolean pure total +predicate f

+

+filter

+

filter f l returns l with all elements x such that f x +does not hold removed. Requires, at type-checking time, f to be a +pure total function. Named as in: OCaml, Coq

+
val filter : #a: Type -> f:(a -> Tot bool) -> l: list a -> Tot (m:list a{forall x. memP x m ==> f x})
+let rec filter #a f = function
+  | [] -> []
+  | hd::tl -> if f hd then hd::filter f tl else filter f tl
+

+mem_filter

+

Postcondition on filter f l: for any element x of filter f l, +f x holds. Requires, at type-checking time, f to be a pure total +function.

+
val mem_filter (#a:Type) (f: (a -> Tot bool)) (l: list a) (x: a) : Lemma
+  (requires (memP x (filter f l)))
+  (ensures (f x))
+let mem_filter f l x = ()
+

+mem_filter_forall

+

Postcondition on filter f l: stated with forall: for any element +x of filter f l, f x holds. Requires, at type-checking time, f +to be a pure total function.

+
val mem_filter_forall (#a:Type) (f: (a -> Tot bool)) (l: list a) : Lemma
+  (requires True)
+  (ensures (forall x . memP x (filter f l) ==> f x))
+  [SMTPat (filter f l)]
+let mem_filter_forall f l = FStar.Classical.ghost_lemma (mem_filter f l)
+

+for_all

+

for_all f l returns true if, and only if, for all elements x +appearing in l, f x holds. Requires, at type-checking time, f to +be a pure total function. Named as in: OCaml. Similar to: List.forallb +in Coq

+
val for_all: ('a -> Tot bool) -> list 'a -> Tot bool
+let rec for_all f l = match l with
+    | [] -> true
+    | hd::tl -> if f hd then for_all f tl else false
+

+for_all_mem

+

Specification for for_all f l vs. mem

+
let rec for_all_mem
+  (#a: Type)
+  (f: (a -> Tot bool))
+  (l: list a)
+: Lemma
+  (for_all f l <==> (forall x . memP x l ==> f x))
+= match l with
+  | [] -> ()
+  | _ :: q -> for_all_mem f q
+

+collect

+

collect f l applies f to each element of l and returns the +concatenation of the results, in the order of the original elements of +l. It is equivalent to flatten (map f l). Requires, at +type-checking time, f to be a pure total function. TODO: what is +the difference with concatMap?

+
val collect: ('a -> Tot (list 'b)) -> list 'a -> Tot (list 'b)
+let rec collect f l = match l with
+    | [] -> []
+    | hd::tl -> append (f hd) (collect f tl)
+

+tryFind

+

tryFind f l returns Some x for some element x appearing in +l such that f x holds, or None only if no such x +exists. Requires, at type-checking time, f to be a pure total +function. Contrary to find, tryFind provides no postcondition on +its result.

+
val tryFind: ('a -> Tot bool) -> list 'a -> Tot (option 'a)
+let rec tryFind p l = match l with
+    | [] -> None
+    | hd::tl -> if p hd then Some hd else tryFind p tl
+

+tryPick

+

tryPick f l returns y for some element x appearing in l +such that f x = Some y for some y, or None only if f x = None +for all elements x of l. Requires, at type-checking time, f to +be a pure total function.

+
val tryPick: ('a -> Tot (option 'b)) -> list 'a -> Tot (option 'b)
+let rec tryPick f l = match l with
+    | [] -> None
+    | hd::tl ->
+       match f hd with
+         | Some x -> Some x
+         | None -> tryPick f tl
+

+choose

+

choose f l returns the list of y for all elements x +appearing in l such that f x = Some y for some y. Requires, at +type-checking time, f to be a pure total function.

+
val choose: ('a -> Tot (option 'b)) -> list 'a -> Tot (list 'b)
+let rec choose f l = match l with
+    | [] -> []
+    | hd::tl ->
+       match f hd with
+         | Some x -> x::(choose f tl)
+         | None -> choose f tl
+

+partition

+

partition f l returns the pair of lists (l1, l2) where all +elements x of l are in l1 if f x holds, and in l2 +otherwise. Both l1 and l2 retain the original order of +l. Requires, at type-checking time, f to be a pure total +function.

+
val partition: f:('a -> Tot bool) -> list 'a -> Tot (list 'a * list 'a)
+let rec partition f = function
+  | [] -> [], []
+  | hd::tl ->
+     let l1, l2 = partition f tl in
+     if f hd
+     then hd::l1, l2
+     else l1, hd::l2
+

+subset

+

subset la lb is true if and only if all the elements from la +are also in lb. Requires, at type-checking time, the type of +elements of la and lb to have decidable equality.

+
val subset: #a:eqtype -> list a -> list a -> Tot bool
+let rec subset #a la lb =
+  match la with
+  | [] -> true
+  | h :: tl ->  mem h lb && subset tl lb
+

+noRepeats

+

noRepeats l returns true if, and only if, no element of l +appears in l more than once. Requires, at type-checking time, the +type of elements of la and lb to have decidable equality.

+
val noRepeats : #a:eqtype -> list a -> Tot bool
+let rec noRepeats #a la =
+  match la with
+  | [] -> true
+  | h :: tl -> not(mem h tl) && noRepeats tl
+

+no_repeats_p

+

no_repeats_p l valid if, and only if, no element of l +appears in l more than once.

+
val no_repeats_p : #a:Type -> list a -> Tot prop
+let rec no_repeats_p #a la =
+  match la with
+  | [] -> True
+  | h :: tl -> ~(memP h tl) /\ no_repeats_p tl
+

List of tuples *

+

+assoc

+

assoc x l returns Some y where (x, y) is the first element +of l whose first element is x, or None only if no such element +exists. Requires, at type-checking time, the type of x to have +decidable equality. Named as in: OCaml.

+
val assoc: #a:eqtype -> #b:Type -> a -> list (a * b) -> Tot (option b)
+let rec assoc #a #b x = function
+  | [] -> None
+  | (x', y)::tl -> if x=x' then Some y else assoc x tl
+

+split

+

split takes a list of pairs (x1, y1), ..., (xn, yn) and +returns the pair of lists (x1, ..., xn, y1, ..., yn). Named as in: +OCaml

+
val split: list ('a * 'b) -> Tot (list 'a * list 'b)
+let rec split l = match l with
+    | [] -> ([],[])
+    | (hd1,hd2)::tl ->
+       let (tl1,tl2) = split tl in
+       (hd1::tl1,hd2::tl2)
+

+unzip

+

unzip takes a list of pairs (x1, y1), ..., (xn, yn) and +returns the pair of lists (x1, ..., xn, y1, ..., yn). Named as in: +Haskell

+
let unzip l = split l
+

+unzip3

+

unzip3 takes a list of triples (x1, y1, z1), ..., (xn, yn, zn) +and returns the triple of lists (x1, ..., xn, y1, ..., yn, `z1, +..., zn]). Named as in: Haskell

+
val unzip3: list ('a * 'b * 'c) -> Tot (list 'a * list 'b * list 'c)
+let rec unzip3 l = match l with
+    | [] -> ([],[],[])
+    | (hd1,hd2,hd3)::tl ->
+       let (tl1,tl2,tl3) = unzip3 tl in
+       (hd1::tl1,hd2::tl2,hd3::tl3)
+

Splitting a list at some index *

+

+splitAt

+

splitAt takes a natural number n and a list and returns a pair +of the maximal prefix of l of size smaller than n and the rest of +the list

+
let rec splitAt (#a:Type) (n:nat) (l:list a) : Tot (list a * list a) =
+  if n = 0 then [], l
+  else
+    match l with
+    | [] -> [], l
+    | x :: xs -> let l1, l2 = splitAt (n-1) xs in x :: l1, l2
+
let rec lemma_splitAt_snd_length (#a:Type) (n:nat) (l:list a) :
+  Lemma
+    (requires (n <= length l))
+    (ensures (length (snd (splitAt n l)) = length l - n)) =
+  match n, l with
+  | 0, _ -> ()
+  | _, [] -> ()
+  | _, _ :: l' -> lemma_splitAt_snd_length (n - 1) l'
+

+unsnoc

+

unsnoc is an inverse of snoc. It splits a list into +all-elements-except-last and last element.

+
val unsnoc: #a:Type -> l:list a{length l > 0} -> Tot (list a * a)
+let unsnoc #a l =
+  let l1, l2 = splitAt (length l - 1) l in
+  lemma_splitAt_snd_length (length l - 1) l;
+  l1, hd l2
+

+split3

+

split3 splits a list into 3 parts. This allows easy access to +the part of the list before and after the element, as well as the +element itself.

+
val split3: #a:Type -> l:list a -> i:nat{i < length l} -> Tot (list a * a * list a)
+let split3 #a l i =
+  let a, as = splitAt i l in
+  lemma_splitAt_snd_length i l;
+  let b :: c = as in
+  a, b, c
+

Sorting (implemented as quicksort) *

+

+partition_length

+

partition splits a list l into two lists, the sum of whose +lengths is the length of l.

+
val partition_length: f:('a -> Tot bool)
+                    -> l:list 'a
+                    -> Lemma (requires True)
+                            (ensures (length (fst (partition f l))
+                                      + length (snd (partition f l)) = length l))
+let rec partition_length f l = match l with
+  | [] -> ()
+  | hd::tl -> partition_length f tl
+

+bool_of_compare

+

bool_of_compare turns a comparison function into a strict +order. More precisely, bool_of_compare compare x y returns true +if, and only if, compare x y is negative, meaning x precedes +y in the ordering defined by compare.

+
val bool_of_compare : #a:Type -> (a -> a -> Tot int) -> a -> a -> Tot bool
+let bool_of_compare #a f x y = f x y < 0
+

This is used in sorting, and is defined to be consistent with +OCaml and F#, where sorting is performed in ascending order.

+

+compare_of_bool

+

compare_of_bool turns a strict order into a comparison +function. More precisely, compare_of_bool rel x y returns a positive +number if, and only if, x rel y holds. Inspired from OCaml, where +polymorphic comparison using both the compare function and the (>) +infix operator are such that compare x y is positive if, and only +if, x > y. Requires, at type-checking time, rel to be a pure total +function.

+
val compare_of_bool : #a:eqtype -> (a -> a -> Tot bool) -> a -> a -> Tot int
+let compare_of_bool #a rel x y =
+    if x `rel` y  then -1
+    else if x = y then 0
+    else 1
+
let compare_of_bool_of_compare (#a:eqtype) (f:a -> a -> Tot bool)
+  : Lemma (forall x y. bool_of_compare (compare_of_bool f) x y == f x y)
+  = ()
+

+sortWith

+

sortWith compare l returns the list l' containing the elements +of l sorted along the comparison function compare, in such a +way that if compare x y > 0, then x appears before y in +l'. Sorts in ascending order

+
val sortWith: ('a -> 'a -> Tot int) -> l:list 'a -> Tot (list 'a) (decreases (length l))
+let rec sortWith f = function
+  | [] -> []
+  | pivot::tl ->
+     let hi, lo = partition (bool_of_compare f pivot) tl in
+     partition_length (bool_of_compare f pivot) tl;
+     append (sortWith f lo) (pivot::sortWith f hi)
+

+strict_suffix_of

+

A l1 is a strict suffix of l2.

+
let rec strict_suffix_of (#a: Type) (l1 l2: list a)
+: Pure Type0
+  (requires True)
+  (ensures (fun _ -> True))
+  (decreases l2)
+= match l2 with
+  | [] -> False
+  | _ :: q -> l1 == q \/ l1 `strict_suffix_of` q
+
[@@deprecated "This function was misnamed: Please use 'strict_suffix_of'"]
+let strict_prefix_of = strict_suffix_of
+
val list_unref : #a:Type -> #p:(a -> Type0) -> list (x:a{p x}) -> Tot (list a)
+let rec list_unref #a #p l =
+    match l with
+    | [] -> []
+    | x::xs -> x :: list_unref xs
+
val list_refb: #a:eqtype -> #p:(a -> Tot bool) ->
+  l:list a { for_all p l } ->
+  Tot (l':list (x:a{ p x }) {
+    length l = length l' /\
+    (forall i. {:pattern (index l i) } index l i = index l' i) })
+let rec list_refb #a #p l =
+  match l with
+  | hd :: tl -> hd :: list_refb #a #p tl
+  | [] -> []
+
val list_ref: #a:eqtype -> #p:(a -> Tot prop) -> l:list a {
+  forall x. {:pattern mem x l} mem x l ==> p x
+} -> Tot (l':list (x:a{ p x }) {
+    length l = length l' /\
+    (forall i. {:pattern (index l i) } index l i = index l' i) })
+let rec list_ref #a #p l =
+  match l with
+  | hd :: tl ->
+      assert (mem hd l);
+      assert (p hd);
+      assert (forall x. {:pattern mem x tl} mem x tl ==> mem x l);
+      hd :: list_ref #a #p tl
+  | [] -> []
+ diff --git a/docs/FStar.List.Tot.Properties.html b/docs/FStar.List.Tot.Properties.html index 8324441..7543af3 100644 --- a/docs/FStar.List.Tot.Properties.html +++ b/docs/FStar.List.Tot.Properties.html @@ -1,129 +1,1013 @@ - - + + - - - - - - + FStar.List.Tot.Properties + -

module FStar.List.Tot.Properties

-

Properties of pure total operations on lists

-

This module states and proves some properties about pure and total operations on lists.

-
let (llist a (n:nat)):l:list a:{=(length l, n)}
+

+FStar.List.Tot.Properties

+ +

@summary Properties of pure total operations on lists

+

+llist

A list indexed by its length *

-
 Properties about mem *
-
val mem_empty:Unidentified product: [#a:eqtype] Unidentified product: [x:a] (Lemma ((requires (mem x (Prims.Nil )))) ((ensures False)))
+
let llist a (n:nat) = l:list a {length l = n}
+

Properties about mem *

+

+mem_empty

The empty list has no elements

-
val mem_existsb:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [xs:list a] (Lemma ((ensures (<==>(existsb f xs, (exists x:a.{:pattern } (/\(=(f x, true), mem x xs))))))))
-

Full specification for [existsb]: [existsb f xs] holds if, and only if, there exists an element [x] of [xs] such that [f x] holds.

-
 Properties about rev *
-
val rev_mem:Unidentified product: [#a:eqtype] Unidentified product: [l:list a] Unidentified product: [x:a] (Lemma ((requires True)) ((ensures (<==>(mem x (rev l), mem x l)))))
+
val mem_empty : #a:eqtype -> x:a ->
+  Lemma (requires (mem x []))
+        (ensures False)
+let mem_empty #a x = ()
+

+mem_existsb

+

Full specification for existsb: existsb f xs holds if, and +only if, there exists an element x of xs such that f x holds.

+
val mem_existsb: #a:eqtype -> f:(a -> Tot bool) -> xs:list a ->
+  Lemma(ensures (existsb f xs <==> (exists (x:a). (f x = true /\ mem x xs))))
+let rec mem_existsb #a f xs =
+  match xs with
+  | [] -> ()
+  | hd::tl -> mem_existsb f tl
+
let rec mem_count
+  (#a: eqtype)
+  (l: list a)
+  (x: a)
+: Lemma
+  (mem x l <==> count x l > 0)
+= match l with
+  | [] -> ()
+  | x' :: l' -> mem_count l' x
+

Properties about rev *

+
val rev_acc_length : l:list 'a -> acc:list 'a ->
+  Lemma (requires True)
+        (ensures (length (rev_acc l acc) = length l + length acc))
+let rec rev_acc_length l acc = match l with
+    | [] -> ()
+    | hd::tl -> rev_acc_length tl (hd::acc)
+
val rev_length : l:list 'a ->
+  Lemma (requires True)
+        (ensures (length (rev l) = length l))
+let rev_length l = rev_acc_length l []
+
val rev_acc_mem : #a:eqtype -> l:list a -> acc:list a -> x:a ->
+  Lemma (requires True)
+        (ensures (mem x (rev_acc l acc) <==> (mem x l \/ mem x acc)))
+let rec rev_acc_mem #a l acc x = match l with
+    | [] -> ()
+    | hd::tl -> rev_acc_mem tl (hd::acc) x
+

+rev_mem

A list and its reversed have the same elements

-
 Properties about append *
-
let ((lemma_append_last (#a:Type) (l1:list a) (l2:list a)):(Lemma ((requires (>(length l2, 0)))) ((ensures (==(last (@(l1, l2)), last l2)))))):match l1 with []  -> () | (Prims.Cons _ l1')  -> lemma_append_last l1' l2
-

The [last] element of a list remains the same, even after that list is [append]ed to another list.

-
 Properties mixing rev and append *
-
 Properties about snoc
-
 Reverse induction principle *
-
 Properties about iterators *
-
 Properties about unsnoc
-
val lemma_unsnoc_snoc:Unidentified product: [#a:Type] Unidentified product: [l:l:list a:{>(length l, 0)}] (Lemma ((requires True)) ((ensures (==(snoc (unsnoc l), l)))) (Prims.Cons (SMTPat (snoc (unsnoc l))) (Prims.Nil )))
-

[unsnoc] is the inverse of [snoc]

-
val lemma_snoc_unsnoc:Unidentified product: [#a:Type] Unidentified product: [lx:(*(list a, a))] (Lemma ((requires True)) ((ensures (==(unsnoc (snoc lx), lx)))) (decreases (length (fst (lx)))) (Prims.Cons (SMTPat (unsnoc (snoc lx))) (Prims.Nil )))
-

[snoc] is the inverse of [unsnoc]

-
val lemma_unsnoc_length:Unidentified product: [#a:Type] Unidentified product: [l:l:list a:{>(length l, 0)}] (Lemma ((requires True)) ((ensures (==(length (fst (unsnoc l)), -(length l, 1))))))
-

Doing an [unsnoc] gives us a list that is shorter in length by 1

-
let ((lemma_unsnoc_append (#a:Type) (l1:list a) (l2:list a)):(Lemma ((requires (>(length l2, 0)))) ((ensures (let  (as, a) = unsnoc (@(l1, l2)) in let  (bs, b) = unsnoc l2 in /\(==(as, @(l1, bs)), ==(a, b))))))):match l1 with []  -> () | (Prims.Cons _ l1')  -> lemma_unsnoc_append l1' l2
-

[unsnoc] followed by [append] can be connected to the same vice-versa.

-
let ((lemma_unsnoc_is_last (#t:Type) (l:list t)):(Lemma ((requires (>(length l, 0)))) ((ensures (/\(==(snd (unsnoc l), last l), ==(snd (unsnoc l), index l (-(length l, 1))))))))):match l with [_]  -> () | _  -> lemma_unsnoc_is_last (tl l)
-

[unsnoc] gives you [last] element, which is [index]ed at [length l - 1]

-
let ((lemma_unsnoc_index (#t:Type) (l:list t) (i:nat)):(Lemma ((requires (/\(>(length l, 0), <(i, -(length l, 1)))))) ((ensures (/\(<(i, length (fst (unsnoc l))), ==(index (fst (unsnoc l)) i, index l i))))))):match i with 0  -> () | _  -> lemma_unsnoc_index (tl l) (-(i, 1))
-

[index]ing on the left part of an [unsnoc]d list is the same as indexing the original list.

-
 Definition and properties about [split_using]
-
let ((split_using (#t:Type) (l:list t) (x:x:t:{memP x l})):(GTot (r:(*(list t, list t))))):match l with [_]  -> (FStar.Pervasives.Native.Mktuple2 (Prims.Nil ) l) | (Prims.Cons a as)  -> if FStar.StrongExcludedMiddle.strong_excluded_middle (==(a, x)) then ((FStar.Pervasives.Native.Mktuple2 (Prims.Nil ) l)) else (let  (l1', l2') = split_using as x in (FStar.Pervasives.Native.Mktuple2 (Prims.Cons a l1') l2'))
-

[split_using] splits a list at the first instance of finding an element in it.

-
NOTE: Uses [strong_excluded_middle] axiom.
-
 Definition of [index_of]
-
let ((index_of (#t:Type) (l:list t) (x:x:t:{memP x l})):(GTot (i:nat:{/\(<(i, length l), ==(index l i, x))}))):match l with [_]  -> 0 | (Prims.Cons a as)  -> if FStar.StrongExcludedMiddle.strong_excluded_middle (==(a, x)) then (0) else (+(1, index_of as x))
-

[index_of l x] gives the index of the leftmost [x] in [l].

-
NOTE: Uses [strong_excluded_middle] axiom.
-
 Properties about partition *
-
val partition_mem:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [l:list a] Unidentified product: [x:a] (Lemma ((requires True)) ((ensures (let  (l1, l2) = partition f l in =(mem x l, (||(mem x l1, mem x l2)))))))
-

If [partition f l = (l1, l2)], then for any [x], [x] is in [l] if and only if [x] is in either one of [l1] or [l2]

-
val partition_mem_forall:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [l:list a] (Lemma ((requires True)) ((ensures (let  (l1, l2) = partition f l in (forall x.{:pattern } =(mem x l, (||(mem x l1, mem x l2))))))))
-

Same as [partition_mem], but using [forall]

-
val partition_mem_p_forall:Unidentified product: [#a:eqtype] Unidentified product: [p:(Unidentified product: [a] (Tot bool))] Unidentified product: [l:list a] (Lemma ((requires True)) ((ensures (let  (l1, l2) = partition p l in /\((forall x.{:pattern } ==>(mem x l1, p x)), (forall x.{:pattern } ==>(mem x l2, not (p x))))))))
-

If [partition f l = (l1, l2)], then for any [x], if [x] is in [l1] (resp. [l2]), then [f x] holds (resp. does not hold)

-
val partition_count:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [l:list a] Unidentified product: [x:a] (Lemma ((requires True)) ((ensures (=(count x l, (+(count x (fst (partition f l)), count x (snd (partition f l)))))))))
-

If [partition f l = (l1, l2)], then the number of occurrences of any [x] in [l] is the same as the sum of the number of occurrences in [l1] and [l2].

-
val partition_count_forall:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [l:list a] (Lemma ((requires True)) ((ensures (forall x.{:pattern } =(count x l, (+(count x (fst (partition f l)), count x (snd (partition f l)))))))))
-

Same as [partition_count], but using [forall]

-
 Correctness of quicksort *
-
val sortWith_permutation:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] Unidentified product: [a] (Tot int))] Unidentified product: [l:list a] (Lemma ((requires True)) ((ensures (forall x.{:pattern } =(count x l, count x (sortWith f l))))) (decreases (length l)))
-

Correctness of [sortWith], part 1/2: the number of occurrences of any [x] in [sortWith f l] is the same as the number of occurrences in [l].

-
val sorted:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['a] (Tot bool))] Unidentified product: [list 'a] (Tot bool)
-

[sorted f l] holds if, and only if, any two consecutive elements [x], [y] of [l] are such that [f x y] holds.

-
typeabbrev
-

[f] is a total order if, and only if, it is reflexive, anti-symmetric, transitive and total.

-
val append_sorted:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] Unidentified product: [a] (Tot bool))] Unidentified product: [l1:l1:list a:{sorted f l1}] Unidentified product: [l2:l2:list a:{sorted f l2}] Unidentified product: [pivot:a] (Lemma ((requires (/\(/\(total_order #a f, (forall y.{:pattern } ==>(mem y l1, not (f pivot y)))), (forall y.{:pattern } ==>(mem y l2, f pivot y)))))) ((ensures (sorted f (@(l1, ((Prims.Cons pivot l2))))))) (Prims.Cons (SMTPat (sorted f (@(l1, ((Prims.Cons pivot l2)))))) (Prims.Nil )))
+
val rev_mem : #a:eqtype -> l:list a -> x:a ->
+  Lemma (requires True)
+        (ensures (mem x (rev l) <==> mem x l))
+let rev_mem #a l x = rev_acc_mem l [] x
+

Properties about append *

+
val append_nil_l: l:list 'a ->
+  Lemma (requires True)
+        (ensures ([]@l == l))
+let append_nil_l l = ()
+
val append_l_nil: l:list 'a ->
+  Lemma (requires True)
+        (ensures (l@[] == l)) [SMTPat (l@[])]
+let rec append_l_nil = function
+  | [] -> ()
+  | hd::tl -> append_l_nil tl
+
val append_cons_l: hd:'a -> tl:list 'a -> l:list 'a ->
+  Lemma (requires True)
+        (ensures (((hd::tl)@l) == (hd::(tl@l))))
+let append_cons_l hd tl l = ()
+
val append_l_cons: hd:'a -> tl:list 'a -> l:list 'a ->
+  Lemma (requires True)
+        (ensures ((l@(hd::tl)) == ((l@[hd])@tl)))
+let rec append_l_cons hd tl l = match l with
+    | [] -> ()
+    | hd'::tl' -> append_l_cons hd tl tl'
+
val append_assoc: l1:list 'a -> l2:list 'a -> l3:list 'a ->
+  Lemma (requires True)
+        (ensures ((l1@(l2@l3)) == ((l1@l2)@l3)))
+let rec append_assoc l1 l2 l3 = match l1 with
+    | [] -> ()
+    | hd::tl -> append_assoc tl l2 l3
+
val append_length: l1:list 'a -> l2:list 'a ->
+  Lemma (requires True)
+        (ensures (length (l1@l2) = length l1 + length l2)) [SMTPat (length (l1 @ l2))]
+let rec append_length l1 l2 = match l1 with
+  | [] -> ()
+  | hd::tl -> append_length tl l2
+
val append_mem: #t:eqtype ->  l1:list t
+              -> l2:list t
+              -> a:t
+              -> Lemma (requires True)
+                       (ensures (mem a (l1@l2) = (mem a l1 || mem a l2)))
+

SMTPat (mem a (l1@l2))

+
let rec append_mem #t l1 l2 a = match l1 with
+  | [] -> ()
+  | hd::tl -> append_mem tl l2 a
+
val append_mem_forall: #a:eqtype -> l1:list a
+              -> l2:list a
+              -> Lemma (requires True)
+                       (ensures (forall a. mem a (l1@l2) = (mem a l1 || mem a l2)))
+let rec append_mem_forall #a l1 l2 = match l1 with
+  | [] -> ()
+  | hd::tl -> append_mem_forall tl l2
+
val append_count: #t:eqtype ->  l1:list t
+              -> l2:list t
+              -> a:t
+              -> Lemma (requires True)
+                       (ensures (count a (l1@l2) = (count a l1 + count a l2)))
+let rec append_count #t l1 l2 a = match l1 with
+  | [] -> ()
+  | hd::tl -> append_count tl l2 a
+
val append_count_forall: #a:eqtype ->  l1:list a
+              -> l2:list a
+              -> Lemma (requires True)
+                       (ensures (forall a. count a (l1@l2) = (count a l1 + count a l2)))
+

SMTPat (l1@l2)

+
let rec append_count_forall #a l1 l2 = match l1 with
+  | [] -> ()
+  | hd::tl -> append_count_forall tl l2
+
val append_eq_nil: l1:list 'a -> l2:list 'a ->
+  Lemma (requires (l1@l2 == []))
+        (ensures (l1 == [] /\ l2 == []))
+let append_eq_nil l1 l2 = ()
+
val append_eq_singl: l1:list 'a -> l2:list 'a -> x:'a ->
+  Lemma (requires (l1@l2 == [x]))
+        (ensures ((l1 == [x] /\ l2 == []) \/ (l1 == [] /\ l2 == [x])))
+let append_eq_singl l1 l2 x = ()
+
val append_inv_head: l:list 'a -> l1:list 'a -> l2:list 'a ->
+  Lemma (requires ((l@l1) == (l@l2)))
+        (ensures (l1 == l2))
+let rec append_inv_head l l1 l2 = match l with
+    | [] -> ()
+    | hd::tl -> append_inv_head tl l1 l2
+
val append_inv_tail: l:list 'a -> l1:list 'a -> l2:list 'a ->
+  Lemma (requires ((l1@l) == (l2@l)))
+        (ensures (l1 == l2))
+let rec append_inv_tail l l1 l2 = match l1, l2 with
+    | [], [] -> ()
+    | hd1::tl1, hd2::tl2 -> append_inv_tail l tl1 tl2
+    | [], hd2::tl2 ->
+       (match l with
+          | [] -> ()
+          | hd::tl -> append_l_cons hd tl tl2; append_inv_tail tl [] (tl2@[hd])
+

We can here apply the induction hypothesis thanks to termination on a lexicographical ordering of the arguments!

+
   )
+| hd1::tl1, [] ->
+   (match l with
+      | [] -> ()
+      | hd::tl -> append_l_cons hd tl tl1; append_inv_tail tl (tl1@[hd]) []
+

Idem

+
)
+
let rec append_length_inv_head
+  (#a: Type)
+  (left1 right1 left2 right2: list a)
+: Lemma
+  (requires (append left1 right1 == append left2 right2 /\ length left1 == length left2))
+  (ensures (left1 == left2 /\ right1 == right2))
+  (decreases left1)
+= match left1 with
+  | [] -> ()
+  | _ :: left1' ->
+    append_length_inv_head left1' right1 (tl left2) right2
+
let append_length_inv_tail
+  (#a: Type)
+  (left1 right1 left2 right2: list a)
+: Lemma
+  (requires (append left1 right1 == append left2 right2 /\ length right1 == length right2))
+  (ensures (left1 == left2 /\ right1 == right2))
+= append_length left1 right1;
+  append_length left2 right2;
+  append_length_inv_head left1 right1 left2 right2
+

+lemma_append_last

+

The last element of a list remains the same, even after that list is +appended to another list.

+
let rec lemma_append_last (#a:Type) (l1 l2:list a) :
+  Lemma
+    (requires (length l2 > 0))
+    (ensures (last (l1 @ l2) == last l2)) =
+  match l1 with
+  | [] -> ()
+  | _ :: l1' -> lemma_append_last l1' l2
+

Properties mixing rev and append *

+
val rev': list 'a -> Tot (list 'a)
+let rec rev' = function
+  | [] -> []
+  | hd::tl -> (rev' tl)@[hd]
+let rev'T = rev'
+
val rev_acc_rev': l:list 'a -> acc:list 'a ->
+  Lemma (requires (True))
+        (ensures ((rev_acc l acc) == ((rev' l)@acc)))
+let rec rev_acc_rev' l acc = match l with
+    | [] -> ()
+    | hd::tl -> rev_acc_rev' tl (hd::acc); append_l_cons hd acc (rev' tl)
+
val rev_rev': l:list 'a ->
+  Lemma (requires True)
+        (ensures ((rev l) == (rev' l)))
+let rev_rev' l = rev_acc_rev' l []; append_l_nil (rev' l)
+
val rev'_append: l1:list 'a -> l2:list 'a ->
+  Lemma (requires True)
+        (ensures ((rev' (l1@l2)) == ((rev' l2)@(rev' l1))))
+let rec rev'_append l1 l2 = match l1 with
+    | [] -> append_l_nil (rev' l2)
+    | hd::tl -> rev'_append tl l2; append_assoc (rev' l2) (rev' tl) [hd]
+
val rev_append: l1:list 'a -> l2:list 'a ->
+  Lemma (requires True)
+        (ensures ((rev (l1@l2)) == ((rev l2)@(rev l1))))
+let rev_append l1 l2 = rev_rev' l1; rev_rev' l2; rev_rev' (l1@l2); rev'_append l1 l2
+
val rev'_involutive : l:list 'a ->
+  Lemma (requires True)
+        (ensures (rev' (rev' l) == l))
+let rec rev'_involutive = function
+  | [] -> ()
+  | hd::tl -> rev'_append (rev' tl) [hd]; rev'_involutive tl
+
val rev_involutive : l:list 'a ->
+  Lemma (requires True)
+        (ensures (rev (rev l) == l))
+let rev_involutive l = rev_rev' l; rev_rev' (rev' l); rev'_involutive l
+

Properties about snoc

+
val lemma_snoc_length : (lx:(list 'a * 'a)) ->
+  Lemma (requires True)
+        (ensures (length (snoc lx) = length (fst lx) + 1))
+let lemma_snoc_length (l, x) = append_length l [x]
+

Reverse induction principle *

+
val rev'_list_ind: p:(list 'a -> Tot bool) -> l:list 'a ->
+  Lemma (requires ((p []) /\ (forall hd tl. p (rev' tl) ==> p (rev' (hd::tl)))))
+        (ensures (p (rev' l)))
+let rec rev'_list_ind p = function
+  | [] -> ()
+  | hd::tl -> rev'_list_ind p tl
+
val rev_ind: p:(list 'a -> Tot bool) -> l:list 'a ->
+  Lemma (requires ((p []) /\ (forall hd tl. p hd ==> p (hd@[tl]))))
+        (ensures (p l))
+let rev_ind p l = rev'_involutive l; rev'_list_ind p (rev' l)
+

Properties about iterators *

+
val map_lemma: f:('a -> Tot 'b)
+             -> l:(list 'a)
+             -> Lemma (requires True)
+                      (ensures (length (map f l)) = length l)
+                      [SMTPat (map f l)]
+let rec map_lemma f l =
+    match l with
+    | [] -> ()
+    | h::t -> map_lemma f t
+

Properties about unsnoc

+

+lemma_unsnoc_snoc

+

unsnoc is the inverse of snoc

+
val lemma_unsnoc_snoc: #a:Type -> l:list a{length l > 0} ->
+  Lemma (requires True)
+    (ensures (snoc (unsnoc l) == l))
+    [SMTPat (snoc (unsnoc l))]
+let lemma_unsnoc_snoc #a l =
+  let l', x = unsnoc l in
+  let l1, l2 = l', [x] in
+  lemma_splitAt_snd_length (length l - 1) l;
+

assert ((l1, l2) == splitAt (length l - 1) l);

+
let rec aux (l:list a{length l > 0}) :
+  Lemma (let l1, l2 = splitAt (length l - 1) l in
+         append l1 l2 == l) =
+  if length l = 1 then () else aux (tl l) in
+aux l
+

+lemma_snoc_unsnoc

+

snoc is the inverse of unsnoc

+
val lemma_snoc_unsnoc: #a:Type -> lx:(list a * a) ->
+  Lemma (requires True)
+    (ensures (unsnoc (snoc lx) == lx))
+    (decreases (length (fst (lx))))
+    [SMTPat (unsnoc (snoc lx))]
+let rec lemma_snoc_unsnoc #a lx =
+  let l, x = lx in
+  match l with
+  | [] -> ()
+  | _ -> lemma_snoc_unsnoc (tl l, x)
+

+lemma_unsnoc_length

+

Doing an unsnoc gives us a list that is shorter in length by 1

+
val lemma_unsnoc_length: #a:Type -> l:list a{length l > 0} ->
+  Lemma (requires True)
+    (ensures (length (fst (unsnoc l)) == length l - 1))
+let lemma_unsnoc_length #a l =
+  lemma_snoc_length (unsnoc l)
+

+lemma_unsnoc_append

+

unsnoc followed by append can be connected to the same vice-versa.

+
let rec lemma_unsnoc_append (#a:Type) (l1 l2:list a) :
+  Lemma
+    (requires (length l2 > 0)) // the [length l2 = 0] is trivial
+    (ensures (
+        let as, a = unsnoc (l1 @ l2) in
+        let bs, b = unsnoc l2 in
+        as == l1 @ bs /\ a == b)) =
+  match l1 with
+  | [] -> ()
+  | _ :: l1' -> lemma_unsnoc_append l1' l2
+

+lemma_unsnoc_is_last

+

unsnoc gives you last element, which is indexed at length l - 1

+
let rec lemma_unsnoc_is_last (#t:Type) (l:list t) :
+  Lemma
+    (requires (length l > 0))
+    (ensures (snd (unsnoc l) == last l /\ snd (unsnoc l) == index l (length l - 1))) =
+  match l with
+  | [_] -> ()
+  | _ -> lemma_unsnoc_is_last (tl l)
+

+lemma_unsnoc_index

+

indexing on the left part of an unsnocd list is the same as indexing +the original list.

+
let rec lemma_unsnoc_index (#t:Type) (l:list t) (i:nat) :
+  Lemma
+    (requires (length l > 0 /\ i < length l - 1))
+    (ensures (
+        i < length (fst (unsnoc l)) /\
+        index (fst (unsnoc l)) i == index l i)) =
+  match i with
+  | 0 -> ()
+  | _ -> lemma_unsnoc_index (tl l) (i - 1)
+

Definition and properties about split_using

+

+split_using

+

split_using splits a list at the first instance of finding an +element in it.

+
let rec split_using (#t:Type) (l:list t) (x:t{x `memP` l}) :
+  GTot (list t * list t) =
+  match l with
+  | [_] -> [], l
+  | a :: as ->
+    if FStar.StrongExcludedMiddle.strong_excluded_middle (a == x) then (
+      [], l
+    ) else (
+      let l1', l2' = split_using as x in
+      a :: l1', l2'
+    )
+

NOTE: Uses strong_excluded_middle axiom.

+
let rec lemma_split_using (#t:Type) (l:list t) (x:t{x `memP` l}) :
+  Lemma
+    (ensures (
+        let l1, l2 = split_using l x in
+         length l2 > 0 /\
+        ~(x `memP` l1) /\
+         hd l2 == x /\
+        append l1 l2 == l)) =
+  match l with
+  | [_] -> ()
+  | a :: as ->
+    let goal =
+      let l1, l2 = split_using l x in
+        length l2 > 0 /\
+        ~(x `memP` l1) /\
+         hd l2 == x /\
+        append l1 l2 == l
+    in
+    FStar.Classical.or_elim
+      #_ #_
+      #(fun () -> goal)
+      (fun (_:squash (a == x)) -> ())
+      (fun (_:squash (x `memP` as)) -> lemma_split_using as x)
+

Definition of index_of

+

+index_of

+

index_of l x gives the index of the leftmost x in l.

+
let rec index_of (#t:Type) (l:list t) (x:t{x `memP` l}) :
+  GTot (i:nat{i < length l /\ index l i == x}) =
+  match l with
+  | [_] -> 0
+  | a :: as ->
+    if FStar.StrongExcludedMiddle.strong_excluded_middle (a == x) then (
+      0
+    ) else (
+      1 + index_of as x
+    )
+

NOTE: Uses strong_excluded_middle axiom.

+

Properties about partition *

+

+partition_mem

+

If partition f l = (l1, l2), then for any x, x is in l if +and only if x is in either one of l1 or l2

+
val partition_mem: #a:eqtype -> f:(a -> Tot bool)
+                  -> l:list a
+                  -> x:a
+                  -> Lemma (requires True)
+                          (ensures (let l1, l2 = partition f l in
+                        mem x l = (mem x l1 || mem x l2)))
+let rec partition_mem #a f l x = match l with
+  | [] -> ()
+  | hd::tl -> partition_mem f tl x
+

+partition_mem_forall

+

Same as partition_mem, but using forall

+
val partition_mem_forall: #a:eqtype -> f:(a -> Tot bool)
+                  -> l:list a
+                  -> Lemma (requires True)
+                          (ensures (let l1, l2 = partition f l in
+                                    (forall x. mem x l = (mem x l1 || mem x l2))))
+let rec partition_mem_forall #a f l = match l with
+  | [] -> ()
+  | hd::tl -> partition_mem_forall f tl
+

+partition_mem_p_forall

+

If partition f l = (l1, l2), then for any x, if x is in l1 +(resp. l2), then f x holds (resp. does not hold)

+
val partition_mem_p_forall: #a:eqtype -> p:(a -> Tot bool)
+                  -> l:list a
+                  -> Lemma (requires True)
+                          (ensures (let l1, l2 = partition p l in
+                                    (forall x. mem x l1 ==> p x) /\ (forall x. mem x l2 ==> not (p x))))
+let rec partition_mem_p_forall #a p l = match l with
+  | [] -> ()
+  | hd::tl -> partition_mem_p_forall p tl
+

+partition_count

+

If partition f l = (l1, l2), then the number of occurrences of +any x in l is the same as the sum of the number of occurrences in +l1 and l2.

+
val partition_count: #a:eqtype -> f:(a -> Tot bool)
+                  -> l:list a
+                  -> x:a
+                  -> Lemma (requires True)
+                           (ensures (count x l = (count x (fst (partition f l)) + count x (snd (partition f l)))))
+let rec partition_count #a f l x = match l with
+  | [] -> ()
+  | hd::tl -> partition_count f tl x
+

+partition_count_forall

+

Same as partition_count, but using forall

+
val partition_count_forall: #a:eqtype -> f:(a -> Tot bool)
+                  -> l:list a
+                  -> Lemma (requires True)
+                           (ensures (forall x. count x l = (count x (fst (partition f l)) + count x (snd (partition f l)))))
+

SMTPat (partitionT f l)

+
let rec partition_count_forall #a f l= match l with
+  | [] -> ()
+  | hd::tl -> partition_count_forall f tl
+

Correctness of quicksort *

+

+sortWith_permutation

+

Correctness of sortWith, part 1/2: the number of occurrences of +any x in sortWith f l is the same as the number of occurrences in +l.

+
val sortWith_permutation: #a:eqtype -> f:(a -> a -> Tot int) -> l:list a ->
+  Lemma (requires True)
+        (ensures (forall x. count x l = count x (sortWith f l)))
+        (decreases (length l))
+let rec sortWith_permutation #a f l = match l with
+    | [] -> ()
+    | pivot::tl ->
+       let hi, lo  = partition (bool_of_compare f pivot) tl in
+       partition_length (bool_of_compare f pivot) tl;
+       partition_count_forall (bool_of_compare f pivot) tl;
+       sortWith_permutation f lo;
+       sortWith_permutation f hi;
+       append_count_forall (sortWith f lo) (pivot::sortWith f hi)
+

+sorted

+

sorted f l holds if, and only if, any two consecutive elements +x, y of l are such that f x y holds

+
val sorted: ('a -> 'a -> Tot bool) -> list 'a -> Tot bool
+let rec sorted f = function
+  | []
+  | [_] -> true
+  | x::y::tl -> f x y && sorted f (y::tl)
+

+total_order

+

f is a total order if, and only if, it is reflexive, +anti-symmetric, transitive and total.

+
type total_order (#a:Type) (f: (a -> a -> Tot bool)) =
+    (forall a. f a a)                                           (* reflexivity   *)
+    /\ (forall a1 a2. f a1 a2 /\ f a2 a1  ==> a1 == a2)          (* anti-symmetry *)
+    /\ (forall a1 a2 a3. f a1 a2 /\ f a2 a3 ==> f a1 a3)        (* transitivity  *)
+    /\ (forall a1 a2. f a1 a2 \/ f a2 a1)                       (* totality *)
+

+append_sorted

Correctness of the merging of two sorted lists around a pivot.

-
val sortWith_sorted:Unidentified product: [#a:eqtype] Unidentified product: [f:(Unidentified product: [a] Unidentified product: [a] (Tot int))] Unidentified product: [l:list a] (Lemma ((requires (total_order #a (bool_of_compare f)))) ((ensures (/\((sorted (bool_of_compare f) (sortWith f l)), (forall x.{:pattern } =(mem x l, mem x (sortWith f l))))))) (decreases (length l)))
-

Correctness of [sortWith], part 2/2: the elements of [sortWith f l] are sorted according to comparison function [f], and the elements of [sortWith f l] are the elements of [l].

-
let ((mem_memP (#a:eqtype) (x:a) (l:list a)):(Lemma ((ensures (<==>(mem x l, memP x l)))))):match l with []  -> () | (Prims.Cons a q)  -> mem_memP x q
-

Correctness of [mem] for types with decidable equality. TODO: replace [mem] with [memP] in relevant lemmas and define the right SMTPat to automatically recover lemmas about [mem] for types with decidable equality

-
let ((lemma_index_memP (#t:Type) (l:list t) (i:i:nat:{<(i, length l)})):(Lemma ((ensures (memP index l i l))) (Prims.Cons (SMTPat (memP index l i l)) (Prims.Nil )))):match i with 0  -> () | _  -> lemma_index_memP (tl l) (-(i, 1))
-

If an element can be [index]ed, then it is a [memP] of the list.

-
val memP_empty:Unidentified product: [#a:Type] Unidentified product: [x:a] (Lemma ((requires (memP x (Prims.Nil )))) ((ensures False)))
+
val append_sorted: #a:eqtype
+               ->  f:(a -> a -> Tot bool)
+               ->  l1:list a{sorted f l1}
+               ->  l2:list a{sorted f l2}
+               ->  pivot:a
+               ->  Lemma (requires (total_order #a f
+                                    /\ (forall y. mem y l1 ==> not(f pivot y))
+                                    /\ (forall y. mem y l2 ==> f pivot y)))
+                        (ensures (sorted f (l1@(pivot::l2))))
+                        [SMTPat (sorted f (l1@(pivot::l2)))]
+let rec append_sorted #a f l1 l2 pivot = match l1 with
+  | [] -> ()
+  | hd::tl -> append_sorted f tl l2 pivot
+

+sortWith_sorted

+

Correctness of sortWith, part 2/2: the elements of sortWith f l are sorted according to comparison function f, and the elements +of sortWith f l are the elements of l.

+
val sortWith_sorted: #a:eqtype -> f:(a -> a -> Tot int) -> l:list a ->
+  Lemma (requires (total_order #a (bool_of_compare f)))
+        (ensures ((sorted (bool_of_compare f) (sortWith f l)) /\ (forall x. mem x l = mem x (sortWith f l))))
+        (decreases (length l))
+let rec sortWith_sorted #a f l = match l with
+    | [] -> ()
+    | pivot::tl ->
+       let hi, lo  = partition (bool_of_compare f pivot) tl in
+       partition_length (bool_of_compare f pivot) tl;
+       partition_mem_forall (bool_of_compare f pivot) tl;
+       partition_mem_p_forall (bool_of_compare f pivot) tl;
+       sortWith_sorted f lo;
+       sortWith_sorted f hi;
+       append_mem_forall (sortWith f lo) (pivot::sortWith f hi);
+       append_sorted (bool_of_compare f) (sortWith f lo) (sortWith f hi) pivot
+

+mem_memP

+

Correctness of mem for types with decidable equality. TODO: +replace mem with memP in relevant lemmas and define the right +SMTPat to automatically recover lemmas about mem for types with +decidable equality

+
let rec mem_memP
+  (#a: eqtype)
+  (x: a)
+  (l: list a)
+: Lemma (ensures (mem x l <==> memP x l))
+        [SMTPat (mem x l); SMTPat (memP x l)]
+= match l with
+  | [] -> ()
+  | a :: q -> mem_memP x q
+

+lemma_index_memP

+

If an element can be indexed, then it is a memP of the list.

+
let rec lemma_index_memP (#t:Type) (l:list t) (i:nat{i < length l}) :
+  Lemma
+    (ensures (index l i `memP` l))
+    [SMTPat (index l i `memP` l)] =
+  match i with
+  | 0 -> ()
+  | _ -> lemma_index_memP (tl l) (i - 1)
+

+memP_empty

The empty list has no elements.

-
val memP_existsb:Unidentified product: [#a:Type] Unidentified product: [f:(Unidentified product: [a] (Tot bool))] Unidentified product: [xs:list a] (Lemma ((ensures (<==>(existsb f xs, (exists x:a.{:pattern } (/\(=(f x, true), memP x xs))))))))
-

Full specification for [existsb]: [existsb f xs] holds if, and only if, there exists an element [x] of [xs] such that [f x] holds.

-
let ((noRepeats_nil (#a:eqtype)):(Lemma ((ensures (noRepeats #a (Prims.Nil )))))):()
-

Properties of [noRepeats]

-
 Properties of [assoc]
-
 Properties of [fold_left]
-
 Properties of [strict_prefix_of]
-
 Properties of << with lists
-
 Properties about find
-
 Properties of init and last
+
val memP_empty : #a: Type -> x:a ->
+  Lemma (requires (memP x []))
+        (ensures False)
+let memP_empty #a x = ()
+

+memP_existsb

+

Full specification for existsb: existsb f xs holds if, and +only if, there exists an element x of xs such that f x holds.

+
val memP_existsb: #a: Type -> f:(a -> Tot bool) -> xs:list a ->
+  Lemma(ensures (existsb f xs <==> (exists (x:a). (f x = true /\ memP x xs))))
+let rec memP_existsb #a f xs =
+  match xs with
+  | [] -> ()
+  | hd::tl -> memP_existsb f tl
+
let rec memP_map_intro
+  (#a #b: Type)
+  (f: a -> Tot b)
+  (x: a)
+  (l: list a)
+: Lemma
+  (requires True)
+  (ensures (memP x l ==> memP (f x) (map f l)))
+  (decreases l)
+= match l with
+  | [] -> ()
+  | _ :: q -> memP_map_intro f x q (* NOTE: would fail if [requires memP x l] instead of [ ==> ] *)
+
let rec memP_map_elim
+  (#a #b: Type)
+  (f: a -> Tot b)
+  (y: b)
+  (l: list a)
+: Lemma
+  (requires True)
+  (ensures (memP y (map f l) ==> (exists (x : a) . memP x l /\ f x == y)))
+  (decreases l)
+= match l with
+  | [] -> ()
+  | _ :: q -> memP_map_elim f y q
+

+noRepeats_nil

+

Properties of noRepeats

+
let noRepeats_nil
+  (#a: eqtype)
+: Lemma
+  (ensures (noRepeats #a []))
+= ()
+
let noRepeats_cons
+  (#a: eqtype)
+  (h: a)
+  (tl: list a)
+: Lemma
+  (requires ((~ (mem h tl)) /\ noRepeats tl))
+  (ensures (noRepeats #a (h::tl)))
+= ()
+
let rec noRepeats_append_elim
+  (#a: eqtype)
+  (l1 l2: list a)
+: Lemma
+  (requires (noRepeats (l1 @ l2)))
+  (ensures (noRepeats l1 /\ noRepeats l2 /\ (forall x . mem x l1 ==> ~ (mem x l2))))
+  (decreases l1)
+= match l1 with
+  | [] -> ()
+  | x :: q1 ->
+    append_mem q1 l2 x;
+    noRepeats_append_elim q1 l2
+
let rec noRepeats_append_intro
+  (#a: eqtype)
+  (l1 l2: list a)
+: Lemma
+  (requires (noRepeats l1 /\ noRepeats l2 /\ (forall x . mem x l1 ==> ~ (mem x l2))))
+  (ensures (noRepeats (l1 @ l2)))
+  (decreases l1)
+= match l1 with
+  | [] -> ()
+  | x :: q1 ->
+    append_mem q1 l2 x;
+    noRepeats_append_intro q1 l2
+

Properties of assoc

+
let assoc_nil
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+: Lemma
+  (ensures (assoc #a #b x [] == None))
+= ()
+
let assoc_cons_eq
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (y: b)
+  (q: list (a * b))
+: Lemma
+  (ensures (assoc x ((x, y) :: q) == Some y))
+= ()
+
let assoc_cons_not_eq
+  (#a: eqtype)
+  (#b: Type)
+  (x x': a)
+  (y: b)
+  (q: list (a * b))
+: Lemma
+  (requires (x <> x'))
+  (ensures (assoc x' ((x, y) :: q) == assoc x' q))
+= ()
+
let rec assoc_append_elim_r
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (l1 l2: list (a * b))
+: Lemma
+  (requires (assoc x l2 == None \/ ~ (assoc x l1 == None)))
+  (ensures (assoc x (l1 @ l2) == assoc x l1))
+  (decreases l1)
+= match l1 with
+  | [] -> ()
+  | (x', _) :: q -> if x = x' then () else assoc_append_elim_r x q l2
+
let rec assoc_append_elim_l
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (l1 l2: list (a * b))
+: Lemma
+  (requires (assoc x l1 == None))
+  (ensures (assoc x (l1 @ l2) == assoc x l2))
+  (decreases l1)
+= match l1 with
+  | [] -> ()
+  | (x', _) :: q -> if x = x' then assert False else assoc_append_elim_l x q l2
+
let rec assoc_memP_some
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (y: b)
+  (l: list (a * b))
+: Lemma
+  (requires (assoc x l == Some y))
+  (ensures (memP (x, y) l))
+  (decreases l)
+= match l with
+  | [] -> ()
+  | (x', _) :: q -> if x = x' then () else assoc_memP_some x y q
+
let rec assoc_memP_none
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (l: list (a * b))
+: Lemma
+  (requires (assoc x l == None))
+  (ensures (forall y . ~ (memP (x, y) l)))
+  (decreases l)
+= match l with
+  | [] -> ()
+  | (x', _) :: q -> if x = x' then assert False else assoc_memP_none x q
+
let assoc_mem
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (l: list (a * b))
+: Lemma
+  (ensures (mem x (map fst l) <==> (exists y . assoc x l == Some y)))
+= match assoc x l with
+  | None ->
+    assoc_memP_none x l;
+    mem_memP x (map fst l);
+    memP_map_elim fst x l
+  | Some y ->
+    assoc_memP_some x y l;
+    memP_map_intro fst (x, y) l;
+    mem_memP x (map fst l)
+

Properties of fold_left

+
let rec fold_left_invar
+  (#a #b: Type)
+  (f: (a -> b -> Tot a))
+  (l: list b)
+  (p: (a -> Tot Type0))
+  : Lemma
+  (requires forall (x: a) (y: b) . p x ==> memP y l ==> p (f x y) )
+  (ensures forall (x: a) . p x ==> p (fold_left f x l))
+=
+  match l with
+  | [] -> ()
+  | y :: q -> fold_left_invar f q p
+
let rec fold_left_map
+  (#a #b #c: Type)
+  (f_aba: a -> b -> Tot a)
+  (f_bc:  b -> Tot c)
+  (f_aca: a -> c -> Tot a)
+  (l: list b)
+  : Lemma
+  (requires forall (x: a) (y: b) . f_aba x y == f_aca x (f_bc y) )
+  (ensures forall (x : a) . fold_left f_aba x l == fold_left f_aca x (map f_bc l) )
+  =
+  match l with
+  | [] -> ()
+  | y :: q -> fold_left_map f_aba f_bc f_aca q
+
let rec map_append
+  (#a #b: Type)
+  (f: a -> Tot b)
+  (l1 l2: list a)
+:
+  Lemma
+  (ensures map f (l1 @ l2) == map f l1 @ map f l2)
+=
+  match l1 with
+  | [] -> ()
+  | x :: q -> map_append f q l2
+
let rec fold_left_append
+  (#a #b: Type)
+  (f: a -> b -> Tot a)
+  (l1 l2: list b)
+  : Lemma
+  (ensures forall x . fold_left f x (l1 @ l2) == fold_left f (fold_left f x l1) l2)
+= match l1 with
+  | [] -> ()
+  | x :: q -> fold_left_append f q l2
+
let rec fold_left_monoid
+  (#a: Type)
+  (opA: (a -> a -> Tot a))
+  (zeroA: a)
+  (l: list a)
+: Lemma
+  (requires
+    (forall u v w . (u `opA` (v `opA` w)) == ((u `opA` v) `opA` w)) /\
+    (forall x . (x `opA` zeroA) == x) /\
+    (forall x . (zeroA `opA` x) == x))
+  (ensures
+    forall x .
+    (fold_left opA x l) == (x `opA` (fold_left opA zeroA l)))
+= match l with
+  | [] -> ()
+  | x :: q -> fold_left_monoid opA zeroA q
+
let fold_left_append_monoid
+  (#a: Type)
+  (f: (a -> a -> Tot a))
+  (z: a)
+  (l1 l2: list a)
+: Lemma
+  (requires
+    (forall u v w . f u (f v w) == f (f u v) w) /\
+    (forall x . f x z == x) /\
+    (forall x . f z x == x))
+  (ensures
+    fold_left f z (l1 @ l2) == f (fold_left f z l1) (fold_left f z l2))
+= fold_left_append f l1 l2;
+  fold_left_monoid f z l2
+

Properties of index

+
private let rec index_extensionality_aux
+  (#a: Type)
+  (l1 l2: list a)
+  (l_len: (l_len: unit { length l1 == length l2 } ))
+  (l_index: (i: (i: nat {i < length l1})) -> Tot (l_index: unit {index l1 i == index l2 i}))
+: Lemma
+  (ensures (l1 == l2))
+= match (l1, l2) with
+  | (a1::q1, a2::q2) ->
+    let a_eq : (a_eq : unit {a1 == a2}) = l_index 0 in
+    let q_len : (q_len: unit {length q1 == length q2}) = () in
+    let q_index (i: (i: nat {i < length q1})) : Tot (q_index: unit {index q1 i == index q2 i}) =
+      l_index (i + 1) in
+    let q_eq : (q_eq : unit {l1 == l2}) = index_extensionality_aux q1 q2 q_len q_index in
+    ()
+  | _ -> ()
+
let index_extensionality
+  (#a: Type)
+  (l1 l2: list a)
+: Lemma
+  (requires
+    (length l1 == length l2 /\
+    (forall (i: nat) . i < length l1 ==> index l1 i == index l2 i)))
+  (ensures (l1 == l2))
+= index_extensionality_aux l1 l2 () (fun i -> ())
+

Properties of strict_suffix_of

+
let rec strict_suffix_of_nil (#a: Type) (x: a) (l: list a)
+: Lemma
+  (requires True)
+  (ensures (strict_suffix_of [] (x::l)))
+  (decreases l)
+= match l with
+  | [] -> ()
+  | a' :: q -> strict_suffix_of_nil a' q
+
let strict_suffix_of_or_eq_nil (#a: Type) (l: list a)
+: Lemma
+  (ensures (strict_suffix_of [] l \/ l == []))
+= match l with
+  | [] -> ()
+  | a :: q -> strict_suffix_of_nil a q
+
let strict_suffix_of_cons (#a: Type) (x: a) (l: list a) :
+  Lemma
+  (ensures (strict_suffix_of l (x::l)))
+= ()
+
let rec strict_suffix_of_trans (#a: Type) (l1 l2 l3: list a)
+: Lemma
+  (requires True)
+  (ensures ((strict_suffix_of l1 l2 /\ strict_suffix_of l2 l3) ==> strict_suffix_of l1 l3))
+  (decreases l3)
+  [SMTPat (strict_suffix_of l1 l2); SMTPat (strict_suffix_of l2 l3)]
+= match l3 with
+  | [] -> ()
+  | _ :: q -> strict_suffix_of_trans l1 l2 q
+
let rec strict_suffix_of_correct (#a) (l1 l2: list a)
+: Lemma
+  (requires True)
+  (ensures (strict_suffix_of l1 l2 ==> l1 << l2))
+  (decreases l2)
+= match l2 with
+  | [] -> ()
+  | _ :: q ->
+    strict_suffix_of_correct l1 q
+
let rec map_strict_suffix_of (#a #b: Type) (f: a -> Tot b) (l1: list a) (l2: list a) :
+ Lemma
+ (requires True)
+ (ensures (strict_suffix_of l1 l2 ==> strict_suffix_of (map f l1) (map f l2)))
+ (decreases l2)
+= match l2 with
+  | [] -> ()
+  | a::q ->
+    map_strict_suffix_of f l1 q
+
let rec mem_strict_suffix_of (#a: eqtype) (l1: list a) (m: a) (l2: list a)
+: Lemma
+  (requires True)
+  (ensures ((mem m l1 /\ strict_suffix_of l1 l2) ==> mem m l2))
+= match l2 with
+  | [] -> ()
+  | a :: q ->
+    mem_strict_suffix_of l1 m q
+
let rec strict_suffix_of_exists_append
+  (#a: Type)
+  (l1 l2: list a)
+: Lemma
+  (ensures (strict_suffix_of l1 l2 ==> (exists l3 . l2 == append l3 l1)))
+= match l2 with
+  | [] -> ()
+  | a :: q ->
+    FStar.Classical.or_elim
+      #(l1 == q)
+      #(strict_suffix_of l1 q)
+      #(fun _ -> exists l3 . l2 == append l3 l1)
+      (fun _ ->
+    FStar.Classical.exists_intro (fun l3 -> l2 == append l3 l1) (a :: []))
+      (fun _ ->
+    FStar.Classical.exists_elim
+      (exists l3 . l2 == append l3 l1)
+      #_
+      #(fun l3 -> q == append l3 l1)
+      (strict_suffix_of_exists_append l1 q)
+      (fun l3 ->
+         FStar.Classical.exists_intro (fun l3 -> l2 == append l3 l1) (a :: l3)
+         ))
+
let strict_suffix_of_or_eq_exists_append
+  (#a: Type)
+  (l1 l2: list a)
+: Lemma
+  (ensures ((strict_suffix_of l1 l2 \/ l1 == l2) ==> (exists l3 . l2 == append l3 l1)))
+= FStar.Classical.or_elim
+    #(strict_suffix_of l1 l2)
+    #(l1 == l2)
+    #(fun _ -> exists l3 . l2 == append l3 l1)
+    (fun _ ->
+      strict_suffix_of_exists_append l1 l2)
+    (fun _ ->
+    FStar.Classical.exists_intro
+      (fun l3 -> l2 == append l3 l1)
+      [] )
+

Properties of << with lists

+
let precedes_tl
+  (#a: Type)
+  (l: list a {Cons? l})
+: Lemma (ensures (tl l << l))
+= ()
+
let rec precedes_append_cons_r
+  (#a: Type)
+  (l1: list a)
+  (x: a)
+  (l2: list a)
+: Lemma
+  (requires True)
+  (ensures (x << append l1 (x :: l2)))
+  [SMTPat (x << append l1 (x :: l2))]
+= match l1 with
+  | [] -> ()
+  | _ :: q -> precedes_append_cons_r q x l2
+
let precedes_append_cons_prod_r
+  (#a #b: Type)
+  (l1: list (a * b))
+  (x: a)
+  (y: b)
+  (l2: list (a * b))
+: Lemma
+  (ensures
+    x << (append l1 ((x, y) :: l2)) /\
+    y << (append l1 ((x, y) :: l2)))
+= precedes_append_cons_r l1 (x, y) l2
+
let rec memP_precedes
+  (#a: Type)
+  (x: a)
+  (l: list a)
+: Lemma
+  (requires True)
+  (ensures (memP x l ==> x << l))
+  (decreases l)
+= match l with
+  | [] -> ()
+  | y :: q ->
+    FStar.Classical.or_elim
+      #(x == y)
+      #(memP x q)
+      #(fun _ -> x << l)
+      (fun _ -> ())
+      (fun _ -> memP_precedes x q)
+
let assoc_precedes
+  (#a: eqtype)
+  (#b: Type)
+  (x: a)
+  (l: list (a * b))
+  (y: b)
+: Lemma
+  (requires (assoc x l == Some y))
+  (ensures (x << l /\ y << l))
+= assoc_memP_some x y l;
+  memP_precedes (x, y) l
+

Properties about find

+
let rec find_none
+  (#a: Type)
+  (f: (a -> Tot bool))
+  (l: list a)
+  (x: a)
+: Lemma
+  (requires (find f l == None /\ memP x l))
+  (ensures (f x == false))
+= let (x' :: l') = l in
+  Classical.or_elim
+    #(x == x')
+    #(~ (x == x'))
+    #(fun _ -> f x == false)
+    (fun h -> ())
+    (fun h -> find_none f l' x)
+

Properties of init and last

+
let rec append_init_last (#a: Type) (l: list a { Cons? l }) : Lemma
+  (l == append (init l) [last l])
+= match l with
+  | a :: q ->
+    if Cons? q
+    then
+      append_init_last q
+    else
+      ()
+
let rec init_last_def (#a: Type) (l: list a) (x: a) : Lemma
+  (let l' = append l [x] in
+  init l' == l /\ last l' == x)
+= match l with
+  | [] -> ()
+  | y :: q -> init_last_def q x
+
let init_last_inj (#a: Type) (l1: list a { Cons? l1 } ) (l2: list a { Cons? l2 } ) : Lemma
+  (requires (init l1 == init l2 /\ last l1 == last l2))
+  (ensures (l1 == l2))
+= append_init_last l1;
+  append_init_last l2
+ diff --git a/docs/FStar.List.Tot.html b/docs/FStar.List.Tot.html index c3d6373..7bdec58 100644 --- a/docs/FStar.List.Tot.html +++ b/docs/FStar.List.Tot.html @@ -1,16 +1,19 @@ - - + + - - - - - + FStar.List.Tot + -

module FStar.List.Tot

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.List.Tot

+ + diff --git a/docs/FStar.List.html b/docs/FStar.List.html index 20c8498..5bd1a77 100644 --- a/docs/FStar.List.html +++ b/docs/FStar.List.html @@ -1,127 +1,379 @@ - - + + - - - - - - + FStar.List + -

module FStar.List

-

F* stdlib List module.

-

F* standard library List module.

-
 Base operations *
-
val hd:Unidentified product: [list 'a] (ML 'a)
-

[hd l] returns the first element of [l]. Raises an exception if [l] is empty (thus, [hd] hides [List.Tot.hd] which requires [l] to be nonempty at type-checking time.) Named as in: OCaml, F#, Coq

-
val tail:Unidentified product: [list 'a] (ML (list 'a))
-

[tail l] returns [l] without its first element. Raises an exception if [l] is empty (thus, [tail] hides [List.Tot.tail] which requires [l] to be nonempty at type-checking time). Similar to: tl in OCaml, F#, Coq

-
val tl:Unidentified product: [list 'a] (ML (list 'a))
-

[tl l] returns [l] without its first element. Raises an exception if [l] is empty (thus, [tl] hides [List.Tot.tl] which requires [l] to be nonempty at type-checking time). Named as in: tl in OCaml, F#, Coq

-
val last:Unidentified product: [list 'a] (ML 'a)
-

[last l] returns the last element of [l]. Requires, at type-checking time, that [l] be nonempty. Named as in: Haskell

-
val init:Unidentified product: [list 'a] (ML (list 'a))
-

[init l] returns [l] without its last element. Requires, at type-checking time, that [l] be nonempty. Named as in: Haskell

-
 [nth l n] returns the [n]-th element in list [l] (with the first
-element being the 0-th) if [l] is long enough, or raises an exception
-otherwise (thus, [nth] hides [List.Tot.nth] which has [option] type.)
-Named as in: OCaml, F#, Coq
-
 Iterators *
-
val iter:Unidentified product: [(Unidentified product: ['a] (ML unit))] Unidentified product: [list 'a] (ML unit)
-

[iter f l] performs [f x] for each element [x] of [l], in the order in which they appear in [l]. Named as in: OCaml, F# .

-
val iteri_aux:Unidentified product: [int] Unidentified product: [(Unidentified product: [int] Unidentified product: ['a] (ML unit))] Unidentified product: [list 'a] (ML unit)
-

[iteri_aux n f l] performs, for each i, [f (i+n) x] for the i-th element [x] of [l], in the order in which they appear in [l].

-
val iteri:Unidentified product: [(Unidentified product: [int] Unidentified product: ['a] (ML unit))] Unidentified product: [list 'a] (ML unit)
-

[iteri_aux f l] performs, for each [i], [f i x] for the i-th element [x] of [l], in the order in which they appear in [l]. Named as in: OCaml

-
val map:Unidentified product: [(Unidentified product: ['a] (ML 'b))] Unidentified product: [list 'a] (ML (list 'b))
-

[map f l] applies [f] to each element of [l] and returns the list of results, in the order of the original elements in [l]. (Hides [List.Tot.map] which requires, at type-checking time, [f] to be a pure total function.) Named as in: OCaml, Coq, F#

-
val mapT:Unidentified product: [(Unidentified product: ['a] (Tot 'b))] Unidentified product: [list 'a] (Tot (list 'b))
-

[mapT f l] applies [f] to each element of [l] and returns the list of results, in the order of the original elements in [l]. Requires, at type-checking time, [f] to be a pure total function.

-
val mapi_init:Unidentified product: [(Unidentified product: [int] Unidentified product: ['a] (ML 'b))] Unidentified product: [list 'a] Unidentified product: [int] (ML (list 'b))
-

[mapi_init f n l] applies, for each [k], [f (n+k)] to the [k]-th element of [l] and returns the list of results, in the order of the original elements in [l]. (Hides [List.Tot.mapi_init] which requires, at type-checking time, [f] to be a pure total function.)

-
val mapi:Unidentified product: [(Unidentified product: [int] Unidentified product: ['a] (ML 'b))] Unidentified product: [list 'a] (ML (list 'b))
-

[mapi f l] applies, for each [k], [f k] to the [k]-th element of [l] and returns the list of results, in the order of the original elements in [l]. (Hides [List.Tot.mapi] which requires, at type-checking time, [f] to be a pure total function.) Named as in: OCaml

-
 [concatMap f l] applies [f] to each element of [l] and returns the
-concatenation of the results, in the order of the original elements of
-[l]. This is equivalent to [flatten (map f l)]. (Hides
-[List.Tot.concatMap], which requires, at type-checking time, [f] to be
-a pure total function.)
-
val map2:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] (ML 'c))] Unidentified product: [list 'a] Unidentified product: [list 'b] (ML (list 'c))
-

[map2 f l1 l2] computes [f x1 x2] for each element x1 of [l1] and the element [x2] of [l2] at the same position, and returns the list of such results, in the order of the original elements in [l1]. Raises an exception if [l1] and [l2] have different lengths. Named as in: OCaml

-
val map3:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] Unidentified product: ['c] (ML 'd))] Unidentified product: [list 'a] Unidentified product: [list 'b] Unidentified product: [list 'c] (ML (list 'd))
-

[map3 f l1 l2 l3] computes [f x1 x2 x3] for each element x1 of [l1] and the element [x2] of [l2] and the element [x3] of [l3] at the same position, and returns the list of such results, in the order of the original elements in [l1]. Raises an exception if [l1], [l2] and [l3] have different lengths. Named as in: OCaml

-
val fold_left:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] (ML 'a))] Unidentified product: ['a] Unidentified product: [list 'b] (ML 'a)
-

[fold_left f x [y1; y2; ...; yn]] computes (f (... (f x y1) y2) ... yn). (Hides [List.Tot.fold_left], which requires, at type-checking time, [f] to be a pure total function.) Named as in: OCaml, Coq

-
val fold_left2:Unidentified product: [(Unidentified product: ['s] Unidentified product: ['a] Unidentified product: ['b] (ML 's))] Unidentified product: ['s] Unidentified product: [list 'a] Unidentified product: [list 'b] (ML 's)
-

[fold_left2 f x [y1; y2; ...; yn] [z1; z2; ...; zn]] computes (f (... (f x y1 z1) y2 z2 ... yn zn). Raises an exception if [y1; y2; ...] and [z1; z2; ...] have different lengths. (Thus, hides [List.Tot.fold_left2] which requires such a condition at type-checking time.) Named as in: OCaml

-
val fold_right:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] (ML 'b))] Unidentified product: [list 'a] Unidentified product: ['b] (ML 'b)
-

[fold_right f [x1; x2; ...; xn] y] computes (f x1 (f x2 (... (f xn y)) ... )). (Hides [List.Tot.fold_right], which requires, at type-checking time, [f] to be a pure total function.) Named as in: OCaml, Coq

-
 List searching *
-
val filter:Unidentified product: [(Unidentified product: ['a] (ML bool))] Unidentified product: [list 'a] (ML (list 'a))
-

[filter f l] returns [l] with all elements [x] such that [f x] does not hold removed. (Hides [List.Tot.filter] which requires, at type-checking time, [f] to be a pure total function.) Named as in: OCaml, Coq

-
val for_all:Unidentified product: [(Unidentified product: ['a] (ML bool))] Unidentified product: [list 'a] (ML bool)
-

[for_all f l] returns [true] if, and only if, for all elements [x] appearing in [l], [f x] holds. (Hides [List.Tot.for_all], which requires, at type-checking time, [f] to be a pure total function.) Named as in: OCaml. Similar to: List.forallb in Coq

-
val forall2:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['b] (ML bool))] Unidentified product: [list 'a] Unidentified product: [list 'b] (ML bool)
-

[for_all f l1 l2] returns [true] if, and only if, for all elements [x1] appearing in [l1] and the element [x2] appearing in [l2] at the same position, [f x1 x2] holds. Raises an exception if [l1] and [l2] have different lengths. Similar to: List.for_all2 in OCaml. Similar to: List.Forall2 in Coq (which is propositional)

-
val collect:Unidentified product: [(Unidentified product: ['a] (ML (list 'b)))] Unidentified product: [list 'a] (ML (list 'b))
-

[collect f l] applies [f] to each element of [l] and returns the concatenation of the results, in the order of the original elements of [l]. It is equivalent to [flatten (map f l)]. (Hides [List.Tot.collect] which requires, at type-checking time, [f] to be a pure total function.) TODO: what is the difference with [concatMap]?

-
val tryFind:Unidentified product: [(Unidentified product: ['a] (ML bool))] Unidentified product: [list 'a] (ML (option 'a))
-

[tryFind f l] returns [Some x] for some element [x] appearing in [l] such that [f x] holds, or [None] only if no such [x] exists. (Hides [List.Tot.tryFind], which requires, at type-checking time, [f] to be a pure total function.)

-
val tryPick:Unidentified product: [(Unidentified product: ['a] (ML (option 'b)))] Unidentified product: [list 'a] (ML (option 'b))
-

[tryPick f l] returns [y] for some element [x] appearing in [l] such that [f x = Some y] for some y, or [None] only if [f x = None] for all elements [x] of [l]. (Hides [List.Tot.tryPick], which requires, at type-checking time, [f] to be a pure total function.)

-
val choose:Unidentified product: [(Unidentified product: ['a] (ML (option 'b)))] Unidentified product: [list 'a] (ML (list 'b))
-

[choose f l] returns the list of [y] for all elements [x] appearing in [l] such that [f x = Some y] for some [y]. (Hides [List.Tot.choose] which requires, at type-checking time, [f] to be a pure total function.)

-
val partition:Unidentified product: [(Unidentified product: ['a] (ML bool))] Unidentified product: [list 'a] (ML (*(list 'a, list 'a)))
-

[partition f l] returns the pair of lists [(l1, l2)] where all elements [x] of [l] are in [l1] if [f x] holds, and in [l2] otherwise. Both [l1] and [l2] retain the original order of [l]. (Hides [List.Tot.partition], which requires, at type-checking time, [f] to be a pure total function.)

-
 List of tuples *
-
val zip:Unidentified product: [list 'a] Unidentified product: [list 'b] (ML (list (*('a, 'b))))
-

[zip] takes two lists [x1, ..., xn] and [y1, ..., yn] and returns the list of pairs [(x1, y1), ..., (xn, yn)]. Raises an exception if the two lists have different lengths. Named as in: Haskell

-
 Sorting (implemented as quicksort) *
-
val sortWith:Unidentified product: [(Unidentified product: ['a] Unidentified product: ['a] (ML int))] Unidentified product: [list 'a] (ML (list 'a))
-

[sortWith compare l] returns the list [l'] containing the elements of [l] sorted along the comparison function [compare], in such a way that if [compare x y > 0], then [x] appears before [y] in [l']. (Hides [List.Tot.sortWith], which requires, at type-checking time, [compare] to be a pure total function.)

-
val splitAt:Unidentified product: [nat] Unidentified product: [list 'a] (ML (*(list 'a, list 'a)))
-

[splitAt n l] returns the pair of lists [(l1, l2)] such that [l1] contains the first [n] elements of [l] and [l2] contains the rest. Raises an exception if [l] has fewer than [n] elements.

-
let ((filter_map (f:Unidentified product: ['a] (ML (option 'b))) (l:list 'a)):(ML (list 'b))):let rec ((filter_map_acc (acc:list 'b) (l:list 'a)):(ML (list 'b)))=match l with []  -> rev acc | (Prims.Cons hd tl)  -> match f hd with (Some hd)  -> filter_map_acc ((Prims.Cons hd acc)) tl | None  -> filter_map_acc acc tl in filter_map_acc (Prims.Nil ) l
-

[filter_map f l] returns the list of [y] for all elements [x] appearing in [l] such that [f x = Some y] for some [y]. (Implemented here as a tail-recursive version of [choose]

-
val index:Unidentified product: [(Unidentified product: ['a] (ML bool))] Unidentified product: [list 'a] (ML int)
-

[index f l] returns the position index in list [l] of the first element [x] in [l] such that [f x] holds. Raises an exception if no such [x] exists. TODO: rename this function (it hides List.Tot.index which has a completely different semantics.)

+

+FStar.List

+ +

@summary F* stdlib List module.

+

Base operations *

+

+hd

+

hd l returns the first element of l. Raises an exception if +l is empty (thus, hd hides List.Tot.hd which requires l to be +nonempty at type-checking time.) Named as in: OCaml, F#, Coq

+
val hd: list 'a -> ML 'a
+let hd = function
+  | hd::tl -> hd
+  | _ -> failwith "head of empty list"
+

+tail

+

tail l returns l without its first element. Raises an +exception if l is empty (thus, tail hides List.Tot.tail which +requires l to be nonempty at type-checking time). Similar to: tl in +OCaml, F#, Coq

+
val tail: list 'a -> ML (list 'a)
+let tail = function
+  | hd::tl -> tl
+  | _ -> failwith "tail of empty list"
+

+tl

+

tl l returns l without its first element. Raises an exception +if l is empty (thus, tl hides List.Tot.tl which requires l to +be nonempty at type-checking time). Named as in: tl in OCaml, F#, Coq

+
val tl : list 'a -> ML (list 'a)
+let tl l = tail l
+

+last

+

last l returns the last element of l. Requires, at +type-checking time, that l be nonempty. Named as in: Haskell

+
val last: list 'a -> ML 'a
+let rec last = function
+  | [hd] -> hd
+  | _::tl -> last tl
+  | _ -> failwith "last of empty list"
+

+init

+

init l returns l without its last element. Requires, at +type-checking time, that l be nonempty. Named as in: Haskell

+
val init: list 'a -> ML (list 'a)
+let rec init = function
+  | [_] -> []
+  | hd::tl -> hd::(init tl)
+  | _ -> failwith "init of empty list"
+

nth l n returns the n-th element in list l (with the first +element being the 0-th) if l is long enough, or raises an exception +otherwise (thus, nth hides List.Tot.nth which has option type.) +Named as in: OCaml, F#, Coq

+
val nth: list 'a -> int -> ML 'a
+let rec nth l n =
+  if n < 0 then
+    failwith "nth takes a non-negative integer as input"
+  else
+    if n = 0 then
+      match l with
+        | [] -> failwith "not enough elements"
+        | hd::_ -> hd
+    else
+      match l with
+        | [] -> failwith "not enough elements"
+        | _::tl -> nth tl (n - 1)
+

Iterators *

+

+iter

+

iter f l performs f x for each element x of l, in the +order in which they appear in l. Named as in: OCaml, F# .

+
val iter: ('a -> ML unit) -> list 'a -> ML unit
+let rec iter f x = match x with
+  | [] -> ()
+  | a::tl -> let _ = f a in iter f tl
+

+iteri_aux

+

iteri_aux n f l performs, for each i, f (i+n) x for the i-th +element x of l, in the order in which they appear in l.

+
val iteri_aux: int -> (int -> 'a -> ML unit) -> list 'a -> ML unit
+let rec iteri_aux i f x = match x with
+  | [] -> ()
+  | a::tl -> f i a; iteri_aux (i+1) f tl
+

+iteri

+

iteri_aux f l performs, for each i, f i x for the i-th +element x of l, in the order in which they appear in l. Named as +in: OCaml

+
val iteri: (int -> 'a -> ML unit) -> list 'a -> ML unit
+let iteri f x = iteri_aux 0 f x
+

+map

+

map f l applies f to each element of l and returns the list +of results, in the order of the original elements in l. (Hides +List.Tot.map which requires, at type-checking time, f to be a pure +total function.) Named as in: OCaml, Coq, F#

+
val map: ('a -> ML 'b) -> list 'a -> ML (list 'b)
+let rec map f x = match x with
+  | [] -> []
+  | a::tl -> f a::map f tl
+

+mapT

+

mapT f l applies f to each element of l and returns the list +of results, in the order of the original elements in l. Requires, at +type-checking time, f to be a pure total function.

+
val mapT: ('a -> Tot 'b) -> list 'a -> Tot (list 'b)
+let mapT = FStar.List.Tot.map
+

+mapi_init

+

mapi_init f n l applies, for each k, f (n+k) to the k-th +element of l and returns the list of results, in the order of the +original elements in l. (Hides List.Tot.mapi_init which requires, +at type-checking time, f to be a pure total function.)

+
val mapi_init: (int -> 'a -> ML 'b) -> list 'a -> int -> ML (list 'b)
+let rec mapi_init f l i = match l with
+    | [] -> []
+    | hd::tl -> (f i hd)::(mapi_init f tl (i+1))
+

+mapi

+

mapi f l applies, for each k, f k to the k-th element of +l and returns the list of results, in the order of the original +elements in l. (Hides List.Tot.mapi which requires, at +type-checking time, f to be a pure total function.) Named as in: +OCaml

+
val mapi: (int -> 'a -> ML 'b) -> list 'a -> ML (list 'b)
+let mapi f l = mapi_init f l 0
+

concatMap f l applies f to each element of l and returns the +concatenation of the results, in the order of the original elements of +l. This is equivalent to flatten (map f l). (Hides +List.Tot.concatMap, which requires, at type-checking time, f to be +a pure total function.)

+
val concatMap: ('a -> ML (list 'b)) -> list 'a -> ML (list 'b)
+let rec concatMap f = function
+  | [] -> []
+  | a::tl ->
+    let fa = f a in
+    let ftl = concatMap f tl in
+    fa @ ftl
+

+map2

+

map2 f l1 l2 computes f x1 x2 for each element x1 of l1 and +the element x2 of l2 at the same position, and returns the list of +such results, in the order of the original elements in l1. Raises an +exception if l1 and l2 have different lengths. Named as in: OCaml

+
val map2: ('a -> 'b -> ML 'c) -> list 'a -> list 'b -> ML (list 'c)
+let rec map2 f l1 l2 = match l1, l2 with
+    | [], [] -> []
+    | hd1::tl1, hd2::tl2 -> (f hd1 hd2)::(map2 f tl1 tl2)
+    | _, _ -> failwith "The lists do not have the same length"
+

+map3

+

map3 f l1 l2 l3 computes f x1 x2 x3 for each element x1 of +l1 and the element x2 of l2 and the element x3 of l3 at the +same position, and returns the list of such results, in the order of +the original elements in l1. Raises an exception if l1, l2 and +l3 have different lengths. Named as in: OCaml

+
val map3: ('a -> 'b -> 'c -> ML 'd) -> list 'a -> list 'b -> list 'c -> ML (list 'd)
+let rec map3 f l1 l2 l3 = match l1, l2, l3 with
+    | [], [], [] -> []
+    | hd1::tl1, hd2::tl2, hd3::tl3 -> (f hd1 hd2 hd3)::(map3 f tl1 tl2 tl3)
+    | _, _, _ -> failwith "The lists do not have the same length"
+

+fold_left

+

fold_left f x y1; y2; ...; yn`` computes (f (... (f x y1) y2) +... yn). (Hides List.Tot.fold_left, which requires, at type-checking +time, `f` to be a pure total function.) Named as in: OCaml, Coq

+
val fold_left: ('a -> 'b -> ML 'a) -> 'a -> list 'b -> ML 'a
+let rec fold_left f x y = match y with
+  | [] -> x
+  | hd::tl -> fold_left f (f x hd) tl
+

+fold_left2

+

fold_left2 f x y1; y2; ...; yn z1; z2; ...; zn`` computes (f +(... (f x y1 z1) y2 z2 ... yn zn). Raises an exception if [y1; y2; +...andz1; z2; ...` have different lengths. (Thus, hides +`List.Tot.fold_left2` which requires such a condition at type-checking +time.) Named as in: OCaml

+
val fold_left2: ('s -> 'a -> 'b -> ML 's) -> 's -> list 'a -> list 'b -> ML 's
+let rec fold_left2 f a l1 l2 = match l1, l2 with
+    | [], [] -> a
+    | hd1::tl1, hd2::tl2 -> fold_left2 f (f a hd1 hd2) tl1 tl2
+    | _, _ -> failwith "The lists do not have the same length"
+

+fold_right

+

fold_right f x1; x2; ...; xn y computes (f x1 (f x2 (... (f xn +y)) ... )). (Hides List.Tot.fold_right, which requires, at +type-checking time, f to be a pure total function.) Named as in: +OCaml, Coq

+
val fold_right: ('a -> 'b -> ML 'b) -> list 'a -> 'b -> ML 'b
+let rec fold_right f l x = match l with
+  | [] -> x
+  | hd::tl -> f hd (fold_right f tl x)
+

List searching *

+

+filter

+

filter f l returns l with all elements x such that f x +does not hold removed. (Hides List.Tot.filter which requires, at +type-checking time, f to be a pure total function.) Named as in: +OCaml, Coq

+
val filter: ('a -> ML bool) -> list 'a -> ML (list 'a)
+let rec filter f = function
+  | [] -> []
+  | hd::tl -> if f hd then hd::(filter f tl) else filter f tl
+

+for_all

+

for_all f l returns true if, and only if, for all elements x +appearing in l, f x holds. (Hides List.Tot.for_all, which +requires, at type-checking time, f to be a pure total function.) +Named as in: OCaml. Similar to: List.forallb in Coq

+
val for_all: ('a -> ML bool) -> list 'a -> ML bool
+let rec for_all f l = match l with
+    | [] -> true
+    | hd::tl -> if f hd then for_all f tl else false
+

+forall2

+

for_all f l1 l2 returns true if, and only if, for all elements +x1 appearing in l1 and the element x2 appearing in l2 at the +same position, f x1 x2 holds. Raises an exception if l1 and l2 +have different lengths. Similar to: List.for_all2 in OCaml. Similar +to: List.Forall2 in Coq (which is propositional)

+
val forall2: ('a -> 'b -> ML bool) -> list 'a -> list 'b -> ML bool
+let rec forall2 f l1 l2 = match l1,l2 with
+    | [], [] -> true
+    | hd1::tl1, hd2::tl2 -> if f hd1 hd2 then forall2 f tl1 tl2 else false
+    | _, _ -> failwith "The lists do not have the same length"
+

+collect

+

collect f l applies f to each element of l and returns the +concatenation of the results, in the order of the original elements of +l. It is equivalent to flatten (map f l). (Hides +List.Tot.collect which requires, at type-checking time, f to be a +pure total function.) TODO: what is the difference with concatMap?

+
val collect: ('a -> ML (list 'b)) -> list 'a -> ML (list 'b)
+let rec collect f l = match l with
+    | [] -> []
+    | hd::tl -> append (f hd) (collect f tl)
+

+tryFind

+

tryFind f l returns Some x for some element x appearing in +l such that f x holds, or None only if no such x +exists. (Hides List.Tot.tryFind, which requires, at type-checking +time, f to be a pure total function.)

+
val tryFind: ('a -> ML bool) -> list 'a -> ML (option 'a)
+let rec tryFind p l = match l with
+    | [] -> None
+    | hd::tl -> if p hd then Some hd else tryFind p tl
+

+tryPick

+

tryPick f l returns y for some element x appearing in l +such that f x = Some y for some y, or None only if f x = None +for all elements x of l. (Hides List.Tot.tryPick, which +requires, at type-checking time, f to be a pure total function.)

+
val tryPick: ('a -> ML (option 'b)) -> list 'a -> ML (option 'b)
+let rec tryPick f l = match l with
+    | [] -> None
+    | hd::tl ->
+       match f hd with
+         | Some x -> Some x
+         | None -> tryPick f tl
+

+choose

+

choose f l returns the list of y for all elements x +appearing in l such that f x = Some y for some y. (Hides +List.Tot.choose which requires, at type-checking time, f to be a +pure total function.)

+
val choose: ('a -> ML (option 'b)) -> list 'a -> ML (list 'b)
+let rec choose f l = match l with
+    | [] -> []
+    | hd::tl ->
+       match f hd with
+         | Some x -> x::(choose f tl)
+         | None -> choose f tl
+

+partition

+

partition f l returns the pair of lists (l1, l2) where all +elements x of l are in l1 if f x holds, and in l2 +otherwise. Both l1 and l2 retain the original order of l. (Hides +List.Tot.partition, which requires, at type-checking time, f to be +a pure total function.)

+
val partition: ('a -> ML bool) -> list 'a -> ML (list 'a * list 'a)
+let rec partition f = function
+  | [] -> [], []
+  | hd::tl ->
+     let l1, l2 = partition f tl in
+     if f hd
+     then hd::l1, l2
+     else l1, hd::l2
+

List of tuples *

+

+zip

+

zip takes two lists x1, ..., xn and y1, ..., yn and returns +the list of pairs (x1, y1), ..., (xn, yn). Raises an exception if +the two lists have different lengths. Named as in: Haskell

+
val zip: list 'a -> list 'b -> ML (list ('a * 'b))
+let rec zip l1 l2 = match l1,l2 with
+    | [], [] -> []
+    | hd1::tl1, hd2::tl2 -> (hd1,hd2)::(zip tl1 tl2)
+    | _, _ -> failwith "The lists do not have the same length"
+

Sorting (implemented as quicksort) *

+

+sortWith

+

sortWith compare l returns the list l' containing the elements +of l sorted along the comparison function compare, in such a way +that if compare x y > 0, then x appears before y in l'. (Hides +List.Tot.sortWith, which requires, at type-checking time, compare +to be a pure total function.)

+
val sortWith: ('a -> 'a -> ML int) -> list 'a -> ML (list 'a)
+let rec sortWith f = function
+  | [] -> []
+  | pivot::tl ->
+     let hi, lo  = partition (fun x -> f pivot x > 0) tl in
+     sortWith f lo@(pivot::sortWith f hi)
+

+splitAt

+

splitAt n l returns the pair of lists (l1, l2) such that l1 +contains the first n elements of l and l2 contains the +rest. Raises an exception if l has fewer than n elements.

+
val splitAt: nat -> list 'a -> ML (list 'a * list 'a)
+let rec splitAt n l =
+  if n = 0 then [], l
+  else
+    match l with
+      | []     -> failwith "splitAt index is more that list length"
+      | hd::tl ->
+        let l1, l2 = splitAt (n - 1) tl in
+        hd::l1, l2
+

+filter_map_acc

+

filter_map f l returns the list of y for all elements x +appearing in l such that f x = Some y for some y. (Implemented +here as a tail-recursive version of choose

+
let filter_map (f:'a -> ML (option 'b)) (l:list 'a) : ML (list 'b) =
+  let rec filter_map_acc (acc:list 'b) (l:list 'a) : ML (list 'b) =
+    match l with
+    | [] ->
+        rev acc
+    | hd :: tl ->
+        match f hd with
+        | Some hd ->
+            filter_map_acc (hd :: acc) tl
+        | None ->
+            filter_map_acc acc tl
+  in
+  filter_map_acc [] l
+

+index

+

index f l returns the position index in list l of the first +element x in l such that f x holds. Raises an exception if no +such x exists. TODO: rename this function (it hides List.Tot.index +which has a completely different semantics.)

+
val index: ('a -> ML bool) -> list 'a -> ML int
+let index f l =
+  let rec index l i : ML int =
+    match l with
+    | [] ->
+        failwith "List.index: not found"
+    | hd :: tl ->
+        if f hd then
+          i
+        else
+          index tl (i + 1)
+  in
+  index l 0
+ diff --git a/docs/FStar.MRef.html b/docs/FStar.MRef.html index 1d5da0e..50801e9 100644 --- a/docs/FStar.MRef.html +++ b/docs/FStar.MRef.html @@ -1,16 +1,45 @@ - - + + - - - - - + FStar.MRef + -

module FStar.MRef

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.MRef

+ +
let stable = FStar.Preorder.stable
+
val token (#a:Type) (#b:preorder a) (r:mref a b) (p:(a -> Type){stable p b}) : Type0
+
val witness_token: #a:Type -> #b:preorder a -> m:mref a b -> p:(a -> Type){stable p b}
+  -> ST unit (requires (fun h0 -> p (sel h0 m)))
+            (ensures (fun h0 _ h1 -> h0==h1 /\ token m p))
+
val recall_token: #a:Type -> #b:preorder a -> m:mref a b -> p:(a -> Type){stable p b}
+  -> ST unit (requires (fun _ ->  token m p))
+            (ensures (fun h0 _ h1 -> h0==h1 /\ p (sel h1 m)))
+
let spred (#a:Type) (rel:preorder a) = p:(a -> Type){Preorder.stable p rel}
+
val lemma_functoriality (#a:Type) (#rel:preorder a) (r:mref a rel) (p q:spred rel)
+  : Lemma (requires (token r p /\ (forall x. p x ==> q x)))
+    (ensures (token r q))
+

KM : These don't have much to do here...

+
val recall: p:(heap -> Type){ST.stable p} ->
+  ST unit
+    (requires (fun _ ->  witnessed p))
+    (ensures (fun h0 _ h1 -> h0 == h1 /\ p h1))
+
val witness: p:(heap -> Type){ST.stable p} ->
+  ST unit
+    (requires (fun h0 -> p h0))
+    (ensures (fun h0 _ h1 -> h0==h1 /\ witnessed p))
+ diff --git a/docs/FStar.Map.html b/docs/FStar.Map.html index 45a54a8..8c50974 100644 --- a/docs/FStar.Map.html +++ b/docs/FStar.Map.html @@ -1,57 +1,134 @@ - - + + - - - - - - + FStar.Map + -

module FStar.Map

-

FStar.Map provides a polymorphic, partial map from keys to

-

values, where keys support decidable equality.

+

+FStar.Map

+

m:Map.t key value is a partial map from key to value

A distinctive feature of the library is in its model of partiality.

-

A map can be seen as a pair of: 1. a total map key -> Tot value 2. a set of keys that record the domain of the map

-
* Extensional equality **
+

A map can be seen as a pair of:

+
    +
  1. a total map key -> Tot value +
    2. +
  2. a set of keys that record the domain of the map
    3. +
+

Map.t key value: The main type provided by this module

+
val t (key:eqtype) (value:Type u#a)
+  : Type u#a
+

sel m k : Look up key k in map m

+
val sel: #key:eqtype -> #value:Type -> t key value -> key -> Tot value
+

upd m k v : A map identical to m except mapping k to v

+
val upd: #key:eqtype -> #value:Type -> t key value -> key -> value -> Tot (t key value)
+

const v : A constant map mapping all keys to v

+
val const: #key:eqtype -> #value:Type -> value -> Tot (t key value)
+

domain m : The set of keys on which this partial map is defined

+
val domain: #key:eqtype -> #value:Type -> t key value -> Tot (S.set key)
+

contains m k: Decides if key k is in the map m

+
val contains: #key:eqtype -> #value:Type -> t key value -> key -> Tot bool
+

concat m1 m2 : +A map whose domain is the union of the domains of m1 and m2.

+
 Maps every key `k` in the domain of `m1` to `sel m1 k`
+ and all other keys to `sel m2 k`.
+
+
val concat: #key:eqtype -> #value:Type -> t key value -> t key value -> Tot (t key value)
+

map_val f m: +A map whose domain is the same as m but all values have +f applied to them.

+
val map_val: #val1:Type -> #val2:Type -> f:(val1 -> val2) -> #key:eqtype -> t key val1 -> Tot (t key val2)
+

restrict s m: +Restricts the domain of m to (domain m intersect s)

+
val restrict: #key:eqtype -> #value:Type -> S.set key -> t key value -> Tot (t key value)
+

const_on dom v: A defined notion, for convenience +A partial constant map on dom

+
let const_on (#key:eqtype) (#value:Type) (dom:S.set key) (v:value)
+  : t key value
+  = restrict dom (const v)
+

disjoint_dom m1 m2: +Disjoint domains. TODO: its pattern is biased towards m1. Why?

+
let disjoint_dom (#key:eqtype) (#value:Type) (m1:t key value) (m2:t key value)
+  = forall x.{:pattern (contains m1 x)(* ; (contains m2 x) *)} contains m1 x ==> not (contains m2 x)
+

has_dom m dom: A relational version of the domain m function

+
let has_dom (#key:eqtype) (#value:Type) (m:t key value) (dom:S.set key)
+  = forall x. contains m x <==> S.mem x dom
+

Properties about map functions

+
val lemma_SelUpd1: #key:eqtype -> #value:Type -> m:t key value -> k:key -> v:value ->
+                   Lemma (requires True) (ensures (sel (upd m k v) k == v))
+                   [SMTPat (sel (upd m k v) k)]
+
val lemma_SelUpd2: #key:eqtype -> #value:Type -> m:t key value -> k1:key -> k2:key -> v:value ->
+                   Lemma (requires True) (ensures (k2=!=k1 ==> sel (upd m k2 v) k1 == sel m k1))
+                   [SMTPat (sel (upd m k2 v) k1)]
+
val lemma_SelConst: #key:eqtype -> #value:Type -> v:value -> k:key ->
+                    Lemma (requires True) (ensures (sel (const v) k == v))
+                    [SMTPat (sel (const v) k)]
+
val lemma_SelRestrict: #key:eqtype -> #value:Type -> m:t key value -> ks:S.set key -> k:key ->
+                       Lemma (requires True) (ensures (S.mem k ks ==> sel (restrict ks m) k == sel m k))
+                       [SMTPat (sel (restrict ks m) k)]
+
val lemma_SelConcat1: #key:eqtype -> #value:Type -> m1:t key value -> m2:t key value -> k:key ->
+                      Lemma (requires True) (ensures (contains m2 k ==> sel (concat m1 m2) k==sel m2 k))
+                      [SMTPat (sel (concat m1 m2) k)]
+
val lemma_SelConcat2: #key:eqtype -> #value:Type -> m1:t key value -> m2:t key value -> k:key ->
+                      Lemma (requires True) (ensures (not(contains m2 k) ==> sel (concat m1 m2) k==sel m1 k))
+                      [SMTPat (sel (concat m1 m2) k)]
+
val lemma_SelMapVal: #val1:Type -> #val2:Type -> f:(val1 -> val2) -> #key:eqtype -> m:t key val1 -> k:key ->
+                     Lemma (requires True) (ensures (sel (map_val f m) k == f (sel m k)))
+                     [SMTPat (sel (map_val f m) k)]
+
val lemma_InDomUpd1: #key:eqtype -> #value:Type -> m:t key value -> k1:key -> k2:key -> v:value ->
+                     Lemma (requires True) (ensures (contains (upd m k1 v) k2 == (k1=k2 || contains m k2)))
+                     [SMTPat (contains (upd m k1 v) k2)]
+
val lemma_InDomUpd2: #key:eqtype -> #value:Type -> m:t key value -> k1:key -> k2:key -> v:value ->
+                     Lemma (requires True) (ensures (k2=!=k1 ==> contains (upd m k2 v) k1 == contains m k1))
+                     [SMTPat (contains (upd m k2 v) k1)]
+
val lemma_InDomConstMap: #key:eqtype -> #value:Type -> v:value -> k:key ->
+                         Lemma (requires True) (ensures (contains (const v) k))
+                         [SMTPat (contains (const v) k)]
+
val lemma_InDomConcat: #key:eqtype -> #value:Type -> m1:t key value -> m2:t key value -> k:key ->
+                 Lemma (requires True) (ensures (contains (concat m1 m2) k==(contains m1 k || contains m2 k)))
+                 [SMTPat (contains (concat m1 m2) k)]
+
val lemma_InMapVal: #val1:Type -> #val2:Type -> f:(val1 -> val2) -> #key:eqtype -> m:t key val1 -> k:key ->
+                    Lemma (requires True) (ensures (contains (map_val f m) k == contains m k))
+                    [SMTPat (contains (map_val f m) k)]
+
val lemma_InDomRestrict: #key:eqtype -> #value:Type -> m:t key value -> ks:S.set key -> k:key ->
+                         Lemma (requires True) (ensures (contains (restrict ks m) k == (S.mem k ks && contains m k)))
+                         [SMTPat (contains (restrict ks m) k)]
+
val lemma_ContainsDom: #key:eqtype -> #value:Type -> m:t key value -> k:key ->
+  Lemma (requires True) (ensures (contains m k = S.mem k (domain m)))
+                      [SMTPatOr[[SMTPat (contains m k)]; [SMTPat (S.mem k (domain m))]]]
+
val lemma_UpdDomain : #key:eqtype -> #value:Type -> m:t key value -> k:key -> v:value ->
+  Lemma (requires True)
+        (ensures (S.equal (domain (upd m k v)) (S.union (domain m) (S.singleton k))))
+        [SMTPat (domain (upd m k v))]
+

+Extensional equality **

+

equal m1 m2: +Maps m1 and m2 have the same domain and +and are pointwise equal on that domain.

+
val equal (#key:eqtype) (#value:Type) (m1:t key value) (m2:t key value) : prop
+

lemma_equal_intro: +Introducing equal m1 m2 by showing maps to be pointwise equal on the same domain

+
val lemma_equal_intro: #key:eqtype -> #value:Type -> m1:t key value -> m2:t key value ->
+                       Lemma (requires (forall k. sel m1 k == sel m2 k /\
+                                             contains m1 k = contains m2 k))
+                             (ensures (equal m1 m2))
+                             [SMTPat (equal m1 m2)]
+

lemma_equal_elim: +Eliminating equal m1 m2 to provable equality of maps +Internally, this involves a use of functional extensionality

+
val lemma_equal_elim: #key:eqtype -> #value:Type -> m1:t key value -> m2:t key value ->
+                      Lemma (ensures (equal m1 m2 <==> m1 == m2))
+                            [SMTPat (equal m1 m2)]
+
[@@(deprecated "use lemma_equal_elim")]
+val lemma_equal_refl: #key:eqtype -> #value:Type -> m1:t key value -> m2:t key value ->
+                      Lemma  (requires (m1 == m2))
+                             (ensures  (equal m1 m2))
+ diff --git a/docs/FStar.MarkovsPrinciple.html b/docs/FStar.MarkovsPrinciple.html index b4d56ad..7c02c4e 100644 --- a/docs/FStar.MarkovsPrinciple.html +++ b/docs/FStar.MarkovsPrinciple.html @@ -1,16 +1,21 @@ - - + + - - - - - + FStar.MarkovsPrinciple + -

module FStar.MarkovsPrinciple

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.MarkovsPrinciple

+
assume val markovs_principle : p:(nat -> Tot bool) -> Ghost nat
+  (requires (~(forall (n:nat). ~(p n))))
+  (ensures (fun n -> p n))
+

here is a stronger variant of Markov's principle +(might be as strong as indefinite description?)

+
assume val stronger_markovs_principle : p:(nat -> GTot bool) -> Ghost nat
+  (requires (~(forall (n:nat). ~(p n))))
+  (ensures (fun n -> p n))
+ diff --git a/docs/FStar.Math.Euclid.html b/docs/FStar.Math.Euclid.html index 37de926..ade5315 100644 --- a/docs/FStar.Math.Euclid.html +++ b/docs/FStar.Math.Euclid.html @@ -1,16 +1,108 @@ - - + + - - - - - + FStar.Math.Euclid + -

module FStar.Math.Euclid

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Math.Euclid

+ +
#set-options "--fuel 0 --ifuel 0 --z3rlimit 40"
+
+

Divides relation

+

It is reflexive, transitive, and antisymmetric up to sign. +When a <> 0, a divides b iff a % b = 0 (this is proved below)

+
+
let divides (a b:int) : prop = exists q. b = q * a
+
val divides_reflexive (a:int) : Lemma (a `divides` a) [SMTPat (a `divides` a)]
+
val divides_transitive (a b c:int) : Lemma
+  (requires a `divides` b /\ b `divides` c)
+  (ensures  a `divides` c)
+
val divide_antisym (a b:int) : Lemma
+  (requires a `divides` b /\ b `divides` a)
+  (ensures  a = b \/ a = -b)
+
val divides_0 (a:int) : Lemma (a `divides` 0)
+
val divides_1 (a:int) : Lemma (requires a `divides` 1) (ensures a = 1 \/ a = -1)
+
val divides_minus (a b:int) : Lemma
+  (requires a `divides` b)
+  (ensures  a `divides` (-b))
+
val divides_opp (a b:int) : Lemma
+  (requires a `divides` b)
+  (ensures (-a) `divides` b)
+
val divides_plus (a b d:int) : Lemma
+  (requires d `divides` a /\ d `divides` b)
+  (ensures  d `divides` (a + b))
+
val divides_sub (a b d:int) : Lemma
+  (requires d `divides` a /\ d `divides` b)
+  (ensures  d `divides` (a - b))
+
val divides_mult_right (a b d:int) : Lemma
+  (requires d `divides` b)
+  (ensures  d `divides` (a * b))
+
+

Greatest Common Divisor (GCD) relation

+

We deviate from the standard definition in that we allow the divisor to +be negative. Thus, the GCD of two integers is unique up to sign.

+
+
let is_gcd (a b d:int) : prop =
+  d `divides` a /\
+  d `divides` b /\
+  (forall x. (x `divides` a /\ x `divides` b) ==> x `divides` d)
+
val mod_divides (a:int) (b:nonzero) : Lemma (requires a % b = 0) (ensures b `divides` a)
+
val divides_mod (a:int) (b:nonzero) : Lemma (requires b `divides` a) (ensures a % b = 0)
+
val is_gcd_unique (a b c d:int) : Lemma
+  (requires is_gcd a b c /\ is_gcd a b d)
+  (ensures  c = d \/ c = -d)
+
val is_gcd_reflexive (a:int) : Lemma (is_gcd a a a)
+
val is_gcd_symmetric (a b d:int) : Lemma
+  (requires is_gcd a b d)
+  (ensures  is_gcd b a d)
+
val is_gcd_0 (a:int) : Lemma (is_gcd a 0 a)
+
val is_gcd_1 (a:int) : Lemma (is_gcd a 1 1)
+
val is_gcd_minus (a b d:int) : Lemma
+  (requires is_gcd a (-b) d)
+  (ensures  is_gcd b a d)
+
val is_gcd_opp (a b d:int) : Lemma
+  (requires is_gcd a b d)
+  (ensures  is_gcd b a (-d))
+
val is_gcd_plus (a b q d:int) : Lemma
+  (requires is_gcd a b d)
+  (ensures  is_gcd a (b + q * a) d)
+
+

Extended Euclidean algorithm

+

Computes the GCD of two integers (a, b) together with Bézout coefficients +(r, s) satisfying r a + s b = gcd(a, b)

+
+
val euclid_gcd (a b:int) : Pure (int & int & int)
+  (requires True)
+  (ensures  fun (r, s, d) -> r * a + s * b = d /\ is_gcd a b d)
+
+

A definition of primality based on the divides relation

+
+
let is_prime (p:int) =
+  1 < p /\
+  (forall (d:int).{:pattern (d `divides` p)}
+     (d `divides` p ==> (d = 1 \/ d = -1 \/ d = p \/ d = -p)))
+
val bezout_prime (p:int) (a:pos{a < p}) : Pure (int & int)
+  (requires is_prime p)
+  (ensures  fun (r, s) -> r * p + s * a = 1)
+
+

Euclid's lemma and its generalization to arbitrary integers

+ +
+
val euclid (n:pos) (a b r s:int) : Lemma
+  (requires (a * b) % n = 0 /\ r * n + s * a = 1)
+  (ensures  b % n = 0)
+
val euclid_prime (p:int{is_prime p}) (a b:int) : Lemma
+  (requires (a * b) % p = 0)
+  (ensures  a % p = 0 \/ b % p = 0)
+ diff --git a/docs/FStar.Math.Fermat.html b/docs/FStar.Math.Fermat.html index 2d74dca..d1b4268 100644 --- a/docs/FStar.Math.Fermat.html +++ b/docs/FStar.Math.Fermat.html @@ -1,16 +1,40 @@ - - + + - - - - - + FStar.Math.Fermat + -

module FStar.Math.Fermat

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Math.Fermat

+ +
+

Fermat's Little Theorem (and Binomial Theorem)

+

Proven by induction from the Freshman's dream identity

+

pow (a + b) p % p = (pow a p + pow b p) % p

+

which follows from the Binomial Theorem

+

pow (a + b) n = sum_{i=0}^n (binomial n k * pow a (n - i) * pow b i)

+

which in turn can be proved by induction from Pascal's identity

+

binomial n k + binomial n (k - 1) = binomial (n + 1) k

+

See +https://github.com/coqtail/coqtail/blob/master/src/Hierarchy/Commutative_ring_binomial.v +https://github.com/coq-contribs/rsa/blob/master/Binomials.v

+
+
#set-options "--fuel 0 --ifuel 0"
+
let rec pow (a:int) (k:nat) : int =
+  if k = 0 then 1
+  else a * pow a (k - 1)
+
val fermat (p:int{is_prime p}) (a:int) : Lemma (pow a p % p == a % p)
+
val mod_mult_congr (p:int{is_prime p}) (a b c:int) : Lemma
+  (requires (a * c) % p = (b * c) % p /\ c % p <> 0)
+  (ensures  a % p = b % p)
+
val fermat_alt (p:int{is_prime p}) (a:int{a % p <> 0}) : Lemma (pow a (p - 1) % p == 1)
+ diff --git a/docs/FStar.Math.Lemmas.html b/docs/FStar.Math.Lemmas.html index 93d7bec..4a38701 100644 --- a/docs/FStar.Math.Lemmas.html +++ b/docs/FStar.Math.Lemmas.html @@ -1,57 +1,815 @@ - - + + - - - - - - + FStar.Math.Lemmas + -

module FStar.Math.Lemmas

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
val modulo_lemma:Unidentified product: [a:nat] Unidentified product: [b:pos] (Lemma ((requires (<(a, b)))) ((ensures (=(%(a, b), a)))))
+

+FStar.Math.Lemmas

+ +
#push-options "--fuel 0 --ifuel 0"
+

Lemma: definition of Euclidean division

+
val euclidean_div_axiom: a:int -> b:pos -> Lemma
+  (a - b * (a / b) >= 0 /\ a - b * (a / b) < b)
+let euclidean_div_axiom a b = ()
+
val lemma_eucl_div_bound: a:int -> b:int -> q:int -> Lemma
+  (requires (a < q))
+  (ensures  (a + q * b < q * (b+1)))
+let lemma_eucl_div_bound a b q = ()
+
val lemma_mult_le_left: a:nat -> b:int -> c:int -> Lemma
+  (requires (b <= c))
+  (ensures  (a * b <= a * c))
+let lemma_mult_le_left a b c = ()
+
val lemma_mult_le_right: a:nat -> b:int -> c:int -> Lemma
+  (requires (b <= c))
+  (ensures  (b * a <= c * a))
+let lemma_mult_le_right a b c = ()
+
val lemma_mult_lt_left: a:pos -> b:int -> c:int -> Lemma
+  (requires (b < c))
+  (ensures  (a * b < a * c))
+let lemma_mult_lt_left a b c = ()
+
val lemma_mult_lt_right: a:pos -> b:int -> c:int -> Lemma
+  (requires (b < c))
+  (ensures  (b * a < c * a))
+let lemma_mult_lt_right a b c = ()
+
let lemma_mult_lt_sqr (n:nat) (m:nat) (k:nat{n < k && m < k})
+  : Lemma (n * m < k * k) =
+  calc (<=) {
+    n * m;
+  <= { lemma_mult_le_left n m (k - 1) }
+    n * (k - 1);
+  <= { lemma_mult_le_right (k - 1) n (k - 1) }
+    (k - 1) * (k - 1);
+  <= {}
+    k*k - 1;
+  }
+

Lemma: multiplication on integers is commutative

+
val swap_mul: a:int -> b:int -> Lemma (a * b = b * a)
+let swap_mul a b = ()
+
val lemma_cancel_mul (a b : int) (n : pos) : Lemma (requires (a * n = b * n)) (ensures (a = b))
+let lemma_cancel_mul a b n = ()
+

Lemma: multiplication is right distributive over addition

+
val distributivity_add_left: a:int -> b:int -> c:int -> Lemma
+  ((a + b) * c = a * c + b * c)
+let distributivity_add_left a b c = ()
+

Lemma: multiplication is left distributive over addition

+
val distributivity_add_right: a:int -> b:int -> c:int -> Lemma
+  (a * (b + c) = a * b + a * c)
+let distributivity_add_right a b c =
+  calc (==) {
+    a * (b + c);
+  == {}
+    (b + c) * a;
+  == { distributivity_add_left b c a }
+    b * a + c * a;
+  == {}
+    a * b + a * c;
+  }
+

Lemma: multiplication is associative, hence parenthesizing is meaningless

+

GM: This is really just an identity since the LHS is associated to the left

+
val paren_mul_left: a:int -> b:int -> c:int -> Lemma
+  (a * b * c = (a * b) * c)
+let paren_mul_left a b c = ()
+

Lemma: multiplication is associative, hence parenthesizing is meaningless

+
val paren_mul_right: a:int -> b:int -> c:int -> Lemma
+  (a * b * c = a * (b * c))
+let paren_mul_right a b c = ()
+

Lemma: addition is associative, hence parenthesizing is meaningless

+
val paren_add_left: a:int -> b:int -> c:int -> Lemma
+  (a + b + c = (a + b) + c)
+let paren_add_left a b c = ()
+

Lemma: addition is associative, hence parenthesizing is meaningless

+
val paren_add_right: a:int -> b:int -> c:int -> Lemma
+  (a + b + c = a + (b + c))
+let paren_add_right a b c = ()
+
val addition_is_associative: a:int -> b:int -> c:int -> Lemma
+  (a + b + c = (a + b) + c /\ a + b + c = a + (b + c))
+let addition_is_associative a b c = ()
+
val subtraction_is_distributive: a:int -> b:int -> c:int -> Lemma
+  (a - b + c = (a - b) + c /\
+   a - b - c = a - (b + c) /\
+   a - b - c = (a - b) - c /\
+   a + (-b - c) = a - b - c /\
+   a - (b - c) = a - b + c)
+let subtraction_is_distributive a b c = ()
+
val swap_add_plus_minus: a:int -> b:int -> c:int -> Lemma
+  (a + b - c = (a - c) + b)
+let swap_add_plus_minus a b c = ()
+

Lemma: minus applies to the whole term

+
val neg_mul_left: a:int -> b:int -> Lemma (-(a * b) = (-a) * b)
+let neg_mul_left a b = ()
+

Lemma: minus applies to the whole term

+
val neg_mul_right: a:int -> b:int -> Lemma (-(a * b) = a * (-b))
+let neg_mul_right a b = ()
+
val swap_neg_mul: a:int -> b:int -> Lemma ((-a) * b = a * (-b))
+let swap_neg_mul a b =
+  neg_mul_left a b;
+  neg_mul_right a b
+

Lemma: multiplication is left distributive over substraction

+
val distributivity_sub_left: a:int -> b:int -> c:int ->
+  Lemma ((a - b) * c = a * c - b * c)
+let distributivity_sub_left a b c =
+  calc (==) {
+    (a - b) * c;
+  == {}
+    (a + (-b)) * c;
+  == { distributivity_add_left a (-b) c }
+    a * c + (-b) * c;
+  == { neg_mul_left b c }
+    a * c - b * c;
+  }
+

Lemma: multiplication is right distributive over substraction

+
val distributivity_sub_right: a:int -> b:int -> c:int ->
+  Lemma ((a * (b - c) = a * b - a * c))
+let distributivity_sub_right a b c =
+  calc (==) {
+    a * (b - c);
+  == {}
+    a * (b + (-c));
+  == { distributivity_add_right a b (-c) }
+    a * b + a * (-c);
+  == { neg_mul_right a c }
+    a * b - a * c;
+  }
+

Lemma: multiplication precedence on addition

+
val mul_binds_tighter: a:int -> b:int -> c:int -> Lemma (a + (b * c) = a + b * c)
+let mul_binds_tighter a b c = ()
+
val lemma_abs_mul : a:int -> b:int -> Lemma (abs a * abs b = abs (a * b))
+let lemma_abs_mul a b = ()
+
val lemma_abs_bound : a:int -> b:nat -> Lemma (abs a < b <==> -b < a /\ a < b)
+let lemma_abs_bound a b = ()
+

Lemma: multiplication keeps symetric bounds : +b > 0 && d > 0 && -b < a < b && -d < c < d ==> - b * d < a * c < b * d

+
val mul_ineq1: a:int -> b:nat -> c:int -> d:nat -> Lemma
+    (requires (-b < a /\ a < b /\
+               -d < c /\ c < d))
+    (ensures  (-(b * d) < a * c /\ a * c < b * d))
+let mul_ineq1 a b c d =
+  if a = 0 || c = 0 then ()
+  else begin
+    lemma_abs_bound a b;
+    lemma_abs_bound c d;
+    lemma_abs_mul a c;
+    lemma_mult_lt_left (abs a) (abs c) d;
+    lemma_mult_lt_right d (abs a) b;
+    lemma_abs_bound (a * c) (b * d);
+    ()
+  end
+

Zero is neutral for addition

+
let add_zero_left_is_same (n : int) : Lemma(0 + n = n) = ()
+let add_zero_right_is_same (n : int) : Lemma(n + 0 = n) = ()
+

One is neutral for multiplication

+
let mul_one_left_is_same (n : int) : Lemma(1 * n = n) = ()
+let mul_one_right_is_same (n : int) : Lemma(n * 1 = n) = ()
+

Multiplying by zero gives zero

+
let mul_zero_left_is_zero (n : int) : Lemma(0 * n = 0) = ()
+let mul_zero_right_is_zero (n : int) : Lemma(n * 0 = 0) = ()
+
val nat_times_nat_is_nat: a:nat -> b:nat -> Lemma (a * b >= 0)
+let nat_times_nat_is_nat a b = ()
+
val pos_times_pos_is_pos: a:pos -> b:pos -> Lemma (a * b > 0)
+let pos_times_pos_is_pos a b = ()
+
val nat_over_pos_is_nat: a:nat -> b:pos -> Lemma (a / b >= 0)
+let nat_over_pos_is_nat a b = ()
+
val nat_plus_nat_equal_zero_lemma: a:nat -> b:nat{a + b = 0} -> Lemma(a = 0 /\ b = 0)
+let nat_plus_nat_equal_zero_lemma a b = ()
+
val int_times_int_equal_zero_lemma: a:int -> b:int{a * b = 0} -> Lemma(a = 0 \/ b = 0)
+let int_times_int_equal_zero_lemma a b = ()
+
#push-options "--fuel 1"
+val pow2_double_sum: n:nat -> Lemma (pow2 n + pow2 n = pow2 (n + 1))
+let pow2_double_sum n = ()
+
val pow2_double_mult: n:nat -> Lemma (2 * pow2 n = pow2 (n + 1))
+let pow2_double_mult n = pow2_double_sum n
+
val pow2_lt_compat: n:nat -> m:nat -> Lemma
+  (requires (m < n))
+  (ensures  (pow2 m < pow2 n))
+  (decreases m)
+let rec pow2_lt_compat n m =
+  match m with
+  | 0 -> ()
+  | _ -> pow2_lt_compat (n-1) (m-1)
+#pop-options
+
val pow2_le_compat: n:nat -> m:nat -> Lemma
+  (requires (m <= n))
+  (ensures  (pow2 m <= pow2 n))
+let pow2_le_compat n m =
+  if m < n then pow2_lt_compat n m
+
#push-options "--fuel 1"
+val pow2_plus: n:nat -> m:nat -> Lemma
+  (ensures (pow2 n * pow2 m = pow2 (n + m)))
+  (decreases n)
+let rec pow2_plus n m =
+  match n with
+  | 0 -> ()
+  | _ -> pow2_plus (n - 1) m
+#pop-options
+

Lemma : definition of the exponential property of pow2

+
val pow2_minus: n:nat -> m:nat{ n >= m } -> Lemma
+  ((pow2 n) / (pow2 m) = pow2 (n - m))
+let pow2_minus n m =
+  pow2_plus (n - m) m;
+  slash_star_axiom (pow2 (n - m)) (pow2 m) (pow2 n)
+

Lemma: loss of precision in euclidean division

+
val multiply_fractions (a:int) (n:nonzero) : Lemma (n * ( a / n ) <= a)
+let multiply_fractions a n = ()
+

+modulo_lemma

Same as small_mod

-
val lemma_div_mod:Unidentified product: [a:int] Unidentified product: [p:nonzero] (Lemma (=(a, +(*(p, (/(a, p))), %(a, p)))))
+
val modulo_lemma: a:nat -> b:pos -> Lemma (requires (a < b)) (ensures (a % b = a))
+let modulo_lemma a b = ()
+

+lemma_div_mod

Same as lemma_div_def in Math.Lib

+
val lemma_div_mod: a:int -> p:nonzero -> Lemma (a = p * (a / p) + a % p)
+let lemma_div_mod a p = ()
+
val lemma_mod_lt: a:int -> p:pos -> Lemma (0 <= a % p /\ a % p < p /\ (a >= 0 ==> a % p <= a))
+let lemma_mod_lt a p = ()
+
val lemma_div_lt_nat: a:int -> n:nat -> m:nat{m <= n} ->
+  Lemma (requires (a < pow2 n))
+        (ensures  (a / pow2 m < pow2 (n-m)))
+let lemma_div_lt_nat a n m =
+  lemma_div_mod a (pow2 m);
+  assert(a = pow2 m * (a / pow2 m) + a % pow2 m);
+  pow2_plus m (n-m);
+  assert(pow2 n = pow2 m * pow2 (n - m))
+
val lemma_div_lt (a:int) (n:nat) (m:nat) : Lemma
+  (requires m <= n /\ a < pow2 n)
+  (ensures a / pow2 m < pow2 (n-m))
+let lemma_div_lt a n m =
+  if a >= 0 then lemma_div_lt_nat a n m
+
val bounded_multiple_is_zero (x:int) (n:pos) : Lemma
+  (requires -n < x * n /\ x * n < n)
+  (ensures x == 0)
+let bounded_multiple_is_zero (x:int) (n:pos) = ()
+
val small_div (a:nat) (n:pos) : Lemma (requires a < n) (ensures a / n == 0)
+let small_div (a:nat) (n:pos) : Lemma (requires a < n) (ensures a / n == 0) = ()
+
val small_mod (a:nat) (n:pos) : Lemma (requires a < n) (ensures a % n == a)
+let small_mod (a:nat) (n:pos) : Lemma (requires a < n) (ensures a % n == a) = ()
+
val lt_multiple_is_equal (a:nat) (b:nat) (x:int) (n:nonzero) : Lemma
+  (requires a < n /\ b < n /\ a == b + x * n)
+  (ensures a == b /\ x == 0)
+let lt_multiple_is_equal a b x n =
+  assert (0 * n == 0);
+  bounded_multiple_is_zero x n
+
val lemma_mod_plus (a:int) (k:int) (n:pos) : Lemma ((a + k * n) % n = a % n)
+let lemma_mod_plus (a:int) (k:int) (n:pos) =
+  calc (==) {
+    (a+k*n)%n - a%n;
+    == { lemma_div_mod a n; lemma_div_mod (a+k*n) n }
+    ((a + k*n) - n*((a + k*n)/n)) - (a - n*(a/n));
+    == {}
+    n*k + n*(a/n) - n*((a + k*n)/n);
+    == { distributivity_add_right n k (a/n);
+         distributivity_sub_right n (k + a/n) ((a + k*n)/n) }
+    n * (k + a/n - (a+k*n)/n);
+  };
+  lt_multiple_is_equal ((a+k*n)%n) (a%n) (k + a/n - (a+k*n)/n) n;
+  ()
+
val lemma_div_plus (a:int) (k:int) (n:pos) : Lemma ((a + k * n) / n = a / n + k)
+let lemma_div_plus (a:int) (k:int) (n:pos) =
+  calc (==) {
+    n * ((a+k*n)/n - a/n);
+    == { distributivity_sub_right n ((a+k*n)/n) (a/n) }
+    n * ((a+k*n)/n) - n*(a/n);
+    == { lemma_div_mod (a+k*n) n; lemma_div_mod a n }
+    (a + k*n - (a+k*n)%n) - (a - a%n);
+    == {}
+    k*n - (a+k*n)%n + a%n;
+    == { lemma_mod_plus a k n }
+    k*n;
+  };
+  lemma_cancel_mul ((a+k*n)/n - a/n) k n
+
let lemma_div_mod_plus (a:int) (k:int) (n:pos) : Lemma ((a + k * n) / n = a / n + k /\
+                                                        (a + k * n) % n = a % n) =
+    lemma_div_plus a k n;
+    lemma_mod_plus a k n
+
val add_div_mod_1 (a:int) (n:pos) : Lemma ((a + n) % n == a % n /\ (a + n) / n == a / n + 1)
+let add_div_mod_1 a n =
+    lemma_mod_plus a 1 n;
+    lemma_div_plus a 1 n
+
val sub_div_mod_1 (a:int) (n:pos) : Lemma ((a - n) % n == a % n /\ (a - n) / n == a / n - 1)
+let sub_div_mod_1 a n =
+    lemma_mod_plus a (-1) n;
+    lemma_div_plus a (-1) n
+
#push-options "--smtencoding.elim_box true --smtencoding.nl_arith_repr native"
+
val cancel_mul_div (a:int) (n:nonzero) : Lemma ((a * n) / n == a)
+let cancel_mul_div (a:int) (n:nonzero) = ()
+
#pop-options
+
val cancel_mul_mod (a:int) (n:pos) : Lemma ((a * n) % n == 0)
+let cancel_mul_mod (a:int) (n:pos) =
+  small_mod 0 n;
+  lemma_mod_plus 0 a n
+
val lemma_mod_add_distr (a:int) (b:int) (n:pos) : Lemma ((a + b % n) % n = (a + b) % n)
+let lemma_mod_add_distr (a:int) (b:int) (n:pos) =
+  calc (==) {
+    (a + b%n) % n;
+    == { lemma_mod_plus (a + (b % n)) (b / n) n }
+    (a + b%n + n * (b/n)) % n;
+    == { lemma_div_mod b n }
+    (a + b) % n;
+  }
+
val lemma_mod_sub_distr (a:int) (b:int) (n:pos) : Lemma ((a - b % n) % n = (a - b) % n)
+let lemma_mod_sub_distr (a:int) (b:int) (n:pos) =
+  calc (==) {
+    (a - b%n) % n;
+    == { lemma_mod_plus (a - (b % n)) (-(b / n)) n }
+    (a - b%n + n * (-(b/n))) % n;
+    == { neg_mul_right n (b/n) }
+    (a - b%n - n * (b/n)) % n;
+    == { lemma_div_mod b n }
+    (a - b) % n;
+  }
+
val lemma_mod_sub_0: a:pos -> Lemma ((-1) % a = a - 1)
+let lemma_mod_sub_0 a = ()
+
val lemma_mod_sub_1: a:pos -> b:pos{a < b} -> Lemma ((-a) % b = b - (a%b))
+let lemma_mod_sub_1 a b =
+  calc (==) {
+    (-a) % b;
+    == { lemma_mod_plus (-a) 1 b }
+    ((-a) + 1*b) % b;
+    == {}
+    (b - a) % b;
+    == { small_mod (b-a) b }
+    b - a;
+    == { small_mod a b }
+    b - a%b;
+  }
+
val lemma_mod_mul_distr_l (a:int) (b:int) (n:pos) : Lemma
+  (requires True)
+  (ensures (a * b) % n = ((a % n) * b) % n)
+
let lemma_mod_mul_distr_l a b n =
+  calc (==) {
+    (a * b)  % n;
+    == { lemma_div_mod a n }
+    ((n * (a/n) + a%n) * b)  % n;
+    == { distributivity_add_left (n * (a/n)) (a%n) b }
+    (n * (a/n) * b + (a%n) * b)  % n;
+    == { paren_mul_right n (a/n) b; swap_mul ((a/n) * b) n }
+    ((a%n) * b + ((a/n) * b) * n)  % n;
+    == { lemma_mod_plus ((a%n) * b) ((a/n) * b) n }
+    ((a%n) * b)  % n;
+  }
+
val lemma_mod_mul_distr_r (a:int) (b:int) (n:pos) : Lemma ((a * b) % n = (a * (b % n)) % n)
+let lemma_mod_mul_distr_r (a:int) (b:int) (n:pos) =
+  calc (==) {
+    (a * b) % n;
+    == { swap_mul a b }
+    (b * a) % n;
+    == { lemma_mod_mul_distr_l b a n }
+    (b%n * a) % n;
+    == { swap_mul a (b%n) }
+    (a * (b%n)) % n;
+  }
+
val lemma_mod_injective: p:pos -> a:nat -> b:nat -> Lemma
+  (requires (a < p /\ b < p /\ a % p = b % p))
+  (ensures  (a = b))
+let lemma_mod_injective p a b = ()
+
val lemma_mul_sub_distr: a:int -> b:int -> c:int -> Lemma
+  (a * b - a * c = a * (b - c))
+let lemma_mul_sub_distr a b c =
+  distributivity_sub_right a b c
+
val lemma_div_exact: a:int -> p:pos -> Lemma
+  (requires (a % p = 0))
+  (ensures  (a = p * (a / p)))
+let lemma_div_exact a p = ()
+
val div_exact_r (a:int) (n:pos) : Lemma
+  (requires (a % n = 0))
+  (ensures  (a = (a / n) * n))
+let div_exact_r (a:int) (n:pos) = lemma_div_exact a n
+
val lemma_mod_spec: a:int -> p:pos -> Lemma
+  (a / p = (a - (a % p)) / p)
+
let lemma_mod_spec a p =
+  calc (==) {
+    (a - a%p)/p;
+    == { lemma_div_mod a p }
+    (p*(a/p))/p;
+    == { cancel_mul_div (a/p) p }
+    a/p;
+  }
+
val lemma_mod_spec2: a:int -> p:pos -> Lemma
+  (let q:int = (a - (a % p)) / p in a = (a % p) + q * p)
+let lemma_mod_spec2 a p =
+  calc (==) {
+    (a % p) + ((a - (a % p)) / p) * p;
+    == { lemma_mod_spec a p }
+    (a % p) + (a / p) * p;
+    == { lemma_div_mod a p }
+    a;
+  }
+
val lemma_mod_plus_distr_l: a:int -> b:int -> p:pos -> Lemma
+  ((a + b) % p = ((a % p) + b) % p)
+let lemma_mod_plus_distr_l a b p =
+  let q = (a - (a % p)) / p in
+  lemma_mod_spec2 a p;
+  lemma_mod_plus (a % p + b) q p
+
val lemma_mod_plus_distr_r: a:int -> b:int -> p:pos -> Lemma
+  ((a + b) % p = (a + (b % p)) % p)
+let lemma_mod_plus_distr_r a b p =
+  lemma_mod_plus_distr_l b a p
+
val lemma_mod_mod: a:int -> b:int -> p:pos -> Lemma
+  (requires (a = b % p))
+  (ensures  (a % p = b % p))
+let lemma_mod_mod a b p =
+  lemma_mod_lt b p;
+  modulo_lemma (b % p) p
+ +

Lemma: Definition of euclidean division

+
val euclidean_division_definition: a:int -> b:nonzero ->
+  Lemma (a = (a / b) * b + a % b)
+let euclidean_division_definition a b = ()
+

Lemma: Propriety about modulo

+
val modulo_range_lemma: a:int -> b:pos ->
+  Lemma (a % b >= 0 && a % b < b)
+let modulo_range_lemma a b = ()
+
val small_modulo_lemma_1: a:nat -> b:nonzero ->
+  Lemma (requires a < b) (ensures a % b = a)
+let small_modulo_lemma_1 a b = ()
+
val small_modulo_lemma_2: a:int -> b:pos ->
+  Lemma (requires a % b = a) (ensures a < b)
+let small_modulo_lemma_2 a b = ()
+
val small_division_lemma_1: a:nat -> b:nonzero ->
+  Lemma (requires a < b) (ensures a / b = 0)
+let small_division_lemma_1 a b = ()
+
val small_division_lemma_2 (a:int) (n:pos) : Lemma
+  (requires a / n = 0)
+  (ensures 0 <= a /\ a < n)
+let small_division_lemma_2 (a:int) (n:pos) = lemma_div_mod a n
+

Lemma: Multiplication by a positive integer preserves order

+
val multiplication_order_lemma: a:int -> b:int -> p:pos ->
+  Lemma (a >= b <==> a * p >= b * p)
+let multiplication_order_lemma a b p = ()
+

Lemma: Propriety about multiplication after division

+
val division_propriety: a:int -> b:pos ->
+  Lemma (a - b < (a / b) * b && (a / b) * b <= a)
+let division_propriety a b = ()
+

Internal lemmas for proving the definition of division

+
val division_definition_lemma_1: a:int -> b:pos -> m:int{a - b < m * b} ->
+  Lemma (m > a / b - 1)
+let division_definition_lemma_1 a b m =
+  if a / b - 1 < 0 then () else begin
+    division_propriety a b;
+    multiplication_order_lemma m (a / b - 1) b
+  end
+val division_definition_lemma_2: a:int -> b:pos -> m:int{m * b <= a} ->
+  Lemma (m < a / b + 1)
+let division_definition_lemma_2 a b m =
+  division_propriety a b;
+  multiplication_order_lemma (a / b + 1) m b
+

Lemma: Definition of division

+
val division_definition: a:int -> b:pos -> m:int{a - b < m * b && m * b <= a} ->
+  Lemma (m = a / b)
+let division_definition a b m =
+  division_definition_lemma_1 a b m;
+  division_definition_lemma_2 a b m
+

Lemma: (a * b) / b = a; identical to cancel_mul_div above

+
val multiple_division_lemma (a:int) (n:nonzero) : Lemma ((a * n) / n = a)
+let multiple_division_lemma (a:int) (n:nonzero) = cancel_mul_div a n
+

Lemma: (a * b) % b = 0

+
val multiple_modulo_lemma (a:int) (n:pos) : Lemma ((a * n) % n = 0)
+let multiple_modulo_lemma (a:int) (n:pos) = cancel_mul_mod a n
+

Lemma: Division distributivity under special condition

+
val division_addition_lemma: a:int -> b:pos -> n:int ->
+  Lemma ( (a + n * b) / b = a / b + n )
+let division_addition_lemma a b n = division_definition (a + n * b) b (a / b + n)
+
let lemma_div_le_ (a:int) (b:int) (d:pos) : Lemma
+  (requires (a <= b /\ a / d > b / d))
+  (ensures  (False))
+  = lemma_div_mod a d;
+    lemma_div_mod b d;
+    cut (d * (a / d) + a % d <= d * (b / d) + b % d);
+    cut (d * (a / d) - d * (b / d) <= b % d - a % d);
+    distributivity_sub_right d (a/d) (b/d);
+    cut (b % d < d /\ a % d < d);
+    cut (d * (a/d - b/d) <= d)
+
val lemma_div_le: a:int -> b:int -> d:pos ->
+  Lemma (requires (a <= b))
+        (ensures  (a / d <= b / d))
+let lemma_div_le a b d =
+  if a / d > b / d then lemma_div_le_ a b d
+

Lemma: Division distributivity under special condition

+
val division_sub_lemma (a:int) (n:pos) (b:nat) : Lemma ((a - b * n) / n = a / n - b)
+let division_sub_lemma (a:int) (n:pos) (b:nat) =
+  neg_mul_left b n;
+  lemma_div_plus a (-b) n
+

Lemma: Modulo distributivity

+
val modulo_distributivity: a:int -> b:int -> c:pos -> Lemma ((a + b) % c == (a % c + b % c) % c)
+let modulo_distributivity a b c =
+  calc (==) {
+    (a + b) % c;
+    == { lemma_mod_plus_distr_l a b c }
+    ((a % c) + b) % c;
+    == { lemma_mod_plus_distr_r (a % c) b c }
+    ((a % c) + (b % c)) % c;
+  }
+
val lemma_mod_plus_mul_distr: a:int -> b:int -> c:int -> p:pos -> Lemma
+  (((a + b) * c) % p = ((((a % p) + (b % p)) % p) * (c % p)) % p)
+let lemma_mod_plus_mul_distr a b c p =
+  calc (==) {
+    ((a + b) * c) % p;
+    == { lemma_mod_mul_distr_l (a + b) c p }
+    (((a + b) % p) * c) % p;
+    == { lemma_mod_mul_distr_r ((a + b) % p) c p }
+    (((a + b) % p) * (c % p)) % p;
+    == { modulo_distributivity a b p }
+    ((((a % p) + (b % p)) % p) * (c % p)) % p;
+  }
+

Lemma: Modulo distributivity under special condition

+
val modulo_addition_lemma (a:int) (n:pos) (b:int) : Lemma ((a + b * n) % n = a % n)
+let modulo_addition_lemma (a:int) (n:pos) (b:int) = lemma_mod_plus a b n
+

Lemma: Modulo distributivity under special condition

+
val lemma_mod_sub (a:int) (n:pos) (b:int) : Lemma (ensures (a - b * n) % n = a % n)
+let lemma_mod_sub (a:int) (n:pos) (b:int) =
+  neg_mul_left b n;
+  lemma_mod_plus a (-b) n
+
val mod_mult_exact (a:int) (n:pos) (q:pos) : Lemma
+  (requires (a % (n * q) == 0))
+  (ensures a % n == 0)
+
let mod_mult_exact (a:int) (n:pos) (q:pos) =
+  calc (==) {
+    a % n;
+    == { lemma_div_mod a (n * q) }
+    ((n * q) * (a / (n * q)) + a % (n * q))  % n;
+    == { (* hyp *) }
+    ((n * q) * (a / (n * q)))  % n;
+    == { paren_mul_right n q (a / (n * q));
+         swap_mul n (q * (a / (n * q))) }
+    ((q * (a / (n * q))) * n) % n;
+    == { multiple_modulo_lemma (q * (a / (n*q))) n }
+    0;
+  }
+
val mod_mul_div_exact (a:int) (b:pos) (n:pos) : Lemma
+  (requires (a % (b * n) == 0))
+  (ensures (a / b) % n == 0)
+let mod_mul_div_exact (a:int) (b:pos) (n:pos) =
+  calc (==) {
+    (a / b) % n;
+    == { lemma_div_mod a (b * n) (* + hyp *) }
+    (((b*n)*(a / (b*n))) / b) % n;
+    == { paren_mul_right b n (a / (b*n)) }
+    ((b*(n*(a / (b*n)))) / b) % n;
+    == { cancel_mul_div (n * (a / (b * n))) b }
+    (n*(a / (b*n))) % n;
+    == { cancel_mul_mod (a / (b*n)) n }
+    0;
+  }
+
#push-options "--fuel 1"
+val mod_pow2_div2 (a:int) (m:pos) : Lemma
+  (requires a % pow2 m == 0)
+  (ensures (a / 2) % pow2 (m - 1) == 0)
+let mod_pow2_div2 (a:int) (m:pos) : Lemma
+  (requires a % pow2 m == 0)
+  (ensures (a / 2) % pow2 (m - 1) == 0)
+  =
+  mod_mul_div_exact a 2 (pow2 (m - 1))
+#pop-options
+
private val lemma_div_lt_cancel (a : int) (b : pos) (n : int) :
+  Lemma (requires (a < b * n))
+        (ensures (a / b < n))
+
private let lemma_div_lt_cancel a b n =
+

by contradiction

+
if a / b >= n then begin
+  calc (>=) {
+    a;
+    >= { slash_decr_axiom a b }
+    (a / b) * b;
+    >= {}
+    n * b;
+  };
+  assert False
+end
+
private val lemma_mod_mult_zero (a : int) (b : pos) (c : pos) : Lemma ((a % (b * c)) / b / c == 0)
+private let lemma_mod_mult_zero a b c =
+

< 1

+
lemma_mod_lt a (b * c);
+lemma_div_lt_cancel (a % (b * c)) b c;
+lemma_div_lt_cancel ((a % (b * c)) / b) c 1;
+
+

= 0

+
+
nat_over_pos_is_nat (a % (b * c)) b;
+nat_over_pos_is_nat ((a % (b * c)) / b) c;
+()
+

Lemma: Divided by a product is equivalent to being divided one by one

+
val division_multiplication_lemma (a:int) (b:pos) (c:pos) : Lemma
+  (a / (b * c) = (a / b) / c)
+let division_multiplication_lemma (a:int) (b:pos) (c:pos) =
+  calc (==) {
+    a / b / c;
+    == { lemma_div_mod a (b * c) }
+    ((b * c) * (a / (b * c)) + a % (b * c)) / b / c;
+    == { paren_mul_right b c (a / (b * c)) }
+    (b * (c * (a / (b * c))) + a % (b * c)) / b / c;
+    == { lemma_div_plus (a % (b * c)) (c * (a / (b * c))) b }
+    (c * (a / (b * c)) + ((a % (b * c)) / b)) / c;
+    == { lemma_div_plus ((a % (b * c)) / b) (a / (b * c)) c }
+    (a / (b * c)) + (a % (b * c)) / b / c;
+    == { lemma_mod_mult_zero a b c }
+    a / (b * c);
+  }
+
private val cancel_fraction (a:int) (b:pos) (c:pos) : Lemma ((a * c) / (b * c) == a / b)
+private let cancel_fraction a b c =
+  calc (==) {
+    (a * c) / (b * c);
+    == { swap_mul b c }
+    (a * c) / (c * b);
+    == { division_multiplication_lemma (a * c) c b }
+    ((a * c) / c) / b;
+    == { cancel_mul_div a c }
+    a / b;
+  }
+
val modulo_scale_lemma : a:int -> b:pos -> c:pos -> Lemma ((a * b) % (b * c) == (a % c) * b)
+let modulo_scale_lemma a b c =
+  calc (==) {
+    (a * b) % (b * c);
+    == { lemma_div_mod (a * b) (b * c) }
+    a * b - (b * c) * ((a * b) / (b * c));
+    == { cancel_fraction a c b }
+    a * b - (b * c) * (a / c);
+    == { paren_mul_right b c (a / c) }
+    a * b - b * (c * (a / c));
+    == { swap_mul b (c * (a / c)); distributivity_sub_left a (c * (a / c)) b }
+    (a - c * (a / c)) * b;
+    == { lemma_div_mod a c }
+    (a % c) * b;
+  }
+
let lemma_mul_pos_pos_is_pos (x:pos) (y:pos) : Lemma (x*y > 0) = ()
+let lemma_mul_nat_pos_is_nat (x:nat) (y:pos) : Lemma (x*y >= 0) = ()
+
let modulo_division_lemma_0 (a:nat) (b:pos) (c:pos) : Lemma
+  (a / (b*c) <= a /\ (a - (a / (b * c)) * (b * c)) / b = a / b - ((a / (b * c)) * c))
+  = slash_decr_axiom a (b*c);
+    calc (==) {
+      (a / (b*c)) * (b * c);
+      == { swap_mul b c }
+      (a / (b*c)) * (c * b);
+      == { paren_mul_right (a / (b*c)) c b }
+      ((a / (b*c)) * c) * b;
+    };
+    cut ((a / (b*c)) * (b * c) = ((a / (b * c)) * c) * b);
+    lemma_div_mod a (b*c);
+    division_sub_lemma a b ((a / (b*c)) * c);
+    ()
+
val modulo_division_lemma: a:nat -> b:pos -> c:pos ->
+    Lemma ((a % (b * c)) / b = (a / b) % c)
+
let modulo_division_lemma a b c =
+  calc (==) {
+    (a % (b * c)) / b;
+    == { lemma_div_mod a (b * c) }
+    (a - (b * c) * (a / (b * c))) / b;
+    == { paren_mul_right b c ((a / (b * c))); neg_mul_right b (c * (a / (b * c))) }
+    (a + b * (-(c * (a / (b * c))))) / b;
+    == { lemma_div_plus a (-(c * (a / (b * c)))) b }
+    (a / b) - c * (a / (b * c));
+    == { division_multiplication_lemma a b c }
+    (a / b) - c * ((a / b) / c);
+    == { lemma_div_mod (a/b) c }
+    (a / b) % c;
+  }
+
val modulo_modulo_lemma (a:int) (b:pos) (c:pos) : Lemma
+  ((a % (b * c)) % b = a % b)
+
let modulo_modulo_lemma (a:int) (b:pos) (c:pos) =
+  pos_times_pos_is_pos b c;
+  calc (==) {
+    (a % (b * c)) % b;
+    == { calc (==) {
+             a % (b * c);
+             == { lemma_div_mod a (b * c) }
+             a - (b * c) * (a / (b * c));
+             == { paren_mul_right b c (a / (b * c)) }
+             a - b * (c * (a / (b * c)));
+         }}
+    (a - b * (c * (a / (b * c)))) % b;
+    == { () }
+    (a + (- (b * (c * (a / (b * c)))))) % b;
+    == { neg_mul_right b (c * (a / (b * c))) }
+    (a + (b * (-c * (a / (b * c))))) % b;
+    == { () }
+    (a + (-c * (a / (b * c))) * b) % b;
+    == { lemma_mod_plus a (-c * (a / (b * c))) b}
+    a % b;
+  }
+
val pow2_multiplication_division_lemma_1: a:int -> b:nat -> c:nat{c >= b} ->
+  Lemma ( (a * pow2 c) / pow2 b = a * pow2 (c - b))
+let pow2_multiplication_division_lemma_1 a b c =
+  pow2_plus (c - b) b;
+  paren_mul_right a (pow2 (c - b)) (pow2 b);
+  paren_mul_left a (pow2 (c - b)) (pow2 b);
+  multiple_division_lemma (a * pow2 (c - b)) (pow2 b)
+
val pow2_multiplication_division_lemma_2: a:int -> b:nat -> c:nat{c <= b} ->
+  Lemma ( (a * pow2 c) / pow2 b = a / pow2 (b - c))
+let pow2_multiplication_division_lemma_2 a b c =
+  pow2_plus c (b - c);
+  division_multiplication_lemma (a * pow2 c) (pow2 c) (pow2 (b - c));
+  multiple_division_lemma a (pow2 c)
+
val pow2_multiplication_modulo_lemma_1: a:int -> b:nat -> c:nat{c >= b} ->
+  Lemma ( (a * pow2 c) % pow2 b = 0 )
+let pow2_multiplication_modulo_lemma_1 a b c =
+  pow2_plus (c - b) b;
+  paren_mul_right a (pow2 (c - b)) (pow2 b);
+  paren_mul_left a (pow2 (c - b)) (pow2 b);
+  multiple_modulo_lemma (a * pow2 (c - b)) (pow2 b)
+
val pow2_multiplication_modulo_lemma_2: a:int -> b:nat -> c:nat{c <= b} ->
+  Lemma ( (a * pow2 c) % pow2 b = (a % pow2 (b - c)) * pow2 c )
+
let pow2_multiplication_modulo_lemma_2 a b c =
+  calc (==) {
+    (a * pow2 c) % pow2 b;
+    == {}
+    (a * pow2 c) % pow2 (c + (b-c));
+    == { pow2_plus c (b-c) }
+    (a * pow2 c) % (pow2 c * pow2 (b-c));
+    == { modulo_scale_lemma a (pow2 c) (pow2 (b-c)) }
+    (a % pow2 (b - c)) * pow2 c;
+  }
+
val pow2_modulo_division_lemma_1: a:nat -> b:nat -> c:nat{c >= b} ->
+  Lemma ( (a % pow2 c) / pow2 b = (a / pow2 b) % (pow2 (c - b)) )
+let pow2_modulo_division_lemma_1 a b c =
+  pow2_plus (c - b) b;
+  modulo_division_lemma a (pow2 b) (pow2 (c - b))
+
val pow2_modulo_division_lemma_2: a:int -> b:nat -> c:nat{c <= b} ->
+  Lemma ( (a % pow2 c) / pow2 b = 0 )
+let pow2_modulo_division_lemma_2 a b c =
+  pow2_le_compat b c;
+  small_division_lemma_1 (a % pow2 c) (pow2 b)
+
val pow2_modulo_modulo_lemma_1: a:int -> b:nat -> c:nat{c >= b} ->
+  Lemma ( (a % pow2 c) % pow2 b = a % pow2 b )
+let pow2_modulo_modulo_lemma_1 a b c =
+  pow2_plus (c - b) b;
+  modulo_modulo_lemma a (pow2 b) (pow2 (c - b))
+
val pow2_modulo_modulo_lemma_2: a:int -> b:nat -> c:nat{c <= b} ->
+  Lemma ( (a % pow2 c) % pow2 b = a % pow2 c )
+let pow2_modulo_modulo_lemma_2 a b c =
+  pow2_le_compat b c;
+  small_modulo_lemma_1 (a % pow2 c) (pow2 b)
+
val modulo_add : p:pos -> a:int -> b:int -> c:int -> Lemma
+  (requires (b % p = c % p))
+  (ensures  ((a + b) % p = (a + c) % p))
+let modulo_add p a b c =
+  modulo_distributivity a b p;
+  modulo_distributivity a c p
+
val lemma_mod_twice : a:int -> p:pos -> Lemma ((a % p) % p == a % p)
+let lemma_mod_twice a p = lemma_mod_mod (a % p) a p
+
val modulo_sub : p:pos -> a:int -> b:int -> c:int -> Lemma
+  (requires ((a + b) % p = (a + c) % p))
+  (ensures (b % p = c % p))
+
let modulo_sub p a b c =
+  modulo_add p (-a) (a + b) (a + c)
+
val mod_add_both (a:int) (b:int) (x:int) (n:pos) : Lemma
+  (requires a % n == b % n)
+  (ensures (a + x) % n == (b + x) % n)
+let mod_add_both (a:int) (b:int) (x:int) (n:pos) =
+  calc (==) {
+    (a + x) % n;
+    == { modulo_distributivity a x n }
+    ((a % n) + (x % n)) % n;
+    == { (* hyp *) }
+    ((b % n) + (x % n)) % n;
+    == { modulo_distributivity b x n }
+    (b + x) % n;
+  }
+
val lemma_mod_plus_injective (n:pos) (a:int) (b:nat) (c:nat) : Lemma
+  (requires b < n /\ c < n /\ (a + b) % n = (a + c) % n)
+  (ensures  b = c)
+let lemma_mod_plus_injective (n:pos) (a:int) (b:nat) (c:nat) =
+  small_mod b n;
+  small_mod c n;
+  mod_add_both (a + b) (a + c) (-a) n
+

Another characterization of the modulo

+
val modulo_sub_lemma (a : int) (b : nat) (c : pos) :
+  Lemma
+  (requires (b < c /\ (a - b) % c = 0))
+  (ensures (b = a % c))
+let modulo_sub_lemma a b c =
+  calc (==) {
+    b;
+    == { modulo_lemma b c }
+    b % c;
+    == { lemma_mod_twice b c }
+    (b%c) % c;
+    == { (* hyp *) }
+    (b%c  + (a-b)%c) % c;
+    == { modulo_distributivity b (a-b) c }
+    (b+(a-b)) % c;
+    == {}
+    a % c;
+  }
+ diff --git a/docs/FStar.Math.Lib.html b/docs/FStar.Math.Lib.html index ccb5bbd..2125ec5 100644 --- a/docs/FStar.Math.Lib.html +++ b/docs/FStar.Math.Lib.html @@ -1,54 +1,120 @@ - - + + - - - - - - + FStar.Math.Lib + -

module FStar.Math.Lib

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
 Useful lemmas for future proofs *
+

+FStar.Math.Lib

+ +

Definition of the diviion operator

+
val lemma_div_def: a:nat -> b:pos -> Lemma (a = b * (a/b) + a % b)
+let lemma_div_def a b = ()
+
private let mul_lemma (a:nat) (b:nat) (c:nat) : Lemma (requires (a <= b))
+                                           (ensures  (c * a <= c * b))
+  = ()
+
private let mul_lemma' (a:nat) (b:nat) (c:pos) : Lemma (requires (c * a <= c * b))
+                                           (ensures (a <= b))
+  = ()
+
private let mul_div_lemma (a:nat) (b:pos) : Lemma (b * (a / b) <= a) = ()
+
val slash_decr_axiom: a:nat -> b:pos -> Lemma (a / b <= a)
+let slash_decr_axiom a b =
+    mul_lemma 1 b a;
+    mul_div_lemma a b;
+    mul_lemma' (a / b) a b
+
private let lemma_mul_minus_distr_l (a:int) (b:int) (c:int) : Lemma (a * (b - c) = a * b - a * c)
+  = ()
+

Axiom: definition of the "b divides c" relation

+
#reset-options "--z3rlimit 30"
+val slash_star_axiom: a:nat -> b:pos -> c:nat -> Lemma
+  (requires (a * b = c))
+  (ensures  (a = c / b))
+let slash_star_axiom a b c =
+  lemma_div_def c b;
+  lemma_mul_minus_distr_l b a (c/b)
+
#reset-options
+val log_2: x:pos -> Tot nat
+let rec log_2 x =
+  if x >= 2 then 1 + log_2 (x / 2) else 0
+

Function: power of x

+
val powx : x:int -> n:nat -> Tot int
+let rec powx x n =
+  match n with
+  | 0 -> 1
+  | n -> x * powx x (n - 1)
+

Function: absolute value

+
val abs: x:int -> Tot (y:int{ (x >= 0 ==> y = x) /\ (x < 0 ==> y = -x) })
+let abs x = if x >= 0 then x else -x
+

Function: maximum value

+
val max: x:int -> y:int -> Tot (z:int{ (x >= y ==> z = x) /\ (x < y ==> z = y) })
+let max x y = if x >= y then x else y
+

Function: minimum value

+
val min: x:int -> y:int -> Tot (z:int{ (x >= y ==> z = y) /\ (x < y ==> z = x) })
+let min x y = if x >= y then y else x
+

Function: standard euclidean division, the rest is always positive

+
val div: a:int -> b:pos -> Tot (c:int{(a < 0 ==> c < 0) /\ (a >= 0 ==> c >= 0)})
+let div a b =
+  if a < 0 then
+    begin
+    slash_decr_axiom (-a) b;
+    if a % b = 0 then - (-a / b)
+    else - (-a / b) - 1
+    end
+  else a / b
+

Function: equivalent of the '/' operator in C, hence the rest can be negative

+
val div_non_eucl: a:int -> b:pos ->
+  Tot (q:int{ ( a >= 0 ==> q = a / b ) /\ ( a < 0 ==> q = -((-a)/b) ) })
+let div_non_eucl a b =
+  if a < 0 then 0 - ((0 - a) / b)
+  else a / b
+

The equivalent of the << C operator

+
val shift_left: v:int -> i:nat -> Tot (res:int{res = v * (pow2 i)})
+let shift_left v i =
+  v * (pow2 i)
+

asr OCaml operator

+
val arithmetic_shift_right: v:int -> i:nat -> Tot (res:int{ res = div v (pow2 i) })
+let arithmetic_shift_right v i =
+  div v (pow2 i)
+

Case of C cast functions ?

+

Implemented by "mod" in OCaml

+
val signed_modulo: v:int -> p:pos -> Tot (res:int{ res = v - ((div_non_eucl v p) * p) })
+let signed_modulo v p =
+  if v >= 0 then v % p
+  else 0 - ( (0-v) % p)
+
val op_Plus_Percent : a:int -> p:pos ->
+  Tot (res:int{ (a >= 0 ==> res = a % p) /\ (a < 0 ==> res = -((-a) % p)) })
+let op_Plus_Percent a p = signed_modulo a p
+

Useful lemmas for future proofs *

+

Lemmas of x^n

+
val powx_lemma1: a:int -> Lemma (powx a 1 = a)
+let powx_lemma1 a = ()
+
val powx_lemma2: x:int -> n:nat -> m:nat -> Lemma
+  (powx x n * powx x m = powx x (n + m))
+let rec powx_lemma2 x n m =
+  let ass (x y z : int) : Lemma ((x*y)*z == x*(y*z)) = () in
+  match n with
+  | 0 -> ()
+  | _ -> powx_lemma2 x (n-1) m; ass x (powx x (n-1)) (powx x m)
+

Lemma: absolute value of product is the product of the absolute values

+
val abs_mul_lemma: a:int -> b:int -> Lemma (abs (a * b) = abs a * abs b)
+let abs_mul_lemma a b = ()
+

Lemma: absolute value of a signed_module b is bounded by b

+
val signed_modulo_property: v:int -> p:pos -> Lemma (abs (signed_modulo v p ) < p)
+let signed_modulo_property v p = ()
+

Lemma: non-Euclidean division has a smaller output compared to its input

+
val div_non_eucl_decr_lemma: a:int -> b:pos -> Lemma (abs (div_non_eucl a b) <= abs a)
+let div_non_eucl_decr_lemma a b =
+  slash_decr_axiom (abs a) b
+

Lemma: dividing by a bigger value leads to 0 in non-Euclidean division

+
val div_non_eucl_bigger_denom_lemma: a:int -> b:pos -> Lemma
+  (requires (b > abs a))
+  (ensures  (div_non_eucl a b = 0))
+let div_non_eucl_bigger_denom_lemma a b = ()
+ diff --git a/docs/FStar.Modifies.html b/docs/FStar.Modifies.html index 9329f45..f5894c8 100644 --- a/docs/FStar.Modifies.html +++ b/docs/FStar.Modifies.html @@ -1,59 +1,764 @@ - - + + - - - - - - + FStar.Modifies + -

module FStar.Modifies

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
* The modifies clause
-
val loc_union_idem:s:loc -> (Lemma (==(loc_union s s, s)) (Prims.Cons (SMTPat (loc_union s s)) (Prims.Nil )))
-

The following is useful to make Z3 cut matching loops with modifies_trans and modifies_refl

-
 The modifies clause proper
-
 BEGIN TODO: move to FStar.Monotonic.HyperStack
-
 END TODO
+

+FStar.Modifies

+ +

+The modifies clause

+
val loc : Type u#1
+
val loc_none: loc
+
val loc_union
+  (s1 s2: loc)
+: GTot loc
+

+loc_union_idem

+

The following is useful to make Z3 cut matching loops with +modifies_trans and modifies_refl

+
val loc_union_idem
+  (s: loc)
+: Lemma
+  (loc_union s s == s)
+  [SMTPat (loc_union s s)]
+
val loc_union_comm
+  (s1 s2: loc)
+: Lemma
+  (loc_union s1 s2 == loc_union s2 s1)
+  [SMTPat (loc_union s1 s2)]
+
val loc_union_assoc
+  (s1 s2 s3: loc)
+: Lemma
+  (loc_union s1 (loc_union s2 s3) == loc_union (loc_union s1 s2) s3)
+
val loc_union_loc_none_l
+  (s: loc)
+: Lemma
+  (loc_union loc_none s == s)
+  [SMTPat (loc_union loc_none s)]
+
val loc_union_loc_none_r
+  (s: loc)
+: Lemma
+  (loc_union s loc_none == s)
+  [SMTPat (loc_union s loc_none)]
+
val loc_buffer
+  (#t: Type)
+  (b: B.buffer t)
+: GTot loc
+
val loc_addresses
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: GTot loc
+
val loc_regions
+  (preserve_liveness: bool)
+  (r: Set.set HS.rid)
+: GTot loc
+
let loc_mreference
+  (#a: Type)
+  (#p: Preorder.preorder a)
+  (b: HS.mreference a p)
+: GTot loc
+= loc_addresses true (HS.frameOf b) (Set.singleton (HS.as_addr b))
+
let loc_freed_mreference
+  (#a: Type)
+  (#p: Preorder.preorder a)
+  (b: HS.mreference a p)
+: GTot loc
+= loc_addresses false (HS.frameOf b) (Set.singleton (HS.as_addr b))
+
let loc_region_only
+  (preserve_liveness: bool)
+  (r: HS.rid)
+: GTot loc
+= loc_regions preserve_liveness (Set.singleton r)
+
let loc_all_regions_from
+  (preserve_liveness: bool)
+  (r: HS.rid)
+: GTot loc
+= loc_regions preserve_liveness (HS.mod_set (Set.singleton r))
+

Inclusion of memory locations

+
val loc_includes
+  (s1 s2: loc)
+: GTot Type0
+
val loc_includes_refl
+  (s: loc)
+: Lemma
+  (loc_includes s s)
+  [SMTPat (loc_includes s s)]
+
val loc_includes_trans
+  (s1 s2 s3: loc)
+: Lemma
+  (requires (loc_includes s1 s2 /\ loc_includes s2 s3))
+  (ensures (loc_includes s1 s3))
+
val loc_includes_union_r
+  (s s1 s2: loc)
+: Lemma
+  (requires (loc_includes s s1 /\ loc_includes s s2))
+  (ensures (loc_includes s (loc_union s1 s2)))
+  [SMTPat (loc_includes s (loc_union s1 s2))]
+
val loc_includes_union_l
+  (s1 s2 s: loc)
+: Lemma
+  (requires (loc_includes s1 s \/ loc_includes s2 s))
+  (ensures (loc_includes (loc_union s1 s2) s))
+  [SMTPat (loc_includes (loc_union s1 s2) s)]
+
val loc_includes_none
+  (s: loc)
+: Lemma
+  (loc_includes s loc_none)
+  [SMTPat (loc_includes s loc_none)]
+
val loc_includes_buffer
+  (#t: Type)
+  (b1 b2: B.buffer t)
+: Lemma
+  (requires (b1 `B.includes` b2))
+  (ensures (loc_includes (loc_buffer b1) (loc_buffer b2)))
+  [SMTPatOr [
+    [SMTPat (B.includes b1 b2)];
+    [SMTPat (loc_includes(loc_buffer b1) (loc_buffer b2))]
+  ]]
+
val loc_includes_gsub_buffer_r
+  (l: loc)
+  (#t: Type)
+  (b: B.buffer t)
+  (i: UInt32.t)
+  (len: UInt32.t)
+: Lemma
+  (requires (UInt32.v i + UInt32.v len <= (B.length b) /\ loc_includes l (loc_buffer b)))
+  (ensures (UInt32.v i + UInt32.v len <= (B.length b) /\ loc_includes l (loc_buffer (B.sub b i len))))
+  [SMTPat (loc_includes l (loc_buffer (B.sub b i len)))]
+
val loc_includes_gsub_buffer_l
+  (#t: Type)
+  (b: B.buffer t)
+  (i1: UInt32.t)
+  (len1: UInt32.t)
+  (i2: UInt32.t)
+  (len2: UInt32.t)
+: Lemma
+  (requires (UInt32.v i1 + UInt32.v len1 <= (B.length b) /\ UInt32.v i1 <= UInt32.v i2 /\ UInt32.v i2 + UInt32.v len2 <= UInt32.v i1 + UInt32.v len1))
+  (ensures (UInt32.v i1 + UInt32.v len1 <= (B.length b) /\ UInt32.v i1 <= UInt32.v i2 /\ UInt32.v i2 + UInt32.v len2 <= UInt32.v i1 + UInt32.v len1 /\ loc_includes (loc_buffer (B.sub b i1 len1)) (loc_buffer (B.sub b i2 len2))))
+  [SMTPat (loc_includes (loc_buffer (B.sub b i1 len1)) (loc_buffer (B.sub b i2 len2)))]
+
val loc_includes_addresses_buffer
+  (#t: Type)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (s: Set.set nat)
+  (p: B.buffer t)
+: Lemma
+  (requires (B.frameOf p == r /\ Set.mem (B.as_addr p) s))
+  (ensures (loc_includes (loc_addresses preserve_liveness r s) (loc_buffer p)))
+  [SMTPat (loc_includes (loc_addresses preserve_liveness r s) (loc_buffer p))]
+
val loc_includes_region_buffer
+  (#t: Type)
+  (preserve_liveness: bool)
+  (s: Set.set HS.rid)
+  (b: B.buffer t)
+: Lemma
+  (requires (Set.mem (B.frameOf b) s))
+  (ensures (loc_includes (loc_regions preserve_liveness s) (loc_buffer b)))
+  [SMTPat (loc_includes (loc_regions preserve_liveness s) (loc_buffer b))]
+
val loc_includes_region_addresses
+  (preserve_liveness1: bool)
+  (preserve_liveness2: bool)
+  (s: Set.set HS.rid)
+  (r: HS.rid)
+  (a: Set.set nat)
+: Lemma
+  (requires (Set.mem r s))
+  (ensures (loc_includes (loc_regions preserve_liveness1 s) (loc_addresses preserve_liveness2 r a)))
+  [SMTPat (loc_includes (loc_regions preserve_liveness1 s) (loc_addresses preserve_liveness2 r a))]
+
val loc_includes_region_region
+  (preserve_liveness1: bool)
+  (preserve_liveness2: bool)
+  (s1 s2: Set.set HS.rid)
+: Lemma
+  (requires ((preserve_liveness1 ==> preserve_liveness2) /\ Set.subset s2 s1))
+  (ensures (loc_includes (loc_regions preserve_liveness1 s1) (loc_regions preserve_liveness2 s2)))
+  [SMTPat (loc_includes (loc_regions preserve_liveness1 s1) (loc_regions preserve_liveness2 s2))]
+
val loc_includes_region_union_l
+  (preserve_liveness: bool)
+  (l: loc)
+  (s1 s2: Set.set HS.rid)
+: Lemma
+  (requires (loc_includes l (loc_regions preserve_liveness (Set.intersect s2 (Set.complement s1)))))
+  (ensures (loc_includes (loc_union (loc_regions preserve_liveness s1) l) (loc_regions preserve_liveness s2)))
+  [SMTPat (loc_includes (loc_union (loc_regions preserve_liveness s1) l) (loc_regions preserve_liveness s2))]
+
val loc_includes_addresses_addresses
+  (preserve_liveness1 preserve_liveness2: bool)
+  (r: HS.rid)
+  (s1 s2: Set.set nat)
+: Lemma
+  (requires ((preserve_liveness1 ==> preserve_liveness2) /\ Set.subset s2 s1))
+  (ensures (loc_includes (loc_addresses preserve_liveness1 r s1) (loc_addresses preserve_liveness2 r s2)))
+

Disjointness of two memory locations

+
val loc_disjoint
+  (s1 s2: loc)
+: GTot Type0
+
val loc_disjoint_sym
+  (s1 s2: loc)
+: Lemma
+  (requires (loc_disjoint s1 s2))
+  (ensures (loc_disjoint s2 s1))
+
let loc_disjoint_sym'
+  (s1 s2: loc)
+: Lemma
+  (loc_disjoint s1 s2 <==> loc_disjoint s2 s1)
+  [SMTPat (loc_disjoint s1 s2)]
+= Classical.move_requires (loc_disjoint_sym s1) s2;
+  Classical.move_requires (loc_disjoint_sym s2) s1
+
val loc_disjoint_none_r
+  (s: loc)
+: Lemma
+  (ensures (loc_disjoint s loc_none))
+  [SMTPat (loc_disjoint s loc_none)]
+
val loc_disjoint_union_r
+  (s s1 s2: loc)
+: Lemma
+  (requires (loc_disjoint s s1 /\ loc_disjoint s s2))
+  (ensures (loc_disjoint s (loc_union s1 s2)))
+  [SMTPat (loc_disjoint s (loc_union s1 s2))]
+
val loc_disjoint_includes
+  (p1 p2 p1' p2' : loc)
+: Lemma
+  (requires (loc_includes p1 p1' /\ loc_includes p2 p2' /\ loc_disjoint p1 p2))
+  (ensures (loc_disjoint p1' p2'))
+  [SMTPatOr [
+    [SMTPat (loc_disjoint p1 p2); SMTPat (loc_disjoint p1' p2')];
+    [SMTPat (loc_includes p1 p1'); SMTPat (loc_includes p2 p2')];
+  ]]
+
val loc_disjoint_buffer
+  (#t1 #t2: Type)
+  (b1: B.buffer t1)
+  (b2: B.buffer t2)
+: Lemma
+  (requires (B.disjoint b1 b2))
+  (ensures (loc_disjoint (loc_buffer b1) (loc_buffer b2)))
+  [SMTPatOr [
+    [SMTPat (B.disjoint b1 b2)];
+    [SMTPat (loc_disjoint (loc_buffer b1) (loc_buffer b2))];
+  ]]
+
val loc_disjoint_gsub_buffer
+  (#t: Type)
+  (b: B.buffer t)
+  (i1: UInt32.t)
+  (len1: UInt32.t)
+  (i2: UInt32.t)
+  (len2: UInt32.t)
+: Lemma
+  (requires (
+    UInt32.v i1 + UInt32.v len1 <= (B.length b) /\
+    UInt32.v i2 + UInt32.v len2 <= (B.length b) /\ (
+    UInt32.v i1 + UInt32.v len1 <= UInt32.v i2 \/
+    UInt32.v i2 + UInt32.v len2 <= UInt32.v i1
+  )))
+  (ensures (
+    UInt32.v i1 + UInt32.v len1 <= (B.length b) /\
+    UInt32.v i2 + UInt32.v len2 <= (B.length b) /\
+    loc_disjoint (loc_buffer (B.sub b i1 len1)) (loc_buffer (B.sub b i2 len2))
+  ))
+  [SMTPat (loc_disjoint (loc_buffer (B.sub b i1 len1)) (loc_buffer (B.sub b i2 len2)))]
+
val loc_disjoint_addresses
+  (preserve_liveness1 preserve_liveness2: bool)
+  (r1 r2: HS.rid)
+  (n1 n2: Set.set nat)
+: Lemma
+  (requires (r1 <> r2 \/ Set.subset (Set.intersect n1 n2) Set.empty))
+  (ensures (loc_disjoint (loc_addresses preserve_liveness1 r1 n1) (loc_addresses preserve_liveness2 r2 n2)))
+  [SMTPat (loc_disjoint (loc_addresses preserve_liveness1 r1 n1) (loc_addresses preserve_liveness2 r2 n2))]
+
val loc_disjoint_buffer_addresses
+  (#t: Type)
+  (p: B.buffer t)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: Lemma
+  (requires (r <> B.frameOf p \/ (~ (Set.mem (B.as_addr p) n))))
+  (ensures (loc_disjoint (loc_buffer p) (loc_addresses preserve_liveness r n)))
+  [SMTPat (loc_disjoint (loc_buffer p) (loc_addresses preserve_liveness r n))]
+
val loc_disjoint_regions
+  (preserve_liveness1 preserve_liveness2: bool)
+  (rs1 rs2: Set.set HS.rid)
+: Lemma
+  (requires (Set.subset (Set.intersect rs1 rs2) Set.empty))
+  (ensures (loc_disjoint (loc_regions preserve_liveness1 rs1) (loc_regions preserve_liveness2 rs2)))
+  [SMTPat (loc_disjoint (loc_regions preserve_liveness1 rs1) (loc_regions preserve_liveness2 rs2))]
+

The modifies clause proper

+
val modifies
+  (s: loc)
+  (h1 h2: HS.mem)
+: GTot Type0
+
val modifies_mreference_elim
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (b: HS.mreference t pre)
+  (p: loc)
+  (h h': HS.mem)
+: Lemma
+  (requires (
+    loc_disjoint (loc_mreference b) p /\
+    HS.contains h b /\
+    modifies p h h'
+  ))
+  (ensures (
+    HS.contains h' b /\
+    HS.sel h b == HS.sel h' b
+  ))
+  [SMTPatOr [
+    [ SMTPat (modifies p h h'); SMTPat (HS.sel h b) ] ;
+    [ SMTPat (modifies p h h'); SMTPat (HS.contains h b) ];
+    [ SMTPat (modifies p h h'); SMTPat (HS.sel h' b) ] ;
+    [ SMTPat (modifies p h h'); SMTPat (HS.contains h' b) ]
+  ] ]
+
val modifies_buffer_elim
+  (#t1: Type)
+  (b: B.buffer t1)
+  (p: loc)
+  (h h': HS.mem)
+: Lemma
+  (requires (
+    loc_disjoint (loc_buffer b) p /\
+    B.live h b /\
+    modifies p h h'
+  ))
+  (ensures (
+    B.live h' b /\ (
+    B.as_seq h b == B.as_seq h' b
+  )))
+  [SMTPatOr [
+    [ SMTPat (modifies p h h'); SMTPat (B.as_seq h b) ] ;
+    [ SMTPat (modifies p h h'); SMTPat (B.live h b) ];
+    [ SMTPat (modifies p h h'); SMTPat (B.as_seq h' b) ] ;
+    [ SMTPat (modifies p h h'); SMTPat (B.live h' b) ]
+  ] ]
+
val modifies_refl
+  (s: loc)
+  (h: HS.mem)
+: Lemma
+  (modifies s h h)
+  [SMTPat (modifies s h h)]
+
val modifies_loc_includes
+  (s1: loc)
+  (h h': HS.mem)
+  (s2: loc)
+: Lemma
+  (requires (modifies s2 h h' /\ loc_includes s1 s2))
+  (ensures (modifies s1 h h'))
+  [SMTPatOr [
+    [SMTPat (modifies s1 h h'); SMTPat (modifies s2 h h')];
+    [SMTPat (modifies s1 h h'); SMTPat (loc_includes s1 s2)];
+    [SMTPat (modifies s2 h h'); SMTPat (loc_includes s1 s2)];
+  ]]
+
+

Some memory locations are tagged as liveness-insensitive: the +liveness preservation of a memory location only depends on its +disjointness from the liveness-sensitive memory locations of a +modifies clause.

+
+
val address_liveness_insensitive_locs: loc
+
val region_liveness_insensitive_locs: loc
+
val address_liveness_insensitive_buffer (#t: Type) (b: B.buffer t) : Lemma
+  (address_liveness_insensitive_locs `loc_includes` (loc_buffer b))
+  [SMTPat (address_liveness_insensitive_locs `loc_includes` (loc_buffer b))]
+
val address_liveness_insensitive_addresses (r: HS.rid) (a: Set.set nat) : Lemma
+  (address_liveness_insensitive_locs `loc_includes` (loc_addresses true r a))
+  [SMTPat (address_liveness_insensitive_locs `loc_includes` (loc_addresses true r a))]
+
val region_liveness_insensitive_buffer (#t: Type) (b: B.buffer t) : Lemma
+  (region_liveness_insensitive_locs `loc_includes` (loc_buffer b))
+  [SMTPat (region_liveness_insensitive_locs `loc_includes` (loc_buffer b))]
+
val region_liveness_insensitive_addresses (preserve_liveness: bool) (r: HS.rid) (a: Set.set nat) : Lemma
+  (region_liveness_insensitive_locs `loc_includes` (loc_addresses preserve_liveness r a))
+  [SMTPat (region_liveness_insensitive_locs `loc_includes` (loc_addresses preserve_liveness r a))]
+
val region_liveness_insensitive_regions (rs: Set.set HS.rid) : Lemma
+  (region_liveness_insensitive_locs `loc_includes` (loc_regions true rs))
+  [SMTPat (region_liveness_insensitive_locs `loc_includes` (loc_regions true rs))]
+
val region_liveness_insensitive_address_liveness_insensitive:
+  squash (region_liveness_insensitive_locs `loc_includes` address_liveness_insensitive_locs)
+
val modifies_liveness_insensitive_mreference
+  (l1 l2 : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (x: HS.mreference t pre)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ loc_disjoint l1 (loc_mreference x) /\ address_liveness_insensitive_locs `loc_includes` l2 /\ h `HS.contains` x))
+  (ensures (h' `HS.contains` x))
+

TODO: pattern

+
val modifies_liveness_insensitive_buffer
+  (l1 l2 : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (x: B.buffer t)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ loc_disjoint l1 (loc_buffer x) /\ address_liveness_insensitive_locs `loc_includes` l2 /\ B.live h x))
+  (ensures (B.live h' x))
+

TODO: pattern

+
let modifies_liveness_insensitive_mreference_weak
+  (l : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (x: HS.mreference t pre)
+: Lemma
+  (requires (modifies l h h' /\ address_liveness_insensitive_locs `loc_includes` l /\ h `HS.contains` x))
+  (ensures (h' `HS.contains` x))
+  [SMTPatOr [
+    [SMTPat (h `HS.contains` x); SMTPat (modifies l h h');];
+    [SMTPat (h' `HS.contains` x); SMTPat (modifies l h h');];
+  ]]
+= modifies_liveness_insensitive_mreference loc_none l h h' x
+
let modifies_liveness_insensitive_buffer_weak
+  (l : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (x: B.buffer t)
+: Lemma
+  (requires (modifies l h h' /\ address_liveness_insensitive_locs `loc_includes` l /\ B.live h x))
+  (ensures (B.live h' x))
+  [SMTPatOr [
+    [SMTPat (B.live h x); SMTPat (modifies l h h');];
+    [SMTPat (B.live h' x); SMTPat (modifies l h h');];
+  ]]
+= modifies_liveness_insensitive_buffer loc_none l h h' x
+
val modifies_liveness_insensitive_region
+  (l1 l2 : loc)
+  (h h' : HS.mem)
+  (x: HS.rid)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ loc_disjoint l1 (loc_region_only false x) /\ region_liveness_insensitive_locs `loc_includes` l2 /\ HS.live_region h x))
+  (ensures (HS.live_region h' x))
+

TODO: pattern

+
val modifies_liveness_insensitive_region_mreference
+  (l1 l2 : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (x: HS.mreference t pre)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ loc_disjoint l1 (loc_mreference x) /\ region_liveness_insensitive_locs `loc_includes` l2 /\ HS.live_region h (HS.frameOf x)))
+  (ensures (HS.live_region h' (HS.frameOf x)))
+

TODO: pattern

+
val modifies_liveness_insensitive_region_buffer
+  (l1 l2 : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (x: B.buffer t)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ loc_disjoint l1 (loc_buffer x) /\ region_liveness_insensitive_locs `loc_includes` l2 /\ HS.live_region h (B.frameOf x)))
+  (ensures (HS.live_region h' (B.frameOf x)))
+

TODO: pattern

+
let modifies_liveness_insensitive_region_weak
+  (l2 : loc)
+  (h h' : HS.mem)
+  (x: HS.rid)
+: Lemma
+  (requires (modifies l2 h h' /\ region_liveness_insensitive_locs `loc_includes` l2 /\ HS.live_region h x))
+  (ensures (HS.live_region h' x))
+  [SMTPatOr [
+    [SMTPat (modifies l2 h h'); SMTPat (HS.live_region h x)];
+    [SMTPat (modifies l2 h h'); SMTPat (HS.live_region h' x)];
+  ]]
+= modifies_liveness_insensitive_region loc_none l2 h h' x
+
let modifies_liveness_insensitive_region_mreference_weak
+  (l2 : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (x: HS.mreference t pre)
+: Lemma
+  (requires (modifies l2 h h' /\ region_liveness_insensitive_locs `loc_includes` l2 /\ HS.live_region h (HS.frameOf x)))
+  (ensures (HS.live_region h' (HS.frameOf x)))
+  [SMTPatOr [
+    [SMTPat (modifies l2 h h'); SMTPat (HS.live_region h (HS.frameOf x))];
+    [SMTPat (modifies l2 h h'); SMTPat (HS.live_region h' (HS.frameOf x))];
+  ]]
+= modifies_liveness_insensitive_region_mreference loc_none l2 h h' x
+
let modifies_liveness_insensitive_region_buffer_weak
+  (l2 : loc)
+  (h h' : HS.mem)
+  (#t: Type)
+  (x: B.buffer t)
+: Lemma
+  (requires (modifies l2 h h' /\ region_liveness_insensitive_locs `loc_includes` l2 /\ HS.live_region h (B.frameOf x)))
+  (ensures (HS.live_region h' (B.frameOf x)))
+  [SMTPatOr [
+    [SMTPat (modifies l2 h h'); SMTPat (HS.live_region h (B.frameOf x))];
+    [SMTPat (modifies l2 h h'); SMTPat (HS.live_region h' (B.frameOf x))];
+  ]]
+= modifies_liveness_insensitive_region_buffer loc_none l2 h h' x
+
val modifies_trans
+  (s12: loc)
+  (h1 h2: HS.mem)
+  (s23: loc)
+  (h3: HS.mem)
+: Lemma
+  (requires (modifies s12 h1 h2 /\ modifies s23 h2 h3))
+  (ensures (modifies (loc_union s12 s23) h1 h3))
+  [SMTPat (modifies s12 h1 h2); SMTPat (modifies s23 h2 h3)]
+
val modifies_only_live_regions
+  (rs: Set.set HS.rid)
+  (l: loc)
+  (h h' : HS.mem)
+: Lemma
+  (requires (
+    modifies (loc_union (loc_regions false rs) l) h h' /\
+    (forall r . Set.mem r rs ==> (~ (HS.live_region h r)))
+  ))
+  (ensures (modifies l h h'))
+
val no_upd_fresh_region: r:HS.rid -> l:loc -> h0:HS.mem -> h1:HS.mem -> Lemma
+  (requires (HS.fresh_region r h0 h1 /\ modifies (loc_union (loc_all_regions_from false r) l) h0 h1))
+  (ensures  (modifies l h0 h1))
+  [SMTPat (HS.fresh_region r h0 h1); SMTPat (modifies l h0 h1)]
+
val modifies_fresh_frame_popped
+  (h0 h1: HS.mem)
+  (s: loc)
+  (h2 h3: HS.mem)
+: Lemma
+  (requires (
+    HS.fresh_frame h0 h1 /\
+    modifies (loc_union (loc_all_regions_from false (HS.get_tip h1)) s) h1 h2 /\
+    (HS.get_tip h2) == (HS.get_tip h1) /\
+    HS.popped h2 h3
+  ))
+  (ensures (
+    modifies s h0 h3 /\
+    (HS.get_tip h3) == HS.get_tip h0
+  ))
+  [SMTPat (HS.fresh_frame h0 h1); SMTPat (HS.popped h2 h3); SMTPat (modifies s h0 h3)]
+
val modifies_loc_regions_intro
+  (rs: Set.set HS.rid)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (HS.modifies rs h1 h2))
+  (ensures (modifies (loc_regions true rs) h1 h2))
+
val modifies_loc_addresses_intro
+  (r: HS.rid)
+  (a: Set.set nat)
+  (l: loc)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (
+    HS.live_region h2 r /\
+    modifies (loc_union (loc_region_only false r) l) h1 h2 /\
+    HS.modifies_ref r a h1 h2
+  ))
+  (ensures (modifies (loc_union (loc_addresses true r a) l) h1 h2))
+
val modifies_ralloc_post
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (i: HS.rid)
+  (init: a)
+  (h: HS.mem)
+  (x: HST.mreference a rel { HST.is_eternal_region (HS.frameOf x) } )
+  (h' : HS.mem)
+: Lemma
+  (requires (HST.ralloc_post i init h x h'))
+  (ensures (modifies loc_none h h'))
+
val modifies_salloc_post
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (init: a)
+  (h: HS.mem)
+  (x: HST.mreference a rel { HS.is_stack_region (HS.frameOf x) } )
+  (h' : HS.mem)
+: Lemma
+  (requires (HST.salloc_post init h x h'))
+  (ensures (modifies loc_none h h'))
+
val modifies_free
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel { HS.is_mm r } )
+  (m: HS.mem { m `HS.contains` r } )
+: Lemma
+  (modifies (loc_freed_mreference r) m (HS.free r m))
+
val modifies_none_modifies
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (HST.modifies_none h1 h2))
+  (ensures (modifies loc_none h1 h2))
+
val modifies_buffer_none_modifies
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (B.modifies_none h1 h2))
+  (ensures (modifies loc_none h1 h2))
+
val modifies_0_modifies
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (B.modifies_0 h1 h2))
+  (ensures (modifies loc_none h1 h2))
+  [SMTPat (B.modifies_0 h1 h2)]
+
val modifies_1_modifies
+  (#a: Type)
+  (b: B.buffer a)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (B.modifies_1 b h1 h2))
+  (ensures (modifies (loc_buffer b) h1 h2))
+  [SMTPat (B.modifies_1 b h1 h2)]
+
val modifies_2_modifies
+  (#a1 #a2: Type)
+  (b1: B.buffer a1)
+  (b2: B.buffer a2)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (B.modifies_2 b1 b2 h1 h2))
+  (ensures (modifies (loc_union (loc_buffer b1) (loc_buffer b2)) h1 h2))
+  [SMTPat (B.modifies_2 b1 b2 h1 h2)]
+
val modifies_3_modifies
+  (#a1 #a2 #a3: Type)
+  (b1: B.buffer a1)
+  (b2: B.buffer a2)
+  (b3: B.buffer a3)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (B.modifies_3 b1 b2 b3 h1 h2))
+  (ensures (modifies (loc_union (loc_buffer b1) (loc_union (loc_buffer b2) (loc_buffer b3))) h1 h2))
+
val modifies_buffer_rcreate_post_common
+  (#a: Type)
+  (r: HS.rid)
+  (init: a)
+  (len: FStar.UInt32.t)
+  (b: B.buffer a)
+  (h0 h1: HS.mem)
+: Lemma
+  (requires (B.rcreate_post_common r init len b h0 h1))
+  (ensures (modifies loc_none h0 h1))
+
val mreference_live_buffer_unused_in_disjoint
+  (#t1: Type)
+  (#pre: Preorder.preorder t1)
+  (#t2: Type)
+  (h: HS.mem)
+  (b1: HS.mreference t1 pre)
+  (b2: B.buffer t2)
+: Lemma
+  (requires (HS.contains h b1 /\ B.unused_in b2 h))
+  (ensures (loc_disjoint (loc_freed_mreference b1)  (loc_buffer b2)))
+  [SMTPat (HS.contains h b1); SMTPat (B.unused_in b2 h)]
+
val buffer_live_mreference_unused_in_disjoint
+  (#t1: Type)
+  (#t2: Type)
+  (#pre: Preorder.preorder t2)
+  (h: HS.mem)
+  (b1: B.buffer t1)
+  (b2: HS.mreference t2 pre)
+: Lemma
+  (requires (B.live h b1 /\ HS.unused_in b2 h))
+  (ensures (loc_disjoint (loc_buffer b1) (loc_freed_mreference b2)))
+  [SMTPat (B.live h b1); SMTPat (HS.unused_in b2 h)]
+

BEGIN TODO: move to FStar.Monotonic.HyperStack

+
val does_not_contain_addr
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: GTot Type0
+
val not_live_region_does_not_contain_addr
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: Lemma
+  (requires (~ (HS.live_region h (fst ra))))
+  (ensures (h `does_not_contain_addr` ra))
+
val unused_in_does_not_contain_addr
+  (h: HS.mem)
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel)
+: Lemma
+  (requires (r `HS.unused_in` h))
+  (ensures (h `does_not_contain_addr` (HS.frameOf r, HS.as_addr r)))
+
val addr_unused_in_does_not_contain_addr
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: Lemma
+  (requires (HS.live_region h (fst ra) ==> snd ra `Heap.addr_unused_in` (Map.sel (HS.get_hmap h) (fst ra))))
+  (ensures (h `does_not_contain_addr` ra))
+
val free_does_not_contain_addr
+  (#a: Type0)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel)
+  (m: HS.mem)
+  (x: HS.rid * nat)
+: Lemma
+  (requires (
+    HS.is_mm r /\
+    m `HS.contains` r /\
+    fst x == HS.frameOf r /\
+    snd x == HS.as_addr r
+  ))
+  (ensures (
+    HS.free r m `does_not_contain_addr` x
+  ))
+  [SMTPat (HS.free r m `does_not_contain_addr` x)]
+
val does_not_contain_addr_elim
+  (#a: Type0)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel)
+  (m: HS.mem)
+  (x: HS.rid * nat)
+: Lemma
+  (requires (
+    m `does_not_contain_addr` x /\
+    HS.frameOf r == fst x /\
+    HS.as_addr r == snd x
+  ))
+  (ensures (~ (m `HS.contains` r)))
+

END TODO

+
val modifies_only_live_addresses
+  (r: HS.rid)
+  (a: Set.set nat)
+  (l: loc)
+  (h h' : HS.mem)
+: Lemma
+  (requires (
+    modifies (loc_union (loc_addresses false r a) l) h h' /\
+    (forall x . Set.mem x a ==> h `does_not_contain_addr` (r, x))
+  ))
+  (ensures (modifies l h h'))
+
+

Type class instantiation for compositionality with other kinds of memory locations than regions, references or buffers (just in case). +No usage pattern has been found yet.

+
+ +
val cloc_aloc : HS.rid -> nat -> Tot (Type u#1)
+
val cloc_cls: MG.cls cloc_aloc
+
val cloc_of_loc (l: loc) : Tot (MG.loc cloc_cls)
+
val loc_of_cloc (l: MG.loc cloc_cls) : Tot loc
+
val loc_of_cloc_of_loc (l: loc) : Lemma
+  (loc_of_cloc (cloc_of_loc l) == l)
+  [SMTPat (loc_of_cloc (cloc_of_loc l))]
+
val cloc_of_loc_of_cloc (l: MG.loc cloc_cls) : Lemma
+  (cloc_of_loc (loc_of_cloc l) == l)
+  [SMTPat (cloc_of_loc (loc_of_cloc l))]
+
val cloc_of_loc_none : unit -> Lemma (cloc_of_loc loc_none == MG.loc_none)
+
val cloc_of_loc_union (l1 l2: loc) : Lemma
+  (cloc_of_loc (loc_union l1 l2) == MG.loc_union (cloc_of_loc l1) (cloc_of_loc l2))
+
val cloc_of_loc_addresses
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: Lemma
+  (cloc_of_loc (loc_addresses preserve_liveness r n) == MG.loc_addresses preserve_liveness r n)
+
val cloc_of_loc_regions
+  (preserve_liveness: bool)
+  (r: Set.set HS.rid)
+: Lemma
+  (cloc_of_loc (loc_regions preserve_liveness r) == MG.loc_regions preserve_liveness r)
+
val loc_includes_to_cloc (l1 l2: loc) : Lemma
+  (loc_includes l1 l2 <==> MG.loc_includes (cloc_of_loc l1) (cloc_of_loc l2))
+
val loc_disjoint_to_cloc (l1 l2: loc) : Lemma
+  (loc_disjoint l1 l2 <==> MG.loc_disjoint (cloc_of_loc l1) (cloc_of_loc l2))
+
val modifies_to_cloc (l: loc) (h1 h2: HS.mem) : Lemma
+  (modifies l h1 h2 <==> MG.modifies (cloc_of_loc l) h1 h2)
+ diff --git a/docs/FStar.ModifiesGen.html b/docs/FStar.ModifiesGen.html index 998014e..93fd421 100644 --- a/docs/FStar.ModifiesGen.html +++ b/docs/FStar.ModifiesGen.html @@ -1,61 +1,1083 @@ - - + + - - - - - - + FStar.ModifiesGen + -

module FStar.ModifiesGen

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
* The modifies clause
-
val loc_union_idem:#aloc:aloc_t -> #c:cls aloc -> s:loc c -> (Lemma (==(loc_union s s, s)))
-

The following is useful to make Z3 cut matching loops with modifies_trans and modifies_refl

-
 Liveness-insensitive memory locations
-
 The modifies clause proper
-
 BEGIN TODO: move to FStar.Monotonic.HyperStack
-
 END TODO
-
 * Compositionality
+

+FStar.ModifiesGen

+ +

+The modifies clause

+

NOTE: aloc cannot be a member of the class, because of OCaml +extraction. So it must be a parameter of the class instead.

+
type aloc_t = HS.rid -> nat -> Tot Type
+
noeq
+type cls (aloc: aloc_t) : Type = | Cls:
+  (aloc_includes: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    aloc r a ->
+    aloc r a ->
+    GTot Type0
+  )) ->
+  (aloc_includes_refl: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (x: aloc r a) ->
+    Lemma
+    (aloc_includes x x)
+  )) ->
+  (aloc_includes_trans: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (x1: aloc r a) ->
+    (x2: aloc r a) ->
+    (x3: aloc r a) ->
+    Lemma
+    (requires (aloc_includes x1 x2 /\ aloc_includes x2 x3))
+    (ensures (aloc_includes x1 x3))
+  )) ->
+  (aloc_disjoint: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (x1: aloc r a) ->
+    (x2: aloc r a) ->
+    GTot Type0
+  )) ->
+  (aloc_disjoint_sym: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (x1: aloc r a) ->
+    (x2: aloc r a) ->
+    Lemma
+    (aloc_disjoint x1 x2 <==> aloc_disjoint x2 x1)
+  )) ->
+  (aloc_disjoint_includes: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (larger1: aloc r a) ->
+    (larger2: aloc r a) ->
+    (smaller1: aloc r a) ->
+    (smaller2: aloc r a) ->
+    Lemma
+    (requires (aloc_disjoint larger1 larger2 /\ larger1 `aloc_includes` smaller1 /\ larger2 `aloc_includes` smaller2))
+    (ensures (aloc_disjoint smaller1 smaller2))
+  )) ->
+  (aloc_preserved: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    aloc r a ->
+    HS.mem ->
+    HS.mem ->
+    GTot Type0
+  )) ->
+  (aloc_preserved_refl: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (x: aloc r a) ->
+    (h: HS.mem) ->
+    Lemma
+    (aloc_preserved x h h)
+  )) ->
+  (aloc_preserved_trans: (
+    (#r: HS.rid) ->
+    (#a: nat) ->
+    (x: aloc r a) ->
+    (h1: HS.mem) ->
+    (h2: HS.mem) ->
+    (h3: HS.mem) ->
+    Lemma
+    (requires (aloc_preserved x h1 h2 /\ aloc_preserved x h2 h3))
+    (ensures (aloc_preserved x h1 h3))
+  )) ->
+

if any reference at this address is preserved, then any location at this address is preserved

+
(same_mreference_aloc_preserved: (
+  (#r: HS.rid) ->
+  (#a: nat) ->
+  (b: aloc r a) ->
+  (h1: HS.mem) ->
+  (h2: HS.mem) ->
+  (f: (
+    (a' : Type0) ->
+    (pre: Preorder.preorder a') ->
+    (r': HS.mreference a' pre) ->
+    Lemma
+    (requires (h1 `HS.contains` r' /\ r == HS.frameOf r' /\ a == HS.as_addr r'))
+    (ensures (h2 `HS.contains` r' /\ h1 `HS.sel` r' == h2 `HS.sel` r'))
+  )) ->
+  Lemma
+  (aloc_preserved b h1 h2)
+)) ->
+cls aloc
+
val loc (#aloc: aloc_t u#x) (c: cls aloc) : Tot (Type u#x)
+
val loc_none (#aloc: aloc_t) (#c: cls aloc): Tot (loc c)
+
val loc_union
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+: GTot (loc c)
+

+loc_union_idem

+

The following is useful to make Z3 cut matching loops with +modifies_trans and modifies_refl

+
val loc_union_idem
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (loc_union s s == s)
+
val loc_union_comm
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+: Lemma
+  (loc_union s1 s2 == loc_union s2 s1)
+
val loc_union_assoc
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2 s3: loc c)
+: Lemma
+  (loc_union s1 (loc_union s2 s3) == loc_union (loc_union s1 s2) s3)
+
val loc_union_loc_none_l
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (loc_union loc_none s == s)
+
val loc_union_loc_none_r
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (loc_union s loc_none == s)
+
val loc_of_aloc
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r: HS.rid)
+  (#n: nat)
+  (b: aloc r n)
+: GTot (loc c)
+
val loc_of_aloc_not_none
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r: HS.rid)
+  (#n: nat)
+  (b: aloc r n)
+: Lemma (loc_of_aloc #_ #c b == loc_none ==> False)
+
val loc_addresses
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: GTot (loc c)
+
val loc_regions
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (r: Set.set HS.rid)
+: GTot (loc c)
+
let loc_mreference
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#a: Type)
+  (#p: Preorder.preorder a)
+  (b: HS.mreference a p)
+: GTot (loc c)
+= loc_addresses true (HS.frameOf b) (Set.singleton (HS.as_addr b))
+
let loc_freed_mreference
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#a: Type)
+  (#p: Preorder.preorder a)
+  (b: HS.mreference a p)
+: GTot (loc c)
+= loc_addresses false (HS.frameOf b) (Set.singleton (HS.as_addr b))
+
let loc_region_only
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+: GTot (loc c)
+= loc_regions preserve_liveness (Set.singleton r)
+
let loc_all_regions_from
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+: GTot (loc c)
+= loc_regions preserve_liveness (HS.mod_set (Set.singleton r))
+

Inclusion of memory locations

+
val loc_includes
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+: GTot Type0
+
val loc_includes_refl
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (loc_includes s s)
+
val loc_includes_trans
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2 s3: loc c)
+: Lemma
+  (requires (loc_includes s1 s2 /\ loc_includes s2 s3))
+  (ensures (loc_includes s1 s3))
+
val loc_includes_union_r
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s s1 s2: loc c)
+: Lemma
+  (requires (loc_includes s s1 /\ loc_includes s s2))
+  (ensures (loc_includes s (loc_union s1 s2)))
+
val loc_includes_union_l
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2 s: loc c)
+: Lemma
+  (requires (loc_includes s1 s \/ loc_includes s2 s))
+  (ensures (loc_includes (loc_union s1 s2) s))
+
val loc_includes_none
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (loc_includes s loc_none)
+
val loc_includes_none_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (requires (loc_includes loc_none s))
+  (ensures (s == loc_none))
+
val loc_includes_aloc
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r: HS.rid)
+  (#n: nat)
+  (b1 b2: aloc r n)
+: Lemma
+  (requires (c.aloc_includes b1 b2))
+  (ensures (loc_includes (loc_of_aloc b1) (loc_of_aloc #_ #c b2)))
+
val loc_includes_aloc_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r1 #r2: HS.rid)
+  (#n1 #n2: nat)
+  (b1: aloc r1 n1)
+  (b2: aloc r2 n2)
+: Lemma
+  (requires (loc_includes (loc_of_aloc b1) (loc_of_aloc #_ #c b2)))
+  (ensures (r1 == r2 /\ n1 == n2 /\ c.aloc_includes b1 b2))
+
val loc_includes_addresses_aloc
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (s: Set.set nat)
+  (#a: nat)
+  (p: aloc r a)
+: Lemma
+  (requires (Set.mem a s))
+  (ensures (loc_includes (loc_addresses preserve_liveness r s) (loc_of_aloc #_ #c p)))
+
val loc_includes_region_aloc
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (s: Set.set HS.rid)
+  (#r: HS.rid)
+  (#a: nat)
+  (b: aloc r a)
+: Lemma
+  (requires (Set.mem r s))
+  (ensures (loc_includes (loc_regions preserve_liveness s) (loc_of_aloc #_ #c b)))
+
val loc_includes_region_addresses
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness1 preserve_liveness2: bool)
+  (s: Set.set HS.rid)
+  (r: HS.rid)
+  (a: Set.set nat)
+: Lemma
+  (requires (Set.mem r s))
+  (ensures (loc_includes (loc_regions #_ #c preserve_liveness1 s) (loc_addresses preserve_liveness2 r a)))
+
val loc_includes_region_region
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness1 preserve_liveness2: bool)
+  (s1 s2: Set.set HS.rid)
+: Lemma
+  (requires ((preserve_liveness1 ==> preserve_liveness2) /\ Set.subset s2 s1))
+  (ensures (loc_includes (loc_regions #_ #c preserve_liveness1 s1) (loc_regions preserve_liveness2 s2)))
+
val loc_includes_region_union_l
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness: bool)
+  (l: loc c)
+  (s1 s2: Set.set HS.rid)
+: Lemma
+  (requires (loc_includes l (loc_regions preserve_liveness (Set.intersect s2 (Set.complement s1)))))
+  (ensures (loc_includes (loc_union (loc_regions preserve_liveness s1) l) (loc_regions preserve_liveness s2)))
+
val loc_includes_addresses_addresses
+  (#aloc: aloc_t) (c: cls aloc)
+  (preserve_liveness1 preserve_liveness2: bool)
+  (r: HS.rid)
+  (a1 a2: Set.set nat)
+: Lemma
+  (requires ((preserve_liveness1 ==> preserve_liveness2) /\ Set.subset a2 a1))
+  (ensures (loc_includes #_ #c (loc_addresses preserve_liveness1 r a1) (loc_addresses preserve_liveness2 r a2)))
+

Disjointness of two memory locations

+
val loc_disjoint
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+: GTot Type0
+
val loc_disjoint_sym
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+: Lemma
+  (requires (loc_disjoint s1 s2))
+  (ensures (loc_disjoint s2 s1))
+
val loc_disjoint_none_r
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+: Lemma
+  (ensures (loc_disjoint s loc_none))
+
val loc_disjoint_union_r
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s s1 s2: loc c)
+: Lemma
+  (requires (loc_disjoint s s1 /\ loc_disjoint s s2))
+  (ensures (loc_disjoint s (loc_union s1 s2)))
+
val loc_disjoint_includes
+  (#aloc: aloc_t) (#c: cls aloc)
+  (p1 p2 p1' p2' : loc c)
+: Lemma
+  (requires (loc_includes p1 p1' /\ loc_includes p2 p2' /\ loc_disjoint p1 p2))
+  (ensures (loc_disjoint p1' p2'))
+
val loc_disjoint_aloc_intro
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r1: HS.rid)
+  (#a1: nat)
+  (#r2: HS.rid)
+  (#a2: nat)
+  (b1: aloc r1 a1)
+  (b2: aloc r2 a2)
+: Lemma
+  (requires ((r1 == r2 /\ a1 == a2) ==> c.aloc_disjoint b1 b2))
+  (ensures (loc_disjoint (loc_of_aloc b1) (loc_of_aloc #_ #c b2)))
+
val loc_disjoint_aloc_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r1: HS.rid)
+  (#a1: nat)
+  (#r2: HS.rid)
+  (#a2: nat)
+  (b1: aloc r1 a1)
+  (b2: aloc r2 a2)
+: Lemma
+  (requires (loc_disjoint (loc_of_aloc b1) (loc_of_aloc #_ #c b2)))
+  (ensures ((r1 == r2 /\ a1 == a2) ==> c.aloc_disjoint b1 b2))
+
val loc_disjoint_addresses_intro
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness1 preserve_liveness2: bool)
+  (r1 r2: HS.rid)
+  (n1 n2: Set.set nat)
+: Lemma
+  (requires (r1 <> r2 \/ Set.subset (Set.intersect n1 n2) Set.empty))
+  (ensures (loc_disjoint (loc_addresses #_ #c preserve_liveness1 r1 n1) (loc_addresses preserve_liveness2 r2 n2)))
+
let loc_disjoint_addresses #aloc #c = loc_disjoint_addresses_intro #aloc #c
+
val loc_disjoint_addresses_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness1 preserve_liveness2: bool)
+  (r1 r2: HS.rid)
+  (n1 n2: Set.set nat)
+: Lemma
+  (requires (loc_disjoint (loc_addresses #_ #c preserve_liveness1 r1 n1) (loc_addresses preserve_liveness2 r2 n2)))
+  (ensures (r1 <> r2 \/ Set.subset (Set.intersect n1 n2) Set.empty))
+
val loc_disjoint_aloc_addresses_intro
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r' : HS.rid)
+  (#a' : nat)
+  (p: aloc r' a')
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: Lemma
+  (requires (r == r' ==> (~ (Set.mem a' n))))
+  (ensures (loc_disjoint (loc_of_aloc p) (loc_addresses #_ #c preserve_liveness r n)))
+
val loc_disjoint_aloc_addresses_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r' : HS.rid)
+  (#a' : nat)
+  (p: aloc r' a')
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: Lemma
+  (requires (loc_disjoint (loc_of_aloc p) (loc_addresses #_ #c preserve_liveness r n)))
+  (ensures (r == r' ==> (~ (Set.mem a' n))))
+
val loc_disjoint_regions
+  (#aloc: aloc_t) (#c: cls aloc)
+  (preserve_liveness1 preserve_liveness2: bool)
+  (rs1 rs2: Set.set HS.rid)
+: Lemma
+  (requires (Set.subset (Set.intersect rs1 rs2) Set.empty))
+  (ensures (loc_disjoint (loc_regions #_ #c preserve_liveness1 rs1) (loc_regions preserve_liveness2 rs2)))
+

Liveness-insensitive memory locations

+
val address_liveness_insensitive_locs (#aloc: aloc_t) (c: cls aloc) : Tot (loc c)
+
val loc_includes_address_liveness_insensitive_locs_aloc (#aloc: aloc_t) (#c: cls aloc) (#r: HS.rid) (#n: nat) (a: aloc r n) : Lemma
+  (loc_includes (address_liveness_insensitive_locs c) (loc_of_aloc a))
+
val loc_includes_address_liveness_insensitive_locs_addresses (#aloc: aloc_t) (c: cls aloc) (r: HS.rid) (a: Set.set nat) : Lemma
+  (loc_includes (address_liveness_insensitive_locs c) (loc_addresses true r a))
+
val region_liveness_insensitive_locs (#al: aloc_t) (c: cls al) : Tot (loc c)
+
val loc_includes_region_liveness_insensitive_locs_address_liveness_insensitive_locs (#al: aloc_t) (c: cls al) : Lemma
+  (loc_includes (region_liveness_insensitive_locs c) (address_liveness_insensitive_locs c))
+
val loc_includes_region_liveness_insensitive_locs_loc_regions
+  (#al: aloc_t) (c: cls al) (r: Set.set HS.rid)
+: Lemma
+  (region_liveness_insensitive_locs c `loc_includes` loc_regions #_ #c true r)
+
val loc_includes_region_liveness_insensitive_locs_loc_addresses
+  (#al: aloc_t) (c: cls al) (preserve_liveness: bool) (r: HS.rid) (a: Set.set nat)
+: Lemma
+  (region_liveness_insensitive_locs c `loc_includes` loc_addresses #_ #c preserve_liveness r a)
+
val loc_includes_region_liveness_insensitive_locs_loc_of_aloc
+  (#al: aloc_t) (c: cls al) (#r: HS.rid) (#a: nat) (x: al r a)
+: Lemma
+  (region_liveness_insensitive_locs c `loc_includes` loc_of_aloc #_ #c x)
+

The modifies clause proper

+
val modifies
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+  (h1 h2: HS.mem)
+: GTot Type0
+
val modifies_intro
+  (#al: aloc_t) (#c: cls al) (l: loc c) (h h' : HS.mem)
+  (regions: (
+    (r: HS.rid) ->
+    Lemma
+    (requires (HS.live_region h r))
+    (ensures (HS.live_region h' r))
+  ))
+  (mrefs: (
+    (t: Type0) ->
+    (pre: Preorder.preorder t) ->
+    (b: HS.mreference t pre) ->
+    Lemma
+    (requires ((loc_disjoint (loc_mreference b) l) /\ HS.contains h b))
+    (ensures (HS.contains h' b /\ HS.sel h' b == HS.sel h b))
+  ))
+  (livenesses: (
+    (t: Type0) ->
+    (pre: Preorder.preorder t) ->
+    (b: HS.mreference t pre) ->
+    Lemma
+    (requires (HS.contains h b))
+    (ensures (HS.contains h' b))
+  ))
+  (addr_unused_in: (
+    (r: HS.rid) ->
+    (n: nat) ->
+    Lemma
+    (requires (
+      HS.live_region h r /\
+      HS.live_region h' r /\ n `Heap.addr_unused_in` (HS.get_hmap h' `Map.sel` r)
+    ))
+    (ensures (n `Heap.addr_unused_in` (HS.get_hmap h `Map.sel` r)))
+  ))
+  (alocs: (
+    (r: HS.rid) ->
+    (a: nat) ->
+    (x: al r a) ->
+    Lemma
+    (requires (loc_disjoint (loc_of_aloc x) l))
+    (ensures (c.aloc_preserved x h h'))
+  ))
+: Lemma
+  (modifies l h h')
+
val modifies_none_intro
+  (#al: aloc_t) (#c: cls al) (h h' : HS.mem)
+  (regions: (
+    (r: HS.rid) ->
+    Lemma
+    (requires (HS.live_region h r))
+    (ensures (HS.live_region h' r))
+  ))
+  (mrefs: (
+    (t: Type0) ->
+    (pre: Preorder.preorder t) ->
+    (b: HS.mreference t pre) ->
+    Lemma
+    (requires (HS.contains h b))
+    (ensures (HS.contains h' b /\ HS.sel h' b == HS.sel h b))
+  ))
+  (addr_unused_in: (
+    (r: HS.rid) ->
+    (n: nat) ->
+    Lemma
+    (requires (HS.live_region h r /\ HS.live_region h' r /\ n `Heap.addr_unused_in` (HS.get_hmap h' `Map.sel` r)))
+    (ensures (n `Heap.addr_unused_in` (HS.get_hmap h `Map.sel` r)))
+  ))
+: Lemma
+  (modifies (loc_none #_ #c) h h')
+
val modifies_address_intro
+  (#al: aloc_t) (#c: cls al) (r: HS.rid) (n: nat) (h h' : HS.mem)
+  (regions: (
+    (r: HS.rid) ->
+    Lemma
+    (requires (HS.live_region h r))
+    (ensures (HS.live_region h' r))
+  ))
+  (mrefs: (
+    (t: Type0) ->
+    (pre: Preorder.preorder t) ->
+    (b: HS.mreference t pre) ->
+    Lemma
+    (requires ((r <> HS.frameOf b \/ n <> HS.as_addr b) /\ HS.contains h b))
+    (ensures (HS.contains h' b /\ HS.sel h' b == HS.sel h b))
+  ))
+  (addr_unused_in: (
+    (r': HS.rid) ->
+    (n' : nat) ->
+    Lemma
+    (requires ((r' <> r \/ n' <> n) /\ HS.live_region h r' /\ HS.live_region h' r' /\ n' `Heap.addr_unused_in` (HS.get_hmap h' `Map.sel` r')))
+    (ensures (n' `Heap.addr_unused_in` (HS.get_hmap h `Map.sel` r')))
+  ))
+: Lemma
+  (modifies (loc_addresses #_ #c false r (Set.singleton n)) h h')
+
val modifies_aloc_intro
+  (#al: aloc_t) (#c: cls al) (#r: HS.rid) (#n: nat) (z: al r n) (h h' : HS.mem)
+  (regions: (
+    (r: HS.rid) ->
+    Lemma
+    (requires (HS.live_region h r))
+    (ensures (HS.live_region h' r))
+  ))
+  (mrefs: (
+    (t: Type0) ->
+    (pre: Preorder.preorder t) ->
+    (b: HS.mreference t pre) ->
+    Lemma
+    (requires ((r <> HS.frameOf b \/ n <> HS.as_addr b) /\ HS.contains h b))
+    (ensures (HS.contains h' b /\ HS.sel h' b == HS.sel h b))
+  ))
+  (livenesses: (
+    (t: Type0) ->
+    (pre: Preorder.preorder t) ->
+    (b: HS.mreference t pre) ->
+    Lemma
+    (requires (HS.contains h b))
+    (ensures (HS.contains h' b))
+  ))
+  (addr_unused_in: (
+    (r: HS.rid) ->
+    (n: nat) ->
+    Lemma
+    (requires (HS.live_region h r /\ HS.live_region h' r /\ n `Heap.addr_unused_in` (HS.get_hmap h' `Map.sel` r)))
+    (ensures (n `Heap.addr_unused_in` (HS.get_hmap h `Map.sel` r)))
+  ))
+  (alocs: (
+    (x: al r n) ->
+    Lemma
+    (requires (c.aloc_disjoint x z))
+    (ensures (c.aloc_preserved x h h'))
+  ))
+: Lemma
+  (modifies (loc_of_aloc #_ #c z) h h')
+
val modifies_live_region
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+  (h1 h2: HS.mem)
+  (r: HS.rid)
+: Lemma
+  (requires (modifies s h1 h2 /\ loc_disjoint s (loc_region_only false r) /\ HS.live_region h1 r))
+  (ensures (HS.live_region h2 r))
+
val modifies_mreference_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (b: HS.mreference t pre)
+  (p: loc c)
+  (h h': HS.mem)
+: Lemma
+  (requires (
+    loc_disjoint (loc_mreference b) p /\
+    HS.contains h b /\
+    modifies p h h'
+  ))
+  (ensures (
+    HS.contains h' b /\
+    HS.sel h b == HS.sel h' b
+  ))
+
val modifies_aloc_elim
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#r: HS.rid)
+  (#a: nat)
+  (b: aloc r a)
+  (p: loc c)
+  (h h': HS.mem)
+: Lemma
+  (requires (
+    loc_disjoint (loc_of_aloc b) p /\
+    modifies p h h'
+  ))
+  (ensures (
+    c.aloc_preserved b h h'
+  ))
+
val modifies_refl
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s: loc c)
+  (h: HS.mem)
+: Lemma
+  (modifies s h h)
+
val modifies_loc_includes
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1: loc c)
+  (h h': HS.mem)
+  (s2: loc c)
+: Lemma
+  (requires (modifies s2 h h' /\ loc_includes s1 s2))
+  (ensures (modifies s1 h h'))
+
val modifies_preserves_liveness
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (r: HS.mreference t pre)
+: Lemma
+  (requires (modifies (loc_union s1 s2) h h' /\ loc_disjoint s1 (loc_mreference r) /\ loc_includes (address_liveness_insensitive_locs c) s2 /\ h `HS.contains` r))
+  (ensures (h' `HS.contains` r))
+
val modifies_preserves_liveness_strong
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s1 s2: loc c)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (r: HS.mreference t pre)
+  (x: aloc (HS.frameOf r) (HS.as_addr r))
+: Lemma
+  (requires (modifies (loc_union s1 s2) h h' /\ loc_disjoint s1 (loc_of_aloc #_ #c #(HS.frameOf r) #(HS.as_addr r) x) /\ loc_includes (address_liveness_insensitive_locs c) s2 /\ h `HS.contains` r))
+  (ensures (h' `HS.contains` r))
+
val modifies_preserves_region_liveness
+  (#al: aloc_t) (#c: cls al)
+  (l1 l2: loc c)
+  (h h' : HS.mem)
+  (r: HS.rid)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ region_liveness_insensitive_locs c `loc_includes` l2 /\ loc_disjoint (loc_region_only false r) l1 /\ HS.live_region h r))
+  (ensures (HS.live_region h' r))
+
val modifies_preserves_region_liveness_reference
+  (#al: aloc_t) (#c: cls al)
+  (l1 l2: loc c)
+  (h h' : HS.mem)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (r: HS.mreference t pre)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ region_liveness_insensitive_locs c `loc_includes` l2 /\ loc_disjoint (loc_mreference r) l1 /\ HS.live_region h (HS.frameOf r)))
+  (ensures (HS.live_region h' (HS.frameOf r)))
+
val modifies_preserves_region_liveness_aloc
+  (#al: aloc_t) (#c: cls al)
+  (l1 l2: loc c)
+  (h h' : HS.mem)
+  (#r: HS.rid)
+  (#n: nat)
+  (x: al r n)
+: Lemma
+  (requires (modifies (loc_union l1 l2) h h' /\ region_liveness_insensitive_locs c `loc_includes` l2 /\ loc_disjoint (loc_of_aloc x) l1 /\ HS.live_region h r))
+  (ensures (HS.live_region h' r))
+
val modifies_trans
+  (#aloc: aloc_t) (#c: cls aloc)
+  (s12: loc c)
+  (h1 h2: HS.mem)
+  (s23: loc c)
+  (h3: HS.mem)
+: Lemma
+  (requires (modifies s12 h1 h2 /\ modifies s23 h2 h3))
+  (ensures (modifies (loc_union s12 s23) h1 h3))
+
val modifies_only_live_regions
+  (#aloc: aloc_t) (#c: cls aloc)
+  (rs: Set.set HS.rid)
+  (l: loc c)
+  (h h' : HS.mem)
+: Lemma
+  (requires (
+    modifies (loc_union (loc_regions false rs) l) h h' /\
+    (forall r . Set.mem r rs ==> (~ (HS.live_region h r)))
+  ))
+  (ensures (modifies l h h'))
+
val no_upd_fresh_region
+  (#aloc: aloc_t) (#c: cls aloc)
+  (r:HS.rid)
+  (l:loc c)
+  (h0:HS.mem)
+  (h1:HS.mem)
+: Lemma
+  (requires (HS.fresh_region r h0 h1 /\ modifies (loc_union (loc_all_regions_from false r) l) h0 h1))
+  (ensures  (modifies l h0 h1))
+
val fresh_frame_modifies
+  (#aloc: aloc_t) (c: cls aloc)
+  (h0 h1: HS.mem)
+: Lemma
+  (requires (HS.fresh_frame h0 h1))
+  (ensures (modifies #_ #c loc_none h0 h1))
+
val new_region_modifies
+  (#al: aloc_t)
+  (c: cls al)
+  (m0: HS.mem)
+  (r0: HS.rid)
+  (col: option int)
+: Lemma
+  (requires (HST.is_eternal_region r0 /\ HS.live_region m0 r0 /\ (None? col \/ HS.is_heap_color (Some?.v col))))
+  (ensures (
+    let (_, m1) = HS.new_eternal_region m0 r0 col in
+    modifies (loc_none #_ #c) m0 m1
+  ))
+
val popped_modifies
+  (#aloc: aloc_t) (c: cls aloc)
+  (h0 h1: HS.mem) : Lemma
+  (requires (HS.popped h0 h1))
+  (ensures (modifies #_ #c (loc_region_only false (HS.get_tip h0)) h0 h1))
+
val modifies_fresh_frame_popped
+  (#aloc: aloc_t) (#c: cls aloc)
+  (h0 h1: HS.mem)
+  (s: loc c)
+  (h2 h3: HS.mem)
+: Lemma
+  (requires (
+    HS.fresh_frame h0 h1 /\
+    modifies (loc_union (loc_all_regions_from false (HS.get_tip h1)) s) h1 h2 /\
+    HS.get_tip h2 == HS.get_tip h1 /\
+    HS.popped h2 h3
+  ))
+  (ensures (
+    modifies s h0 h3 /\
+    HS.get_tip h3 == HS.get_tip h0
+  ))
+
val modifies_loc_regions_intro
+  (#aloc: aloc_t) (#c: cls aloc)
+  (rs: Set.set HS.rid)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (HS.modifies rs h1 h2))
+  (ensures (modifies (loc_regions #_ #c true rs) h1 h2))
+
val modifies_loc_addresses_intro
+  (#aloc: aloc_t) (#c: cls aloc)
+  (r: HS.rid)
+  (a: Set.set nat)
+  (l: loc c)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (
+    HS.live_region h2 r /\
+    modifies (loc_union (loc_region_only false r) l) h1 h2 /\
+    HS.modifies_ref r a h1 h2
+  ))
+  (ensures (modifies (loc_union (loc_addresses true r a) l) h1 h2))
+
val modifies_ralloc_post
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (i: HS.rid)
+  (init: a)
+  (h: HS.mem)
+  (x: HST.mreference a rel)
+  (h' : HS.mem)
+: Lemma
+  (requires (HST.ralloc_post i init h x h'))
+  (ensures (modifies (loc_none #_ #c) h h'))
+
val modifies_salloc_post
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (init: a)
+  (h: HS.mem)
+  (x: HST.mreference a rel { HS.is_stack_region (HS.frameOf x) } )
+  (h' : HS.mem)
+: Lemma
+  (requires (HST.salloc_post init h x h'))
+  (ensures (modifies (loc_none #_ #c) h h'))
+
val modifies_free
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel { HS.is_mm r } )
+  (m: HS.mem { m `HS.contains` r } )
+: Lemma
+  (modifies (loc_freed_mreference #_ #c r) m (HS.free r m))
+
val modifies_none_modifies
+  (#aloc: aloc_t) (#c: cls aloc)
+  (h1 h2: HS.mem)
+: Lemma
+  (requires (HST.modifies_none h1 h2))
+  (ensures (modifies (loc_none #_ #c) h1 h2))
+
val modifies_upd
+  (#aloc: aloc_t) (#c: cls aloc)
+  (#t: Type) (#pre: Preorder.preorder t)
+  (r: HS.mreference t pre)
+  (v: t)
+  (h: HS.mem)
+: Lemma
+  (requires (HS.contains h r))
+  (ensures (modifies #_ #c (loc_mreference r) h (HS.upd h r v)))
+
val modifies_strengthen
+  (#al: aloc_t) (#c: cls al) (l: loc c) (#r0: HS.rid) (#a0: nat) (al0: al r0 a0) (h h' : HS.mem)
+  (alocs: (
+    (f: ((t: Type) -> (pre: Preorder.preorder t) -> (m: HS.mreference t pre) -> Lemma
+      (requires (HS.frameOf m == r0 /\ HS.as_addr m == a0 /\ HS.contains h m))
+      (ensures (HS.contains h' m))
+    )) ->
+    (x: al r0 a0) ->
+    Lemma
+    (requires (c.aloc_disjoint x al0 /\ loc_disjoint (loc_of_aloc x) l))
+    (ensures (c.aloc_preserved x h h'))
+  ))
+: Lemma
+  (requires (modifies (loc_union l (loc_addresses true r0 (Set.singleton a0))) h h'))
+  (ensures (modifies (loc_union l (loc_of_aloc al0)) h h'))
+

BEGIN TODO: move to FStar.Monotonic.HyperStack

+
val does_not_contain_addr
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: GTot Type0
+
val not_live_region_does_not_contain_addr
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: Lemma
+  (requires (~ (HS.live_region h (fst ra))))
+  (ensures (h `does_not_contain_addr` ra))
+
val unused_in_does_not_contain_addr
+  (h: HS.mem)
+  (#a: Type)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel)
+: Lemma
+  (requires (r `HS.unused_in` h))
+  (ensures (h `does_not_contain_addr` (HS.frameOf r, HS.as_addr r)))
+
val addr_unused_in_does_not_contain_addr
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: Lemma
+  (requires (HS.live_region h (fst ra) ==> snd ra `Heap.addr_unused_in` (HS.get_hmap h `Map.sel` (fst ra))))
+  (ensures (h `does_not_contain_addr` ra))
+
val does_not_contain_addr_addr_unused_in
+  (h: HS.mem)
+  (ra: HS.rid * nat)
+: Lemma
+  (requires (h `does_not_contain_addr` ra))
+  (ensures (HS.live_region h (fst ra) ==> snd ra `Heap.addr_unused_in` (HS.get_hmap h `Map.sel` (fst ra))))
+
val free_does_not_contain_addr
+  (#a: Type0)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel)
+  (m: HS.mem)
+  (x: HS.rid * nat)
+: Lemma
+  (requires (
+    HS.is_mm r /\
+    m `HS.contains` r /\
+    fst x == HS.frameOf r /\
+    snd x == HS.as_addr r
+  ))
+  (ensures (
+    HS.free r m `does_not_contain_addr` x
+  ))
+
val does_not_contain_addr_elim
+  (#a: Type0)
+  (#rel: Preorder.preorder a)
+  (r: HS.mreference a rel)
+  (m: HS.mem)
+  (x: HS.rid * nat)
+: Lemma
+  (requires (
+    m `does_not_contain_addr` x /\
+    HS.frameOf r == fst x /\
+    HS.as_addr r == snd x
+  ))
+  (ensures (~ (m `HS.contains` r)))
+

END TODO

+
val loc_not_unused_in (#al: aloc_t) (c: cls al) (h: HS.mem) : GTot (loc c)
+
val loc_unused_in (#al: aloc_t) (c: cls al) (h: HS.mem) : GTot (loc c)
+
val loc_regions_unused_in (#al: aloc_t) (c: cls al) (h: HS.mem) (rs: Set.set HS.rid) : Lemma
+  (requires (forall r . Set.mem r rs ==> (~ (HS.live_region h r))))
+  (ensures (loc_unused_in c h `loc_includes` loc_regions false rs))
+
val loc_addresses_unused_in (#al: aloc_t) (c: cls al) (r: HS.rid) (a: Set.set nat) (h: HS.mem) : Lemma
+  (requires (forall x . Set.mem x a ==> h `does_not_contain_addr` (r, x)))
+  (ensures (loc_unused_in c h `loc_includes` loc_addresses false r a))
+
val loc_addresses_not_unused_in (#al: aloc_t) (c: cls al) (r: HS.rid) (a: Set.set nat) (h: HS.mem) : Lemma
+  (requires (forall x . Set.mem x a ==> ~ (h `does_not_contain_addr` (r, x))))
+  (ensures (loc_not_unused_in c h `loc_includes` loc_addresses false r a))
+
val loc_unused_in_not_unused_in_disjoint (#al: aloc_t) (c: cls al) (h: HS.mem) : Lemma
+  (loc_unused_in c h `loc_disjoint` loc_not_unused_in c h)
+
val not_live_region_loc_not_unused_in_disjoint
+  (#al: aloc_t)
+  (c: cls al)
+  (h0: HS.mem)
+  (r: HS.rid)
+: Lemma
+  (requires (~ (HS.live_region h0 r)))
+  (ensures (loc_disjoint (loc_region_only false r) (loc_not_unused_in c h0)))
+
val modifies_address_liveness_insensitive_unused_in
+  (#al: aloc_t)
+  (c: cls al)
+  (h h' : HS.mem)
+: Lemma
+  (requires (modifies (address_liveness_insensitive_locs c) h h'))
+  (ensures (loc_not_unused_in c h' `loc_includes` loc_not_unused_in c h /\ loc_unused_in c h `loc_includes` loc_unused_in c h'))
+
val modifies_only_not_unused_in
+  (#al: aloc_t)
+  (#c: cls al)
+  (l: loc c)
+  (h h' : HS.mem)
+: Lemma
+  (requires (modifies (loc_unused_in c h `loc_union` l) h h'))
+  (ensures (modifies l h h'))
+
let modifies_only_live_addresses
+  (#aloc: aloc_t) (#c: cls aloc)
+  (r: HS.rid)
+  (a: Set.set nat)
+  (l: loc c)
+  (h h' : HS.mem)
+: Lemma
+  (requires (
+    modifies (loc_union (loc_addresses false r a) l) h h' /\
+    (forall x . Set.mem x a ==> h `does_not_contain_addr` (r, x))
+  ))
+  (ensures (modifies l h h'))
+= loc_addresses_unused_in c r a h;
+  loc_includes_refl l;
+  loc_includes_union_l (loc_unused_in c h) l l;
+  loc_includes_union_l (loc_unused_in c h) l (loc_addresses false r a);
+  loc_includes_union_r (loc_union (loc_unused_in c h) l) (loc_addresses false r a) l;
+  modifies_loc_includes (loc_union (loc_unused_in c h) l) h h' (loc_union (loc_addresses false r a) l);
+  modifies_only_not_unused_in l h h'
+
val mreference_live_loc_not_unused_in
+  (#al: aloc_t)
+  (c: cls al)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (h: HS.mem)
+  (r: HS.mreference t pre)
+: Lemma
+  (requires (h `HS.contains` r))
+  (ensures (loc_not_unused_in c h `loc_includes` loc_freed_mreference r /\ loc_not_unused_in c h `loc_includes` loc_mreference r))
+
val mreference_unused_in_loc_unused_in
+  (#al: aloc_t)
+  (c: cls al)
+  (#t: Type)
+  (#pre: Preorder.preorder t)
+  (h: HS.mem)
+  (r: HS.mreference t pre)
+: Lemma
+  (requires (r `HS.unused_in` h))
+  (ensures (loc_unused_in c h `loc_includes` loc_freed_mreference r /\ loc_unused_in c h `loc_includes` loc_mreference r))
+ +
val aloc_union: (bool -> Tot (aloc_t u#x)) -> Tot (aloc_t u#x)
+
val cls_union (#a: (bool -> Tot aloc_t)) (c: ((b: bool) -> Tot (cls (a b)))) : Tot (cls (aloc_union a))
+
val union_loc_of_loc (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b))) (b: bool) (l: loc (c b)) : GTot (loc (cls_union c))
+
val union_loc_of_loc_none
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+: Lemma
+  (union_loc_of_loc c b (loc_none #_ #(c b)) == loc_none #_ #(cls_union c))
+
val union_loc_of_loc_union
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (l1 l2: loc (c b))
+: Lemma
+  (union_loc_of_loc c b (loc_union #_ #(c b) l1 l2) == loc_union #_ #(cls_union c) (union_loc_of_loc c b l1) (union_loc_of_loc c b l2))
+
val union_loc_of_loc_addresses
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: Lemma
+  (union_loc_of_loc c b (loc_addresses #_ #(c b) preserve_liveness r n) == loc_addresses #_ #(cls_union c) preserve_liveness r n)
+
val union_loc_of_loc_regions
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (preserve_liveness: bool)
+  (r: Set.set HS.rid)
+: Lemma
+  (union_loc_of_loc c b (loc_regions #_ #(c b) preserve_liveness r) == loc_regions #_ #(cls_union c) preserve_liveness r)
+
val union_loc_of_loc_includes
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (s1 s2: loc (c b))
+: Lemma
+  (union_loc_of_loc c b s1 `loc_includes` union_loc_of_loc c b s2 <==> s1 `loc_includes` s2)
+
val union_loc_of_loc_disjoint
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (s1 s2: loc (c b))
+: Lemma
+  (union_loc_of_loc c b s1 `loc_disjoint` union_loc_of_loc c b s2 <==> s1 `loc_disjoint` s2)
+
val modifies_union_loc_of_loc
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (l: loc (c b))
+  (h1 h2: HS.mem)
+: Lemma
+  (modifies #_ #(cls_union c) (union_loc_of_loc c b l) h1 h2 <==> modifies #_ #(c b) l h1 h2)
+
val loc_of_union_loc
+  (#al: (bool -> Tot aloc_t))
+  (#c: ((b: bool) -> Tot (cls (al b))))
+  (b: bool)
+  (l: loc (cls_union c))
+: GTot (loc (c b))
+
val loc_of_union_loc_union_loc_of_loc
+  (#al: (bool -> HS.rid -> nat -> Tot Type))
+  (c: ((b: bool) -> Tot (cls (al b))))
+  (b: bool)
+  (s: loc (c b))
+: Lemma
+  (loc_of_union_loc b (union_loc_of_loc c b s) == s)
+
val loc_of_union_loc_none
+  (#al: (bool -> Tot aloc_t))
+  (c: ((b: bool) -> Tot (cls (al b))))
+  (b: bool)
+: Lemma
+  (loc_of_union_loc #_ #c b loc_none == loc_none)
+
val loc_of_union_loc_union
+  (#al: (bool -> Tot aloc_t))
+  (c: ((b: bool) -> Tot (cls (al b))))
+  (b: bool)
+  (l1 l2: loc (cls_union c))
+: Lemma
+  (loc_of_union_loc b (l1 `loc_union` l2) == loc_of_union_loc b l1 `loc_union` loc_of_union_loc b l2)
+
val loc_of_union_loc_addresses
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (preserve_liveness: bool)
+  (r: HS.rid)
+  (n: Set.set nat)
+: Lemma
+  (loc_of_union_loc #_ #c b (loc_addresses preserve_liveness r n) == loc_addresses preserve_liveness r n)
+
val loc_of_union_loc_regions
+  (#al: (bool -> Tot aloc_t)) (c: (b: bool) -> Tot (cls (al b)))
+  (b: bool)
+  (preserve_liveness: bool)
+  (r: Set.set HS.rid)
+: Lemma
+  (loc_of_union_loc #_ #c b (loc_regions preserve_liveness r) == loc_regions preserve_liveness r)
+
+

Universes

+
+
val raise_aloc (al: aloc_t u#x) : Tot (aloc_t u#(max x (y + 1)))
+
val raise_cls (#al: aloc_t u#x) (c: cls al) : Tot (cls (raise_aloc u#x u#y al))
+
val raise_loc (#al: aloc_t u#x) (#c: cls al) (l: loc c) : Tot (loc (raise_cls u#x u#y c))
+
val raise_loc_none (#al: aloc_t u#x) (#c: cls al) : Lemma
+  (raise_loc u#x u#y (loc_none #_ #c) == loc_none)
+
val raise_loc_union (#al: aloc_t u#x) (#c: cls al) (l1 l2: loc c) : Lemma
+  (raise_loc u#x u#y (loc_union l1 l2) == loc_union (raise_loc l1) (raise_loc l2))
+
val raise_loc_addresses (#al: aloc_t u#x) (#c: cls al) (preserve_liveness: bool) (r: HS.rid) (a: Set.set nat) : Lemma
+  (raise_loc u#x u#y (loc_addresses #_ #c preserve_liveness r a) == loc_addresses preserve_liveness r a)
+
val raise_loc_regions (#al: aloc_t u#x) (#c: cls al) (preserve_liveness: bool) (r: Set.set HS.rid) : Lemma
+  (raise_loc u#x u#y (loc_regions #_ #c preserve_liveness r) == loc_regions preserve_liveness r)
+
val raise_loc_includes (#al: aloc_t u#x) (#c: cls al) (l1 l2: loc c) : Lemma
+  (loc_includes (raise_loc u#x u#y l1) (raise_loc l2) <==> loc_includes l1 l2)
+
val raise_loc_disjoint (#al: aloc_t u#x) (#c: cls al) (l1 l2: loc c) : Lemma
+  (loc_disjoint (raise_loc u#x u#y l1) (raise_loc l2) <==> loc_disjoint l1 l2)
+
val modifies_raise_loc (#al: aloc_t u#x) (#c: cls al) (l: loc c) (h1 h2: HS.mem) : Lemma
+  (modifies (raise_loc u#x u#y l) h1 h2 <==> modifies l h1 h2)
+
val lower_loc (#al: aloc_t u#x) (#c: cls al) (l: loc (raise_cls u#x u#y c)) : Tot (loc c)
+
val lower_loc_raise_loc (#al: aloc_t u#x) (#c: cls al) (l: loc c) : Lemma
+  (lower_loc (raise_loc u#x u#y l) == l)
+
val raise_loc_lower_loc (#al: aloc_t u#x) (#c: cls al) (l: loc (raise_cls u#x u#y c)) : Lemma
+  (raise_loc (lower_loc l) == l)
+
val lower_loc_none (#al: aloc_t u#x) (#c: cls al) : Lemma
+  (lower_loc u#x u#y #_ #c loc_none == loc_none)
+
val lower_loc_union (#al: aloc_t u#x) (#c: cls al) (l1 l2: loc (raise_cls u#x u#y c)) : Lemma
+  (lower_loc u#x u#y (loc_union l1 l2) == loc_union (lower_loc l1) (lower_loc l2))
+
val lower_loc_addresses (#al: aloc_t u#x) (#c: cls al) (preserve_liveness: bool) (r: HS.rid) (a: Set.set nat) : Lemma
+  (lower_loc u#x u#y #_ #c (loc_addresses preserve_liveness r a) == loc_addresses preserve_liveness r a)
+
val lower_loc_regions (#al: aloc_t u#x) (#c: cls al) (preserve_liveness: bool) (r: Set.set HS.rid) : Lemma
+  (lower_loc u#x u#y #_ #c (loc_regions preserve_liveness r) == loc_regions preserve_liveness r)
+ diff --git a/docs/FStar.Monotonic.DependentMap.html b/docs/FStar.Monotonic.DependentMap.html index ec2fa9e..b950c4a 100644 --- a/docs/FStar.Monotonic.DependentMap.html +++ b/docs/FStar.Monotonic.DependentMap.html @@ -1,55 +1,266 @@ - - + + - - - - - - + FStar.Monotonic.DependentMap + -

module FStar.Monotonic.DependentMap

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
open FStar.HyperStack.ST
-

A library for mutable partial, dependent maps, that grow monotonically, while subject to an invariant on the entire map

+

+FStar.Monotonic.DependentMap

+ +
+

The logical model of the map is given in terms of DM.t///

+
+
let opt (#a:eqtype) (b:a -> Type) = fun (x:a) -> option (b x)
+let partial_dependent_map (a:eqtype) (b:a -> Type) =
+    DM.t a (opt b)
+
+

An empty partial, dependent map maps all keys to None

+
+
let empty_partial_dependent_map (#a:_) (#b:_)
+  : partial_dependent_map a b
+  = DM.create #a #(opt b) (fun x -> None)
+

//////////////////////////////////////////////////////////////////////////////

+
+

map a b: Internally, the model is implemented using this abstract type +These maps provide three operations: +- empty, sel, upd +Which are proven to be in correspondence with the operations on DM.t +via the homomorphism repr below

+
+
val map
+    (a:eqtype)
+    (b:(a -> Type u#b))
+  : Type u#b
+
+

repr m: A ghost function that reveals the internal map as a DM.t

+
+
val repr (#a:_) (#b:_)
+    (r:map a b)
+  : GTot (partial_dependent_map a b)
+
+

An empty : map a b is equivalent to the empty_partial_dependent_map

+
+
val empty (#a:_) (#b:_)
+  : r:map a b{repr r == empty_partial_dependent_map}
+
+

Selecting a key from a map sel r x is equivalent to selecting it from its repr

+
+
val sel (#a:_) (#b:_)
+    (r:map a b)
+    (x:a)
+  : Pure (option (b x))
+    (requires True)
+    (ensures (fun o -> DM.sel (repr r) x == o))
+
+

Updating a map using upd r x v is equivalent to updating its repr

+
+
val upd (#a:_) (#b:_)
+    (r:map a b)
+    (x:a)
+    (v:b x)
+  : Pure (map a b)
+    (requires True)
+    (ensures (fun r' -> repr r' == DM.upd (repr r) x (Some v)))
+
+

imap a b inv further augments a map with an invariant on its repr

+
+
let imap (a:eqtype) (b: a -> Type) (inv:DM.t a (opt b) -> Type) =
+    r:map a b{inv (repr r)}
+
+

grows r1 r2 is an abstract preorder on imap

+
+
val grows (#a:_) (#b:_) (#inv:DM.t a (opt b) -> Type)
+  : FStar.Preorder.preorder (imap a b inv)
+
+

And, finally, the main type of this module:

+

t r a b inv is a mutable, imap stored in region r constrained +to evolve according to grows

+
+
let t (r:HST.erid) (a:eqtype) (b:a -> Type) (inv:DM.t a (opt b) -> Type) =
+    m_rref r (imap a b inv) grows
+
+

defined t x h: In state h, map t is defined at point x. +- We define these in Type rather than bool +since it is typical for client code to use defined +as a stable heap predicate, which requires a heap -> Type

+
+
let defined
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+    (h:HS.mem)
+  : GTot Type
+  = Some? (sel (HS.sel h t) x)
+
+

fresh t x h: The map is not defined at point x

+
+
let fresh
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+    (h:HS.mem)
+  : GTot Type0
+  = ~ (defined t x h)
+
+

value_of t x h: Get the value of x in the map t in state h

+
+
let value_of
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+    (h:HS.mem{defined t x h})
+  : GTot (b x)
+  = Some?.v (sel (HS.sel h t) x)
+
+

contains t x y h: In state h, t maps x to y

+
+
let contains
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+    (y:b x)
+    (h:HS.mem)
+  : GTot Type0
+  = defined t x h /\
+    value_of t x h == y
+
+

contains_stable: The contains predicate is stable with respect to grows

+
+
val contains_stable
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+    (y:b x)
+  : Lemma (ensures (HST.stable_on_t t (contains t x y)))
+
+

defined_stable: The defined predicate is stable with respect to grows

+ +
+
val defined_stable
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+  : Lemma (ensures (HST.stable_on_t t (defined t x)))
+

////////////////////////////////////////////////////////////////////////////// +Interface of stateful operations +//////////////////////////////////////////////////////////////////////////////

+
+

alloc (): Allocating a new t requires proving the inv of the empty map

+
+
val alloc (#a:eqtype) (#b:a -> Type) (#inv:DM.t a (opt b) -> Type) (#r:HST.erid)
+    (_:unit{inv (repr empty)})
+  : ST (t r a b inv)
+       (requires (fun h -> HyperStack.ST.witnessed (region_contains_pred r)))
+       (ensures (fun h0 x h1 ->
+         ralloc_post r empty h0 x h1))
+
+

extend t x y: Extending t with (x -> y) +Requires: - proving that the t does not already define x +- and that the resulting heap would still respect inv +Ensures: - that only t is modified +- by updating it to contain (x -> y) +- and in the future t will always contain (x -> y)

+
+
val extend
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+    (y:b x)
+  : Stack unit
+       (requires (fun h ->
+         ~(defined t x h) /\
+         inv (repr (upd (HS.sel h t) x y))))
+       (ensures (fun h0 u h1 ->
+         let cur = HS.sel h0 t in
+         HS.contains h1 t /\
+         HS.modifies (Set.singleton r) h0 h1 /\
+         HS.modifies_ref r (Set.singleton (HS.as_addr t)) h0 h1 /\
+         HS.sel h1 t == upd cur x y /\
+         witnessed (contains t x y)))
+
+

lookup t x: Querying the map t at point x +Ensures: - The state does not change +- If it returns Some v, then t will always contains x -> v

+
+
val lookup
+    (#a:eqtype)
+    (#b:a -> Type)
+    (#inv:DM.t a (opt b) -> Type)
+    (#r:HST.erid)
+    (t:t r a b inv)
+    (x:a)
+  : ST (option (b x))
+       (requires (fun h -> True))
+       (ensures (fun h0 y h1 ->
+         h0==h1 /\
+         y == sel (HS.sel h1 t) x /\
+         (match y with
+          | None -> ~(defined t x h1)
+          | Some v ->
+            contains t x v h1 /\
+            witnessed (contains t x v))))
+
let forall_t (#a:eqtype) (#b:a -> Type) (#inv:DM.t a (opt b) -> Type) (#r:HST.erid)
+             (t:t r a b inv) (h:HS.mem) (pred: (x:a) -> b x -> Type0)
+  = forall (x:a).{:pattern (sel (HS.sel h t) x) \/ (DM.sel (repr (HS.sel h t)) x)}
+            defined t x h ==> pred x (Some?.v (sel (HS.sel h t) x))
+
let f_opt (#a:eqtype) (#b #c:a -> Type) (f: (x:a) -> b x -> c x) :(x:a) -> option (b x) -> option (c x)
+  = fun x y ->
+    match y with
+    | None   -> None
+    | Some y -> Some (f x y)
+
val mmap_f (#a:eqtype) (#b #c:a -> Type) (m:map a b) (f: (x:a) -> b x -> c x)
+  :Tot (m':(map a c){repr m' == DM.map (f_opt f) (repr m)})
+
val map_f (#a:eqtype) (#b #c:a -> Type)
+          (#inv:DM.t a (opt b) -> Type) (#inv':DM.t a (opt c) -> Type)
+      (#r #r':HST.erid)
+          (m:t r a b inv) (f: (x:a) -> b x -> c x)
+      :ST (t r' a c inv')
+          (requires (fun h0 -> inv' (DM.map (f_opt f) (repr (HS.sel h0 m))) /\ witnessed (region_contains_pred r')))
+          (ensures  (fun h0 m' h1 ->
+                     inv' (DM.map (f_opt f) (repr (HS.sel h0 m))) /\  //AR: surprised that even after the fix for #57, we need this repetetion from the requires clause
+                     ralloc_post r' (mmap_f (HS.sel h0 m) f) h0 m' h1))
+ diff --git a/docs/FStar.Monotonic.Heap.html b/docs/FStar.Monotonic.Heap.html index be03f76..472ec6e 100644 --- a/docs/FStar.Monotonic.Heap.html +++ b/docs/FStar.Monotonic.Heap.html @@ -1,54 +1,347 @@ - - + + - - - - - - + FStar.Monotonic.Heap + -

module FStar.Monotonic.Heap

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
* Untyped views of monotonic references
+

+FStar.Monotonic.Heap

+ +
let set  = Set.set
+let tset = TSet.set
+
val heap :Type u#1
+
val equal: heap -> heap -> Type0
+
val equal_extensional (h1:heap) (h2:heap)
+  :Lemma (requires True) (ensures (equal h1 h2 <==> h1 == h2))
+         [SMTPat (equal h1 h2)]
+
val emp :heap
+
val next_addr: heap -> GTot pos
+
[@@ remove_unused_type_parameters [1]]
+val mref ([@@@ strictly_positive] a:Type0) ([@@@ strictly_positive] rel:preorder a) :Type0
+
val addr_of: #a:Type0 -> #rel:preorder a -> mref a rel -> GTot pos
+
val is_mm: #a:Type0 -> #rel:preorder a -> mref a rel -> GTot bool
+
let compare_addrs (#a #b:Type0) (#rel1:preorder a) (#rel2:preorder b) (r1:mref a rel1) (r2:mref b rel2)
+  :GTot bool = addr_of r1 = addr_of r2
+
val contains: #a:Type0 -> #rel:preorder a -> heap -> mref a rel -> Type0
+
val addr_unused_in: nat -> heap -> Type0
+
val not_addr_unused_in_nullptr (h: heap) : Lemma (~ (addr_unused_in 0 h))
+
val unused_in: #a:Type0 -> #rel:preorder a -> mref a rel -> heap -> Type0
+
let fresh (#a:Type) (#rel:preorder a) (r:mref a rel) (h0:heap) (h1:heap) =
+  r `unused_in` h0 /\ h1 `contains` r
+
let only_t (#a:Type0) (#rel:preorder a) (x:mref a rel) :GTot (tset nat) = TS.singleton (addr_of x)
+
let only (#a:Type0) (#rel:preorder a) (x:mref a rel) :GTot (set nat) = S.singleton (addr_of x)
+
let op_Hat_Plus_Plus (#a:Type0) (#rel:preorder a) (r:mref a rel) (s:set nat) :GTot (set nat) = S.union (only r) s
+
let op_Plus_Plus_Hat (#a:Type0) (#rel:preorder a) (s:set nat) (r:mref a rel) :GTot (set nat) = S.union s (only r)
+
let op_Hat_Plus_Hat (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (r1:mref a rel1) (r2:mref b rel2)
+  :GTot (set nat) = S.union (only r1) (only r2)
+
val sel_tot: #a:Type0 -> #rel:preorder a -> h:heap -> r:mref a rel{h `contains` r} -> Tot a
+
val sel: #a:Type0 -> #rel:preorder a -> heap -> mref a rel -> GTot a
+
val upd_tot: #a:Type0 -> #rel:preorder a -> h:heap -> r:mref a rel{h `contains` r} -> x:a -> Tot heap
+
val upd: #a:Type0 -> #rel:preorder a -> h:heap -> r:mref a rel -> x:a -> GTot heap
+
val alloc: #a:Type0 -> rel:preorder a -> heap -> a -> mm:bool -> Tot (mref a rel * heap)
+
val free_mm: #a:Type0 -> #rel:preorder a -> h:heap -> r:mref a rel{h `contains` r /\ is_mm r} -> Tot heap
+
let modifies_t (s:tset nat) (h0:heap) (h1:heap) =
+  (forall (a:Type) (rel:preorder a) (r:mref a rel).{:pattern (sel h1 r)}
+                               ((~ (TS.mem (addr_of r) s)) /\ h0 `contains` r) ==> sel h1 r == sel h0 r) /\
+  (forall (a:Type) (rel:preorder a) (r:mref a rel).{:pattern (contains h1 r)}
+                               h0 `contains` r ==> h1 `contains` r) /\
+  (forall (a:Type) (rel:preorder a) (r:mref a rel).{:pattern (r `unused_in` h0)}
+                               r `unused_in` h1 ==> r `unused_in` h0) /\
+  (forall (n: nat) . {:pattern (n `addr_unused_in` h0) }
+    n `addr_unused_in` h1 ==> n `addr_unused_in` h0
+  )
+
let modifies (s:set nat) (h0:heap) (h1:heap) = modifies_t (TS.tset_of_set s) h0 h1
+
let equal_dom (h1:heap) (h2:heap) :GTot Type0 =
+  (forall (a:Type0) (rel:preorder a) (r:mref a rel).
+     {:pattern (h1 `contains` r) \/ (h2 `contains` r)}
+     h1 `contains` r <==> h2 `contains` r) /\
+  (forall (a:Type0) (rel:preorder a) (r:mref a rel).
+     {:pattern (r `unused_in` h1) \/ (r `unused_in` h2)}
+     r `unused_in` h1 <==> r `unused_in` h2)
+
val lemma_ref_unused_iff_addr_unused (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel)
+  :Lemma (requires True)
+         (ensures  (r `unused_in` h <==> addr_of r `addr_unused_in` h))
+     [SMTPatOr [[SMTPat (r `unused_in` h)]; [SMTPat (addr_of r `addr_unused_in` h)]]]
+
val lemma_contains_implies_used (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel)
+  :Lemma (requires (h `contains` r))
+         (ensures  (~ (r `unused_in` h)))
+     [SMTPatOr [[SMTPat (h `contains` r)]; [SMTPat (r `unused_in` h)]]]
+
val lemma_distinct_addrs_distinct_types
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (r2:mref b rel2)
+  :Lemma (requires (a =!= b /\ h `contains` r1 /\ h `contains` r2))
+         (ensures  (addr_of r1 <> addr_of r2))
+     [SMTPat (h `contains` r1); SMTPat (h `contains` r2)]
+
val lemma_distinct_addrs_distinct_preorders (u:unit)
+  :Lemma (forall (a:Type0) (rel1 rel2:preorder a) (r1:mref a rel1) (r2:mref a rel2) (h:heap).
+            {:pattern (h `contains` r1); (h `contains` r2)}
+        (h `contains` r1 /\ h `contains` r2 /\ rel1 =!= rel2) ==> addr_of r1 <> addr_of r2)
+
val lemma_distinct_addrs_distinct_mm (u:unit)
+  :Lemma (forall (a b:Type0) (rel1:preorder a) (rel2:preorder b) (r1:mref a rel1) (r2:mref b rel2) (h:heap).
+            {:pattern (h `contains` r1); (h `contains` r2)}
+        (h `contains` r1 /\ h `contains` r2 /\ is_mm r1 =!= is_mm r2) ==> addr_of r1 <> addr_of r2)
+ +
val lemma_distinct_addrs_unused
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (r2:mref b rel2)
+  :Lemma (requires (r1 `unused_in` h /\ ~ (r2 `unused_in` h)))
+         (ensures  (addr_of r1 <> addr_of r2 /\ (~ (r1 === r2))))
+         [SMTPat (r1 `unused_in` h); SMTPat (r2 `unused_in` h)]
+
val lemma_alloc (#a:Type0) (rel:preorder a) (h0:heap) (x:a) (mm:bool)
+  :Lemma (requires True)
+         (ensures  (let r, h1 = alloc rel h0 x mm in
+                    fresh r h0 h1 /\ h1 == upd h0 r x /\ is_mm r = mm /\ addr_of r == next_addr h0))
+     [SMTPat (alloc rel h0 x mm)]
+
val lemma_free_mm_sel
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h0:heap)
+  (r1:mref a rel1{h0 `contains` r1 /\ is_mm r1}) (r2:mref b rel2)
+  :Lemma (requires True)
+         (ensures  (addr_of r2 <> addr_of r1 ==> sel h0 r2 == sel (free_mm h0 r1) r2))
+     [SMTPat (sel (free_mm h0 r1) r2)]
+
val lemma_free_mm_contains
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h0:heap)
+  (r1:mref a rel1{h0 `contains` r1 /\ is_mm r1}) (r2:mref b rel2)
+  :Lemma (requires True)
+         (ensures  (let h1 = free_mm h0 r1 in
+                (addr_of r2 <> addr_of r1 /\ h0 `contains` r2) <==> h1 `contains` r2))
+     [SMTPat ((free_mm h0 r1) `contains` r2)]
+
val lemma_free_mm_unused
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h0:heap)
+  (r1:mref a rel1{h0 `contains` r1 /\ is_mm r1}) (r2:mref b rel2)
+  :Lemma (requires True)
+         (ensures  (let h1 = free_mm h0 r1 in
+                ((addr_of r1 = addr_of r2 ==> r2 `unused_in` h1)      /\
+             (r2 `unused_in` h0       ==> r2 `unused_in` h1)      /\
+             (r2 `unused_in` h1       ==> (r2 `unused_in` h0 \/ addr_of r2 = addr_of r1)))))
+     [SMTPat (r2 `unused_in` (free_mm h0 r1))]
+
val lemma_free_addr_unused_in
+  (#a: Type) (#rel: preorder a) (h: heap) (r: mref a rel { h `contains` r /\ is_mm r } )
+  (n: nat)
+: Lemma
+  (requires (n `addr_unused_in` (free_mm h r) /\ n <> addr_of r))
+  (ensures (n `addr_unused_in` h))
+  [SMTPat (n `addr_unused_in` (free_mm h r))]
+ +
val lemma_sel_same_addr (#a:Type0) (#rel:preorder a) (h:heap) (r1:mref a rel) (r2:mref a rel)
+  :Lemma (requires (h `contains` r1 /\ addr_of r1 = addr_of r2 /\ is_mm r1 == is_mm r2))
+         (ensures  (h `contains` r2 /\ sel h r1 == sel h r2))
+         [SMTPatOr [
+       [SMTPat (sel h r1); SMTPat (sel h r2)];
+           [SMTPat (h `contains` r1); SMTPat (h `contains` r2)];
+         ]]
+ +
val lemma_sel_upd1 (#a:Type0) (#rel:preorder a) (h:heap) (r1:mref a rel) (x:a) (r2:mref a rel)
+  :Lemma (requires (addr_of r1 = addr_of r2 /\ is_mm r1 == is_mm r2))
+         (ensures  (sel (upd h r1 x) r2 == x))
+         [SMTPat (sel (upd h r1 x) r2)]
+
val lemma_sel_upd2 (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (r2:mref b rel2) (x:b)
+  :Lemma (requires (addr_of r1 <> addr_of r2))
+         (ensures  (sel (upd h r2 x) r1 == sel h r1))
+     [SMTPat (sel (upd h r2 x) r1)]
+
val lemma_mref_injectivity
+  :(u:unit{forall (a:Type0) (b:Type0) (rel1:preorder a) (rel2:preorder b) (r1:mref a rel1) (r2:mref b rel2). a =!= b ==> ~ (eq3 r1 r2)})
+
val lemma_mref_injectivity_preorder (_:unit)
+  : Lemma (forall (a:Type0) (rel1:preorder a) (rel2:preorder a) (r1:mref a rel1) (r2:mref a rel2). rel1 =!= rel2 ==> ~ (eq3 r1 r2))
+
val lemma_in_dom_emp (#a:Type0) (#rel:preorder a) (r:mref a rel)
+  :Lemma (requires True)
+         (ensures  (r `unused_in` emp))
+     [SMTPat (r `unused_in` emp)]
+
val lemma_upd_contains (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel) (x:a)
+  :Lemma (requires True)
+         (ensures  ((upd h r x) `contains` r))
+     [SMTPat ((upd h r x) `contains` r)]
+
val lemma_well_typed_upd_contains
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (x:a) (r2:mref b rel2)
+  :Lemma (requires (h `contains` r1))
+         (ensures  (let h1 = upd h r1 x in
+                h1 `contains` r2 <==> h `contains` r2))
+     [SMTPat ((upd h r1 x) `contains` r2)]
+
val lemma_unused_upd_contains
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (x:a) (r2:mref b rel2)
+  :Lemma (requires (r1 `unused_in` h))
+         (ensures  (let h1 = upd h r1 x in
+                (h `contains` r2  ==> h1 `contains` r2) /\
+            (h1 `contains` r2 ==> (h `contains` r2 \/ addr_of r2 = addr_of r1))))
+     [SMTPat ((upd h r1 x) `contains` r2)]
+
val lemma_upd_contains_different_addr
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (x:a) (r2:mref b rel2)
+  :Lemma (requires (h `contains` r2 /\ addr_of r1 <> addr_of r2))
+         (ensures  ((upd h r1 x) `contains` r2))
+     [SMTPat ((upd h r1 x) `contains` r2)]
+
val lemma_upd_unused
+  (#a:Type0) (#b:Type0) (#rel1:preorder a) (#rel2:preorder b) (h:heap) (r1:mref a rel1) (x:a) (r2:mref b rel2)
+  :Lemma (requires True)
+         (ensures  ((addr_of r1 <> addr_of r2 /\ r2 `unused_in` h) <==> r2 `unused_in` (upd h r1 x)))
+     [SMTPat (r2 `unused_in` (upd h r1 x))]
+
val lemma_contains_upd_modifies (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel) (x:a)
+  :Lemma (requires (h `contains` r))
+         (ensures  (modifies (S.singleton (addr_of r)) h (upd h r x)))
+         [SMTPat (upd h r x)]
+
val lemma_unused_upd_modifies (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel) (x:a)
+  :Lemma (requires (r `unused_in` h))
+         (ensures  (modifies (Set.singleton (addr_of r)) h (upd h r x)))
+         [SMTPat (upd h r x); SMTPat (r `unused_in` h)]
+
val lemma_sel_equals_sel_tot_for_contained_refs
+  (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel{h `contains` r})
+  :Lemma (requires True)
+         (ensures  (sel_tot h r == sel h r))
+
val lemma_upd_equals_upd_tot_for_contained_refs
+  (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel{h `contains` r}) (x:a)
+  :Lemma (requires True)
+         (ensures  (upd_tot h r x == upd h r x))
+
val lemma_modifies_and_equal_dom_sel_diff_addr
+  (#a:Type0)(#rel:preorder a) (s:set nat) (h0:heap) (h1:heap) (r:mref a rel)
+  :Lemma (requires (modifies s h0 h1 /\ equal_dom h0 h1 /\ (~ (S.mem (addr_of r) s))))
+         (ensures  (sel h0 r == sel h1 r))
+     [SMTPat (modifies s h0 h1); SMTPat (equal_dom h0 h1); SMTPat (sel h1 r)]
+
val lemma_heap_equality_upd_same_addr (#a: Type0) (#rel: preorder a) (h: heap) (r1 r2: mref a rel) (x: a)
+  :Lemma (requires ((h `contains` r1 \/ h `contains` r2) /\ addr_of r1 = addr_of r2 /\ is_mm r1 == is_mm r2))
+         (ensures (upd h r1 x == upd h r2 x))
+
val lemma_heap_equality_cancel_same_mref_upd
+  (#a:Type) (#rel:preorder a) (h:heap) (r:mref a rel)
+  (x:a) (y:a)
+  :Lemma (requires True)
+         (ensures  (upd (upd h r x) r y == upd h r y))
+
val lemma_heap_equality_upd_with_sel
+  (#a:Type) (#rel:preorder a) (h:heap) (r:mref a rel)
+  :Lemma (requires (h `contains` r))
+         (ensures  (upd h r (sel h r) == h))
+
val lemma_heap_equality_commute_distinct_upds
+  (#a:Type) (#b:Type) (#rel_a:preorder a) (#rel_b:preorder b) (h:heap) (r1:mref a rel_a) (r2:mref b rel_b)
+  (x:a) (y:b)
+  :Lemma (requires (addr_of r1 =!= addr_of r2))
+         (ensures  (upd (upd h r1 x) r2 y == upd (upd h r2 y) r1 x))
+
val lemma_next_addr_upd_tot
+  (#a:Type0) (#rel:preorder a) (h0:heap) (r:mref a rel{h0 `contains` r}) (x:a)
+  :Lemma (let h1 = upd_tot h0 r x in next_addr h1 == next_addr h0)
+
val lemma_next_addr_upd
+  (#a:Type0) (#rel:preorder a) (h0:heap) (r:mref a rel) (x:a)
+  :Lemma (let h1 = upd h0 r x in next_addr h1 >= next_addr h0)
+
val lemma_next_addr_alloc
+  (#a:Type0) (rel:preorder a) (h0:heap) (x:a) (mm:bool)
+  :Lemma (let _, h1 = alloc rel h0 x mm in next_addr h1 > next_addr h0)
+
val lemma_next_addr_free_mm
+  (#a:Type0) (#rel:preorder a) (h0:heap) (r:mref a rel{h0 `contains` r /\ is_mm r})
+  :Lemma (let h1 = free_mm h0 r in next_addr h1 == next_addr h0)
+
val lemma_next_addr_contained_refs_addr
+  (#a:Type0) (#rel:preorder a) (h:heap) (r:mref a rel)
+  :Lemma (h `contains` r ==> addr_of r < next_addr h)
+

+Untyped views of monotonic references

+

Definition and ghost decidable equality

+
val aref: Type0
+val dummy_aref: aref
+val aref_equal (a1 a2: aref) : Ghost bool (requires True) (ensures (fun b -> b == true <==> a1 == a2))
+

Introduction rule

+
val aref_of: #t: Type0 -> #rel: preorder t -> r: mref t rel -> Tot aref
+

Operators lifted from ref

+
val addr_of_aref: a: aref -> GTot (n: nat { n > 0 } )
+val addr_of_aref_of: #t: Type0 -> #rel: preorder t -> r: mref t rel -> Lemma (addr_of r == addr_of_aref (aref_of r))
+[SMTPat (addr_of_aref (aref_of r))]
+val aref_is_mm: aref -> GTot bool
+val is_mm_aref_of: #t: Type0 -> #rel: preorder t -> r: mref t rel -> Lemma (is_mm r == aref_is_mm (aref_of r))
+[SMTPat (aref_is_mm (aref_of r))]
+val aref_unused_in: aref -> heap -> Type0
+val unused_in_aref_of: #t: Type0 -> #rel: preorder t -> r: mref t rel -> h: heap -> Lemma (unused_in r h <==> aref_unused_in (aref_of r) h)
+[SMTPat (aref_unused_in (aref_of r) h)]
+val contains_aref_unused_in: #a:Type -> #rel: preorder a -> h:heap -> x:mref a rel -> y:aref -> Lemma
+  (requires (contains h x /\ aref_unused_in y h))
+  (ensures  (addr_of x <> addr_of_aref y))
+

Elimination rule

+
val aref_live_at: h: heap -> a: aref -> t: Type0 -> rel: preorder t -> GTot Type0
+val gref_of: a: aref -> t: Type0 -> rel: preorder t -> Ghost (mref t rel) (requires (exists h . aref_live_at h a t rel)) (ensures (fun _ -> True))
+val ref_of: h: heap -> a: aref -> t: Type0 -> rel: preorder t -> Pure (mref t rel) (requires (aref_live_at h a t rel)) (ensures (fun x -> aref_live_at h a t rel /\ addr_of (gref_of a t rel) == addr_of x /\ is_mm x == aref_is_mm a))
+val aref_live_at_aref_of
+  (h: heap)
+  (#t: Type0)
+  (#rel: preorder t)
+  (r: mref t rel)
+: Lemma
+  (ensures (aref_live_at h (aref_of r) t rel <==> contains h r))
+  [SMTPat (aref_live_at h (aref_of r) t rel)]
+val contains_gref_of
+  (h: heap)
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+: Lemma
+  (requires (exists h' . aref_live_at h' a t rel))
+  (ensures ((exists h' . aref_live_at h' a t rel) /\ (contains h (gref_of a t rel) <==> aref_live_at h a t rel)))
+  [SMTPatOr [
+    [SMTPat (contains h (gref_of a t rel))];
+    [SMTPat (aref_live_at h a t rel)];
+  ]]
+
val aref_of_gref_of
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+: Lemma
+  (requires (exists h . aref_live_at h a t rel))
+  (ensures ((exists h . aref_live_at h a t rel) /\ aref_of (gref_of a t rel) == a))
+  [SMTPat (aref_of (gref_of a t rel))]
+

Operators lowered to ref

+
val addr_of_gref_of
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+: Lemma
+  (requires (exists h . aref_live_at h a t rel))
+  (ensures ((exists h . aref_live_at h a t rel) /\ addr_of (gref_of a t rel) == addr_of_aref a))
+  [SMTPat (addr_of (gref_of a t rel))]
+
val is_mm_gref_of
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+: Lemma
+  (requires (exists h . aref_live_at h a t rel))
+  (ensures ((exists h . aref_live_at h a t rel) /\ is_mm (gref_of a t rel) == aref_is_mm a))
+  [SMTPat (is_mm (gref_of a t rel))]
+
val unused_in_gref_of
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+  (h: heap)
+: Lemma
+  (requires (exists h . aref_live_at h a t rel))
+  (ensures ((exists h . aref_live_at h a t rel) /\ (unused_in (gref_of a t rel) h <==> aref_unused_in a h)))
+  [SMTPat (unused_in (gref_of a t rel) h)]
+
val sel_ref_of
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+  (h1 h2: heap)
+: Lemma
+  (requires (aref_live_at h1 a t rel /\ aref_live_at h2 a t rel))
+  (ensures (aref_live_at h2 a t rel /\ sel h1 (ref_of h2 a t rel) == sel h1 (gref_of a t rel)))
+  [SMTPat (sel h1 (ref_of h2 a t rel))]
+
val upd_ref_of
+  (a: aref)
+  (t: Type0)
+  (rel: preorder t)
+  (h1 h2: heap)
+  (x: t)
+: Lemma
+  (requires (aref_live_at h1 a t rel /\ aref_live_at h2 a t rel))
+  (ensures (aref_live_at h2 a t rel /\ upd h1 (ref_of h2 a t rel) x == upd h1 (gref_of a t rel) x))
+  [SMTPat (upd h1 (ref_of h2 a t rel) x)]
+ diff --git a/docs/FStar.Monotonic.HyperHeap.html b/docs/FStar.Monotonic.HyperHeap.html index dba9a44..91e430e 100644 --- a/docs/FStar.Monotonic.HyperHeap.html +++ b/docs/FStar.Monotonic.HyperHeap.html @@ -1,16 +1,152 @@ - - + + - - - - - + FStar.Monotonic.HyperHeap + -

module FStar.Monotonic.HyperHeap

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Monotonic.HyperHeap

+ +
[@@must_erase_for_extraction]
+val rid :eqtype
+
val reveal (r:rid) :GTot (list (int * int))
+
val color (x:rid) :GTot int
+
val rid_freeable (x:rid) : GTot bool
+
type hmap = Map.t rid heap
+
val root : r:rid{color r == 0 /\ not (rid_freeable r)}
+
let root_has_color_zero (u:unit) :Lemma (color root == 0) = ()
+
val root_is_not_freeable (_:unit) : Lemma (not (rid_freeable root))
+
private val rid_length (r:rid) :GTot nat
+
private val rid_tail (r:rid{rid_length r > 0}) :rid
+
val includes (r1:rid) (r2:rid) :GTot bool (decreases (reveal r2))
+
let disjoint (i:rid) (j:rid) :GTot bool = not (includes i j) && not (includes j i)
+
val lemma_disjoint_includes (i:rid) (j:rid) (k:rid)
+  :Lemma (requires  (disjoint i j /\ includes j k))
+         (ensures   (disjoint i k))
+         (decreases (List.Tot.length (reveal k)))
+         [SMTPat (disjoint i j); SMTPat (includes j k)]
+
val extends (i:rid) (j:rid) :GTot bool
+
val parent (r:rid{r =!= root}) :rid
+
val lemma_includes_refl (i:rid)
+  :Lemma (includes i i)
+         [SMTPat (includes i i)]
+
val lemma_extends_includes (i:rid) (j:rid)
+  :Lemma (requires (extends j i))
+         (ensures  (includes i j /\ not(includes j i)))
+         [SMTPat (extends j i)]
+
val lemma_includes_anti_symmetric (i:rid) (j:rid)
+  :Lemma (requires (includes i j /\ i =!= j))
+         (ensures  (not (includes j i)))
+         [SMTPat (includes i j)]
+
val lemma_extends_disjoint (i:rid) (j:rid) (k:rid)
+  :Lemma (requires (extends j i /\ extends k i /\ j =!= k))
+         (ensures  (disjoint j k))
+
val lemma_extends_parent (i:rid{i =!= root})
+  :Lemma (extends i (parent i))
+         [SMTPat (parent i)]
+
val lemma_extends_not_root (i:rid) (j:rid{extends j i})
+  :Lemma (j =!= root)
+         [SMTPat (extends j i)]
+
val lemma_extends_only_parent (i:rid) (j:rid{extends j i})
+  :Lemma (i == parent j)
+         [SMTPat (extends j i)]
+
val mod_set (s:Set.set rid) :(Set.set rid)
+assume Mod_set_def: forall (x:rid) (s:Set.set rid). {:pattern Set.mem x (mod_set s)}
+                    Set.mem x (mod_set s) <==> (exists (y:rid). Set.mem y s /\ includes y x)
+
let modifies (s:Set.set rid) (m0:hmap) (m1:hmap) =
+  Map.equal m1 (Map.concat m1 (Map.restrict (Set.complement (mod_set s)) m0)) /\
+  Set.subset (Map.domain m0) (Map.domain m1)
+
let modifies_just (s:Set.set rid) (m0:hmap) (m1:hmap) =
+  Map.equal m1 (Map.concat m1 (Map.restrict (Set.complement s) m0)) /\
+  Set.subset (Map.domain m0) (Map.domain m1)
+
let modifies_one (r:rid) (m0:hmap) (m1:hmap) = modifies_just (Set.singleton r) m0 m1
+
let equal_on (s:Set.set rid) (m0:hmap) (m1:hmap) =
+ (forall (r:rid). {:pattern (Map.contains m0 r)} (Set.mem r (mod_set s) /\ Map.contains m0 r) ==> Map.contains m1 r) /\
+ Map.equal m1 (Map.concat m1 (Map.restrict (mod_set s) m0))
+
let lemma_modifies_just_trans (m1:hmap) (m2:hmap) (m3:hmap)
+  (s1:Set.set rid) (s2:Set.set rid)
+  :Lemma (requires (modifies_just s1 m1 m2 /\ modifies_just s2 m2 m3))
+         (ensures  (modifies_just (Set.union s1 s2) m1 m3))
+  = ()
+
let lemma_modifies_trans (m1:hmap) (m2:hmap) (m3:hmap)
+  (s1:Set.set rid) (s2:Set.set rid)
+  :Lemma (requires (modifies s1 m1 m2 /\ modifies s2 m2 m3))
+         (ensures  (modifies (Set.union s1 s2) m1 m3))
+  = ()
+
val lemma_includes_trans (i:rid) (j:rid) (k:rid)
+  :Lemma (requires  (includes i j /\ includes j k))
+         (ensures   (includes i k))
+         (decreases (reveal k))
+         [SMTPat (includes i j); SMTPat (includes j k)]
+
val lemma_modset (i:rid) (j:rid)
+  :Lemma (requires (includes j i))
+         (ensures  (Set.subset (mod_set (Set.singleton i)) (mod_set (Set.singleton j))))
+
val lemma_modifies_includes (m1:hmap) (m2:hmap) (i:rid) (j:rid)
+  :Lemma (requires (modifies (Set.singleton i) m1 m2 /\ includes j i))
+         (ensures  (modifies (Set.singleton j) m1 m2))
+
val lemma_modifies_includes2 (m1:hmap) (m2:hmap) (s1:Set.set rid) (s2:Set.set rid)
+  :Lemma (requires (modifies s1 m1 m2 /\ (forall x.  Set.mem x s1 ==> (exists y. Set.mem y s2 /\ includes y x))))
+         (ensures  (modifies s2 m1 m2))
+
val lemma_disjoint_parents (pr:rid) (r:rid) (ps:rid) (s:rid)
+  :Lemma (requires (r `extends` pr /\ s `extends` ps /\ disjoint pr ps))
+         (ensures  (disjoint r s))
+         [SMTPat (extends r pr); SMTPat (extends s ps); SMTPat (disjoint pr ps)]
+
val lemma_include_cons (i:rid) (j:rid)
+  :Lemma (requires (i =!= j /\ includes i j))
+         (ensures  (j =!= root))
+
let disjoint_regions (s1:Set.set rid) (s2:Set.set rid) =
+     forall x y. {:pattern (Set.mem x s1); (Set.mem y s2)} (Set.mem x s1 /\ Set.mem y s2) ==> disjoint x y
+
val extends_parent (tip:rid{tip =!= root}) (r:rid)
+  :Lemma (extends r (parent tip) /\ r =!= tip ==> disjoint r tip \/ extends r tip)
+         [SMTPat (extends r (parent tip))]
+
val includes_child (tip:rid{tip =!= root}) (r:rid)
+  :Lemma (includes r tip ==> r == tip \/ includes r (parent tip))
+         [SMTPat (includes r (parent tip))]
+
val root_is_root (s:rid)
+  :Lemma (requires (includes s root))
+         (ensures  (s == root))
+         [SMTPat (includes s root)]
+
unfold
+let extend_post (r:rid) (n:int) (c:int) (freeable:bool) : pure_post rid =
+  fun s ->
+  s `extends` r /\
+  Cons? (reveal s) /\
+  Cons?.hd (reveal s) == (c, n) /\
+  color s == c /\
+  rid_freeable s == freeable
+
val extend (r:rid) (n:int) (c:int)
+: Pure rid (requires True) (extend_post r n c (rid_freeable r))
+
val extend_monochrome_freeable (r:rid) (n:int) (freeable:bool)
+: Pure rid (requires True) (extend_post r n (color r) freeable)
+
val extend_monochrome (r:rid) (n:int)
+: Pure rid (requires True) (extend_post r n (color r) (rid_freeable r))
+ diff --git a/docs/FStar.Monotonic.HyperStack.html b/docs/FStar.Monotonic.HyperStack.html index 52eedb6..04a36a2 100644 --- a/docs/FStar.Monotonic.HyperStack.html +++ b/docs/FStar.Monotonic.HyperStack.html @@ -1,65 +1,514 @@ - - + + - - - - - - + FStar.Monotonic.HyperStack + -

module FStar.Monotonic.HyperStack

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
**** Some predicates *****
-
**** Mem definition *****
-
**** Lemmas about mem and predicates *****
-
***** map_invariant related lemmas *****
-
**** downward_closed related lemmas ******
-
**** tip_top related lemmas *****
-
**** rid_ctr_pred related lemmas *****
-
**** Operations on mem *****
-
**** The following two lemmas are only used in FStar.Pointer.Base, and invoked explicitly *****
-
**** API for generating modifies clauses in the old style, should use new modifies clauses now *****
-
**** Lemmas about equality of mem *****
-
* Untyped views of references
+

+FStar.Monotonic.HyperStack

+ +

***** Some predicates *****

+
unfold let is_in (r:rid) (h:hmap) = h `Map.contains` r
+
let is_stack_region r = color r > 0
+let is_heap_color c = c <= 0
+
[@@(deprecated "FStar.HyperStack.ST.is_eternal_region")]
+let is_eternal_region r  = is_heap_color (color r) && not (rid_freeable r)
+
unfold let is_eternal_region_hs r = is_heap_color (color r) && not (rid_freeable r)
+
type sid = r:rid{is_stack_region r} //stack region ids
+ +
unfold let is_above r1 r2          = r1 `includes` r2
+unfold let is_just_below r1 r2     = r1 `extends`  r2
+unfold let is_below r1 r2          = r2 `is_above` r1
+let is_strictly_below r1 r2 = r1 `is_below` r2 && r1 <> r2
+let is_strictly_above r1 r2 = r1 `is_above` r2 && r1 <> r2
+
[@@"opaque_to_smt"]
+unfold private let map_invariant_predicate (m:hmap) :Type0 =
+  forall r. Map.contains m r ==>
+      (forall s. includes s r ==> Map.contains m s)
+
[@@"opaque_to_smt"]
+unfold private let downward_closed_predicate (h:hmap) :Type0 =
+  forall (r:rid). r `is_in` h  //for any region in the memory
+        ==> (r=root    //either is the root
+            \/ (forall (s:rid). (r `is_above` s  //or, any region beneath it
+                           /\ s `is_in` h)   //that is also in the memory
+                     ==> ((is_stack_region r = is_stack_region s) /\  //must be of the same flavor as itself
+                          ((is_heap_color (color r) /\ rid_freeable r) ==> s == r)))) //and if r is a freeable heap region, s can only be r (no regions strictly below r)
+
[@@"opaque_to_smt"]
+unfold private let tip_top_predicate (tip:rid) (h:hmap) :Type0 =
+  forall (r:sid). r `is_in` h <==> r `is_above` tip
+
let rid_last_component (r:rid) :GTot int
+  = let open FStar.List.Tot in
+    let r = reveal r in
+    if length r = 0 then 0
+    else snd (hd r)
+
[@@"opaque_to_smt"]
+unfold private let rid_ctr_pred_predicate (h:hmap) (n:int) :Type0 =
+  forall (r:rid). h `Map.contains` r ==> rid_last_component r < n
+

***** Mem definition *****

+
[@@ remove_unused_type_parameters [0]]
+val map_invariant (m:hmap) :Type0  //all regions above a contained region are contained
+[@@ remove_unused_type_parameters [0]]
+val downward_closed (h:hmap) :Type0  //regions below a non-root region are of the same color
+[@@ remove_unused_type_parameters [0;1]]
+val tip_top (tip:rid) (h:hmap) :Type0  //all contained stack regions are above tip
+[@@ remove_unused_type_parameters [0;1]]
+val rid_ctr_pred (h:hmap) (n:int) :Type0  //all live regions have last component less than the rid_ctr
+
let is_tip (tip:rid) (h:hmap) =
+  (is_stack_region tip \/ tip = root) /\  //the tip is a stack region, or the root
+  tip `is_in` h                      /\   //the tip is live
+  tip_top tip h                          //any other sid activation is a above (or equal to) the tip
+
let is_wf_with_ctr_and_tip (h:hmap) (ctr:int) (tip:rid)
+  = (not (rid_freeable root)) /\
+    root `is_in` h /\
+    tip `is_tip` h /\
+    map_invariant h /\
+    downward_closed h /\
+    rid_ctr_pred h ctr
+
private val mem' :Type u#1
+
private val mk_mem (rid_ctr:int) (h:hmap) (tip:rid) :mem'
+
val get_hmap (m:mem') :hmap
+val get_rid_ctr (m:mem') :int
+val get_tip (m:mem') :rid
+
private val lemma_mk_mem'_projectors (rid_ctr:int) (h:hmap) (tip:rid)
+  :Lemma (requires True)
+         (ensures  (let m = mk_mem rid_ctr h tip in
+                (get_hmap m == h /\ get_rid_ctr m == rid_ctr /\ get_tip m == tip)))
+         [SMTPatOr [[SMTPat (get_hmap (mk_mem rid_ctr h tip))];
+                [SMTPat (get_rid_ctr (mk_mem rid_ctr h tip))];
+            [SMTPat (get_tip (mk_mem rid_ctr h tip))]
+            ]]
+
type mem :Type = m:mem'{is_wf_with_ctr_and_tip (get_hmap m) (get_rid_ctr m) (get_tip m) }
+

***** Lemmas about mem and predicates *****

+
private val lemma_mem_projectors_are_in_wf_relation (m:mem)
+  :Lemma (is_wf_with_ctr_and_tip (get_hmap m) (get_rid_ctr m) (get_tip m))
+
private val lemma_is_wf_ctr_and_tip_intro (h:hmap) (ctr:int) (tip:rid)
+  :Lemma (requires (root `is_in` h /\ (is_stack_region tip \/ tip = root) /\  tip `is_in` h /\
+                    tip_top_predicate tip h /\ map_invariant_predicate h /\
+                    downward_closed_predicate h /\ rid_ctr_pred_predicate h ctr))
+     (ensures  (is_wf_with_ctr_and_tip h ctr tip))
+
private val lemma_is_wf_ctr_and_tip_elim (m:mem)
+  :Lemma (let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+          (root `is_in` h /\ (is_stack_region tip \/ tip = root) /\  tip `is_in` h /\
+       tip_top_predicate tip h /\ map_invariant_predicate h /\
+           downward_closed_predicate h /\ rid_ctr_pred_predicate h rid_ctr))
+

****** map_invariant related lemmas *****

+
val lemma_map_invariant (m:mem) (r s:rid)
+  :Lemma (requires (r `is_in` get_hmap m /\ s `is_above` r))
+         (ensures  (s `is_in` get_hmap m))
+         [SMTPat (r `is_in` get_hmap m); SMTPat (s `is_above` r); SMTPat (s `is_in` get_hmap m)]
+

***** downward_closed related lemmas ******

+
val lemma_downward_closed (m:mem) (r:rid) (s:rid{s =!= root})
+  :Lemma (requires (r `is_in` get_hmap m /\ s `is_above` r))
+         (ensures  (is_heap_color (color r) == is_heap_color (color s) /\
+                is_stack_region r == is_stack_region s))
+         [SMTPatOr [[SMTPat (get_hmap m `Map.contains` r); SMTPat (s `is_above` r); SMTPat (is_heap_color (color s))];
+                    [SMTPat (get_hmap m `Map.contains` r); SMTPat (s `is_above` r); SMTPat (is_stack_region s)]
+                    ]]
+

***** tip_top related lemmas *****

+
val lemma_tip_top (m:mem) (r:sid)
+  :Lemma (r `is_in` get_hmap m <==> r `is_above` get_tip m)
+ +
val lemma_tip_top_smt (m:mem) (r:rid)
+  :Lemma (requires (is_stack_region r))
+         (ensures  (r `is_in` get_hmap m <==> r `is_above` get_tip m))
+         [SMTPatOr [[SMTPat (is_stack_region r); SMTPat (r `is_above` get_tip m)];
+                    [SMTPat (is_stack_region r); SMTPat (r `is_in` get_hmap m)]]]
+

***** rid_ctr_pred related lemmas *****

+
val lemma_rid_ctr_pred (_:unit)
+  :Lemma (forall (m:mem) (r:rid).{:pattern (get_hmap m `Map.contains` r)} get_hmap m `Map.contains` r ==> rid_last_component r < get_rid_ctr m)
+
+

***** Operations on mem *****

+
let empty_mem : mem =
+  let empty_map = Map.restrict Set.empty (Map.const Heap.emp) in
+  let h = Map.upd empty_map root Heap.emp in
+  let tip = root in
+  assume (rid_last_component root == 0);
+  lemma_is_wf_ctr_and_tip_intro h 1 tip;
+  mk_mem 1 h tip
+
let heap_region_does_not_overlap_with_tip
+  (m:mem) (r:rid{is_heap_color (color r) /\ not (disjoint r (get_tip m)) /\ r =!= root /\ is_stack_region (get_tip m)})
+  : Lemma (requires True)
+          (ensures (~ (r `is_in` get_hmap m)))
+  = root_has_color_zero()
+
let poppable (m:mem) = get_tip m =!= root
+
private let remove_elt (#a:eqtype) (s:Set.set a) (x:a) = Set.intersect s (Set.complement (Set.singleton x))
+
let popped (m0 m1:mem) =
+  poppable m0 /\
+  (let h0, tip0, h1, tip1 = get_hmap m0, get_tip m0, get_hmap m1, get_tip m1 in
+   (parent tip0 = tip1 /\
+    Set.equal (Map.domain h1) (remove_elt (Map.domain h0) tip0) /\
+    Map.equal h1 (Map.restrict (Map.domain h1) h0)))
+
let pop (m0:mem{poppable m0}) :mem =
+  let h0, tip0, rid_ctr0 = get_hmap m0, get_tip m0, get_rid_ctr m0 in
+  root_has_color_zero();
+  lemma_is_wf_ctr_and_tip_elim m0;
+  let dom = remove_elt (Map.domain h0) tip0 in
+  let h1 = Map.restrict dom h0 in
+  let tip1 = parent tip0 in
+  lemma_is_wf_ctr_and_tip_intro h1 rid_ctr0 tip1;
+  mk_mem rid_ctr0 h1 tip1
+

A (reference a) may reside in the stack or heap, and may be manually managed +Mark it private so that clients can't use its projectors etc. +enabling extraction of mreference to just a reference in ML and pointer in C +note that this not enforcing any abstraction

+ +
private noeq
+type mreference' (a:Type) (rel:preorder a) =
+  | MkRef : frame:rid -> ref:Heap.mref a rel -> mreference' a rel
+
let mreference a rel = mreference' a rel
+

TODO: rename to frame_of, avoiding the inconsistent use of camelCase

+
let frameOf (#a:Type) (#rel:preorder a) (r:mreference a rel) :rid
+  = r.frame
+
let mk_mreference (#a:Type) (#rel:preorder a) (id:rid)
+                  (r:Heap.mref a rel)
+  :mreference a rel
+  = MkRef id r
+

Hopefully we can get rid of this one

+
val as_ref (#a:Type0) (#rel:preorder a) (x:mreference a rel)
+  :Heap.mref a rel
+

And make this one abstract

+
let as_addr #a #rel (x:mreference a rel)
+  :GTot pos
+  = Heap.addr_of (as_ref x)
+
val lemma_as_ref_inj (#a:Type) (#rel:preorder a) (r:mreference a rel)
+  :Lemma (requires True) (ensures (mk_mreference (frameOf r) (as_ref r) == r))
+         [SMTPat (as_ref r)]
+
let is_mm (#a:Type) (#rel:preorder a) (r:mreference a rel) :GTot bool =
+  Heap.is_mm (as_ref r)
+

Warning: all of the type aliases below get special support for KreMLin +extraction. If you rename or add to this list, +src/extraction/FStar.Extraction.Kremlin.fs needs to be updated.

+

adding (not s.mm) to stackref and ref so as to keep their semantics as is

+
let mstackref (a:Type) (rel:preorder a) =
+  s:mreference a rel{ is_stack_region (frameOf s)  && not (is_mm s) }
+
let mref (a:Type) (rel:preorder a) =
+  s:mreference a rel{ is_eternal_region_hs (frameOf s) && not (is_mm s) }
+
let mmmstackref (a:Type) (rel:preorder a) =
+  s:mreference a rel{ is_stack_region (frameOf s) && is_mm s }
+
let mmmref (a:Type) (rel:preorder a) =
+  s:mreference a rel{ is_eternal_region_hs (frameOf s) && is_mm s }
+

NS: Why do we need this one?

+
let s_mref (i:rid) (a:Type) (rel:preorder a) = s:mreference a rel{frameOf s = i}
+ +
let live_region (m:mem) (i:rid) :bool = get_hmap m `Map.contains` i
+
let contains (#a:Type) (#rel:preorder a) (m:mem) (s:mreference a rel) :GTot bool =
+  let i = frameOf s in
+  live_region m i && (FStar.StrongExcludedMiddle.strong_excluded_middle (Heap.contains (get_hmap m `Map.sel` i) (as_ref s)))
+
let unused_in (#a:Type) (#rel:preorder a) (r:mreference a rel) (m:mem) :GTot bool =
+  let h = get_hmap m in
+  let i = frameOf r in
+  not (h `Map.contains` i) ||
+  FStar.StrongExcludedMiddle.strong_excluded_middle (Heap.unused_in (as_ref r) (h `Map.sel` i))
+
let contains_ref_in_its_region (#a:Type) (#rel:preorder a) (m:mem) (r:mreference a rel) :GTot bool =
+  let i = frameOf r in
+  FStar.StrongExcludedMiddle.strong_excluded_middle (Heap.contains (get_hmap m `Map.sel` i) (as_ref r))
+
let fresh_ref (#a:Type) (#rel:preorder a) (r:mreference a rel) (m0:mem) (m1:mem) :Type0 =
+  let i = frameOf r in
+  Heap.fresh (as_ref r) (get_hmap m0 `Map.sel` i) (get_hmap m1 `Map.sel` i)
+
let fresh_region (i:rid) (m0 m1:mem) =
+  not (get_hmap m0 `Map.contains` i) /\ get_hmap m1 `Map.contains` i
+
let sel (#a:Type) (#rel:preorder a) (m:mem) (s:mreference a rel) :GTot a
+  = Heap.sel (get_hmap m `Map.sel` (frameOf s)) (as_ref s)
+
let upd (#a:Type) (#rel:preorder a) (m:mem) (s:mreference a rel{live_region m (frameOf s)}) (v:a)
+  :GTot mem
+  = let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+    lemma_is_wf_ctr_and_tip_elim m;
+    let i = frameOf s in
+    let h = Map.upd h i (Heap.upd (Map.sel h i) (as_ref s) v) in
+    lemma_is_wf_ctr_and_tip_intro h rid_ctr tip;
+    mk_mem rid_ctr h tip
+
let alloc (#a:Type0) (rel:preorder a) (id:rid) (init:a) (mm:bool) (m:mem{get_hmap m `Map.contains` id})
+  :Tot (p:(mreference a rel * mem){let (r, h) = Heap.alloc rel (get_hmap m `Map.sel` id) init mm in
+                                   as_ref (fst p) == r /\
+                                   get_hmap (snd p) == Map.upd (get_hmap m) id h})
+  = let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+    lemma_is_wf_ctr_and_tip_elim m;
+    let r, id_h = Heap.alloc rel (Map.sel h id) init mm in
+    let h = Map.upd h id id_h in
+    lemma_is_wf_ctr_and_tip_intro h rid_ctr tip;
+    (mk_mreference id r), mk_mem rid_ctr h tip
+
let free (#a:Type0) (#rel:preorder a) (r:mreference a rel{is_mm r}) (m:mem{m `contains` r})
+  :Tot mem
+  = let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+    lemma_is_wf_ctr_and_tip_elim m;
+    let i = frameOf r in
+    let i_h = h `Map.sel` i in
+    let i_h = Heap.free_mm i_h (as_ref r) in
+    let h = Map.upd h i i_h in
+    lemma_is_wf_ctr_and_tip_intro h rid_ctr tip;
+    mk_mem rid_ctr h tip
+
let upd_tot (#a:Type) (#rel:preorder a) (m:mem) (r:mreference a rel{m `contains` r}) (v:a)
+  :Tot mem
+  = let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+    lemma_is_wf_ctr_and_tip_elim m;
+    let i = frameOf r in
+    let i_h = h `Map.sel` i in
+    let i_h = Heap.upd_tot i_h (as_ref r) v in
+    let h = Map.upd h i i_h in
+    lemma_is_wf_ctr_and_tip_intro h rid_ctr tip;
+    mk_mem rid_ctr h tip
+
let sel_tot (#a:Type) (#rel:preorder a) (m:mem) (r:mreference a rel{m `contains` r})
+  :Tot a
+  = Heap.sel_tot (get_hmap m `Map.sel` (frameOf r)) (as_ref r)
+
let fresh_frame (m0:mem) (m1:mem) =
+  not (get_hmap m0 `Map.contains` get_tip m1) /\
+  parent (get_tip m1) == get_tip m0  /\
+  get_hmap m1 == Map.upd (get_hmap m0) (get_tip m1) Heap.emp
+
let hs_push_frame (m:mem) :Tot (m':mem{fresh_frame m m'})
+  = let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+    lemma_is_wf_ctr_and_tip_elim m;
+    let new_tip_rid = extend tip rid_ctr 1 in
+    let h = Map.upd h new_tip_rid Heap.emp in
+    assert (forall (s:rid). (new_tip_rid `is_above` s /\ s `is_in` h) ==> s = new_tip_rid);
+    lemma_is_wf_ctr_and_tip_intro h (rid_ctr + 1) new_tip_rid;
+    mk_mem (rid_ctr + 1) h new_tip_rid
+
let new_eternal_region (m:mem) (parent:rid{is_eternal_region_hs parent /\ get_hmap m `Map.contains` parent})
+                       (c:option int{None? c \/ is_heap_color (Some?.v c)})
+  :Tot (t:(rid * mem){fresh_region (fst t) m (snd t)})
+  = let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+    lemma_is_wf_ctr_and_tip_elim m;
+    let new_rid =
+      if None? c then extend_monochrome parent rid_ctr
+      else extend parent rid_ctr (Some?.v c)
+    in
+    let h = Map.upd h new_rid Heap.emp in
+    lemma_is_wf_ctr_and_tip_intro h (rid_ctr + 1) tip;
+    new_rid, mk_mem (rid_ctr + 1) h tip
+
let new_freeable_heap_region
+  (m:mem)
+  (parent:rid{is_eternal_region_hs parent /\ get_hmap m `Map.contains` parent})
+: t:(rid * mem){fresh_region (fst t) m (snd t) /\ rid_freeable (fst t)}
+= let h, rid_ctr, tip = get_hmap m, get_rid_ctr m, get_tip m in
+  lemma_is_wf_ctr_and_tip_elim m;
+  let new_rid = extend_monochrome_freeable parent rid_ctr true in
+  let h = Map.upd h new_rid Heap.emp in
+  lemma_is_wf_ctr_and_tip_intro h (rid_ctr + 1) tip;
+  new_rid, mk_mem (rid_ctr + 1) h tip
+
let free_heap_region
+  (m0:mem)
+  (r:rid{
+    is_heap_color (color r) /\
+    rid_freeable r /\
+    get_hmap m0 `Map.contains` r})
+: mem
+= let h0, rid_ctr0 = get_hmap m0, get_rid_ctr m0 in
+  lemma_is_wf_ctr_and_tip_elim m0;
+  let dom = remove_elt (Map.domain h0) r in
+  let h1 = Map.restrict dom h0 in
+  lemma_is_wf_ctr_and_tip_intro h1 rid_ctr0 (get_tip m0);
+  mk_mem (get_rid_ctr m0) h1 (get_tip m0)
+

***** The following two lemmas are only used in FStar.Pointer.Base, and invoked explicitly *****

+
val lemma_sel_same_addr (#a:Type0) (#rel:preorder a) (h:mem) (r1:mreference a rel) (r2:mreference a rel)
+  :Lemma (requires (frameOf r1 == frameOf r2 /\ h `contains` r1 /\ as_addr r1 = as_addr r2 /\ is_mm r1 == is_mm r2))
+         (ensures  (h `contains` r2 /\ sel h r1 == sel h r2))
+
val lemma_upd_same_addr (#a:Type0) (#rel:preorder a) (h:mem) (r1 r2:mreference a rel) (x: a)
+  :Lemma (requires (frameOf r1 == frameOf r2 /\ (h `contains` r1 \/ h `contains` r2) /\
+                    as_addr r1 == as_addr r2 /\ is_mm r1 == is_mm r2))
+         (ensures  (h `contains` r1 /\ h `contains` r2 /\ upd h r1 x == upd h r2 x))
+

Two references with different reads are disjoint.

+
val mreference_distinct_sel_disjoint
+  (#a:Type0) (#rel1: preorder a) (#rel2: preorder a) (h: mem) (r1: mreference a rel1) (r2:mreference a rel2)
+  : Lemma (requires (h `contains` r1 /\ h `contains` r2 /\ frameOf r1 == frameOf r2 /\ as_addr r1 == as_addr r2))
+          (ensures (sel h r1 == sel h r2))
+ +
let modifies (s:Set.set rid) (m0:mem) (m1:mem) = modifies_just s (get_hmap m0) (get_hmap m1)
+
let modifies_transitively (s:Set.set rid) (m0:mem) (m1:mem) = FStar.Monotonic.HyperHeap.modifies s (get_hmap m0) (get_hmap m1)
+
let heap_only (m0:mem) = get_tip m0 == root
+
let top_frame (m:mem) = get_hmap m `Map.sel` get_tip m
+
val modifies_drop_tip (m0:mem) (m1:mem) (m2:mem) (s:Set.set rid)
+    : Lemma (fresh_frame m0 m1 /\ get_tip m1 == get_tip m2 /\
+             modifies_transitively (Set.union s (Set.singleton (get_tip m1))) m1 m2 ==>
+             modifies_transitively s m0 (pop m2))
+
let modifies_one id h0 h1 = modifies_one id (get_hmap h0) (get_hmap h1)
+let modifies_ref (id:rid) (s:Set.set nat) (h0:mem) (h1:mem) =
+  Heap.modifies s (get_hmap h0 `Map.sel` id) (get_hmap h1 `Map.sel` id)
+

***** API for generating modifies clauses in the old style, should use new modifies clauses now *****

+
noeq type some_ref =
+  | Ref: #a:Type0 -> #rel:preorder a -> mreference a rel -> some_ref
+
let some_refs = list some_ref
+
[@@"opaque_to_smt"]
+private let rec regions_of_some_refs (rs:some_refs) :Tot (Set.set rid) =
+  match rs with
+  | []         -> Set.empty
+  | (Ref r)::tl -> Set.union (Set.singleton (frameOf r)) (regions_of_some_refs tl)
+
[@@"opaque_to_smt"]
+private let rec refs_in_region (r:rid) (rs:some_refs) :GTot (Set.set nat) =
+  match rs with
+  | []         -> Set.empty
+  | (Ref x)::tl ->
+    Set.union (if frameOf x = r then Set.singleton (as_addr x) else Set.empty)
+              (refs_in_region r tl)
+
[@@"opaque_to_smt"]
+private let rec modifies_some_refs (i:some_refs) (rs:some_refs) (h0:mem) (h1:mem) :GTot Type0 =
+  match i with
+  | []         -> True
+  | (Ref x)::tl ->
+    (modifies_ref (frameOf x) (refs_in_region (frameOf x) rs) h0 h1) /\
+    (modifies_some_refs tl rs h0 h1)
+
[@@"opaque_to_smt"]
+unfold private let norm_steps :list norm_step =
+

iota for reducing match

+
[iota; zeta; delta; delta_only ["FStar.Monotonic.HyperStack.regions_of_some_refs";
+                                "FStar.Monotonic.HyperStack.refs_in_region";
+                                "FStar.Monotonic.HyperStack.modifies_some_refs"];
+ primops]
+
[@@"opaque_to_smt"]
+unfold let mods (rs:some_refs) (h0 h1:mem) :GTot Type0 =
+  (norm norm_steps (modifies (regions_of_some_refs rs) h0 h1)) /\
+  (norm norm_steps (modifies_some_refs rs rs h0 h1))
+

////

+
val eternal_disjoint_from_tip (h:mem{is_stack_region (get_tip h)})
+                              (r:rid{is_heap_color (color r) /\
+                                     r =!= root /\
+                                     r `is_in` get_hmap h})
+  :Lemma (disjoint (get_tip h) r)
+
val above_tip_is_live (#a:Type) (#rel:preorder a) (m:mem) (x:mreference a rel)
+  :Lemma (requires (frameOf x `is_above` get_tip m))
+         (ensures  (frameOf x `is_in` get_hmap m))
+

///

+

***** Lemmas about equality of mem *****

+
val lemma_heap_equality_cancel_same_mref_upd
+  (#a:Type) (#rel:preorder a) (h:mem) (r:mreference a rel) (x y:a)
+  :Lemma (requires (live_region h (frameOf r)))
+         (ensures  (upd (upd h r x) r y == upd h r y))
+
val lemma_heap_equality_upd_with_sel
+  (#a:Type) (#rel:preorder a) (h:mem) (r:mreference a rel)
+  :Lemma (requires (h `contains` r))
+         (ensures  (upd h r (sel h r) == h))
+
val lemma_heap_equality_commute_distinct_upds
+  (#a:Type) (#b:Type) (#rel_a:preorder a) (#rel_b:preorder b)
+  (h:mem) (r1:mreference a rel_a) (r2:mreference b rel_b) (x:a) (y:b)
+  :Lemma (requires (as_addr r1 =!= as_addr r2 /\ live_region h (frameOf r1) /\ live_region h (frameOf r2)))
+         (ensures  (upd (upd h r1 x) r2 y == upd (upd h r2 y) r1 x))
+
val lemma_next_addr_contained_refs_addr (_:unit)
+  :Lemma (forall (a:Type0) (rel:preorder a) (r:mreference a rel) (m:mem).
+            m `contains` r ==> as_addr r < Heap.next_addr (get_hmap m `Map.sel` frameOf r))
+

+Untyped views of references

+

Definition and ghost decidable equality

+
val aref: Type0
+
val dummy_aref :aref
+
val aref_equal (a1 a2: aref)
+  :Ghost bool (requires True)
+              (ensures  (fun b -> b == true <==> a1 == a2))
+

Introduction rule

+
val aref_of (#t: Type) (#rel: preorder t) (r: mreference t rel) :aref
+

Operators lifted from reference

+
val frameOf_aref (a:aref) :GTot rid
+
val frameOf_aref_of (#t:Type) (#rel:preorder t) (r:mreference t rel)
+  :Lemma (frameOf_aref (aref_of r) == frameOf r)
+         [SMTPat (frameOf_aref (aref_of r))]
+
val aref_as_addr (a:aref) :GTot pos
+
val aref_as_addr_aref_of (#t:Type) (#rel:preorder t) (r:mreference t rel)
+  :Lemma (aref_as_addr (aref_of r) == as_addr r)
+         [SMTPat (aref_as_addr (aref_of r))]
+
val aref_is_mm (r:aref) :GTot bool
+
val is_mm_aref_of (#t:Type) (#rel:preorder t) (r:mreference t rel)
+  :Lemma (aref_is_mm (aref_of r) == is_mm r)
+         [SMTPat (aref_is_mm (aref_of r))]
+
[@@ remove_unused_type_parameters [0;1]]
+val aref_unused_in (a:aref) (h:mem) :GTot Type0
+
val unused_in_aref_of (#t:Type) (#rel:preorder t) (r:mreference t rel) (h:mem)
+  :Lemma (aref_unused_in (aref_of r) h <==> unused_in r h)
+         [SMTPat (aref_unused_in (aref_of r) h)]
+
val contains_aref_unused_in (#a:Type) (#rel:preorder a) (h:mem) (x:mreference a rel) (y:aref)
+  :Lemma (requires (contains h x /\ aref_unused_in y h))
+         (ensures  (frameOf x <> frameOf_aref y \/ as_addr x <> aref_as_addr y))
+         [SMTPat (contains h x); SMTPat (aref_unused_in y h)]
+

Elimination rule

+
[@@ remove_unused_type_parameters [0;1;2;3]]
+val aref_live_at (h:mem) (a:aref) (v:Type0) (rel:preorder v) :GTot Type0
+
val greference_of (a:aref) (v:Type0) (rel:preorder v)
+  :Ghost (mreference v rel) (requires (exists h . aref_live_at h a v rel))
+                            (ensures  (fun _ -> True))
+
val reference_of (h:mem) (a:aref) (v:Type0) (rel:preorder v)
+  :Pure (mreference v rel) (requires (aref_live_at h a v rel))
+                           (ensures  (fun x -> aref_live_at h a v rel /\ frameOf x == frameOf_aref a /\
+                                as_addr x == aref_as_addr a /\ is_mm x == aref_is_mm a))
+
val aref_live_at_aref_of (h:mem) (#t:Type0) (#rel:preorder t) (r:mreference t rel)
+  :Lemma (aref_live_at h (aref_of r) t rel <==> contains h r)
+         [SMTPat (aref_live_at h (aref_of r) t rel)]
+
val contains_greference_of (h:mem) (a:aref) (t:Type0) (rel:preorder t)
+  :Lemma (requires (exists h' . aref_live_at h' a t rel))
+         (ensures  ((exists h' . aref_live_at h' a t rel) /\ (contains h (greference_of a t rel) <==> aref_live_at h a t rel)))
+         [SMTPatOr [
+             [SMTPat (contains h (greference_of a t rel))];
+             [SMTPat (aref_live_at h a t rel)];
+         ]]
+
val aref_of_greference_of (a:aref) (v:Type0) (rel:preorder v)
+  :Lemma (requires (exists h' . aref_live_at h' a v rel))
+         (ensures  ((exists h' . aref_live_at h' a v rel) /\ aref_of (greference_of a v rel) == a))
+         [SMTPat (aref_of (greference_of a v rel))]
+

Operators lowered to rref

+
val frameOf_greference_of (a:aref) (t:Type0) (rel:preorder t)
+  :Lemma (requires (exists h . aref_live_at h a t rel))
+         (ensures  ((exists h . aref_live_at h a t rel) /\ frameOf (greference_of a t rel) == frameOf_aref a))
+         [SMTPat (frameOf (greference_of a t rel))]
+
val as_addr_greference_of (a:aref) (t:Type0) (rel:preorder t)
+  :Lemma (requires (exists h . aref_live_at h a t rel))
+         (ensures  ((exists h . aref_live_at h a t rel) /\ as_addr (greference_of a t rel) == aref_as_addr a))
+         [SMTPat (as_addr (greference_of a t rel))]
+
val is_mm_greference_of (a:aref) (t:Type0) (rel:preorder t)
+  :Lemma (requires (exists h . aref_live_at h a t rel))
+         (ensures  ((exists h . aref_live_at h a t rel) /\ is_mm (greference_of a t rel) == aref_is_mm a))
+         [SMTPat (is_mm (greference_of a t rel))]
+
val unused_in_greference_of (a:aref) (t:Type0) (rel:preorder t) (h:mem)
+  :Lemma (requires (exists h . aref_live_at h a t rel))
+         (ensures  ((exists h . aref_live_at h a t rel) /\ (unused_in (greference_of a t rel) h <==> aref_unused_in a h)))
+         [SMTPat (unused_in (greference_of a t rel) h)]
+
val sel_reference_of (a:aref) (v:Type0) (rel:preorder v) (h1 h2: mem)
+  :Lemma (requires (aref_live_at h1 a v rel /\ aref_live_at h2 a v rel))
+         (ensures  (aref_live_at h2 a v rel /\ sel h1 (reference_of h2 a v rel) == sel h1 (greference_of a v rel)))
+         [SMTPat (sel h1 (reference_of h2 a v rel))]
+
val upd_reference_of (a:aref) (v:Type0) (rel:preorder v) (h1 h2:mem) (x:v)
+  :Lemma (requires (aref_live_at h1 a v rel /\ aref_live_at h2 a v rel))
+         (ensures  (aref_live_at h1 a v rel /\ aref_live_at h2 a v rel /\
+                upd h1 (reference_of h2 a v rel) x == upd h1 (greference_of a v rel) x))
+         [SMTPat (upd h1 (reference_of h2 a v rel) x)]
+ diff --git a/docs/FStar.Monotonic.Map.html b/docs/FStar.Monotonic.Map.html index 4af9be7..80b2a1a 100644 --- a/docs/FStar.Monotonic.Map.html +++ b/docs/FStar.Monotonic.Map.html @@ -1,16 +1,114 @@ - - + + - - - - - + FStar.Monotonic.Map + -

module FStar.Monotonic.Map

-

fsdoc: no-summary-found

+

+FStar.Monotonic.Map

A library for monotonic references to partial, dependent maps, with a whole-map invariant

+ +

Partial, dependent maps

+
type map' (a:Type) (b:a -> Type) =
+  (x:a -> Tot (option (b x)))
+

Partial, dependent maps, with a whole-map invariant

+
type map (a:Type) (b:a -> Type) (inv:map' a b -> Type0) =
+  m:map' a b{inv m}
+
let upd (#a:eqtype) #b (m:map' a b) (x:a) (y:b x)
+  : Tot (map' a b)
+  = fun z -> if x = z then Some y else m z
+
let sel #a #b (m:map' a b) (x:a)
+  : Tot (option (b x))
+  = m x
+
let grows_aux #a #b #inv :Preorder.preorder (map a b inv) =
+  fun (m1 m2:map a b inv) ->
+  forall x.{:pattern (Some? (m1 x))}
+      Some? (m1 x) ==> Some? (m2 x) /\ Some?.v (m1 x) == Some?.v (m2 x)
+
[@@"opaque_to_smt"]
+let grows #a #b #inv = grows_aux #a #b #inv
+

Monotone, partial, dependent maps, with a whole-map invariant

+
type t r a b inv = m_rref r (map a b inv) grows  //maybe grows can include the inv?
+
let empty_map a b
+  : Tot (map' a b)
+  = fun x -> None
+
type rid = HST.erid
+
let alloc (#r:rid) #a #b #inv
+  : ST (t r a b inv)
+       (requires (fun h -> inv (empty_map a b) /\ witnessed (region_contains_pred r)))
+       (ensures (fun h0 x h1 ->
+    inv (empty_map a b) /\
+    ralloc_post r (empty_map a b) h0 x h1))
+  = ralloc r (empty_map a b)
+
let defined #r #a #b #inv (m:t r a b inv) (x:a) (h:HS.mem)
+  : GTot Type0
+  = Some? (sel (HS.sel h m) x)
+
let contains #r #a #b #inv (m:t r a b inv) (x:a) (y:b x) (h:HS.mem)
+  : GTot Type0
+  = Some? (sel (HS.sel h m) x) /\ Some?.v (sel (HS.sel h m) x) == y
+
let value #r #a #b #inv (m:t r a b inv) (x:a) (h:HS.mem{defined m x h})
+  : GTot (r:b x{contains m x r h})
+  = Some?.v (sel (HS.sel h m) x)
+
let fresh #r #a #b #inv (m:t r a b inv) (x:a) (h:HS.mem)
+  : GTot Type0
+  = None? (sel (HS.sel h m) x)
+
let contains_stable #r #a #b #inv (m:t r a b inv) (x:a) (y:b x)
+  : Lemma (ensures (stable_on_t m (contains m x y)))
+  = reveal_opaque (`%grows) (grows #a #b #inv)
+
let extend (#r:rid) (#a:eqtype) (#b:a -> Type) (#inv:(map' a b -> Type0)) (m:t r a b inv) (x:a) (y:b x)
+  : ST unit
+      (requires (fun h -> let cur = HS.sel h m in inv (upd cur x y) /\ sel cur x == None))
+      (ensures (fun h0 u h1 ->
+      let cur = HS.sel h0 m in
+      let hsref = m in
+            HS.contains h1 m
+            /\ modifies (Set.singleton r) h0 h1
+            /\ modifies_ref r (Set.singleton (HS.as_addr hsref)) h0 h1
+            /\ HS.sel h1 m == upd cur x y
+            /\ HST.witnessed (defined m x)
+            /\ HST.witnessed (contains m x y)))
+  = recall m;
+    reveal_opaque (`%grows) (grows #a #b #inv);
+    let cur = !m in
+    m := upd cur x y;
+    contains_stable m x y;
+    mr_witness m (defined m x);
+    mr_witness m (contains m x y)
+
let lookup #r #a #b #inv (m:t r a b inv) (x:a)
+  : ST (option (b x))
+       (requires (fun h -> True))
+       (ensures (fun h0 y h1 ->
+       h0==h1 /\
+       y == sel (HS.sel h1 m) x /\
+       (None? y ==> fresh m x h1) /\
+       (Some? y ==>
+         defined m x h1 /\
+         contains m x (Some?.v y) h1 /\
+         HST.witnessed (defined m x) /\
+         HST.witnessed (contains m x (Some?.v y)))))
+= reveal_opaque (`%grows) (grows #a #b #inv);
+  let y = sel !m x in
+  match y with
+    | None -> y
+    | Some b ->
+        contains_stable m x b;
+        mr_witness m (defined m x);
+        mr_witness m (contains m x b);
+        y
+ diff --git a/docs/FStar.Monotonic.Pure.html b/docs/FStar.Monotonic.Pure.html new file mode 100644 index 0000000..9c6c52b --- /dev/null +++ b/docs/FStar.Monotonic.Pure.html @@ -0,0 +1,59 @@ + + + + + FStar.Monotonic.Pure + + + +

Copyright 2019 Microsoft Research

+

Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at

+
http://www.apache.org/licenses/LICENSE-2.0
+
+

Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License.

+

+FStar.Monotonic.Pure

+ +
unfold
+let is_monotonic (#a:Type) (wp:pure_wp' a) =
+ +
forall (p q:pure_post a). (forall (x:a). p x ==> q x) ==> (wp p ==> wp q)
+
let elim_pure_wp_monotonicity (#a:Type) (wp:pure_wp a)
+  : Lemma (is_monotonic wp)
+  = reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic
+
let elim_pure_wp_monotonicity_forall (_:unit)
+  : Lemma
+    (forall (a:Type) (wp:pure_wp a). is_monotonic wp)
+  = reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic
+
let intro_pure_wp_monotonicity (#a:Type) (wp:pure_wp' a)
+  : Lemma
+      (requires is_monotonic wp)
+      (ensures pure_wp_monotonic a wp)
+  = reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic
+
unfold
+let as_pure_wp (#a:Type) (wp:pure_wp' a)
+  : Pure (pure_wp a)
+      (requires is_monotonic wp)
+      (ensures fun r -> r == wp)
+  = intro_pure_wp_monotonicity wp;
+    wp
+ + + diff --git a/docs/FStar.Monotonic.Seq.html b/docs/FStar.Monotonic.Seq.html index a24a6f0..520bf3a 100644 --- a/docs/FStar.Monotonic.Seq.html +++ b/docs/FStar.Monotonic.Seq.html @@ -1,57 +1,398 @@ - - + + - - - - - - + FStar.Monotonic.Seq + -

module FStar.Monotonic.Seq

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((write_at_end (#a:Type) (#i:rid) (r:m_rref i (seq a) grows) (x:a)):(ST unit ((requires ((fun h -> True)))) ((ensures ((fun h0 _ h1 -> /\(/\(/\(/\(contains h1 r, modifies_one i h0 h1), modifies_ref i (Set.singleton (HS.as_addr r)) h0 h1), ==(HS.sel h1 r, Seq.snoc (HS.sel h0 r) x)), witnessed (at_least (Seq.length (HS.sel h0 r)) x r)))))))):recall r; let  s0 = !(r) in let  n = Seq.length s0 in :=(r, Seq.snoc s0 x); at_least_is_stable n x r; Seq.contains_snoc s0 x; mr_witness r (at_least n x r)
+

+FStar.Monotonic.Seq

+ +

//////////////////////////////////////////////////////////////////////////////

+ +
let grows_aux (#a:Type) :Preorder.preorder (seq a)
+  = fun (s1:seq a) (s2:seq a) ->
+    length s1 <= length s2 /\
+    (forall (i:nat).{:pattern (Seq.index s1 i) \/ (Seq.index s2 i)} i < length s1 ==> index s1 i == index s2 i)
+
[@@"opaque_to_smt"]
+let grows #a = grows_aux #a
+
type rid = HST.erid
+
let snoc (s:seq 'a) (x:'a)
+  : Tot (seq 'a)
+  = Seq.append s (Seq.create 1 x)
+
let lemma_snoc_extends (#a:Type) (s:seq a) (x:a)
+  : Lemma (requires True)
+      (ensures (grows s (Seq.snoc s x)))
+      [SMTPat (grows s (Seq.snoc s x))]
+  = reveal_opaque (`%grows) (grows #a)
+
let alloc_mref_seq (#a:Type) (r:rid) (init:seq a)
+  : ST (m_rref r (seq a) grows)
+       (requires (fun _ -> HST.witnessed (region_contains_pred r)))
+       (ensures (fun h0 m h1 ->
+     HS.contains h1 m /\
+     HS.sel h1 m == init /\
+     HST.ralloc_post r init h0 m h1))
+  = ralloc r init
+ +
let at_least (#a:Type) (#i:rid) (n:nat) (x:a) (r:m_rref i (seq a) grows) (h:mem) =
+    Seq.length (HS.sel h r) > n
+  /\ Seq.index (HS.sel h r) n == x
+
let at_least_is_stable (#a:Type) (#i:rid) (n:nat) (x:a) (r:m_rref i (seq a) grows)
+  : Lemma (ensures stable_on_t r (at_least n x r))
+  = reveal_opaque (`%grows) (grows #a)
+

+write_at_end

extending a stored sequence, witnessing its new entry for convenience.

-
val collect:Unidentified product: [(Unidentified product: ['a] (Tot (seq 'b)))] Unidentified product: [s:seq 'a] (Tot (seq 'b) (decreases (Seq.length s)))
+
let write_at_end (#a:Type) (#i:rid) (r:m_rref i (seq a) grows) (x:a)
+  : ST unit
+       (requires (fun h -> True))
+       (ensures (fun h0 _ h1 ->
+                   contains h1 r
+             /\ modifies_one i h0 h1
+             /\ modifies_ref i (Set.singleton (HS.as_addr r)) h0 h1
+             /\ HS.sel h1 r == Seq.snoc (HS.sel h0 r) x
+             /\ witnessed (at_least (Seq.length (HS.sel h0 r)) x r)))
+  =
+    recall r;
+    let s0 = !r in
+    let n = Seq.length s0 in
+    r := Seq.snoc s0 x;
+    at_least_is_stable n x r;
+    Seq.contains_snoc s0 x;
+    mr_witness r (at_least n x r)
+

////////////////////////////////////////////////////////////////////////////// +Monotone sequences with a (stateless) invariant of the whole sequence +//////////////////////////////////////////////////////////////////////////////

+
let grows_p (#a:Type) (p:seq a -> Type) :Preorder.preorder (s:seq a{p s}) =
+  fun s1 s2 -> grows s1 s2
+
let i_seq (r:rid) (a:Type) (p:seq a -> Type) = m_rref r (s:seq a{p s}) (grows_p p)
+
let alloc_mref_iseq (#a:Type) (p:seq a -> Type) (r:rid) (init:seq a{p init})
+  : ST (i_seq r a p)
+       (requires (fun _ -> HST.witnessed (region_contains_pred r)))
+       (ensures (fun h0 m h1 -> HST.ralloc_post r init h0 m h1))
+  = ralloc r init
+
let i_at_least (#r:rid) (#a:Type) (#p:(seq a -> Type)) (n:nat) (x:a) (m:i_seq r a p) (h:mem) =
+        Seq.length (HS.sel h m) > n
+      /\ Seq.index (HS.sel h m) n == x
+
let i_at_least_is_stable (#r:rid) (#a:Type) (#p:seq a -> Type) (n:nat) (x:a) (m:i_seq r a p)
+  : Lemma (ensures stable_on_t m (i_at_least n x m))
+  = reveal_opaque (`%grows) (grows #a)
+
let int_at_most #r #a #p (x:int) (is:i_seq r a p) (h:mem) : Type0 =
+  x < Seq.length (HS.sel h is)
+
let int_at_most_is_stable (#r:rid) (#a:Type) (#p:seq a -> Type) (is:i_seq r a p) (k:int)
+  : Lemma (ensures stable_on_t is (int_at_most k is))
+  = reveal_opaque (`%grows) (grows #a)
+
let i_sel (#r:rid) (#a:Type) (#p:seq a -> Type) (h:mem) (m:i_seq r a p)
+  : GTot (s:seq a{p s})
+  = HS.sel h m
+
let i_read (#a:Type) (#p:Seq.seq a -> Type) (#r:rid) (m:i_seq r a p)
+  : ST (s:seq a{p s})
+       (requires (fun h -> True))
+       (ensures (fun h0 x h1 -> h0==h1 /\ x == i_sel h0 m))
+  = !m
+
let i_contains (#r:rid) (#a:Type) (#p:seq a -> Type) (m:i_seq r a p) (h:mem)
+  : GTot Type0
+  = HS.contains h m
+
let i_write_at_end (#a:Type) (#p:seq a -> Type) (#rgn:rid) (r:i_seq rgn a p) (x:a)
+  : ST unit
+       (requires (fun h -> p (Seq.snoc (i_sel h r) x)))
+       (ensures (fun h0 _ h1 ->
+                   i_contains r h1
+             /\ modifies_one rgn h0 h1
+             /\ modifies_ref rgn (Set.singleton (HS.as_addr r)) h0 h1
+             /\ i_sel h1 r == Seq.snoc (i_sel h0 r) x
+             /\ witnessed (i_at_least (Seq.length (i_sel h0 r)) x r)))
+  =
+    recall r;
+    let s0 = !r in
+    let n = Seq.length s0 in
+    r := Seq.snoc s0 x;
+    i_at_least_is_stable n x r;
+    contains_snoc s0 x;
+    mr_witness r (i_at_least n x r)
+

////////////////////////////////////////////////////////////////////////////// +Testing invariant sequences +//////////////////////////////////////////////////////////////////////////////

+
private let invariant (s:seq nat) =
+  forall (i:nat) (j:nat). i < Seq.length s /\ j < Seq.length s /\ i<>j
+         ==> Seq.index s i <> Seq.index s j
+
private val test0: r:rid -> a:m_rref r (seq nat) grows -> k:nat -> ST unit
+  (requires (fun h -> k < Seq.length (HS.sel h a)))
+  (ensures (fun h0 result h1 -> True))
+let test0 r a k =
+  let h0 = HST.get() in
+  let _ =
+    let s = HS.sel h0 a in
+    at_least_is_stable k (Seq.index (HS.sel h0 a) k) a;
+    Seq.contains_intro s k (Seq.index s k) in
+  mr_witness a (at_least k (Seq.index (HS.sel h0 a) k) a)
+
private val itest: r:rid -> a:i_seq r nat invariant -> k:nat -> ST unit
+  (requires (fun h -> k < Seq.length (i_sel h a)))
+  (ensures (fun h0 result h1 -> True))
+let itest r a k =
+  let h0 = HST.get() in
+  i_at_least_is_stable k (Seq.index (i_sel h0 a) k) a;
+  mr_witness a (i_at_least k (Seq.index (i_sel h0 a) k) a)
+

////////////////////////////////////////////////////////////////////////////// +Mapping functions over monotone sequences +//////////////////////////////////////////////////////////////////////////////

+
val un_snoc: #a: Type -> s:seq a {Seq.length s > 0} -> Tot(seq a * a)
+let un_snoc #a s =
+  let last = Seq.length s - 1 in
+  Seq.slice s 0 last, Seq.index s last
+
val map: ('a -> Tot 'b) -> s:seq 'a -> Tot (seq 'b)
+    (decreases (Seq.length s))
+let rec map f s =
+  if Seq.length s = 0 then Seq.empty
+  else let prefix, last = un_snoc s in
+       Seq.snoc (map f prefix) (f last)
+
val map_snoc: f:('a -> Tot 'b) -> s:seq 'a -> a:'a -> Lemma
+  (map f (Seq.snoc s a) == Seq.snoc (map f s) (f a))
+let map_snoc f s a =
+  let prefix, last = un_snoc (Seq.snoc s a) in
+  cut (Seq.equal prefix s)
+
private let op_At s1 s2 = Seq.append s1 s2
+
val map_append: f:('a -> Tot 'b) -> s1:seq 'a -> s2:seq 'a -> Lemma
+  (requires True)
+  (ensures (map f (s1@s2) == (map f s1 @ map f s2)))
+  (decreases (Seq.length s2))
+#reset-options "--z3rlimit 10 --initial_fuel 1 --max_fuel 1 --initial_ifuel 1 --max_ifuel 1"
+let rec map_append f s_1 s_2 =
+  if Seq.length s_2 = 0
+  then (cut (Seq.equal (s_1@s_2) s_1);
+        cut (Seq.equal (map f s_1 @ map f s_2) (map f s_1)))
+  else (let prefix_2, last = un_snoc s_2 in
+        let m_s_1 = map f s_1 in
+      let m_p_2 = map f prefix_2 in
+      let flast = f last in
+      cut (Seq.equal (s_1@s_2) (Seq.snoc (s_1@prefix_2) last));         //map f (s1@s2) = map f (snoc (s1@p) last)
+      map_snoc f (Seq.append s_1 prefix_2) last;                       //              = snoc (map f (s1@p)) (f last)
+        map_append f s_1 prefix_2;                                       //              = snoc (map f s_1 @ map f p) (f last)
+      cut (Seq.equal (Seq.snoc (m_s_1 @ m_p_2) flast)
+                 (m_s_1 @ Seq.snoc m_p_2 flast));                 //              = map f s1 @ (snoc (map f p) (f last))
+        map_snoc f prefix_2 last)                                       //              = map f s1 @ map f (snoc p last)
+
#reset-options "--z3rlimit 5"
+
val map_length: f:('a -> Tot 'b) -> s1:seq 'a -> Lemma
+  (requires True)
+  (ensures (Seq.length s1 = Seq.length (map f s1)))
+  (decreases (length s1))
+  [SMTPat (Seq.length (map f s1))]
+let rec map_length f s1 =
+  if Seq.length s1 = 0 then ()
+  else let prefix, last = un_snoc s1 in
+       map_length f prefix
+
val map_index: f:('a -> Tot 'b) -> s:seq 'a -> i:nat{i<Seq.length s} -> Lemma
+  (requires True)
+  (ensures (Seq.index (map f s) i == f (Seq.index s i)))
+  (decreases (Seq.length s))
+  [SMTPat (Seq.index (map f s) i)]
+let rec map_index f s i =
+  if i = Seq.length s - 1
+  then ()
+  else let prefix, last = un_snoc s in
+       map_index f prefix i
+

17-01-05 all the stuff above should go to Seq.Properties!

+
let map_grows (#a:Type) (#b:Type) (f:a -> Tot b)
+          (s1:seq a) (s3:seq a)
+  : Lemma (grows s1 s3
+       ==> grows (map f s1) (map f s3))
+  = reveal_opaque (`%grows) (grows #a);
+    reveal_opaque (`%grows) (grows #b)
+
let map_prefix (#a:Type) (#b:Type) (#i:rid)
+           (r:m_rref i (seq a) grows)
+           (f:a -> Tot b)
+           (bs:seq b)
+           (h:mem) =
+  grows bs (map f (HS.sel h r))
+

17-01-05 this applies to log_t's defined below.

+
let map_prefix_stable (#a:Type) (#b:Type) (#i:rid) (r:m_rref i (seq a) grows) (f:a -> Tot b) (bs:seq b)
+  :Lemma (stable_on_t r (map_prefix r f bs))
+  = reveal_opaque (`%grows) (grows #a);
+    reveal_opaque (`%grows) (grows #b)
+
let map_has_at_index (#a:Type) (#b:Type) (#i:rid)
+             (r:m_rref i (seq a) grows)
+             (f:a -> Tot b)
+             (n:nat) (v:b) (h:mem) =
+    let s = HS.sel h r in
+    n < Seq.length s
+  /\ Seq.index (map f s) n == v
+
let map_has_at_index_stable (#a:Type) (#b:Type) (#i:rid)
+                (r:m_rref i (seq a) grows)
+                (f:a -> Tot b) (n:nat) (v:b)
+  : Lemma (stable_on_t r (map_has_at_index r f n v))
+  = reveal_opaque (`%grows) (grows #a)
+

////////////////////////////////////////////////////////////////////////////// +Collecting monotone sequences +//////////////////////////////////////////////////////////////////////////////

+

+collect

yields the concatenation of all sequences returned by f applied to the sequence elements

+
val collect: ('a -> Tot (seq 'b)) -> s:seq 'a -> Tot (seq 'b)
+    (decreases (Seq.length s))
+let rec collect f s =
+  if Seq.length s = 0 then Seq.empty
+  else let prefix, last = un_snoc s in
+       Seq.append (collect f prefix) (f last)
+
val collect_snoc: f:('a -> Tot (seq 'b)) -> s:seq 'a -> a:'a -> Lemma
+  (collect f (Seq.snoc s a) == Seq.append (collect f s) (f a))
+let collect_snoc f s a =
+  let prefix, last = un_snoc (Seq.snoc s a) in
+  cut (Seq.equal prefix s)
+
#reset-options "--z3rlimit 20 --initial_fuel 1 --max_fuel 1 --initial_ifuel 1 --max_ifuel 1"
+
let collect_grows (f:'a -> Tot (seq 'b))
+          (s1:seq 'a) (s2:seq 'a)
+  : Lemma (grows s1 s2 ==> grows (collect f s1) (collect f s2))
+  = reveal_opaque (`%grows) (grows #'a);
+    reveal_opaque (`%grows) (grows #'b);
+    let rec collect_grows_aux (f:'a -> Tot (seq 'b)) (s1:seq 'a) (s2:seq 'a)
+      :Lemma (requires (grows s1 s2)) (ensures (grows (collect f s1) (collect f s2)))
+             (decreases (Seq.length s2))
+      = if length s1 = length s2 then assert (Seq.equal s1 s2)
+        else
+          let s2_prefix, s2_last = un_snoc s2 in
+          collect_grows_aux f s1 s2_prefix
+    in
+    Classical.arrow_to_impl #(grows s1 s2) #(grows (collect f s1) (collect f s2)) (fun _ -> collect_grows_aux f s1 s2)
+
let collect_prefix (#a:Type) (#b:Type) (#i:rid)
+           (r:m_rref i (seq a) grows)
+           (f:a -> Tot (seq b))
+           (bs:seq b)
+           (h:mem) =
+  grows bs (collect f (HS.sel h r))
+
let collect_prefix_stable (#a:Type) (#b:Type) (#i:rid) (r:m_rref i (seq a) grows) (f:a -> Tot (seq b)) (bs:seq b)
+  : Lemma (stable_on_t r (collect_prefix r f bs))
+  = let aux : h0:mem -> h1:mem -> Lemma
+      (collect_prefix r f bs h0
+       /\ grows (HS.sel h0 r) (HS.sel h1 r)
+       ==> collect_prefix r f bs h1) =
+      fun h0 h1 ->
+      let s1 = HS.sel h0 r in
+      let s3 = HS.sel h1 r in
+      collect_grows f s1 s3
+    in
+    forall_intro_2 aux
+
let collect_has_at_index (#a:Type) (#b:Type) (#i:rid)
+             (r:m_rref i (seq a) grows)
+             (f:a -> Tot (seq b))
+             (n:nat) (v:b) (h:mem) =
+    let s = HS.sel h r in
+    n < Seq.length (collect f s)
+  /\ Seq.index (collect f s) n == v
+
let collect_has_at_index_stable (#a:Type) (#b:Type) (#i:rid)
+                (r:m_rref i (seq a) grows)
+                (f:a -> Tot (seq b)) (n:nat) (v:b)
+  : Lemma (stable_on_t r (collect_has_at_index r f n v))
+  = reveal_opaque (`%grows) (grows #b);
+    Classical.forall_intro_2 (collect_grows f)
+

////////////////////////////////////////////////////////////////////////////// +Monotonic sequence numbers, bounded by the length of a log +////////////////////////////////////////////////////////////////////////////// +17-01-05 the simpler variant, with an historic name; consider using uniform names below.

+
type log_t (i:rid) (a:Type) = m_rref i (seq a) grows
+
let increases (x:int) (y:int) = b2t (x <= y)
+
let at_most_log_len (#l:rid) (#a:Type) (x:nat) (log:log_t l a)
+    : mem -> GTot Type0
+    = fun h -> x <= Seq.length (HS.sel h log)
+

Note: we may want int seqn, instead of nat seqn +because the handshake uses an initial value of -1

+
type seqn_val (#l:rid) (#a:Type) (i:rid) (log:log_t l a) (max:nat) =
+     (x:nat{x <= max /\ witnessed (at_most_log_len x log)}) //never more than the length of the log
+
type seqn (#l:rid) (#a:Type) (i:rid) (log:log_t l a) (max:nat) =
+  m_rref i  //counter in region i
+         (seqn_val i log max) //never more than the length of the log
+     increases //increasing
+
let at_most_log_len_stable (#l:rid) (#a:Type) (x:nat) (log:log_t l a)
+  : Lemma (stable_on_t log (at_most_log_len x log))
+  = reveal_opaque (`%grows) (grows #a)
+
let new_seqn (#a:Type) (#l:rid) (#max:nat)
+           (i:rid) (init:nat) (log:log_t l a)
+  : ST (seqn i log max)
+       (requires (fun h ->
+           HST.witnessed (region_contains_pred i) /\
+       init <= max /\
+       init <= Seq.length (HS.sel h log)))
+       (ensures (fun h0 c h1 -> //17-01-05 unify with ralloc_post?
+           modifies_one i h0 h1 /\
+           modifies_ref i Set.empty h0 h1 /\
+           fresh_ref c h0 h1 /\
+           HS.sel h1 c = init /\
+           FStar.Map.contains (HS.get_hmap h1) i))
+  = reveal_opaque (`%grows) (grows #a);
+    recall log; recall_region i;
+    mr_witness log (at_most_log_len init log);
+    ralloc i init
+
let increment_seqn (#a:Type) (#l:rid) (#max:nat)
+               (#i:rid) (#log:log_t l a) ($c:seqn i log max)
+  : ST unit
+       (requires (fun h ->
+      let log = HS.sel h log in
+      let n = HS.sel h c in
+      n < Seq.length log  /\
+      n + 1 <= max))
+       (ensures (fun h0 _ h1 ->
+      modifies_one i h0 h1 /\
+      modifies_ref i (Set.singleton (HS.as_addr c)) h0 h1 /\
+      HS.sel h1 c = HS.sel h0 c + 1))
+  = reveal_opaque (`%grows) (grows #a);
+    recall c; recall log;
+    let n = !c + 1 in
+    mr_witness log (at_most_log_len n log);
+    c := n
+
let testify_seqn (#a:Type0) (#i:rid) (#l:rid) (#log:log_t l a) (#max:nat) (ctr:seqn i log max)
+  : ST unit
+       (requires (fun h -> True))
+       (ensures (fun h0 _ h1 ->
+       h0==h1 /\
+       at_most_log_len (HS.sel h1 ctr) log h1))
+  = let n = !ctr in
+    testify (at_most_log_len n log)
+
private let test (i:rid) (l:rid) (a:Type0) (log:log_t l a) //(p:(nat -> Type))
+         (r:seqn i log 8) (h:mem)
+  = assert (HS.sel h r = Heap.sel (FStar.Map.sel (HS.get_hmap h) i) (HS.as_ref r))
+ diff --git a/docs/FStar.Monotonic.Witnessed.html b/docs/FStar.Monotonic.Witnessed.html index a9b0637..3f55596 100644 --- a/docs/FStar.Monotonic.Witnessed.html +++ b/docs/FStar.Monotonic.Witnessed.html @@ -1,16 +1,70 @@ - - + + - - - - - + FStar.Monotonic.Witnessed + -

module FStar.Monotonic.Witnessed

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Monotonic.Witnessed

+ +

A module that defines the 'witnessed' logical capability/modality +that is the basis of reasoning about monotonic state in F*, as +discussed in Ahman et al.'s POPL 2018 paper "Recalling a Witness: +Foundations and Applications of Monotonic State". Compared to the +POPL paper, where 'witnessed' and 'witnessed_weakening' were +simply postulated as axioms, this module defines them on top of +a more basic hybrid modal extension of F*'s reasoning logic (see +the corresponding fst file). Also, compared to the POPL paper, this +module proves many additional logical properties of 'witnessed'.

+

Witnessed modality

+
[@@ remove_unused_type_parameters [0; 1; 2]]
+val witnessed : #state:Type -> rel:preorder state -> p:(state -> Type0) -> Type0
+

Weakening for the witnessed modality

+
val lemma_witnessed_weakening :#state:Type
+                               -> rel:preorder state
+                               -> p:(state -> Type0)
+                               -> q:(state -> Type0)
+                               -> Lemma (requires (forall s. p s ==> q s))
+                                       (ensures  (witnessed rel p ==> witnessed rel q))
+

Some logical properties of the witnessed modality

+
val lemma_witnessed_constant :#state:Type
+                              -> rel:preorder state
+                              -> p:Type0
+                              -> Lemma (witnessed rel (fun _ -> p) <==> p)
+
val lemma_witnessed_nested :#state:Type
+                            -> rel:preorder state
+                            -> p:(state -> Type0)
+                            -> Lemma (witnessed rel (fun _ -> witnessed rel p) <==> witnessed rel p)
+
val lemma_witnessed_and :#state:Type
+                         -> rel:preorder state
+                         -> p:(state -> Type0)
+                         -> q:(state -> Type0)
+                         -> Lemma (witnessed rel (fun s -> p s /\ q s) <==> (witnessed rel p /\ witnessed rel q))
+
val lemma_witnessed_or :#state:Type
+                        -> rel:preorder state
+                        -> p:(state -> Type0)
+                        -> q:(state -> Type0)
+                        -> Lemma ((witnessed rel p \/ witnessed rel q) ==> witnessed rel (fun s -> p s \/ q s))
+
val lemma_witnessed_impl :#state:Type
+                          -> rel:preorder state
+                          -> p:(state -> Type0)
+                          -> q:(state -> Type0)
+                          -> Lemma ((witnessed rel (fun s -> p s ==> q s) /\ witnessed rel p) ==> witnessed rel q)
+
val lemma_witnessed_forall :#state:Type
+                            -> #t:Type
+                            -> rel:preorder state
+                            -> p:(t -> state -> Type0)
+                            -> Lemma ((witnessed rel (fun s -> forall x. p x s)) <==> (forall x. witnessed rel (p x)))
+
val lemma_witnessed_exists :#state:Type
+                            -> #t:Type
+                            -> rel:preorder state
+                            -> p:(t -> state -> Type0)
+                            -> Lemma ((exists x. witnessed rel (p x)) ==> witnessed rel (fun s -> exists x. p x s))
+ diff --git a/docs/FStar.Mul.html b/docs/FStar.Mul.html index f908268..67b1bf5 100644 --- a/docs/FStar.Mul.html +++ b/docs/FStar.Mul.html @@ -1,16 +1,16 @@ - - + + - - - - - + FStar.Mul + -

module FStar.Mul

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Mul

+

If we're not doing anything with tuples, +open this module to let '*' be multiplication

+
unfold let op_Star = Prims.op_Multiply
+ diff --git a/docs/FStar.Option.html b/docs/FStar.Option.html index cd3703b..96c39b4 100644 --- a/docs/FStar.Option.html +++ b/docs/FStar.Option.html @@ -1,16 +1,46 @@ - - + + - - - - - + FStar.Option + -

module FStar.Option

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Option

+ +
inline_for_extraction
+val isNone: option 'a -> Tot bool
+inline_for_extraction
+let isNone = function
+  | None -> true
+  | Some _ -> false
+
inline_for_extraction
+val isSome: option 'a -> Tot bool
+inline_for_extraction
+let isSome = function
+  | Some _ -> true
+  | None -> false
+
inline_for_extraction
+val map: ('a -> ML 'b) -> option 'a -> ML (option 'b)
+inline_for_extraction
+let map f = function
+  | Some x -> Some (f x)
+  | None -> None
+
inline_for_extraction
+val mapTot: ('a -> Tot 'b) -> option 'a -> Tot (option 'b)
+inline_for_extraction
+let mapTot f = function
+  | Some x -> Some (f x)
+  | None -> None
+
inline_for_extraction
+val get: option 'a -> ML 'a
+let get = function
+  | Some x -> x
+  | None -> failwith "empty option"
+ diff --git a/docs/FStar.OrdSetProps.html b/docs/FStar.OrdSetProps.html index 6939500..94d933f 100644 --- a/docs/FStar.OrdSetProps.html +++ b/docs/FStar.OrdSetProps.html @@ -1,16 +1,43 @@ - - + + - - - - - + FStar.OrdSetProps + -

module FStar.OrdSetProps

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.OrdSetProps

+ +
val fold: #a:eqtype -> #b:Type -> #f:cmp a -> (a -> b -> Tot b) -> s:ordset a f -> b
+          -> Tot b (decreases (size s))
+let rec fold (#a:eqtype) (#b:Type) #f g s x =
+  if s = empty then x
+  else
+    let Some e = choose s in
+    let a_rest = fold g (remove e s) x in
+    g e a_rest
+
+
let insert (#a:eqtype) (#f:cmp a) (x:a) (s:ordset a f) = union #a #f (singleton #a #f x) s
+
val union':#a:eqtype -> #f:cmp a -> ordset a f -> ordset a f -> Tot (ordset a f)
+let union' (#a:eqtype) #f s1 s2 = fold (fun e (s:ordset a f) -> insert e s) s1 s2
+
val union_lemma: #a:eqtype -> #f:cmp a -> s1:ordset a f -> s2:ordset a f
+                 -> Lemma (requires (True))
+                    (ensures (forall x. mem x (union s1 s2) = mem x (union' s1 s2)))
+                    (decreases (size s1))
+let rec union_lemma (#a:eqtype) #f s1 s2 =
+  if s1 = empty then ()
+  else
+    union_lemma (remove (Some?.v (choose s1)) s1) s2
+
val union_lemma': #a:eqtype -> #f:cmp a -> s1:ordset a f -> s2:ordset a f
+                  -> Lemma (requires (True))
+                     (ensures (union s1 s2 = union' s1 s2))
+let union_lemma' (#a:eqtype) #f s1 s2 =
+  union_lemma s1 s2;
+  eq_lemma (union s1 s2) (union' s1 s2)
+ diff --git a/docs/FStar.Order.html b/docs/FStar.Order.html index 7c6ecbf..966dad4 100644 --- a/docs/FStar.Order.html +++ b/docs/FStar.Order.html @@ -1,16 +1,61 @@ - - + + - - - - - + FStar.Order + -

module FStar.Order

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Order

+
type order = | Lt | Eq | Gt
+

Some derived checks

+
val ge : order -> bool
+let ge o = o <> Lt
+
val le : order -> bool
+let le o = o <> Gt
+
val ne : order -> bool
+let ne o = o <> Eq
+

Just for completeness and consistency...

+
val gt : order -> bool
+let gt o = o = Gt
+
val lt : order -> bool
+let lt o = o = Lt
+
val eq : order -> bool
+let eq o = o = Eq
+

Lexicographical combination, thunked to be lazy

+
val lex : order -> (unit -> order) -> order
+let lex o1 o2 =
+    match o1 with
+    | Lt -> Lt
+    | Eq -> o2 ()
+    | Gt -> Gt
+
val order_from_int : int -> order
+let order_from_int i =
+    if i < 0 then Lt
+    else if i = 0 then Eq
+    else Gt
+
val int_of_order : order -> int
+let int_of_order = function
+    | Lt -> (-1)
+    | Eq -> 0
+    | Gt -> 1
+
val compare_int : int -> int -> order
+let compare_int i j = order_from_int (i - j)
+
val compare_list : ('a -> 'a -> order) -> list 'a -> list 'a -> order
+let rec compare_list f l1 l2 =
+    match l1, l2 with
+    | [], [] -> Eq
+    | [], _ -> Lt
+    | _, [] -> Gt
+    | x::xs, y::ys -> lex (f x y) (fun () -> compare_list f xs ys)
+
val compare_option : ('a -> 'a -> order) -> option 'a -> option 'a -> order
+let compare_option f x y =
+    match x, y with
+    | None   , None   -> Eq
+    | None   , Some _ -> Lt
+    | Some _ , None   -> Gt
+    | Some x , Some y -> f x y
+ diff --git a/docs/FStar.PCM.html b/docs/FStar.PCM.html new file mode 100644 index 0000000..ac5db3a --- /dev/null +++ b/docs/FStar.PCM.html @@ -0,0 +1,248 @@ + + + + + FStar.PCM + + + +

+FStar.PCM

+

Copyright 2020 Microsoft Research

+

Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at

+
http://www.apache.org/licenses/LICENSE-2.0
+
+

Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License.

+
+

This module defines the partial commutative monoid (PCM) algebraic structure, as well as helper +predicates and functions to manipulate PCMs.

+
+

+Base definitions

+

+symrel

+

A symmetric relation

+
let symrel (a: Type u#a) = c:(a -> a -> prop) { (forall x y. c x y <==> c y x) }
+

+pcm'

+

pcm' is a magma, the base for the partial commutative monoid

+
noeq
+type pcm' (a:Type u#a) = {
+  composable: symrel a;
+  op: x:a -> y:a{composable x y} -> a;
+  one:a
+}
+

+lem_commutative

+

The type of a commutativity property

+
let lem_commutative (#a: Type u#a) (p:pcm' a) =
+  x:a ->
+  y:a{p.composable x y} ->
+    Lemma (p.op x y == p.op y x)
+

+lem_assoc_l

+

The type of a left-associativity property

+
let lem_assoc_l (#a: Type u#a) (p:pcm' a) =
+  x:a ->
+  y:a ->
+  z:a{p.composable y z /\ p.composable x (p.op y z)} ->
+  Lemma (p.composable x y /\
+         p.composable (p.op x y) z /\
+         p.op x (p.op y z) == p.op (p.op x y) z)
+

+lem_assoc_r

+

The type of a right-associativity property

+
let lem_assoc_r (#a: Type u#a) (p:pcm' a) =
+  x:a ->
+  y:a ->
+  z:a {p.composable x y /\
+       p.composable (p.op x y) z} ->
+  Lemma
+      (p.composable y z /\
+       p.composable x (p.op y z) /\
+       p.op x (p.op y z) == p.op (p.op x y) z)
+

+lem_is_unit

+

The type of the property characterizing the unit element of the monoid

+
let lem_is_unit (#a: Type u#a) (p:pcm' a) =
+  x:a ->
+  Lemma (p.composable x p.one /\
+         p.op x p.one == x)
+

+pcm

+

Main type describing partial commutative monoids

+
noeq
+type pcm (a:Type u#a) = {
+  p:pcm' a;
+  comm:lem_commutative p;
+  assoc: lem_assoc_l p;
+  assoc_r: lem_assoc_r p;
+  is_unit: lem_is_unit p;
+  refine: a -> prop
+}
+

+Derived predicates

+

+composable

+

Returns the composable predicate of the PCM

+
let composable (#a: Type u#a) (p:pcm a) (x y:a) = p.p.composable x y
+

+op

+

Calls the operation of the PCM

+
let op (#a: Type u#a) (p:pcm a) (x:a) (y:a{composable p x y}) = p.p.op x y
+

+compatible

+

Two elements x and y are compatible with respect to a PCM if their substraction +is well-defined, e.g. if there exists an element frame such that x * z = y

+
let compatible (#a: Type u#a) (pcm:pcm a) (x y:a) =
+  (exists (frame:a).
+    composable pcm x frame /\ op pcm frame x == y
+  )
+

+compatible_refl

+

Compatibility is reflexive

+
let compatible_refl
+  (#a: Type u#a) (pcm:pcm a) (x:a)
+    : Lemma (compatible pcm x x)
+  =
+  pcm.is_unit x;
+  pcm.comm x pcm.p.one;
+  assert (op pcm pcm.p.one x == x)
+

+compatible_trans

+

Compatibility is transitive

+
let compatible_trans
+  (#a: Type u#a) (pcm:pcm a) (x y z:a)
+  : Lemma (requires (compatible pcm x y /\ compatible pcm y z))
+          (ensures (compatible pcm x z))
+  = Classical.forall_intro_3 pcm.assoc
+

+compatible_elim

+

Helper function to get access to the existentially quantified frame between two compatible +elements

+
let compatible_elim
+  (#a: Type u#a) (pcm:pcm a) (x y:a)
+  (goal: Type)
+  (lemma: (frame: a{composable pcm x frame /\ op pcm frame x == y}) ->
+    Lemma (goal)
+  )
+    : Lemma (requires (compatible pcm x y)) (ensures (goal))
+  =
+  Classical.exists_elim
+    goal #a #(fun frame -> composable pcm x frame /\ op pcm frame x == y)
+    () (fun frame -> lemma frame)
+
let compatible_intro
+  (#a: Type u#a) (pcm:pcm a) (x y:a)
+  (frame: a)
+  : Lemma
+    (requires (composable pcm x frame /\ op pcm frame x == y))
+    (ensures (compatible pcm x y))
+  = ()
+

+joinable

+

Two elements are joinable when they can evolve to a common point.

+
let joinable #a (p:pcm a) (x y : a) : prop =
+  exists z. compatible p x z /\ compatible p y z
+
let frame_compatible #a (p:pcm a) (x:FStar.Ghost.erased a) (v y:a) =
+  (forall (frame:a). {:pattern (composable p x frame)}
+            composable p x frame /\
+            v == op p x frame ==>
+            composable p y frame /\
+            v == op p y frame)
+ +
type frame_preserving_upd (#a:Type u#a) (p:pcm a) (x y:a) =
+  v:a{
+    p.refine v /\
+    compatible p x v
+  } ->
+  v_new:a{
+    p.refine v_new /\
+    compatible p y v_new /\
+    (forall (frame:a{composable p x frame}).{:pattern composable p x frame}
+       composable p y frame /\
+       (op p x frame == v ==> op p y frame == v_new))}
+ +
let frame_preserving (#a: Type u#a) (pcm:pcm a) (x y: a) =
+    (forall frame. composable pcm frame x ==> composable pcm frame y) /\
+    (forall frame.{:pattern (composable pcm frame x)} composable pcm frame x ==> op pcm frame y == y)
+ +
let frame_preserving_val_to_fp_upd (#a:Type u#a) (p:pcm a)
+  (x:Ghost.erased a) (v:a{frame_preserving p x v /\ p.refine v})
+  : frame_preserving_upd p x v
+  = Classical.forall_intro (p.comm v);
+    fun _ -> v
+

+exclusive

+

The PCM p is exclusive to element x if the only element composable with x is p.one

+
let exclusive (#a:Type u#a) (p:pcm a) (x:a) =
+  forall (frame:a). composable p x frame ==> frame == p.p.one
+

+exclusive_is_frame_preserving

+

A mutation from x to p.one is frame preserving if p is exclusive to x

+
let exclusive_is_frame_preserving (#a: Type u#a) (p:pcm a) (x:a)
+  : Lemma (requires exclusive p x)
+          (ensures frame_preserving p x p.p.one)
+  = p.is_unit x;
+    p.is_unit p.p.one
+

Some sanity checks on the definition of frame preserving updates

+
let no_op_is_frame_preserving (#a:Type u#a) (p:pcm a)
+  (x:a)
+  : frame_preserving_upd p x x
+  = fun v -> v
+
let compose_frame_preserving_updates (#a:Type u#a) (p:pcm a)
+  (x y z:a)
+  (f:frame_preserving_upd p x y)
+  (g:frame_preserving_upd p y z)
+  : frame_preserving_upd p x z
+  = fun v -> g (f v)
+
let frame_preserving_subframe (#a:Type u#a) (p:pcm a) (x y:a)
+  (subframe:a{composable p x subframe /\ composable p y subframe})
+  (f:frame_preserving_upd p x y)
+  : frame_preserving_upd p (op p x subframe) (op p y subframe)
+  = fun v ->
+    compatible_elim p (op p x subframe) v (compatible p x v) (fun frame ->
+      p.comm x subframe;
+      p.assoc frame subframe x);
+    let w = f v in
+    let aux (frame: a{composable p (op p x subframe) frame}):
+      Lemma (composable p (op p y subframe) frame /\
+             (op p (op p x subframe) frame == v ==> op p (op p y subframe) frame == w))
+             [SMTPat (composable p (op p y subframe) frame)]
+    = p.assoc_r x subframe frame;
+      assert (composable p x (op p subframe frame));
+      assert (composable p y (op p subframe frame));
+      p.assoc y subframe frame
+    in
+    compatible_elim p (op p x subframe) v (compatible p (op p y subframe) w) (fun frame ->
+      aux frame;
+      p.comm frame (op p x subframe);
+      p.comm (op p y subframe) frame);
+    w
+ + + diff --git a/docs/FStar.Pervasives.Native.html b/docs/FStar.Pervasives.Native.html index 3b7ea5b..e837d30 100644 --- a/docs/FStar.Pervasives.Native.html +++ b/docs/FStar.Pervasives.Native.html @@ -1,16 +1,159 @@ - - + + - - - - - + FStar.Pervasives.Native + -

module FStar.Pervasives.Native

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Pervasives.Native

+

This is a file from the core library, dependencies must be explicit

+ +
+

This module is implicitly opened in the scope of all other modules.

+

It provides several basic types in F* that enjoy some special +status in extraction. For instance, the tuple type below is +compiled to OCaml's tuple type, rather than to a F*-defined +inductive type. See ulib/ml/FStar_Pervasives_Native.ml

+
+

+option

+

option a represents either Some a-value or a non-informative None.

+
type option (a: Type) =
+  | None : option a
+  | Some : v: a -> option a
+

+Tuples

+
+

Aside from special support in extraction, the tuple types have +special syntax in F*.

+

For instance, rather than tupleN a1 ... aN, +we usually write a1 & ... & aN or a1 * ... * aN.

+

The latter notation is more common for those coming to F* from +OCaml or F#. However, the * also clashes with the multiplication +operator on integers define in FStar.Mul. For this reason, we now +prefer to use the & notation, though there are still many uses +of * remaining.

+

Tuple values are introduced using as a1, ..., an, rather than +MktupleN a1 ... aN.

+

We define tuples up to a fixed arity of 14. We have considered +splitting this module into 14 different modules, one for each +tuple type rather than eagerly including 14-tuples in the +dependence graph of all programs.

+
+

+tuple2

+

Pairs: tuple2 a b is can be written either as a * b, for +notation compatible with OCaml's. Or, better, as a & b.

+
type tuple2 'a 'b = | Mktuple2 : _1: 'a -> _2: 'b -> tuple2 'a 'b
+

+fst

+

The fst and snd projections on pairs are very common

+
let fst (x: tuple2 'a 'b) : 'a = Mktuple2?._1 x
+let snd (x: tuple2 'a 'b) : 'b = Mktuple2?._2 x
+
type tuple3 'a 'b 'c = | Mktuple3 : _1: 'a -> _2: 'b -> _3: 'c -> tuple3 'a 'b 'c
+
type tuple4 'a 'b 'c 'd = | Mktuple4 : _1: 'a -> _2: 'b -> _3: 'c -> _4: 'd -> tuple4 'a 'b 'c 'd
+
type tuple5 'a 'b 'c 'd 'e =
+  | Mktuple5 : _1: 'a -> _2: 'b -> _3: 'c -> _4: 'd -> _5: 'e -> tuple5 'a 'b 'c 'd 'e
+
type tuple6 'a 'b 'c 'd 'e 'f =
+  | Mktuple6 : _1: 'a -> _2: 'b -> _3: 'c -> _4: 'd -> _5: 'e -> _6: 'f -> tuple6 'a 'b 'c 'd 'e 'f
+
type tuple7 'a 'b 'c 'd 'e 'f 'g =
+  | Mktuple7 : _1: 'a -> _2: 'b -> _3: 'c -> _4: 'd -> _5: 'e -> _6: 'f -> _7: 'g
+    -> tuple7 'a 'b 'c 'd 'e 'f 'g
+
type tuple8 'a 'b 'c 'd 'e 'f 'g 'h =
+  | Mktuple8 : _1: 'a -> _2: 'b -> _3: 'c -> _4: 'd -> _5: 'e -> _6: 'f -> _7: 'g -> _8: 'h
+    -> tuple8 'a 'b 'c 'd 'e 'f 'g 'h
+
type tuple9 'a 'b 'c 'd 'e 'f 'g 'h 'i =
+  | Mktuple9 :
+      _1: 'a ->
+      _2: 'b ->
+      _3: 'c ->
+      _4: 'd ->
+      _5: 'e ->
+      _6: 'f ->
+      _7: 'g ->
+      _8: 'h ->
+      _9: 'i
+    -> tuple9 'a 'b 'c 'd 'e 'f 'g 'h 'i
+
type tuple10 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j =
+  | Mktuple10 :
+      _1: 'a ->
+      _2: 'b ->
+      _3: 'c ->
+      _4: 'd ->
+      _5: 'e ->
+      _6: 'f ->
+      _7: 'g ->
+      _8: 'h ->
+      _9: 'i ->
+      _10: 'j
+    -> tuple10 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j
+
type tuple11 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k =
+  | Mktuple11 :
+      _1: 'a ->
+      _2: 'b ->
+      _3: 'c ->
+      _4: 'd ->
+      _5: 'e ->
+      _6: 'f ->
+      _7: 'g ->
+      _8: 'h ->
+      _9: 'i ->
+      _10: 'j ->
+      _11: 'k
+    -> tuple11 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k
+
type tuple12 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l =
+  | Mktuple12 :
+      _1: 'a ->
+      _2: 'b ->
+      _3: 'c ->
+      _4: 'd ->
+      _5: 'e ->
+      _6: 'f ->
+      _7: 'g ->
+      _8: 'h ->
+      _9: 'i ->
+      _10: 'j ->
+      _11: 'k ->
+      _12: 'l
+    -> tuple12 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l
+
type tuple13 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l 'm =
+  | Mktuple13 :
+      _1: 'a ->
+      _2: 'b ->
+      _3: 'c ->
+      _4: 'd ->
+      _5: 'e ->
+      _6: 'f ->
+      _7: 'g ->
+      _8: 'h ->
+      _9: 'i ->
+      _10: 'j ->
+      _11: 'k ->
+      _12: 'l ->
+      _13: 'm
+    -> tuple13 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l 'm
+
type tuple14 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l 'm 'n =
+  | Mktuple14 :
+      _1: 'a ->
+      _2: 'b ->
+      _3: 'c ->
+      _4: 'd ->
+      _5: 'e ->
+      _6: 'f ->
+      _7: 'g ->
+      _8: 'h ->
+      _9: 'i ->
+      _10: 'j ->
+      _11: 'k ->
+      _12: 'l ->
+      _13: 'm ->
+      _14: 'n
+    -> tuple14 'a 'b 'c 'd 'e 'f 'g 'h 'i 'j 'k 'l 'm 'n
+ diff --git a/docs/FStar.Pervasives.html b/docs/FStar.Pervasives.html index ddac107..edbdc42 100644 --- a/docs/FStar.Pervasives.html +++ b/docs/FStar.Pervasives.html @@ -1,123 +1,1034 @@ - - + + - - - - - - + FStar.Pervasives + -

module FStar.Pervasives

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((expect_failure (errs:list int)):unit):()
-

When attached a top-level definition, the typechecker will succeed * if and only if checking the definition results in an error. The * error number list is actually OPTIONAL. If present, it will be * checked that the definition raises exactly those errors in the * specified multiplicity, but order does not matter.

-
let ((expect_lax_failure (errs:list int)):unit):()
-

When --lax is present, we the previous attribute since some definitions * only fail when verification is turned on. With this attribute, one can ensure * that a definition fails while lax-checking too. Same semantics as above, * but lax mode will be turned on for the definition.

-
let (tcdecltime:unit):()
-

Print the time it took to typecheck a top-level definition

-
let (assume_strictly_positive:unit):()
- -
let (unifier_hint_injective:unit):()
+

+FStar.Pervasives

+

This is a file from the core library, dependencies must be explicit

-
let ((strict_on_arguments (x:list int)):unit):()
+
+

This module is implicitly opened in the scope of all other +modules.

+

It provides several basic definitions in F* that are common to +most programs. Broadly, these include:

-
let (erasable:unit):()
+
+

+remove_unused_type_parameters

+

remove_unused_type_parameters

+
val remove_unused_type_parameters : list int -> Tot unit
+

This attribute is used to decorate signatures in interfaces for +type abbreviations, indicating that the 0-based positional +parameters are unused in the definition and should be eliminated +for extraction.

+

This is important particularly for use with F# extraction, since +F# does not accept type abbreviations with unused type parameters.

+

See tests/bug-reports/RemoveUnusedTyparsIFace.A.fsti

+

+pattern

+

Values of type pattern are used to tag Lemmas with SMT +quantifier triggers

+
type pattern : Type0 = unit
+

+smt_pat

+

The concrete syntax SMTPat desugars to smt_pat

+
val smt_pat (#a: Type) (x: a) : Tot pattern
+

+smt_pat_or

+

The concrete syntax SMTPatOr desugars to smt_pat_or. This is +used to represent a disjunction of conjunctions of patterns.

+
val smt_pat_or (x: list (list pattern)) : Tot pattern
+

Note, the typing discipline and syntax of patterns is laxer than +it should be. Patterns like SMTPatOr SMTPatOr `...``` are +expressible, but unsupported by F*

+

TODO: We should tighten this up, perhaps just reusing the +attribute mechanism for patterns.

+

+Lemma

+

Lemma is a very widely used effect abbreviation.

+
effect Lemma (a: Type) (pre: Type) (post: (squash pre -> Type)) (pats: list pattern) =
+  Pure a pre (fun r -> post ())
+

It stands for a unit-returning Ghost computation, whose main +value is its logical payload in proving an implication between its +pre- and postcondition.

+

Lemma is desugared specially. The valid forms are:

+

Lemma (ensures post) +Lemma post SMTPat ... +Lemma (ensures post) SMTPat ... +Lemma (ensures post) (decreases d) +Lemma (ensures post) (decreases d) SMTPat ... +Lemma (requires pre) (ensures post) (decreases d) +Lemma (requires pre) (ensures post) SMTPat ... +Lemma (requires pre) (ensures post) (decreases d) SMTPat ...

+

and

+

Lemma post (== Lemma (ensures post))

+

the squash argument on the postcondition allows to assume the +precondition for the well-formedness of the postcondition.

+

+spinoff

+

In the default mode of operation, all proofs in a verification +condition are bundled into a single SMT query. Sub-terms marked +with the spinoff below are the exception: each of them is +spawned off into a separate SMT query

+
val spinoff (p: Type0) : Type0
+

+assert_spinoff

+

Logically equivalent to assert, but spins off separate query

+
val assert_spinoff (p: Type) : Pure unit (requires (spinoff (squash p))) (ensures (fun x -> p))
+

+id

+

The polymorphic identity function

+
unfold
+let id (#a: Type) (x: a) : a = x
+

+trivial_pure_post

+

Trivial postconditions for the PURE effect

+
unfold
+let trivial_pure_post (a: Type) : pure_post a = fun _ -> True
+

+ambient

+

Sometimes it is convenient to explicit introduce nullary symbols +into the ambient context, so that SMT can appeal to their definitions +even when they are no mentioned explicitly in the program, e.g., when +needed for triggers.

+
[@@ remove_unused_type_parameters [0; 1;]]
+val ambient (#a: Type) (x: a) : Type0
+

Use intro_ambient t for that. +See, e.g., LowStar.Monotonic.Buffer.fst and its usage there for loc_none

+

+intro_ambient

+

cf. ambient, above

+
val intro_ambient (#a: Type) (x: a) : Tot (squash (ambient x))
+
+

Controlling normalization

+
+

+normalize_term

+

In any invocation of the F* normalizer, every occurrence of +normalize_term e is reduced to the full normal for of e.

+
val normalize_term (#a: Type) (x: a) : Tot a
+

+normalize

+

In any invocation of the F* normalizer, every occurrence of +normalize e is reduced to the full normal for of e.

+
val normalize (a: Type0) : Type0
+

+norm_step

+

Value of norm_step are used to enable specific normalization +steps, controlling how the normalizer reduces terms.

+
val norm_step : Type0
+

+simplify

+

Logical simplification, e.g., P /\ True ~> P

+
val simplify : norm_step
+

+weak

+

Weak reduction: Do not reduce under binders

+
val weak : norm_step
+

+hnf

+

Head normal form

+
val hnf : norm_step
+

+primops

+

Reduce primitive operators, e.g., 1 + 1 ~> 2

+
val primops : norm_step
+

+delta

+

Unfold all non-recursive definitions

+
val delta : norm_step
+

+zeta

+

Unroll recursive calls

+
val zeta : norm_step
+

Note: Since F*'s termination check is semantic rather than +syntactically structural, recursive calls in inconsistent contexts, +or recursive evaluation of open terms can diverge.

+

When asking for the zeta step, F* implements a heuristic to +disable zeta when reducing terms beneath a blocked match. This +helps prevent some trivial looping behavior. However, it also +means that with zeta alone, your term may not reduce as much as +you might want. See zeta_full for that.

+

+zeta_full

+

Unroll recursive calls

+
val zeta_full : norm_step
+

Unlike zeta, zeta_full has no looping prevention +heuristics. F* will try to unroll recursive functions as much as +it can, potentially looping. Use with care.

+

Note, zeta_full implies zeta. +See tests/micro-benchmarks/ReduceRecUnderMatch.fst for an example.

+

+iota

+

Reduce case analysis (i.e., match)

+
val iota : norm_step
+

+nbe

+

Use normalization-by-evaluation, instead of interpretation (experimental)

+
val nbe : norm_step
+

+reify_

+

Reify effectful definitions into their representations

+
val reify_ : norm_step
+

+delta_only

+

Unlike delta, unfold definitions for only the names in the given +list. Each string is a fully qualified name like A.M.f

+
val delta_only (s: list string) : Tot norm_step
+

+delta_fully

+

Unfold definitions for only the names in the given list, but +unfold each definition encountered after unfolding as well.

+
val delta_fully (s: list string) : Tot norm_step
+

For example, given

+
let f0 = 0
+let f1 = f0 + 1
+

norm delta_only %f1 f1will reduce tof0 + 1. norm delta_fully ``%f1`` f1 will reduce to 0 + 1.

+

Each string is a fully qualified name like A.M.f, typically +constructed using a quotation, as in the example above.

+

+delta_attr

+

Rather than mention a symbol to unfold by name, it can be +convenient to tag a collection of related symbols with a common +attribute and then to ask the normalizer to reduce them all.

+
val delta_attr (s: list string) : Tot norm_step
+

For example, given:

+
irreducible let my_attr = ()
+
+`@@my_attr`
+let f0 = 0
+
+`@@my_attr`
+let f1 = f0 + 1
+

FStarnorm [delta_attr [`%my_attr]] f1

+

will reduce to 0 + 1.

+

+delta_qualifier

+

For example, given:

+
val delta_qualifier (s: list string) : Tot norm_step
+
unfold
+let f0 = 0
+
+inline_for_extraction
+let f1 = f0 + 1
+
+

FStarnorm [delta_qualifier ["unfold"; "inline_for_extraction"]] f1

+

will reduce to 0 + 1.

+

+unmeta

+

This step removes the some internal meta nodes during normalization

+
val unmeta : norm_step
+

In most cases you shouldn't need to use this step explicitly

+

+norm

+

norm s e requests normalization of e with the reduction steps +s.

+
val norm (s: list norm_step) (#a: Type) (x: a) : Tot a
+

+assert_norm

+

assert_norm p reduces p as much as possible and then asks the +SMT solver to prove the reduct, concluding p

+
val assert_norm (p: Type) : Pure unit (requires (normalize p)) (ensures (fun _ -> p))
+

+normalize_term_spec

+

Sometimes it is convenient to introduce an equation between a term +and its normal form in the context.

+
val normalize_term_spec (#a: Type) (x: a) : Lemma (normalize_term #a x == x)
+

+normalize_spec

+

Like normalize_term_spec, but specialized to Type0

+
val normalize_spec (a: Type0) : Lemma (normalize a == a)
+

+norm_spec

+

Like normalize_term_spec, but with specific normalization steps

+
val norm_spec (s: list norm_step) (#a: Type) (x: a) : Lemma (norm s #a x == x)
+

+reveal_opaque

+

Use the following to expose an "opaque_to_smt" definition to the +solver as: reveal_opaque (%defn) defn`

+
let reveal_opaque (s: string) = norm_spec [delta_only [s]]
+

Wrappers over pure wp combinators that return a pure_wp type +(with monotonicity refinement)

+
unfold
+let pure_return (a:Type) (x:a) : pure_wp a =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_return0 a x
+
unfold
+let pure_bind_wp (a b:Type) (wp1:pure_wp a) (wp2:(a -> Tot (pure_wp b))) : Tot (pure_wp b) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_bind_wp0 a b wp1 wp2
+
unfold
+let pure_if_then_else (a p:Type) (wp_then wp_else:pure_wp a) : Tot (pure_wp a) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_if_then_else0 a p wp_then wp_else
+
unfold
+let pure_ite_wp (a:Type) (wp:pure_wp a) : Tot (pure_wp a) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_ite_wp0 a wp
+
unfold
+let pure_close_wp (a b:Type) (wp:b -> Tot (pure_wp a)) : Tot (pure_wp a) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_close_wp0 a b wp
+
unfold
+let pure_null_wp (a:Type) : Tot (pure_wp a) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_null_wp0 a
+
[@@ "opaque_to_smt"]
+unfold
+let pure_assert_wp (p:Type) : Tot (pure_wp unit) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_assert_wp0 p
+
[@@ "opaque_to_smt"]
+unfold
+let pure_assume_wp (p:Type) : Tot (pure_wp unit) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  pure_assume_wp0 p
+
+

The DIV effect for divergent computations

+

The wp-calculus for DIV is same as that of PURE

+
+

+DIV

+

The effect of divergence: from a specificational perspective it is +identical to PURE, however the specs are given a partial +correctness interpretation. Computations with the DIV effect may +not terminate.

+
new_effect {
+  DIV : a:Type -> wp:pure_wp a -> Effect
+  with
+    return_wp = pure_return
+  ; bind_wp = pure_bind_wp
+  ; if_then_else = pure_if_then_else
+  ; ite_wp = pure_ite_wp
+  ; stronger = pure_stronger
+  ; close_wp = pure_close_wp
+  ; trivial = pure_trivial
+}
+

PURE computations can be silently promoted for use in a DIV context

+
sub_effect PURE ~> DIV { lift_wp = purewp_id }
+

+div_hoare_to_wp

+

Div is the Hoare-style counterpart of the wp-indexed DIV

+
unfold
+let div_hoare_to_wp (#a:Type) (#pre:pure_pre) (post:pure_post' a pre) : Tot (pure_wp a) =
+  reveal_opaque (`%pure_wp_monotonic) pure_wp_monotonic;
+  fun (p:pure_post a) -> pre /\ (forall a. post a ==> p a)
+
effect Div (a: Type) (pre: pure_pre) (post: pure_post' a pre) =
+  DIV a (div_hoare_to_wp post)
+

+Dv

+

Dv is the instance of DIV with trivial pre- and postconditions

+
effect Dv (a: Type) = DIV a (pure_null_wp a)
+

+EXT

+

We use the EXT effect to underspecify external system calls +as being impure but having no observable effect on the state

+
effect EXT (a: Type) = Dv a
+
+

The STATE_h effect template for stateful computations, generic +in the type of the state.

+

Note, STATE_h is itself not a computation type in F*, since it +is parameterized by the type of heap. However, instantiations of +STATE_h with specific types of the heap are computation +types. See, e.g., FStar.ST for such instantiations.

+

Weakest preconditions for stateful computations transform +st_post_h postconditions to st_pre_h preconditions. Both are +parametric in the type of the state, here denoted by the +heap:Type variable.

+
+

+st_pre_h

+

Preconditions are predicates on the heap

+
let st_pre_h (heap: Type) = heap -> GTot Type0
+

+st_post_h'

+

Postconditions relate a-typed results to the final heap, here +refined by some pure proposition pre, typically instantiated to +the precondition applied to the initial heap

+
let st_post_h' (heap a pre: Type) = a -> _: heap{pre} -> GTot Type0
+

+st_post_h

+

Postconditions without refinements

+
let st_post_h (heap a: Type) = st_post_h' heap a True
+

+st_wp_h

+

The type of the main WP-transformer for stateful comptuations

+
let st_wp_h (heap a: Type) = st_post_h heap a -> Tot (st_pre_h heap)
+

+st_return

+

Returning a value does not transform the state

+
unfold
+let st_return (heap a: Type) (x: a) (p: st_post_h heap a) = p x
+

+st_bind_wp

+

Sequential composition of stateful WPs

+
unfold
+let st_bind_wp
+      (heap: Type)
+      (a b: Type)
+      (wp1: st_wp_h heap a)
+      (wp2: (a -> GTot (st_wp_h heap b)))
+      (p: st_post_h heap b)
+      (h0: heap)
+     = wp1 (fun a h1 -> wp2 a p h1) h0
+

+st_if_then_else

+

Branching for stateful WPs

+
unfold
+let st_if_then_else
+      (heap a p: Type)
+      (wp_then wp_else: st_wp_h heap a)
+      (post: st_post_h heap a)
+      (h0: heap)
+     = wp_then post h0 /\ (~p ==> wp_else post h0)
+

+st_ite_wp

+

As with PURE the wp combinator names the postcondition as +k to avoid duplicating it.

+
unfold
+let st_ite_wp (heap a: Type) (wp: st_wp_h heap a) (post: st_post_h heap a) (h0: heap) =
+  forall (k: st_post_h heap a).
+    (forall (x: a) (h: heap). {:pattern (guard_free (k x h))} post x h ==> k x h) ==> wp k h0
+

+st_stronger

+

Subsumption for stateful WPs

+
unfold
+let st_stronger (heap a: Type) (wp1 wp2: st_wp_h heap a) =
+  (forall (p: st_post_h heap a) (h: heap). wp1 p h ==> wp2 p h)
+

+st_close_wp

+

Closing the scope of a binder within a stateful WP

+
unfold
+let st_close_wp (heap a b: Type) (wp: (b -> GTot (st_wp_h heap a))) (p: st_post_h heap a) (h: heap) =
+  (forall (b: b). wp b p h)
+

+st_trivial

+

Applying a stateful WP to a trivial postcondition

+
unfold
+let st_trivial (heap a: Type) (wp: st_wp_h heap a) = (forall h0. wp (fun r h1 -> True) h0)
+

+STATE_h

+

Introducing a new effect template STATE_h

+
new_effect {
+  STATE_h (heap: Type) : result: Type -> wp: st_wp_h heap result -> Effect
+  with
+    return_wp = st_return heap
+  ; bind_wp = st_bind_wp heap
+  ; if_then_else = st_if_then_else heap
+  ; ite_wp = st_ite_wp heap
+  ; stronger = st_stronger heap
+  ; close_wp = st_close_wp heap
+  ; trivial = st_trivial heap
+}
+
+

The EXN effect for computations that may raise exceptions or +fatal errors

+

Weakest preconditions for stateful computations transform +ex_post postconditions (predicates on results) to ex_pre +precondition propositions.

+
+

+result

+

Normal results are represented using V x. +Handleable exceptions are represented E e. +Fatal errors are Err msg.

+
noeq
+type result (a: Type) =
+  | V : v: a -> result a
+  | E : e: exn -> result a
+  | Err : msg: string -> result a
+

+ex_pre

+

Exceptional preconditions are just propositions

+
let ex_pre = Type0
+

+ex_post'

+

Postconditions on results refined by a precondition

+
let ex_post' (a pre: Type) = _: result a {pre} -> GTot Type0
+

+ex_post

+

Postconditions on results

+
let ex_post (a: Type) = ex_post' a True
+

+ex_wp

+

Exceptions WP-predicate transformers

+
let ex_wp (a: Type) = ex_post a -> GTot ex_pre
+

+ex_return

+

Returning a value x normally promotes it to the V x result

+
unfold
+let ex_return (a: Type) (x: a) (p: ex_post a) : GTot Type0 = p (V x)
+

+ex_bind_wp

+

Sequential composition of exception-raising code requires case analysing +the result of the first computation before "running" the second one

+
unfold
+let ex_bind_wp (a b: Type) (wp1: ex_wp a) (wp2: (a -> GTot (ex_wp b))) (p: ex_post b)
+    : GTot Type0 =
+  forall (k: ex_post b).
+    (forall (rb: result b). {:pattern (guard_free (k rb))} p rb ==> k rb) ==>
+    (wp1 (function
+          | V ra1 -> wp2 ra1 k
+          | E e -> k (E e)
+          | Err m -> k (Err m)))
+

+ex_if_then_else

+

As for other effects, branching in ex_wp appears in two forms. +First, a simple case analysis on p

+
unfold
+let ex_if_then_else (a p: Type) (wp_then wp_else: ex_wp a) (post: ex_post a) =
+  wp_then post /\ (~p ==> wp_else post)
+

+ex_ite_wp

+

Naming continuations for use with branching

+
unfold
+let ex_ite_wp (a: Type) (wp: ex_wp a) (post: ex_post a) =
+  forall (k: ex_post a).
+    (forall (rb: result a). {:pattern (guard_free (k rb))} post rb ==> k rb) ==> wp k
+

+ex_stronger

+

Subsumption for exceptional WPs

+
unfold
+let ex_stronger (a: Type) (wp1 wp2: ex_wp a) = (forall (p: ex_post a). wp1 p ==> wp2 p)
+

+ex_close_wp

+

Closing the scope of a binder for exceptional WPs

+
unfold
+let ex_close_wp (a b: Type) (wp: (b -> GTot (ex_wp a))) (p: ex_post a) = (forall (b: b). wp b p)
+

+ex_trivial

+

Applying a computation with a trivial poscondition

+
unfold
+let ex_trivial (a: Type) (wp: ex_wp a) = wp (fun r -> True)
+

+EXN

+

Introduce a new effect for EXN

+
new_effect {
+  EXN : result: Type -> wp: ex_wp result -> Effect
+  with
+    return_wp = ex_return
+  ; bind_wp = ex_bind_wp
+  ; if_then_else = ex_if_then_else
+  ; ite_wp = ex_ite_wp
+  ; stronger = ex_stronger
+  ; close_wp = ex_close_wp
+  ; trivial = ex_trivial
+}
+

+Exn

+

A Hoare-style abbreviation for EXN

+
effect Exn (a: Type) (pre: ex_pre) (post: ex_post' a pre) =
+  EXN a (fun (p: ex_post a) -> pre /\ (forall (r: result a). post r ==> p r))
+

+lift_div_exn

+

We include divergence in exceptions.

+
unfold
+let lift_div_exn (a: Type) (wp: pure_wp a) (p: ex_post a) = wp (fun a -> p (V a))
+sub_effect DIV ~> EXN { lift_wp = lift_div_exn }
+

NOTE: BE WARNED, CODE IN THE EXN EFFECT IS ONLY CHECKED FOR +PARTIAL CORRECTNESS

+

+Ex

+

A variant of Exn with trivial pre- and postconditions

+
effect Ex (a: Type) = Exn a True (fun v -> True)
+
+

The ALL_h effect template for computations that may diverge, +raise exceptions or fatal errors, and uses a generic state.

+

Note, this effect is poorly named, particularly as F* has since +gained many more user-defined effect. We no longer have an effect +that includes all others.

+

We might rename this in the future to something like StExnDiv_h.

+

We layer state on top of exceptions, meaning that raising an +exception does not discard the state.

+

As with STATE_h, ALL_h is not a computation type, though its +instantiation with a specific type of heap (in FStar.All) is.

+
+

+all_pre_h

+

all_pre_h is a predicate on the initial state

+
let all_pre_h (h: Type) = h -> GTot Type0
+

+all_post_h'

+

Postconditions relate results to final heaps refined by a precondition

+
let all_post_h' (h a pre: Type) = result a -> _: h{pre} -> GTot Type0
+

+all_post_h

+

A variant of all_post_h' without the precondition refinement

+
let all_post_h (h a: Type) = all_post_h' h a True
+

+all_wp_h

+

WP predicate transformers for the All_h effect template

+
let all_wp_h (h a: Type) = all_post_h h a -> Tot (all_pre_h h)
+

+all_return

+

Returning a value x normally promotes it to the V x result +without touching the heap

+
unfold
+let all_return (heap a: Type) (x: a) (p: all_post_h heap a) = p (V x)
+

+all_bind_wp

+

Sequential composition for ALL_h is like EXN: case analysis of +the exceptional result before "running" the continuation

+
unfold
+let all_bind_wp
+      (heap: Type)
+      (a b: Type)
+      (wp1: all_wp_h heap a)
+      (wp2: (a -> GTot (all_wp_h heap b)))
+      (p: all_post_h heap b)
+      (h0: heap)
+    : GTot Type0 =
+  wp1 (fun ra h1 ->
+        (match ra with
+          | V v -> wp2 v p h1
+          | E e -> p (E e) h1
+          | Err msg -> p (Err msg) h1))
+    h0
+

+all_if_then_else

+

Case analysis in ALL_h

+
unfold
+let all_if_then_else
+      (heap a p: Type)
+      (wp_then wp_else: all_wp_h heap a)
+      (post: all_post_h heap a)
+      (h0: heap)
+     = wp_then post h0 /\ (~p ==> wp_else post h0)
+

+all_ite_wp

+

Naming postcondition for better sharing in ALL_h

+
unfold
+let all_ite_wp (heap a: Type) (wp: all_wp_h heap a) (post: all_post_h heap a) (h0: heap) =
+  forall (k: all_post_h heap a).
+    (forall (x: result a) (h: heap). {:pattern (guard_free (k x h))} post x h ==> k x h) ==> wp k h0
+

+all_stronger

+

Subsumption in ALL_h

+
unfold
+let all_stronger (heap a: Type) (wp1 wp2: all_wp_h heap a) =
+  (forall (p: all_post_h heap a) (h: heap). wp1 p h ==> wp2 p h)
+

+all_close_wp

+

Closing a binder in the scope of an ALL_h wp

+
unfold
+let all_close_wp
+      (heap a b: Type)
+      (wp: (b -> GTot (all_wp_h heap a)))
+      (p: all_post_h heap a)
+      (h: heap)
+     = (forall (b: b). wp b p h)
+

+all_trivial

+

Applying an ALL_h wp to a trivial postcondition

+
unfold
+let all_trivial (heap a: Type) (wp: all_wp_h heap a) = (forall (h0: heap). wp (fun r h1 -> True) h0)
+

+ALL_h

+

Introducing the ALL_h effect template

+
new_effect {
+  ALL_h (heap: Type) : a: Type -> wp: all_wp_h heap a -> Effect
+  with
+    return_wp = all_return heap
+  ; bind_wp = all_bind_wp heap
+  ; if_then_else = all_if_then_else heap
+  ; ite_wp = all_ite_wp heap
+  ; stronger = all_stronger heap
+  ; close_wp = all_close_wp heap
+  ; trivial = all_trivial heap
+}
+

+inversion

+

Controlling inversions of inductive type

+
[@@ remove_unused_type_parameters [0]]
+val inversion (a: Type) : Type0
+

Given a value of an inductive type v:t, where t = A | B, the SMT +solver can only prove that v=A \/ v=B by inverting t. This +inversion is controlled by the ifuel setting, which usually limits +the recursion depth of the number of such inversions that the solver +can perform.

+

The inversion predicate below is a way to circumvent the +ifuel-based restrictions on inversion depth. In particular, if the +inversion t is available in the SMT solver's context, it is free to +invert t infinitely, regardless of the ifuel setting.

+

Be careful using this, since it explicitly subverts the ifuel +setting. If used unwisely, this can lead to very poor SMT solver +performance.

+

+allow_inversion

+

To introduce inversion t in the SMT solver's context, call +allow_inverson t.

+
val allow_inversion (a: Type) : Pure unit (requires True) (ensures (fun x -> inversion a))
+

+invertOption

+

Since the option type is so common, we always allow inverting +options, regardless of ifuel

+
val invertOption (a: Type)
+    : Lemma (requires True) (ensures (forall (x: option a). None? x \/ Some? x)) [SMTPat (option a)]
+

+either

+

Values of type a or type b

+
type either a b =
+  | Inl : v: a -> either a b
+  | Inr : v: b -> either a b
+

+dfst

+

Projections for the components of a dependent pair

+
let dfst (#a: Type) (#b: a -> GTot Type) (t: dtuple2 a b)
+    : Tot a
+  = Mkdtuple2?._1 t
+
let dsnd (#a: Type) (#b: a -> GTot Type) (t: dtuple2 a b)
+    : Tot (b  (Mkdtuple2?._1 t))
+  = Mkdtuple2?._2 t
+

+dtuple3

+

Dependent triples, with sugar x:a & y:b x & c x y

+
unopteq
+type dtuple3 (a: Type) (b: (a -> GTot Type)) (c: (x: a -> b x -> GTot Type)) =
+  | Mkdtuple3 : _1: a -> _2: b _1 -> _3: c _1 _2 -> dtuple3 a b c
+

+dtuple4

+

Dependent quadruples, with sugar x:a & y:b x & z:c x y & d x y z

+
unopteq
+type dtuple4
+  (a: Type) (b: (x: a -> GTot Type)) (c: (x: a -> b x -> GTot Type))
+  (d: (x: a -> y: b x -> z: c x y -> GTot Type))
+  = | Mkdtuple4 : _1: a -> _2: b _1 -> _3: c _1 _2 -> _4: d _1 _2 _3 -> dtuple4 a b c d
+

+ignore

+

Explicitly discarding a value

+
let ignore (#a: Type) (x: a) : Tot unit = ()
+

+false_elim

+

In a context where false is provable, you can prove that any +type a is inhabited.

+
val false_elim (#a: Type) (u: unit{False}) : Tot a
+

There are many proofs of this fact in F*. Here, in the implementation, we build an +infinitely looping function, since the termination check succeeds +in a False context.

+
+

Attributes:

+

An attribute is any F* term.

+

Attributes are desugared and checked for being well-scoped. But, +they are not type-checked.

+

It is associated with a definition using the @@attribute +notation, just preceding the definition.

+
+

+__internal_ocaml_attributes

+

We collect several internal ocaml attributes into a single +inductive type.

+
type __internal_ocaml_attributes =
+  | PpxDerivingShow
+  | PpxDerivingShowConstant of string (* Generate [@@@ deriving show ] on the resulting OCaml type *)
+  | PpxDerivingYoJson (* Similar, but for constant printers. *)
+  | CInline (* Generate [@@@ deriving yojson ] on the resulting OCaml type *)
+

This may be unnecessary. In the future, we are likely to flatten +this definition into several definitions of abstract top-level +names.

+

An example:

+
`@@ CInline ` let f x = UInt32.(x +%^ 1)
+

is extracted to C by KReMLin to a C definition tagged with the +inline qualifier.

+

KreMLin-only: generates a C "inline" attribute on the resulting +* function declaration. +KreMLin-only: forces KreMLin to inline the function at call-site; this is +* deprecated and the recommended way is now to use F*'s +* inline_for_extraction, which now also works for stateful functions. +KreMLin-only: instructs KreMLin to heap-allocate any value of this +* data-type; this requires running with a conservative GC as the +* allocations are not freed. +KreMLin-only: attach a comment to the declaration. Note that using F*-doc +* syntax automatically fills in this attribute. +KreMLin-only: verbatim C code to be prepended to the declaration. +* Multiple attributes are valid and accumulate, separated by newlines. +KreMLin-only: indicates that the parameter with that name is to be marked +* as C const. This will be checked by the C compiler, not by KreMLin or F*. +* +* This is deprecated and doesn't work as intended. Use +* LowStar.ConstBuffer.fst instead! +KreMLin-only: for types that compile to struct types (records and +* inductives), indicate that the header file should only contain a forward +* declaration, which in turn forces the client to only ever use this type +* through a pointer. +KreMLin-only: for a top-level let v = e, compile as a macro

+
| Substitute
+| Gc
+| Comment of string
+| CPrologue of string
+| CEpilogue of string
+| CConst of string (* Ibid. *)
+| CCConv of string
+| CAbstractStruct (* A calling convention for C, one of stdcall, cdecl, fastcall *)
+| CIfDef
+| CMacro (* KreMLin-only: on a given `val foo`, compile if foo with #ifdef. *)
+

+inline_let

+

The inline_let attribute on a local let-binding, instructs the +extraction pipeline to inline the definition. This may be both to +avoid generating unnecessary intermediate variables, and also to +enable further partial evaluation. Note, use this with care, since +inlining all lets can lead to an exponential blowup in code +size.

+
val inline_let : unit
+

+rename_let

+

The rename_let attribute support a form of metaprogramming for +the names of let-bound variables used in extracted code.

+
val rename_let (new_name: string) : Tot unit
+

This is useful, particularly in conjunction with partial +evaluation, to ensure that names reflect their usage context.

+

See tests/micro-benchmarks/Renaming*.fst

+

+plugin

+

The plugin attribute is used in conjunction with native +compilation of F* components, accelerating their reduction +relative to the default strategy of just interpreting them.

+
val plugin (x: int) : Tot unit
+

See examples/native_tactics for several examples.

+

+tcnorm

+

An attribute to mark things that the typechecker should first +elaborate and typecheck, but unfold before verification.

+
val tcnorm : unit
+

+must_erase_for_extraction

+

We erase all ghost functions and unit-returning pure functions to +() at extraction. This creates a small issue with abstract +types. Consider a module that defines an abstract type t whose +(internal) definition is unit and also defines f: int -> t. f +would be erased to be just () inside the module, while the +client calls to f would not, since t is abstract. To get +around this, when extracting interfaces, if we encounter an +abstract type, we tag it with this attribute, so that +extraction can treat it specially.

+
val must_erase_for_extraction : unit
+

Note, since the use of cross-module inlining (the --cmi option), +this attribute is no longer necessary. We retain it for legacy, +but will remove it in the future.

+

+dm4f_bind_range

+

This attribute is used with the Dijkstra Monads for Free +construction to track position information in generated VCs

+
val dm4f_bind_range : unit
+

+expect_failure

+

When attached a top-level definition, the typechecker will succeed +if and only if checking the definition results in an error. The +error number list is actually OPTIONAL. If present, it will be +checked that the definition raises exactly those errors in the +specified multiplicity, but order does not matter.

+
val expect_failure (errs: list int) : Tot unit
+

+expect_lax_failure

+

When --lax is present, with the previous attribute since some +definitions only fail when verification is turned on. With this +attribute, one can ensure that a definition fails while lax-checking +too. Same semantics as above, but lax mode will be turned on for the +definition.

+
val expect_lax_failure (errs: list int) : Tot unit
+

+tcdecltime

+

Print the time it took to typecheck a top-level definition

+
val tcdecltime : unit
+

+assume_strictly_positive

+

THIS ATTRIBUTE IS AN ESCAPE HATCH AND CAN BREAK SOUNDNESS

+
val assume_strictly_positive : unit
+

USE WITH CARE

+

The positivity check for inductive types stops at abstraction +boundaries. This results in spurious errors about positivity, +e.g., when defining types like type t = ref (option t) By adding +this attribute to a declaration of a top-level name positivity +checks on applications of that name are admitted. See, for +instance, FStar.Monotonic.Heap.mref We plan to decorate binders of +abstract types with polarities to allow us to check positivity +across abstraction boundaries and will eventually remove this +attribute.

+

+unifier_hint_injective

+

This attribute is to be used as a hint for the unifier. A +function-typed symbol t marked with this attribute will be treated +as being injective in all its arguments by the unifier. That is, +given a problem t a1..an =?= t b1..bn the unifier will solve it by +proving ai =?= bi for all i, without trying to unfold the +definition of t.

+
val unifier_hint_injective : unit
+

+strict_on_arguments

+

This attribute is used to control the evaluation order +and unfolding strategy for certain definitions.

+
val strict_on_arguments (x: list int) : Tot unit
+

In particular, given +FStar `@@(strict_on_arguments `1;2`)` let f x0 (x1:list x0) (x1:option x0) = e

+

An application f e0 e1 e2 is reduced by the normalizer by:

+
1. evaluating `e0 ~>* v0, e1 ~>* v1, e2 ~>* v2`
+
+2 a.
+   If, according to the positional arguments `1;2`,
+   if v1 and v2 have constant head symbols
+         (e.g., v1 = Cons _ _ _, and v2 = None _)
+  then `f` is unfolded to `e` and reduced as
+    ```FStare[v0/x0][v1/x1][v2/x2]```
+
+2 b.
+
+ Otherwise, `f` is not unfolded and the term is `f e0 e1 e2`
+ reduces to `f v0 v1 v2`.
+
+

+resolve_implicits

+
val resolve_implicits : unit
+

+erasable

+

This attribute can be added to an inductive type definition, +indicating that it should be erased on extraction to unit.

+
val erasable : unit
+

However, any pattern matching on the inductive type results +in a Ghost effect, ensuring that computationally relevant +code cannot rely on the values of the erasable type.

+

See tests/micro-benchmarks/Erasable.fst, for examples. Also +see https://github.com/FStarLang/FStar/issues/1844

+

+allow_informative_binders

+

THIS ATTRIBUTE CAN BREAK EXTRACTION SOUNDNESS, USE WITH CARE

+
val allow_informative_binders : unit
+

Combinators for reifiable layered effects must have binders with +non-informative types, since at extraction time, those binders are +substituted with (). +This attribute can be added to a layered effect definition to skip this +check, i.e. adding it will allow informative binder types, but then +the code should not be extracted

+

+commute_nested_matches

+

commute_nested_matches +This attribute can be used to decorate an inductive type t

+
val commute_nested_matches : unit
+

During normalization, if reduction is blocked on matching the +constructors of t in the following sense:

+

[ +match (match e0 with | P1 -> e1 | ... | Pn -> en) with +| Q1 -> f1 ... | Qm -> fm +]

+

i.e., the outer match is stuck due to the inner match on e0 +being stuck, and if the head constructor the outer Qi patterns +are the constructors of the decorated inductive type t, then, +this is reduced to

+

[ +match e0 with +| P1 -> (match e1 with | Q1 -> f1 ... | Qm -> fm) +| ... +| Pn -> (match en with | Q1 -> f1 ... | Qm -> fm) +]

+

This is sometimes useful when partially evaluating code before +extraction, particularly when aiming to obtain first-order code +for KReMLin. However, this attribute should be used with care, +since if after the rewriting the inner matches do not reduce, then +this can cause an explosion in code size.

+

See tests/micro-benchmarks/CommuteNestedMatches.fst +and examples/layeredeffects/LowParseWriters.fsti

+

+noextract_to

+

This attribute controls extraction: it can be used to disable +extraction of a given top-level definition into a specific backend, +such as "OCaml". If any extracted code must call into an erased +function, an error will be raised (code 340).

+
val noextract_to (backend:string) : Tot unit
+

+normalize_for_extraction

+

This attribute decorates a let binding, e.g.,

+
val normalize_for_extraction (steps:list norm_step) : Tot unit
+

@@normalize_for_extraction steps +let f = e

+

The effect is that prior to extraction, F* will first reduce e +using the normalization steps, and then proceed to extract it as +usual.

+

Almost the same behavior can be achieved by using a +postprocess_for_extraction_with t attribute, which runs tactic +t on the goal e == ?u and extracts the solution to ?u in +place of e. However, using a tactic to postprocess a term is +more general than needed for some cases.

+

In particular, if we intend to only normalize e before +extraction (rather than applying some other form of equational +reasoning), then using normalize_for_extraction can be more +efficient, for the following reason:

+

Since we are reducing e just before extraction, F* can enable an +otherwise non-user-facing normalization feature that allows all +arguments marked @@@erasable to be erased to ()---these terms +will anyway be extracted to () so erasing them during +normalization is a useful optimization.

+

+ite_soundness_by

+

A layered effect definition may optionally be annoated with +(ite_soundness_by t) attribute, where t is another attribute +When so, the implicits and the smt guard generated when +checking the soundness of the if-then-else combinator, are +dispatched to the tactic in scope that has the t attribute (in addition +to the resolve_implicits attribute as usual)

+
val ite_soundness_by : unit
+

See examples/layeredeffects/IteSoundess.fst for a few examples

+

+strictly_positive

+

A binder in a definition/declaration may optionally be annotated as strictly_positive +When the let definition is used in a data constructor type in an inductive +definition, this annotation is used to check the positivity of the inductive

+
val strictly_positive : unit
+

Further F* checks that the binder is actually positive in the let definition

+

See tests/micro-benchmarks/Positivity.fst and NegativeTests.Positivity.fst for a few examples

+

+singleton

+

Pure and ghost inner let bindings are now always inlined during +the wp computation, if: the return type is not unit and the head +symbol is not marked irreducible.

+
val singleton (#a: Type) (x: a) : Tot (y: a{y == x})
+

To circumvent this behavior, singleton can be used. +See the example usage in ulib/FStar.Algebra.Monoid.fst.

+

+with_type

+

with_type t e is just an identity function, but it receives +special treatment in the SMT encoding, where in addition to being +an identity function, we have an SMT axiom: +forall t e.{:pattern (with_type t e)} has_type (with_type t e) t

+
val with_type (#t: Type) (e: t) : Tot t
+

+eqtype_as_type

+

A weakening coercion from eqtype to Type.

+
unfold let eqtype_as_type (a:eqtype) : Type = a
+

One of its uses is in types of layered effect combinators that +are subjected to stricter typing discipline (no subtyping)

+ diff --git a/docs/FStar.PredicateExtensionality.html b/docs/FStar.PredicateExtensionality.html index c558cdc..0aa4e0e 100644 --- a/docs/FStar.PredicateExtensionality.html +++ b/docs/FStar.PredicateExtensionality.html @@ -1,16 +1,27 @@ - - + + - - - - - + FStar.PredicateExtensionality + -

module FStar.PredicateExtensionality

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.PredicateExtensionality

+ +
let predicate (a:Type) = a -> Tot prop
+
let peq (#a:Type) (p1:predicate a) (p2:predicate a) =
+  forall x. (p1 x <==> p2 x)
+
let predicateExtensionality (a:Type) (p1 p2:predicate a)
+  : Lemma (requires (peq #a p1 p2))
+        (ensures (F.on_domain a p1==F.on_domain a p2))
+  = P.axiom();
+    assert (F.feq p1 p2)
+ diff --git a/docs/FStar.Preorder.html b/docs/FStar.Preorder.html index 51afe67..78313ab 100644 --- a/docs/FStar.Preorder.html +++ b/docs/FStar.Preorder.html @@ -1,16 +1,25 @@ - - + + - - - - - + FStar.Preorder + -

module FStar.Preorder

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Preorder

+

Preordered relations and stable predicates

+
type relation (a:Type) = a -> a -> Type0
+
type predicate (a:Type) = a -> Type0
+
let reflexive (#a:Type) (rel:relation a) =
+  forall (x:a). rel x x
+
let transitive (#a:Type) (rel:relation a) =
+  forall (x:a) (y:a) (z:a). (rel x y /\ rel y z) ==> rel x z
+
let preorder_rel (#a:Type) (rel:relation a) =
+  reflexive rel /\ transitive rel
+
type preorder (a:Type) = rel:relation a{preorder_rel rel}
+
let stable (#a:Type) (p:predicate a) (rel:relation a{preorder_rel rel}) =
+  forall (x:a) (y:a). (p x /\ rel x y) ==> p y
+ diff --git a/docs/FStar.Printf.html b/docs/FStar.Printf.html index 69b173e..ceb96dc 100644 --- a/docs/FStar.Printf.html +++ b/docs/FStar.Printf.html @@ -1,16 +1,214 @@ - - + + - - - - - + FStar.Printf + -

module FStar.Printf

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Printf

+ +
noeq
+type extension =
+  | MkExtension : #a:Type0 -> $f:(a -> Tot string) -> extension
+
+

arg: The format specifiers supported +%b : bool +%d : int +%c : char +%s : string +%uy : U8.t +%us : U16.t +%ul : U32.t +%uL : U64.t +%y : Int8.t +%i : Int16.t +%l : Int32.t +%L : Int64.t

+
+
noeq
+type arg =
+  | Bool
+  | Int
+  | Char
+  | String
+  | U8
+  | U16
+  | U32
+  | U64
+  | I8
+  | I16
+  | I32
+  | I64
+  | Extension of extension
+
+

arg_type: Interpreting a arg tag as a type

+
+
let arg_type (a:arg) : Tot Type0 =
+  match a with
+  | Bool   -> bool
+  | Int    -> int
+  | Char   -> char
+  | String -> string
+  | U8     -> FStar.UInt8.t
+  | U16    -> FStar.UInt16.t
+  | U32    -> FStar.UInt32.t
+  | U64    -> FStar.UInt64.t
+  | I8     -> FStar.Int8.t
+  | I16    -> FStar.Int16.t
+  | I32    -> FStar.Int32.t
+  | I64    -> FStar.Int64.t
+  | Extension (MkExtension #t _)  -> t
+
let string_of_arg (#a:arg) (x:arg_type a) : string =
+    match a with
+    | Bool   -> string_of_bool x
+    | Int    -> string_of_int x
+    | Char   -> string_of_char x
+    | String -> x
+    | U8     -> FStar.UInt8.to_string x
+    | U16    -> FStar.UInt16.to_string x
+    | U32    -> FStar.UInt32.to_string x
+    | U64    -> FStar.UInt64.to_string x
+    | I8     -> FStar.Int8.to_string x
+    | I16    -> FStar.Int16.to_string x
+    | I32    -> FStar.Int32.to_string x
+    | I64    -> FStar.Int64.to_string x
+    | Extension (MkExtension f) -> f x
+
+

dir: Internal to this module +A 'directive"; used when parsing a format specifier

+
+
noeq
+type dir =
+  | Lit of char
+  | Arg of arg
+
+

dir_type ds: Interpreting a list directives as a pure function type

+
+
let rec dir_type (ds:list dir) : Tot Type0 =
+  match ds with
+  | [] -> string
+  | Lit c :: ds' -> dir_type ds'
+  | Arg a :: ds' -> arg_type a -> dir_type ds'
+
+

string_of_dirs ds: +Interpreting a list of directives as its function, +in a continuation-passing style

+
+
let rec string_of_dirs
+        (ds:list dir)
+        (k:string -> string)
+  : dir_type ds
+  = match ds with
+    | [] -> k ""
+    | Lit c :: ds' ->
+      string_of_dirs ds' (fun res -> k (string_of_char c ^ res))
+      <: normalize_term (dir_type ds')
+    | Arg a :: ds' ->
+      fun (x : arg_type a) ->
+        string_of_dirs ds' (fun res -> ((k "")
+                                     ^ string_of_arg x
+                                     ^ res))
+
type extension_parser = i:list char -> option (extension * o:list char{o << i})
+
+

parse_format s: +Parses a list of characters into a list of directives +Or None, in case the format string is invalid

+
+
let rec parse_format
+      (s:list char)
+      (parse_ext: extension_parser)
+    : option (list dir)
+    = let add_dir (d:dir) (ods : option (list dir))
+        : option (list dir)
+        = match ods with
+          | None -> None
+          | Some ds -> Some (d::ds)
+      in
+      match s with
+      | [] -> Some []
+      | ['%'] -> None
+

Unsigned integers beging with '%u'

+
| '%' :: 'u' :: s' -> begin
+  match s' with
+  | 'y' :: s'' -> add_dir (Arg U8) (parse_format s'' parse_ext)
+  | 's' :: s'' -> add_dir (Arg U16) (parse_format s'' parse_ext)
+  | 'l' :: s'' -> add_dir (Arg U32) (parse_format s'' parse_ext)
+  | 'L' :: s'' -> add_dir (Arg U64) (parse_format s'' parse_ext)
+  | _ -> None
+  end
+

User extensions begin with '%X'

+
| '%' :: 'X' :: s' -> begin
+  match parse_ext s' with
+  | Some (ext, rest) -> add_dir (Arg (Extension ext)) (parse_format rest parse_ext)
+  | _ -> None
+ end
+
| '%' :: c :: s' -> begin
+  match c with
+  | '%' -> add_dir (Lit '%')    (parse_format s' parse_ext)
+  | 'b' -> add_dir (Arg Bool)   (parse_format s' parse_ext)
+  | 'd' -> add_dir (Arg Int)    (parse_format s' parse_ext)
+  | 'c' -> add_dir (Arg Char)   (parse_format s' parse_ext)
+  | 's' -> add_dir (Arg String) (parse_format s' parse_ext)
+  | 'y' -> add_dir (Arg I8)     (parse_format s' parse_ext)
+  | 'i' -> add_dir (Arg I16)    (parse_format s' parse_ext)
+  | 'l' -> add_dir (Arg I32)    (parse_format s' parse_ext)
+  | 'L' -> add_dir (Arg I64)    (parse_format s' parse_ext)
+  | _   -> None
+  end
+| c :: s' ->
+  add_dir (Lit c) (parse_format s' parse_ext)
+
+

parse_format_string: parses a format string into a list of directives

+
+
let parse_format_string
+    (s:string)
+    (parse_ext:extension_parser)
+  : option (list dir)
+  = parse_format (list_of_string s) parse_ext
+
let no_extensions : extension_parser = fun s -> None
+
+

sprintf: The main function of this module +A variable arity string formatter +Used as: sprintf "format string" v1 ... vn

+
It's marked `inline_for_extraction`, meaning that we don't need
+any special support in our compilation targets to support sprintf
+
+`sprintf "Hello %s" "world"`
+ will just extract to `"Hello " ^ "world"`
+
+
+
inline_for_extraction
+let sprintf
+    (s:string{normalize_term (b2t (Some? (parse_format_string s no_extensions)))})
+    : normalize_term (dir_type (Some?.v (parse_format_string s no_extensions)))
+    = normalize_term (string_of_dirs (Some?.v (parse_format_string s no_extensions)) (fun s -> s))
+
+

ext_sprintf: An extensible version of sprintf

+
+
inline_for_extraction
+let ext_sprintf
+    (parse_ext: extension_parser)
+    (s:string{normalize_term (b2t (Some? (parse_format_string s parse_ext)))})
+    : normalize_term (dir_type (Some?.v (parse_format_string s parse_ext)))
+    = normalize_term (string_of_dirs (Some?.v (parse_format_string s parse_ext)) (fun s -> s))
+ diff --git a/docs/FStar.PropositionalExtensionality.html b/docs/FStar.PropositionalExtensionality.html index 036ede0..4cd4a98 100644 --- a/docs/FStar.PropositionalExtensionality.html +++ b/docs/FStar.PropositionalExtensionality.html @@ -1,16 +1,43 @@ - - + + - - - - - + FStar.PropositionalExtensionality + -

module FStar.PropositionalExtensionality

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.PropositionalExtensionality

+ +
assume
+val axiom (_:unit)
+  : Lemma (forall (p1 p2:prop). (p1 <==> p2) <==> (p1 == p2))
+
let apply (p1 p2:prop)
+  : Lemma (ensures  ((p1 <==> p2) <==> (p1 == p2)))
+  = axiom ()
+ diff --git a/docs/FStar.Range.html b/docs/FStar.Range.html index 8bf7fb5..58a0874 100644 --- a/docs/FStar.Range.html +++ b/docs/FStar.Range.html @@ -1,16 +1,15 @@ - - + + - - - - - + FStar.Range + -

module FStar.Range

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Range

+
assume new type range
+
val prims_to_fstar_range : Prims.range -> Tot range
+ diff --git a/docs/FStar.Real.html b/docs/FStar.Real.html index 99dc9e6..5baee82 100644 --- a/docs/FStar.Real.html +++ b/docs/FStar.Real.html @@ -1,16 +1,77 @@ - - + + - - - - - + FStar.Real + -

module FStar.Real

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Real

+

This module provides a signature for real arithmetic.

+

Real number constants can be specific in floating point format with +an 'R' suffix, e.g., 1.0R

+

All these operations are mapped to the correspondings primitives +in Z3's theory of real arithmetic.

+
val real : eqtype
+
val of_int : int -> Tot real
+

+of_string

+

Used to extract real constants; this function is +uninterpreted logically. i.e., 1.1R is extracted to +of_string "1.1"

+
val of_string: string -> Tot real
+
val ( +. ) : real -> real -> Tot real
+val ( -. ) : real -> real -> Tot real
+val ( *. ) : real -> real -> Tot real
+val ( /. ) : real -> d:real{d <> 0.0R} -> Tot real
+
val ( >.  ) : real -> real -> Tot bool
+val ( >=. ) : real -> real -> Tot bool
+
val ( <.  ) : real -> real -> Tot bool
+val ( <=. ) : real -> real -> Tot bool
+
#reset-options "--smtencoding.elim_box true --smtencoding.l_arith_repr native --smtencoding.nl_arith_repr native"
+

Tests

+
let zero : real = of_int 0
+let one : real = of_int 1
+let two : real = of_int 2
+
val sqrt_2 : r:real{r *. r = two}
+
let n_over_n2 (n:real{n <> 0.0R /\ n*.n <> 0.0R}) = assert (n /. (n *. n) == 1.0R /. n)
+
let test = assert (two >. one)
+let test1 = assert (one = 1.0R)
+
let test_lt1 = assert (1.0R <. 2.0R)
+let test_lt2 = assert (~ (1.0R <. 1.0R))
+let test_lt3 = assert (~ (2.0R <. 1.0R))
+
let test_le1 = assert (1.0R <=. 2.0R)
+let test_le2 = assert (1.0R <=. 1.0R)
+let test_le3 = assert (~ (2.0R <=. 1.0R))
+
let test_gt1 = assert (~ (1.0R >. 2.0R))
+let test_gt2 = assert (~ (1.0R >. 1.0R))
+let test_gt3 = assert (2.0R >. 1.0R)
+
let test_ge1 = assert (~ (1.0R >=. 2.0R))
+let test_ge2 = assert (1.0R >=. 1.0R)
+let test_ge3 = assert (2.0R >=. 1.0R)
+
let test_add_eq = assert (1.0R +. 1.0R = 2.0R)
+let test_add_eq' = assert (1.0R +. 3.0R = 4.0R)
+let test_add_lt = assert (1.0R +. 1.0R <. 3.0R)
+
let test_mul_eq = assert (2.0R *. 2.0R = 4.0R)
+let test_mul_lt = assert (2.0R *. 2.0R <. 5.0R)
+
let test_div_eq = assert (8.0R /. 2.0R = 4.0R)
+let test_div_lt = assert (8.0R /. 2.0R <. 5.0R)
+
let test_sqrt_2_mul = assert (sqrt_2 *. sqrt_2 = 2.0R)
+

let test_sqrt_2_add = assert (sqrt_2 +. sqrt_2 >. 2.0R) // Fails

+
let test_sqrt_2_scale = assert (1.0R /. sqrt_2 = sqrt_2 /. 2.0R)
+

Common identities

+
let add_id_l = assert (forall n. 0.0R +. n = n)
+let add_id_r = assert (forall n. n +. 0.0R = n)
+
let mul_nil_l = assert (forall n. 0.0R *. n = 0.0R)
+let mul_nil_r = assert (forall n. n *. 0.0R = 0.0R)
+
let mul_id_l = assert (forall n. 1.0R *. n = n)
+let mul_id_r = assert (forall n. n *. 1.0R = n)
+
let add_comm = assert (forall x y. x +. y = y +.x)
+let add_assoc = assert (forall x y z. (x +. y) +.z = (x +. y) +. z)
+
let mul_comm = assert (forall x y. x *. y = y *.x)
+let mul_assoc = assert (forall x y z. (x *. y) *.z = (x *. y) *. z)
+let mul_dist = assert (forall x y z. x *. (y +. z) = (x *. y) +. (x *.z))
+ diff --git a/docs/FStar.Ref.html b/docs/FStar.Ref.html index a3093d5..f0029ba 100644 --- a/docs/FStar.Ref.html +++ b/docs/FStar.Ref.html @@ -1,16 +1,65 @@ - - + + - - - - - + FStar.Ref + -

module FStar.Ref

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Ref

+

wrapper over FStar.ST to provide operations over refs with default preorder

+ +
unfold
+let sel (#a:Type0) (h:heap) (r:ref a) : GTot a
+  = Heap.sel h r
+
unfold
+let upd (#a:Type0) (h:heap) (r:ref a) (v:a) :GTot heap
+  = Heap.upd h r v
+
unfold
+let addr_of (#a:Type0) (r:ref a) : GTot nat = addr_of r
+
unfold
+let contains (#a:Type0) (h:heap) (r:ref a) :GTot Type0
+  = Heap.contains h r
+
unfold
+let unused_in (#a:Type0) (r:ref a) (h:heap) :GTot Type0
+  = Heap.unused_in r h
+
unfold
+let fresh (#a:Type0) (r:ref a) (h0:heap) (h1:heap) : Type0
+  = Heap.fresh r h0 h1
+
unfold
+let only (#a:Type0) (r:ref a) :GTot (Set.set nat)
+  = Heap.only r
+
val recall (#a:Type0) (r:ref a) : STATE unit (fun p h -> h `contains` r ==> p () h)
+let recall #_ r = recall r
+
val alloc (#a:Type0) (init:a)
+  :ST (ref a)
+      (fun _       -> True)
+      (fun h0 r h1 -> fresh r h0 h1 /\ modifies Set.empty h0 h1 /\ sel h1 r == init)
+let alloc #_ init = alloc init
+
val read (#a:Type0) (r:ref a) :STATE a (fun p h -> p (sel h r) h)
+let read #_ r = read r
+
val write (#a:Type0) (r:ref a) (v:a)
+  :ST unit (fun _ -> True) (fun h0 _ h1 -> h0 `contains` r /\ modifies (only r) h0 h1 /\ equal_dom h0 h1 /\ sel h1 r == v)
+let write #_ r v = write r v
+
val op_Bang (#a:Type0) (r:ref a) :STATE a (fun p h -> p (sel h r) h)
+let op_Bang #_ r = read r
+
val op_Colon_Equals (#a:Type0) (r:ref a) (v:a)
+  :ST unit (fun _ -> True) (fun h0 _ h1 -> h0 `contains` r /\ modifies (only r) h0 h1 /\ equal_dom h0 h1 /\ sel h1 r == v)
+let op_Colon_Equals #_ r v = write r v
+ diff --git a/docs/FStar.Reflection.Arith.html b/docs/FStar.Reflection.Arith.html index 75add2a..490a289 100644 --- a/docs/FStar.Reflection.Arith.html +++ b/docs/FStar.Reflection.Arith.html @@ -1,16 +1,242 @@ - - + + - - - - - + FStar.Reflection.Arith + -

module FStar.Reflection.Arith

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection.Arith

+ +
noeq
+type expr =
+    | Lit     : int -> expr
+

atom, contains both a numerical ID and the actual term encountered +| Div : expr -> expr -> expr // Add this one?

+
| Atom    : nat -> term -> expr
+| Plus    : expr -> expr -> expr
+| Mult    : expr -> expr -> expr
+| Minus   : expr -> expr -> expr
+| Land    : expr -> expr -> expr
+| Lxor    : expr -> expr -> expr
+| Lor     : expr -> expr -> expr
+| Ladd    : expr -> expr -> expr
+| Lsub    : expr -> expr -> expr
+| Shl     : expr -> expr -> expr
+| Shr     : expr -> expr -> expr
+| Neg     : expr -> expr
+| Udiv    : expr -> expr -> expr
+| Umod    : expr -> expr -> expr
+| MulMod  : expr -> expr -> expr
+| NatToBv : expr -> expr
+
noeq
+type connective =
+    | C_Lt | C_Eq | C_Gt | C_Ne
+
noeq
+type prop =
+    | CompProp : expr -> connective -> expr -> prop
+    | AndProp  : prop -> prop -> prop
+    | OrProp   : prop -> prop -> prop
+    | NotProp  : prop -> prop
+
let lt e1 e2 = CompProp e1 C_Lt e2
+let le e1 e2 = CompProp e1 C_Lt (Plus (Lit 1) e2)
+let eq e1 e2 = CompProp e1 C_Eq e2
+let ne e1 e2 = CompProp e1 C_Ne e2
+let gt e1 e2 = CompProp e1 C_Gt e2
+let ge e1 e2 = CompProp (Plus (Lit 1) e1) C_Gt e2
+

Define a traversal monad! Makes exception handling and counter-keeping easy

+
private let st = p:(nat * list term){fst p == List.Tot.Base.length (snd p)}
+private let tm a = st -> Tac (either string (a * st))
+private let return (x:'a) : tm 'a = fun i -> Inr (x, i)
+private let bind (m : tm 'a) (f : 'a -> tm 'b) : tm 'b =
+    fun i -> match m i with
+             | Inr (x, j) -> f x j
+             | s -> Inl (Inl?.v s) // why? To have a catch-all pattern and thus an easy WP
+
val lift : ('a -> Tac 'b) -> ('a -> tm 'b)
+let lift f x st =
+    Inr (f x, st)
+
val liftM : ('a -> 'b) -> (tm 'a -> tm 'b)
+let liftM f x =
+    xx <-- x;
+    return (f xx)
+
val liftM2 : ('a -> 'b -> 'c) -> (tm 'a -> tm 'b -> tm 'c)
+let liftM2 f x y =
+    xx <-- x;
+    yy <-- y;
+    return (f xx yy)
+
val liftM3 : ('a -> 'b -> 'c -> 'd) -> (tm 'a -> tm 'b -> tm 'c -> tm 'd)
+let liftM3 f x y z =
+    xx <-- x;
+    yy <-- y;
+    zz <-- z;
+    return (f xx yy zz)
+
private let rec find_idx (f : 'a -> bool) (l : list 'a) : option ((n:nat{n < List.Tot.Base.length l}) * 'a) =
+    match l with
+    | [] -> None
+    | x::xs ->
+        if f x
+        then Some (0, x)
+        else begin match find_idx f xs with
+             | None -> None
+             | Some (i, x) -> Some (i+1, x)
+             end
+
private let atom (t:term) : tm expr = fun (n, atoms) ->
+    match find_idx (term_eq t) atoms with
+    | None -> Inr (Atom n t, (n + 1, t::atoms))
+    | Some (i, t) -> Inr (Atom (n - 1 - i) t, (n, atoms))
+
private val fail : (#a:Type) -> string -> tm a
+private let fail #a s = fun i -> Inl s
+
let refined_list_t (#a:Type) (p:(a -> Type0)) = list (x:a{p x})
+
val list_unref : #a:Type -> #p:(a -> Type0) -> refined_list_t p -> Tot (l:list a{forall x. List.Tot.Base.memP x l ==> p x})
+let rec list_unref #a #p l =
+    match l with
+    | [] -> []
+    | x::xs -> x :: list_unref xs
+
let collect_app_ref (t:term) : ((h:term{h == t \/ h << t}) * refined_list_t (fun (a:argv) -> fst a << t)) =
+  collect_app_ref t
+
val as_arith_expr : term -> tm expr
+#push-options "--initial_fuel 4 --max_fuel 4"
+let rec as_arith_expr (t:term) =
+    let hd, tl = collect_app_ref t in
+    let tl = list_unref tl in //need to be careful to instantiate list_unref at the right type to allow SMT to unfold its recursive definition properly
+    match inspect_ln hd, tl with
+    | Tv_FVar fv, [(e1, Q_Implicit); (e2, Q_Explicit) ; (e3, Q_Explicit)] ->
+      let qn = inspect_fv fv in
+      let e2' = as_arith_expr e2 in
+      let e3' = as_arith_expr e3 in
+      if qn = land_qn then liftM2 Land e2' e3'
+      else if qn = lxor_qn then liftM2 Lxor e2' e3'
+      else if qn = lor_qn then liftM2 Lor e2' e3'
+      else if qn = shiftr_qn then liftM2 Shr e2' e3'
+      else if qn = shiftl_qn then liftM2 Shl e2' e3'
+      else if qn = udiv_qn then liftM2 Udiv e2' e3'
+      else if qn = umod_qn then liftM2 Umod e2' e3'
+      else if qn = mul_mod_qn then liftM2 MulMod e2' e3'
+      else if qn = ladd_qn then liftM2 Ladd e2' e3'
+      else if qn = lsub_qn then liftM2 Lsub e2' e3'
+      else atom t
+    | Tv_FVar fv, [(l, Q_Explicit); (r, Q_Explicit)] ->
+        let qn = inspect_fv fv in
+

Have to go through hoops to get F* to typecheck this. +Maybe the do notation is twisting the terms somehow unexpected?

+
        let ll = as_arith_expr l in
+        let rr = as_arith_expr r in
+        if      qn = add_qn   then liftM2 Plus ll rr
+        else if qn = minus_qn then liftM2 Minus ll rr
+        else if qn = mult_qn  then liftM2 Mult ll rr
+        else if qn = mult'_qn then liftM2 Mult ll rr
+        else atom t
+    | Tv_FVar fv, [(l, Q_Implicit); (r, Q_Explicit)] ->
+        let qn = inspect_fv fv in
+        let ll = as_arith_expr l in
+        let rr = as_arith_expr r in
+        if qn = nat_bv_qn then liftM NatToBv rr
+        else atom t
+    | Tv_FVar fv, [(a, Q_Explicit)] ->
+        let qn = inspect_fv fv in
+        let aa = as_arith_expr a in
+        if qn = neg_qn then liftM Neg aa
+        else atom t
+    | Tv_Const (C_Int i), _ ->
+        return (Lit i)
+    | _ ->
+        atom t
+#pop-options
+
val is_arith_expr : term -> tm expr
+let is_arith_expr t =
+  a <-- as_arith_expr t ;
+  match a with
+  | Atom _ t -> begin
+    let hd, tl = collect_app_ref t in
+    match inspect_ln hd, tl with
+    | Tv_FVar _, []
+    | Tv_BVar _, []
+    | Tv_Var _, [] -> return a
+    | _ -> fail ("not an arithmetic expression: (" ^ term_to_string t ^ ")")
+  end
+  | _ -> return a
+

Cannot use this... +val is_arith_prop : term -> tm prop

+
val is_arith_prop : term -> st -> Tac (either string (prop * st))
+let rec is_arith_prop (t:term) = fun i ->
+    (f <-- lift term_as_formula t;
+    match f with
+    | Comp (Eq _) l r     -> liftM2 eq (is_arith_expr l) (is_arith_expr r)
+    | Comp (BoolEq _) l r -> liftM2 eq (is_arith_expr l) (is_arith_expr r)
+    | Comp Lt l r     -> liftM2 lt (is_arith_expr l) (is_arith_expr r)
+    | Comp Le l r     -> liftM2 le (is_arith_expr l) (is_arith_expr r)
+    | And l r         -> liftM2 AndProp (is_arith_prop l) (is_arith_prop r)
+    | Or l r          -> liftM2  OrProp (is_arith_prop l) (is_arith_prop r)
+    | _               -> fail ("connector (" ^ term_to_string t ^ ")")) i
+

Run the monadic computations, disregard the counter

+
let run_tm (m : tm 'a) : Tac (either string 'a) =
+    match m (0, []) with
+    | Inr (x, _) -> Inr x
+    | s -> Inl (Inl?.v s) // why? To have a catch-all pattern and thus an easy WP
+
let rec expr_to_string (e:expr) : string =
+    match e with
+    | Atom i _ -> "a"^(string_of_int i)
+    | Lit i -> string_of_int i
+    | Plus l r -> "(" ^ (expr_to_string l) ^ " + " ^ (expr_to_string r) ^ ")"
+    | Minus l r -> "(" ^ (expr_to_string l) ^ " - " ^ (expr_to_string r) ^ ")"
+    | Mult l r -> "(" ^ (expr_to_string l) ^ " * " ^ (expr_to_string r) ^ ")"
+    | Neg l -> "(- " ^ (expr_to_string l) ^ ")"
+    | Land l r -> "(" ^ (expr_to_string l) ^ " & " ^ (expr_to_string r) ^ ")"
+    | Lor l r -> "(" ^ (expr_to_string l) ^ " | " ^ (expr_to_string r) ^ ")"
+    | Lxor l r -> "(" ^ (expr_to_string l) ^ " ^ " ^ (expr_to_string r) ^ ")"
+    | Ladd l r -> "(" ^ (expr_to_string l) ^ " >> " ^ (expr_to_string r) ^ ")"
+    | Lsub l r -> "(" ^ (expr_to_string l) ^ " >> " ^ (expr_to_string r) ^ ")"
+    | Shl l r -> "(" ^ (expr_to_string l) ^ " << " ^ (expr_to_string r) ^ ")"
+    | Shr l r -> "(" ^ (expr_to_string l) ^ " >> " ^ (expr_to_string r) ^ ")"
+    | NatToBv l -> "(" ^ "to_vec " ^ (expr_to_string l) ^ ")"
+    | Udiv l r -> "(" ^ (expr_to_string l) ^ " / " ^ (expr_to_string r) ^ ")"
+    | Umod l r -> "(" ^ (expr_to_string l) ^ " % " ^ (expr_to_string r) ^ ")"
+    | MulMod l r -> "(" ^ (expr_to_string l) ^ " ** " ^ (expr_to_string r) ^ ")"
+
let rec compare_expr (e1 e2 : expr) : O.order =
+    match e1, e2 with
+    | Lit i, Lit j -> O.compare_int i j
+    | Atom _ t, Atom _ s -> compare_term t s
+    | Plus l1 l2, Plus r1 r2
+    | Minus l1 l2, Minus r1 r2
+    | Mult l1 l2, Mult r1 r2 -> O.lex (compare_expr l1 r1) (fun () -> compare_expr l2 r2)
+    | Neg e1, Neg e2 -> compare_expr e1 e2
+    | Lit _,    _ -> O.Lt    | _, Lit _    -> O.Gt
+    | Atom _ _, _ -> O.Lt    | _, Atom _ _ -> O.Gt
+    | Plus _ _, _ -> O.Lt    | _, Plus _ _ -> O.Gt
+    | Mult _ _, _ -> O.Lt    | _, Mult _ _ -> O.Gt
+    | Neg _,    _ -> O.Lt    | _, Neg _    -> O.Gt
+    | _ -> O.Gt // don't care about this for now
+ diff --git a/docs/FStar.Reflection.Builtins.html b/docs/FStar.Reflection.Builtins.html new file mode 100644 index 0000000..608ba5d --- /dev/null +++ b/docs/FStar.Reflection.Builtins.html @@ -0,0 +1,92 @@ + + + + + FStar.Reflection.Builtins + + + +

+FStar.Reflection.Builtins

+ +

Views

+

NOTE: You probably want inspect/pack from FStar.Tactics, which work

+ +
val inspect_ln     : (t:term) -> tv:term_view{smaller tv t}
+val pack_ln        : term_view -> term
+
val pack_inspect_inv : (t:term) -> Lemma (pack_ln (inspect_ln t) == t)
+val inspect_pack_inv : (tv:term_view) -> Lemma (inspect_ln (pack_ln tv) == tv)
+
val inspect_comp   : (c:comp) -> cv:comp_view{smaller_comp cv c}
+val pack_comp      : comp_view -> comp
+
val inspect_sigelt : sigelt -> sigelt_view
+val pack_sigelt    : sigelt_view -> sigelt
+
val inspect_fv     : fv -> name
+val pack_fv        : name -> fv
+
val inspect_bv     : bv -> bv_view
+val pack_bv        : bv_view -> bv
+
val inspect_lb     : letbinding -> lb_view
+val pack_lb        : lb_view -> letbinding
+
val inspect_binder : binder -> bv * (aqualv * list term)
+val pack_binder    : bv -> aqualv -> list term -> binder
+

These are equivalent to String.concat ".", String.split '.'``

+ +
val implode_qn     : list string -> string
+val explode_qn     : string -> list string
+val compare_string : string -> string -> int
+

Primitives & helpers

+
val lookup_typ            : env -> name -> option sigelt
+val compare_bv            : bv -> bv -> order
+val binders_of_env        : env -> binders
+val moduleof              : env -> name
+val is_free               : bv -> term -> bool
+val free_bvs              : term -> list bv
+val free_uvars            : term -> list int
+val lookup_attr           : term -> env -> list fv
+val all_defs_in_env       : env -> list fv
+val defs_in_module        : env -> name -> list fv
+val term_eq               : term -> term -> bool
+val term_to_string        : term -> string
+val comp_to_string        : comp -> string
+val env_open_modules      : env -> list name
+

+push_binder

+

push_binder extends the environment with a single binder. +This is useful as one traverses the syntax of a term, +pushing binders as one traverses a binder in a lambda, +match, etc.

+
val push_binder           : env -> binder -> env
+

Attributes are terms, not to be confused with Prims.attribute

+
val sigelt_attrs     : sigelt -> list term
+val set_sigelt_attrs : list term -> sigelt -> sigelt
+

Setting and reading qualifiers from sigelts

+
val sigelt_quals     : sigelt -> list qualifier
+val set_sigelt_quals : list qualifier -> sigelt -> sigelt
+

Reading the vconfig under which a particular sigelt was typechecked

+
val sigelt_opts : sigelt -> option vconfig
+

Embed a vconfig as a term, for instance to use it with the check_with +attribute

+
val embed_vconfig : vconfig -> term
+

Marker to check a sigelt with a particular vconfig

+
irreducible
+let check_with (vcfg : vconfig) : unit = ()
+
val subst : bv -> term -> term -> term
+
val close_term : binder -> term -> term
+ + + diff --git a/docs/FStar.Reflection.Const.html b/docs/FStar.Reflection.Const.html index b561660..be0f16b 100644 --- a/docs/FStar.Reflection.Const.html +++ b/docs/FStar.Reflection.Const.html @@ -1,16 +1,66 @@ - - + + - - - - - + FStar.Reflection.Const + -

module FStar.Reflection.Const

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection.Const

+

Common lids

+

TODO: these are awful names +TODO: _qn vs _lid

+
let imp_qn       = ["Prims"; "l_imp"]
+let and_qn       = ["Prims"; "l_and"]
+let or_qn        = ["Prims"; "l_or"]
+let not_qn       = ["Prims"; "l_not"]
+let iff_qn       = ["Prims"; "l_iff"]
+let eq2_qn       = ["Prims"; "eq2"]
+let eq1_qn       = ["Prims"; "eq"]
+let true_qn      = ["Prims"; "l_True"]
+let false_qn     = ["Prims"; "l_False"]
+let b2t_qn       = ["Prims"; "b2t"]
+let forall_qn    = ["Prims"; "l_Forall"]
+let exists_qn    = ["Prims"; "l_Exists"]
+let squash_qn    = ["Prims"; "squash"]
+
let bool_true_qn  = ["Prims"; "true"]
+let bool_false_qn = ["Prims"; "false"]
+
let int_lid      = ["Prims"; "int"]
+let bool_lid     = ["Prims"; "bool"]
+let unit_lid     = ["Prims"; "unit"]
+let string_lid   = ["Prims"; "string"]
+
let add_qn       = ["Prims"; "op_Addition"]
+let neg_qn       = ["Prims"; "op_Minus"]
+let minus_qn     = ["Prims"; "op_Subtraction"]
+let mult_qn      = ["Prims"; "op_Multiply"]
+let mult'_qn     = ["FStar"; "Mul"; "op_Star"]
+let div_qn       = ["Prims"; "op_Division"]
+let lt_qn        = ["Prims"; "op_LessThan"]
+let lte_qn       = ["Prims"; "op_LessThanOrEqual"]
+let gt_qn        = ["Prims"; "op_GreaterThan"]
+let gte_qn       = ["Prims"; "op_GreaterThanOrEqual"]
+let mod_qn       = ["Prims"; "op_Modulus"]
+
let nil_qn       = ["Prims"; "Nil"]
+let cons_qn      = ["Prims"; "Cons"]
+
let mktuple2_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple2"]
+let mktuple3_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple3"]
+let mktuple4_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple4"]
+let mktuple5_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple5"]
+let mktuple6_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple6"]
+let mktuple7_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple7"]
+let mktuple8_qn  = ["FStar"; "Pervasives"; "Native"; "Mktuple8"]
+
let land_qn    = ["FStar" ; "UInt" ; "logand"]
+let lxor_qn    = ["FStar" ; "UInt" ; "logxor"]
+let lor_qn     = ["FStar" ; "UInt" ; "logor"]
+let ladd_qn    = ["FStar" ; "UInt" ; "add_mod"]
+let lsub_qn    = ["FStar" ; "UInt" ; "sub_mod"]
+let shiftl_qn  = ["FStar" ; "UInt" ; "shift_left"]
+let shiftr_qn  = ["FStar" ; "UInt" ; "shift_right"]
+let udiv_qn    = ["FStar" ; "UInt" ; "udiv"]
+let umod_qn    = ["FStar" ; "UInt" ; "mod"]
+let mul_mod_qn = ["FStar" ; "UInt" ; "mul_mod"]
+let nat_bv_qn  = ["FStar" ; "BV"   ; "int2bv"]
+ diff --git a/docs/FStar.Reflection.Derived.Lemmas.html b/docs/FStar.Reflection.Derived.Lemmas.html index 7c36397..ab97345 100644 --- a/docs/FStar.Reflection.Derived.Lemmas.html +++ b/docs/FStar.Reflection.Derived.Lemmas.html @@ -1,16 +1,73 @@ - - + + - - - - - + FStar.Reflection.Derived.Lemmas + -

module FStar.Reflection.Derived.Lemmas

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection.Derived.Lemmas

+ +
val uncurry : ('a -> 'b -> 'c) -> ('a * 'b -> 'c)
+let uncurry f (x, y) = f x y
+
val curry : ('a * 'b -> 'c) -> ('a -> 'b -> 'c)
+let curry f x y = f (x, y)
+

A glorified id

+
val list_ref : (#a:Type) -> (#p:(a -> Type)) -> (l:list a) ->
+                    Pure (list (x:a{p x}))
+                         (requires (forall_list p l))
+                         (ensures (fun _ -> True))
+let rec list_ref #a #p l =
+    match l with
+    | [] -> []
+    | x::xs -> x :: list_ref #a #p xs
+
val mk_app_collect_inv_s : (t:term) -> (args:list argv) ->
+                            Lemma (uncurry mk_app (collect_app' args t) == mk_app t args)
+let rec mk_app_collect_inv_s t args =
+    match inspect_ln t with
+    | Tv_App l r ->
+        mk_app_collect_inv_s l (r::args);
+        pack_inspect_inv t
+    | _ -> ()
+
val mk_app_collect_inv : (t:term) -> Lemma (uncurry mk_app (collect_app t) == t)
+let mk_app_collect_inv t = mk_app_collect_inv_s t []
+ +
val collect_app_order' : (args:list argv) -> (tt:term) -> (t:term) ->
+            Lemma (requires (forall_list (fun a -> fst a << tt) args)
+                             /\ t << tt)
+                  (ensures (forall_list (fun a -> fst a << tt) (snd (collect_app' args t)))
+                           /\ fst (collect_app' args t) << tt)
+                  (decreases t)
+let rec collect_app_order' args tt t =
+    match inspect_ln t with
+    | Tv_App l r -> collect_app_order' (r::args) tt l
+    | _ -> ()
+
val collect_app_order : (t:term) ->
+            Lemma (ensures (forall (f:term). forall (s:list argv). (f,s) == collect_app t ==>
+                              (f << t /\ forall_list (fun a -> fst a << t) (snd (collect_app t)))
+                           \/ (f == t /\ s == [])))
+let collect_app_order t =
+    match inspect_ln t with
+    | Tv_App l r -> collect_app_order' [r] t l
+    | _ -> ()
+
val collect_app_ref : (t:term) -> (h:term{h == t \/ h << t}) * list (a:argv{fst a << t})
+let collect_app_ref t =
+    let h, a = collect_app t in
+    collect_app_order t;
+    h, list_ref #_ #(fun a -> fst a << t) a
+ diff --git a/docs/FStar.Reflection.Derived.html b/docs/FStar.Reflection.Derived.html index e9c5e28..5bab6fb 100644 --- a/docs/FStar.Reflection.Derived.html +++ b/docs/FStar.Reflection.Derived.html @@ -1,16 +1,310 @@ - - + + - - - - - + FStar.Reflection.Derived + -

module FStar.Reflection.Derived

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection.Derived

+ +
let name_of_bv (bv : bv) : string =
+    (inspect_bv bv).bv_ppname
+
let type_of_bv (bv : bv) : typ =
+    (inspect_bv bv).bv_sort
+
let bv_to_string (bv : bv) : string =
+    let bvv = inspect_bv bv in
+    "(" ^ bvv.bv_ppname ^ ":" ^ term_to_string bvv.bv_sort ^ ")"
+
let bv_of_binder (b : binder) : bv =
+    let bv, _ = inspect_binder b in
+    bv
+ +
let mk_binder (bv : bv) : binder =
+    pack_binder bv Q_Explicit []
+
let mk_implicit_binder (bv : bv) : binder =
+    pack_binder bv Q_Implicit []
+
let name_of_binder (b : binder) : string =
+    name_of_bv (bv_of_binder b)
+
let type_of_binder (b : binder) : typ =
+    type_of_bv (bv_of_binder b)
+
let binder_to_string (b : binder) : string =
+    bv_to_string (bv_of_binder b) //TODO: print aqual, attributes
+
val flatten_name : name -> Tot string
+let rec flatten_name ns =
+    match ns with
+    | [] -> ""
+    | [n] -> n
+    | n::ns -> n ^ "." ^ flatten_name ns
+

Helpers for dealing with nested applications and arrows

+
let rec collect_app' (args : list argv) (t : term) : Tot (term * list argv) (decreases t) =
+    match inspect_ln t with
+    | Tv_App l r ->
+        collect_app' (r::args) l
+    | _ -> (t, args)
+
val collect_app : term -> term * list argv
+let collect_app = collect_app' []
+
let rec mk_app (t : term) (args : list argv) : Tot term (decreases args) =
+    match args with
+    | [] -> t
+    | (x::xs) -> mk_app (pack_ln (Tv_App t x)) xs
+

Helper for when all arguments are explicit

+
let mk_e_app (t : term) (args : list term) : Tot term =
+    let e t = (t, Q_Explicit) in
+    mk_app t (List.Tot.Base.map e args)
+
let rec mk_tot_arr_ln (bs: list binder) (cod : term) : Tot term (decreases bs) =
+    match bs with
+    | [] -> cod
+    | (b::bs) -> pack_ln (Tv_Arrow b (pack_comp (C_Total (mk_tot_arr_ln bs cod) [])))
+
private
+let rec collect_arr' (bs : list binder) (c : comp) : Tot (list binder * comp) (decreases c) =
+    begin match inspect_comp c with
+    | C_Total t _ ->
+        begin match inspect_ln t with
+        | Tv_Arrow b c ->
+            collect_arr' (b::bs) c
+        | _ ->
+            (bs, c)
+        end
+    | _ -> (bs, c)
+    end
+
val collect_arr_ln_bs : typ -> list binder * comp
+let collect_arr_ln_bs t =
+    let (bs, c) = collect_arr' [] (pack_comp (C_Total t [])) in
+    (List.Tot.Base.rev bs, c)
+
val collect_arr_ln : typ -> list typ * comp
+let collect_arr_ln t =
+    let (bs, c) = collect_arr' [] (pack_comp (C_Total t [])) in
+    let ts = List.Tot.Base.map type_of_binder bs in
+    (List.Tot.Base.rev ts, c)
+
private
+let rec collect_abs' (bs : list binder) (t : term) : Tot (list binder * term) (decreases t) =
+    match inspect_ln t with
+    | Tv_Abs b t' ->
+        collect_abs' (b::bs) t'
+    | _ -> (bs, t)
+
val collect_abs_ln : term -> list binder * term
+let collect_abs_ln t =
+    let (bs, t') = collect_abs' [] t in
+    (List.Tot.Base.rev bs, t')
+
let fv_to_string (fv:fv) : string = implode_qn (inspect_fv fv)
+
let compare_name (n1 n2 : name) : order =
+    compare_list (fun s1 s2 -> order_from_int (compare_string s1 s2)) n1 n2
+
let compare_fv (f1 f2 : fv) : order =
+    compare_name (inspect_fv f1) (inspect_fv f2)
+
let compare_const (c1 c2 : vconst) : order =
+    match c1, c2 with
+    | C_Unit, C_Unit -> Eq
+    | C_Int i, C_Int j -> order_from_int (i - j)
+    | C_True, C_True -> Eq
+    | C_False, C_False -> Eq
+    | C_String s1, C_String s2 -> order_from_int (compare_string s1 s2)
+    | C_Range r1, C_Range r2 -> Eq
+    | C_Reify, C_Reify -> Eq
+    | C_Reflect l1, C_Reflect l2 -> compare_name l1 l2
+    | C_Unit,  _ -> Lt       | _, C_Unit  -> Gt
+    | C_Int _, _ -> Lt       | _, C_Int _ -> Gt
+    | C_True,  _ -> Lt       | _, C_True  -> Gt
+    | C_False, _ -> Lt       | _, C_False -> Gt
+    | C_String _, _ -> Lt    | _, C_String _ -> Gt
+    | C_Range _, _ -> Lt     | _, C_Range _ -> Gt
+    | C_Reify, _ -> Lt       | _, C_Reify -> Gt
+    | C_Reflect _, _ -> Lt   | _, C_Reflect _ -> Gt
+
let compare_binder (b1 b2 : binder) : order =
+    let bv1, _ = inspect_binder b1 in
+    let bv2, _ = inspect_binder b2 in
+    compare_bv bv1 bv2
+
let rec compare_term (s t : term) : Tot order (decreases s) =
+    match inspect_ln s, inspect_ln t with
+    | Tv_Var sv, Tv_Var tv ->
+        compare_bv sv tv
+
| Tv_BVar sv, Tv_BVar tv ->
+    compare_bv sv tv
+
| Tv_FVar sv, Tv_FVar tv ->
+    compare_fv sv tv
+
| Tv_App h1 a1, Tv_App h2 a2 ->
+    lex (compare_term h1 h2) (fun () -> compare_argv a1 a2)
+
| Tv_Abs b1 e1, Tv_Abs b2 e2 ->
+    lex (compare_binder b1 b2) (fun () -> compare_term e1 e2)
+
| Tv_Refine bv1 e1, Tv_Refine bv2 e2 ->
+    lex (compare_bv bv1 bv2) (fun () -> compare_term e1 e2)
+
| Tv_Arrow b1 e1, Tv_Arrow b2 e2 ->
+    lex (compare_binder b1 b2) (fun () -> compare_comp e1 e2)
+
| Tv_Type (), Tv_Type () ->
+    Eq
+
| Tv_Const c1, Tv_Const c2 ->
+    compare_const c1 c2
+
| Tv_Uvar u1 _, Tv_Uvar u2 _->
+    compare_int u1 u2
+
| Tv_Let _r1 _attrs1 bv1 t1 t1', Tv_Let _r2 _attrs2 bv2 t2 t2' ->
+    lex (compare_bv bv1 bv2) (fun () ->
+    lex (compare_term t1 t2) (fun () ->
+         compare_term t1' t2'))
+
| Tv_Match _ _ _, Tv_Match _ _ _ ->
+    Eq // TODO
+
| Tv_AscribedT e1 t1 tac1, Tv_AscribedT e2 t2 tac2 ->
+    lex (compare_term e1 e2) (fun () ->
+    lex (compare_term t1 t2) (fun () ->
+    match tac1, tac2 with
+    | None, None -> Eq
+    | None, _  -> Lt
+    | _, None -> Gt
+    | Some e1, Some e2 -> compare_term e1 e2))
+
| Tv_AscribedC e1 c1 tac1, Tv_AscribedC e2 c2 tac2 ->
+    lex (compare_term e1 e2) (fun () ->
+    lex (compare_comp c1 c2) (fun () ->
+    match tac1, tac2 with
+    | None, None -> Eq
+    | None, _  -> Lt
+    | _, None -> Gt
+    | Some e1, Some e2 -> compare_term e1 e2))
+
| Tv_Unknown, Tv_Unknown ->
+    Eq
+

From here onwards, they must have different constructors. Order them arbitrarilly as in the definition.

+
    | Tv_Var _, _      -> Lt   | _, Tv_Var _      -> Gt
+    | Tv_BVar _, _     -> Lt   | _, Tv_BVar _     -> Gt
+    | Tv_FVar _, _     -> Lt   | _, Tv_FVar _     -> Gt
+    | Tv_App _ _, _    -> Lt   | _, Tv_App _ _    -> Gt
+    | Tv_Abs _ _, _    -> Lt   | _, Tv_Abs _ _    -> Gt
+    | Tv_Arrow _ _, _  -> Lt   | _, Tv_Arrow _ _  -> Gt
+    | Tv_Type (), _    -> Lt   | _, Tv_Type ()    -> Gt
+    | Tv_Refine _ _, _ -> Lt   | _, Tv_Refine _ _ -> Gt
+    | Tv_Const _, _    -> Lt   | _, Tv_Const _    -> Gt
+    | Tv_Uvar _ _, _   -> Lt   | _, Tv_Uvar _ _   -> Gt
+    | Tv_Match _ _ _, _  -> Lt | _, Tv_Match _ _ _  -> Gt
+    | Tv_AscribedT _ _ _, _  -> Lt | _, Tv_AscribedT _ _ _  -> Gt
+    | Tv_AscribedC _ _ _, _  -> Lt | _, Tv_AscribedC _ _ _  -> Gt
+    | Tv_Unknown, _    -> Lt   | _, Tv_Unknown    -> Gt
+and compare_term_list (l1 l2:list term) : Tot order (decreases l1) =
+  match l1, l2 with
+  | [], [] -> Eq
+  | [], _ -> Lt
+  | _, [] -> Gt
+  | hd1::tl1, hd2::tl2 ->
+    lex (compare_term hd1 hd2) (fun () -> compare_term_list tl1 tl2)
+
and compare_argv (a1 a2 : argv) : Tot order (decreases a1) =
+    let a1, q1 = a1 in
+    let a2, q2 = a2 in
+    match q1, q2 with
+

We should never see Q_Meta here

+
    | Q_Implicit, Q_Explicit -> Lt
+    | Q_Explicit, Q_Implicit -> Gt
+    | _, _ -> compare_term a1 a2
+and compare_comp (c1 c2 : comp) : Tot order (decreases c1) =
+    let cv1 = inspect_comp c1 in
+    let cv2 = inspect_comp c2 in
+    match cv1, cv2 with
+    | C_Total t1 md1, C_Total t2 md2 -> lex (compare_term t1 t2)
+                                           (fun () -> compare_term_list md1 md2)
+
| C_GTotal t1 md1, C_GTotal t2 md2 -> lex (compare_term t1 t2)
+                                         (fun () -> compare_term_list md1 md2)
+
| C_Lemma p1 q1 s1, C_Lemma p2 q2 s2 ->
+  lex (compare_term p1 p2)
+      (fun () ->
+        lex (compare_term q1 q2)
+            (fun () -> compare_term s1 s2)
+      )
+
| C_Eff _us1 eff1 res1 args1,
+  C_Eff _us2 eff2 res2 args2 ->
+

This could be more complex, not sure it is worth it

+
lex (compare_name eff1 eff2) (fun () -> compare_term res1 res2)
+
| C_Total _ _, _  -> Lt     | _, C_Total _ _ -> Gt
+| C_GTotal _ _, _  -> Lt    | _, C_GTotal _ _ -> Gt
+| C_Lemma _ _ _, _  -> Lt   | _, C_Lemma _ _ _ -> Gt
+| C_Eff _ _ _ _, _ -> Lt    | _, C_Eff _ _ _ _ -> Gt
+
let mk_stringlit (s : string) : term =
+    pack_ln (Tv_Const (C_String s))
+
let mk_strcat (t1 t2 : term) : term =
+    mk_e_app (pack_ln (Tv_FVar (pack_fv ["Prims"; "strcat"]))) [t1; t2]
+
let mk_cons (h t : term) : term =
+   mk_e_app (pack_ln (Tv_FVar (pack_fv cons_qn))) [h; t]
+
let mk_cons_t (ty h t : term) : term =
+   mk_app (pack_ln (Tv_FVar (pack_fv cons_qn))) [(ty, Q_Implicit); (h, Q_Explicit); (t, Q_Explicit)]
+
let rec mk_list (ts : list term) : term =
+    match ts with
+    | [] -> pack_ln (Tv_FVar (pack_fv nil_qn))
+    | t::ts -> mk_cons t (mk_list ts)
+
let mktuple_n (ts : list term) : term =
+    assume (List.Tot.Base.length ts <= 8);
+    match List.Tot.Base.length ts with
+    | 0 -> pack_ln (Tv_Const C_Unit)
+    | 1 -> let [x] = ts in x
+    | n -> begin
+           let qn = match n with
+                    | 2 -> mktuple2_qn
+                    | 3 -> mktuple3_qn
+                    | 4 -> mktuple4_qn
+                    | 5 -> mktuple5_qn
+                    | 6 -> mktuple6_qn
+                    | 7 -> mktuple7_qn
+                    | 8 -> mktuple8_qn
+           in mk_e_app (pack_ln (Tv_FVar (pack_fv qn))) ts
+           end
+
let destruct_tuple (t : term) : option (list term) =
+    let head, args = collect_app t in
+    match inspect_ln head with
+    | Tv_FVar fv ->
+        if List.Tot.Base.mem
+                (inspect_fv fv) [mktuple2_qn; mktuple3_qn; mktuple4_qn; mktuple5_qn;
+                                 mktuple6_qn; mktuple7_qn; mktuple8_qn]
+        then Some (List.Tot.Base.concatMap (fun (t, q) ->
+                                      match q with
+                                      | Q_Explicit -> [t]
+                                      | _ -> []) args)
+        else None
+    | _ -> None
+
let mkpair (t1 t2 : term) : term =
+    mktuple_n [t1;t2]
+
let rec head (t : term) : term =
+    match inspect_ln t with
+    | Tv_Match t _ _
+    | Tv_Let _ _ _ t _
+    | Tv_Abs _ t
+    | Tv_Refine _ t
+    | Tv_App t _
+    | Tv_AscribedT t _ _
+    | Tv_AscribedC t _ _ -> head t
+
| Tv_Unknown
+| Tv_Uvar _ _
+| Tv_Const _
+| Tv_Type _
+| Tv_Var _
+| Tv_BVar _
+| Tv_FVar _
+| Tv_Arrow _ _ -> t
+
let nameof (t : term) : string =
+    match inspect_ln t with
+    | Tv_FVar fv -> implode_qn (inspect_fv fv)
+    | _ -> "?"
+
let is_uvar (t : term) : bool =
+    match inspect_ln (head t) with
+    | Tv_Uvar _ _ -> true
+    | _ -> false
+
let binder_set_qual (q:aqualv) (b:binder) : Tot binder =
+  let bv, (_, attrs) = inspect_binder b in
+  pack_binder bv q attrs
+

+add_check_with

+

Set a vconfig for a sigelt

+
val add_check_with : vconfig -> sigelt -> Tot sigelt
+let add_check_with vcfg se =
+  let attrs = sigelt_attrs se in
+  let vcfg_t = embed_vconfig vcfg in
+  let t = `(check_with (`#vcfg_t)) in
+  set_sigelt_attrs (t :: attrs) se
+ diff --git a/docs/FStar.Reflection.Formula.html b/docs/FStar.Reflection.Formula.html index 64554c8..10bd560 100644 --- a/docs/FStar.Reflection.Formula.html +++ b/docs/FStar.Reflection.Formula.html @@ -1,16 +1,215 @@ - - + + - - - - - + FStar.Reflection.Formula + -

module FStar.Reflection.Formula

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection.Formula

+ +

Cannot open FStar.Tactics.Derived here

+
let fresh_bv = fresh_bv_named "x"
+
noeq type comparison =
+  | Eq     of option typ  (* Propositional equality (eq2), maybe annotated *)
+  | BoolEq of option typ  (* Decidable, boolean equality (eq), maybe annotated *)
+  | Lt | Le | Gt | Ge     (* Orderings, at type `int` (and subtypes) *)
+
noeq type formula =
+  | True_  : formula
+  | False_ : formula
+  | Comp   : comparison -> term -> term -> formula
+  | And    : term -> term -> formula
+  | Or     : term -> term -> formula
+  | Not    : term -> formula
+  | Implies: term -> term -> formula
+  | Iff    : term -> term -> formula
+  | Forall : bv -> term -> formula
+  | Exists : bv -> term -> formula
+  | App    : term -> term -> formula
+  | Name   : bv -> formula
+  | FV     : fv -> formula
+  | IntLit : int -> formula
+  | F_Unknown : formula // Also a baked-in "None"
+
let mk_Forall (typ : term) (pred : term) : Tac formula =
+    let b = pack_bv ({ bv_ppname = "x";
+                       bv_sort = typ;
+                       bv_index = 0; }) in
+    Forall b (pack_ln (Tv_App pred (pack_ln (Tv_BVar b), Q_Explicit)))
+
let mk_Exists (typ : term) (pred : term) : Tac formula =
+    let b = pack_bv ({ bv_ppname = "x";
+                       bv_sort = typ;
+                       bv_index = 0; }) in
+    Exists b (pack_ln (Tv_App pred (pack_ln (Tv_BVar b), Q_Explicit)))
+
let term_as_formula' (t:term) : Tac formula =
+    match inspect_ln t with
+    | Tv_Var n ->
+        Name n
+
| Tv_FVar fv ->
+

Cannot use when clauses when verifying!

+
let qn = inspect_fv fv in
+if qn = true_qn then True_
+else if qn = false_qn then False_
+else FV fv
+

TODO: l_Forall +...or should we just try to drop all squashes? +TODO: b2t at this point ? +Non-annotated comparisons

+
| Tv_App h0 t -> begin
+    let (h, ts) = collect_app h0 in
+    match inspect_ln h, ts@[t] with
+    | Tv_FVar fv, [(a1, Q_Implicit); (a2, Q_Explicit); (a3, Q_Explicit)] ->
+        let qn = inspect_fv fv in
+        if      qn = eq2_qn then Comp (Eq     (Some a1)) a2 a3
+        else if qn = eq1_qn then Comp (BoolEq (Some a1)) a2 a3
+        else if qn = lt_qn  then Comp Lt a2 a3
+        else if qn = lte_qn then Comp Le a2 a3
+        else if qn = gt_qn  then Comp Gt a2 a3
+        else if qn = gte_qn then Comp Ge a2 a3
+        else App h0 (fst t)
+    | Tv_FVar fv, [(a1, Q_Explicit); (a2, Q_Explicit)] ->
+        let qn = inspect_fv fv in
+        if qn = imp_qn then Implies a1 a2
+        else if qn = and_qn then And a1 a2
+        else if qn = iff_qn then Iff a1 a2
+        else if qn = or_qn  then Or a1 a2
+        else if qn = eq2_qn then Comp (Eq     None) a1 a2
+        else if qn = eq1_qn then Comp (BoolEq None) a1 a2
+        else App h0 (fst t)
+
| Tv_FVar fv, [(a1, Q_Implicit); (a2, Q_Explicit)] ->
+    let qn = inspect_fv fv in
+         if qn = forall_qn then mk_Forall a1 a2
+    else if qn = exists_qn then mk_Exists a1 a2
+    else App h0 (fst t)
+| Tv_FVar fv, [(a, Q_Explicit)] ->
+    let qn = inspect_fv fv in
+    if qn = not_qn then Not a
+    else App h0 (fst t)
+| _ ->
+    App h0 (fst t)
+end
+
| Tv_Const (C_Int i) ->
+    IntLit i
+

TODO: all these. Do we want to export them?

+
| Tv_Type _
+| Tv_Abs _ _
+| Tv_Refine _ _
+| Tv_Const (C_Unit)
+| _ ->
+    F_Unknown
+
let rec is_name_imp (nm : name) (t : term) : bool =
+    begin match inspect_ln t with
+    | Tv_FVar fv ->
+        if inspect_fv fv = nm
+        then true
+        else false
+    | Tv_App l (_, Q_Implicit) -> // ignore implicits
+        is_name_imp nm l
+    | _ -> false
+    end
+
let unsquash (t : term) : option term =
+    match inspect_ln t with
+    | Tv_App l (r, Q_Explicit) ->
+        if is_name_imp squash_qn l
+        then Some r
+        else None
+    | _ -> None
+
let unsquash_total (t : term) : term =
+    match inspect_ln t with
+    | Tv_App l (r, Q_Explicit) ->
+        if is_name_imp squash_qn l
+        then r
+        else t
+    | _ -> t
+

Unsquashing

+
let term_as_formula (t:term) : Tac formula =
+    match unsquash t with
+    | None -> F_Unknown
+    | Some t ->
+        term_as_formula' t
+
let term_as_formula_total (t:term) : Tac formula =
+    term_as_formula' (unsquash_total t)
+
let formula_as_term_view (f:formula) : Tot term_view =
+    let mk_app' tv args = List.Tot.Base.fold_left (fun tv a -> Tv_App (pack_ln tv) a) tv args in
+    let e = Q_Explicit in
+    let i = Q_Implicit in
+    match f with
+    | True_  -> Tv_FVar (pack_fv true_qn)
+    | False_ -> Tv_FVar (pack_fv false_qn)
+    | Comp (Eq None)         l r -> mk_app' (Tv_FVar (pack_fv eq2_qn)) [(l,e);(r,e)]
+    | Comp (Eq (Some t))     l r -> mk_app' (Tv_FVar (pack_fv eq2_qn)) [(t,i);(l,e);(r,e)]
+    | Comp (BoolEq None)     l r -> mk_app' (Tv_FVar (pack_fv eq1_qn)) [(l,e);(r,e)]
+    | Comp (BoolEq (Some t)) l r -> mk_app' (Tv_FVar (pack_fv eq1_qn)) [(t,i);(l,e);(r,e)]
+    | Comp Lt l r     -> mk_app' (Tv_FVar (pack_fv lt_qn))  [(l,e);(r,e)]
+    | Comp Le l r     -> mk_app' (Tv_FVar (pack_fv lte_qn)) [(l,e);(r,e)]
+    | Comp Gt l r     -> mk_app' (Tv_FVar (pack_fv gt_qn))  [(l,e);(r,e)]
+    | Comp Ge l r     -> mk_app' (Tv_FVar (pack_fv gte_qn)) [(l,e);(r,e)]
+    | And p q         -> mk_app' (Tv_FVar (pack_fv and_qn)) [(p,e);(q,e)]
+    | Or  p q         -> mk_app' (Tv_FVar (pack_fv  or_qn)) [(p,e);(q,e)]
+    | Implies p q     -> mk_app' (Tv_FVar (pack_fv imp_qn)) [(p,e);(q,e)]
+    | Not p           -> mk_app' (Tv_FVar (pack_fv not_qn)) [(p,e)]
+    | Iff p q         -> mk_app' (Tv_FVar (pack_fv iff_qn)) [(p,e);(q,e)]
+    | Forall b t      -> Tv_Unknown // TODO: decide on meaning of this
+    | Exists b t      -> Tv_Unknown // TODO: ^
+
| App p q ->
+    Tv_App p (q, Q_Explicit)
+
| Name b ->
+    Tv_Var b
+
| FV fv ->
+    Tv_FVar fv
+
| IntLit i ->
+    Tv_Const (C_Int i)
+
| F_Unknown ->
+    Tv_Unknown
+
let formula_as_term (f:formula) : Tot term =
+    pack_ln (formula_as_term_view f)
+
let formula_to_string (f:formula) : string =
+    match f with
+    | True_ -> "True_"
+    | False_ -> "False_"
+    | Comp (Eq mt) l r -> "Eq" ^
+                        (match mt with
+                         | None -> ""
+                         | Some t -> " (" ^ term_to_string t ^ ")") ^
+                        " (" ^ term_to_string l ^ ") (" ^ term_to_string r ^ ")"
+    | Comp (BoolEq mt) l r -> "BoolEq" ^
+                        (match mt with
+                         | None -> ""
+                         | Some t -> " (" ^ term_to_string t ^ ")") ^
+                        " (" ^ term_to_string l ^ ") (" ^ term_to_string r ^ ")"
+    | Comp Lt l r -> "Lt (" ^ term_to_string l ^ ") (" ^ term_to_string r ^ ")"
+    | Comp Le l r -> "Le (" ^ term_to_string l ^ ") (" ^ term_to_string r ^ ")"
+    | Comp Gt l r -> "Gt (" ^ term_to_string l ^ ") (" ^ term_to_string r ^ ")"
+    | Comp Ge l r -> "Ge (" ^ term_to_string l ^ ") (" ^ term_to_string r ^ ")"
+    | And p q -> "And (" ^ term_to_string p ^ ") (" ^ term_to_string q ^ ")"
+    | Or  p q ->  "Or (" ^ term_to_string p ^ ") (" ^ term_to_string q ^ ")"
+    | Implies p q ->  "Implies (" ^ term_to_string p ^ ") (" ^ term_to_string q ^ ")"
+    | Not p ->  "Not (" ^ term_to_string p ^ ")"
+    | Iff p q ->  "Iff (" ^ term_to_string p ^ ") (" ^ term_to_string q ^ ")"
+    | Forall bs t -> "Forall <bs> (" ^ term_to_string t ^ ")"
+    | Exists bs t -> "Exists <bs> (" ^ term_to_string t ^ ")"
+    | App p q ->  "App (" ^ term_to_string p ^ ") (" ^ term_to_string q ^ ")"
+    | Name bv ->  "Name (" ^ bv_to_string bv ^ ")"
+    | FV fv -> "FV (" ^ flatten_name (inspect_fv fv) ^ ")"
+    | IntLit i -> "Int " ^ string_of_int i
+    | F_Unknown -> "?"
+ diff --git a/docs/FStar.Reflection.Types.html b/docs/FStar.Reflection.Types.html index 9c2381d..fdee178 100644 --- a/docs/FStar.Reflection.Types.html +++ b/docs/FStar.Reflection.Types.html @@ -1,16 +1,31 @@ - - + + - - - - - + FStar.Reflection.Types + -

module FStar.Reflection.Types

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection.Types

+ +
assume new type binder
+assume new type bv
+assume new type term
+assume new type env
+assume new type fv
+assume new type comp
+assume new type sigelt // called `def` in the paper, but we keep the internal name here
+assume new type ctx_uvar_and_subst
+assume new type letbinding
+
type name : eqtype = list string
+type ident = range * string
+type univ_name = ident
+type typ     = term
+type binders = list binder
+ diff --git a/docs/FStar.Reflection.html b/docs/FStar.Reflection.html index 0dc917f..ae6a3a7 100644 --- a/docs/FStar.Reflection.html +++ b/docs/FStar.Reflection.html @@ -1,16 +1,27 @@ - - + + - - - - - + FStar.Reflection + -

module FStar.Reflection

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Reflection

+ + diff --git a/docs/FStar.ReflexiveTransitiveClosure.html b/docs/FStar.ReflexiveTransitiveClosure.html index ee7dbc4..ff1c78d 100644 --- a/docs/FStar.ReflexiveTransitiveClosure.html +++ b/docs/FStar.ReflexiveTransitiveClosure.html @@ -1,64 +1,61 @@ - - + + - - - - - - + FStar.ReflexiveTransitiveClosure + -

module FStar.ReflexiveTransitiveClosure

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
val closure_step:Unidentified product: [#a:Type0] Unidentified product: [r:relation a] Unidentified product: [x:a] Unidentified product: [y:a] (Lemma ((requires r x y)) ((ensures closure r x y)) (Prims.Cons (SMTPat (closure r x y)) (Prims.Nil )))
+

+FStar.ReflexiveTransitiveClosure

+
+

This module defines the reflexive transitive closure of a +relation. That is, the smallest preorder that includes it.

+

Closures are convenient for defining monotonic memory references:

+ +

See examples/preorder/Closure.fst for usage examples.

+
+ +
val closure (#a:Type u#a) (r:relation a) : preorder a
+

+closure_step

closure r includes r

-
val closure_inversion:Unidentified product: [#a:Type0] Unidentified product: [r:relation a] Unidentified product: [x:a] Unidentified product: [y:a] (Lemma ((requires closure r x y)) ((ensures \/(==(x, y), (exists z.{:pattern } /\(r x z, closure r z y))))) (Prims.Cons (SMTPat (closure r x y)) (Prims.Nil )))
+
val closure_step: #a:Type u#a -> r:relation a -> x:a -> y:a
+  -> Lemma (requires r x y) (ensures closure r x y)
+    [SMTPat (closure r x y)]
+

+closure_inversion

closure r is the smallest preorder that includes r

-
val stable_on_closure:Unidentified product: [#a:Type0] Unidentified product: [r:relation a] Unidentified product: [p:(Unidentified product: [a] Type0)] Unidentified product: [p_stable_on_r:(squash (forall x y.{:pattern (p y); (r x y)} ==>(/\(p x, r x y), p y)))] (Lemma (forall x y.{:pattern (closure r x y)} ==>(/\(p x, closure r x y), p y)))
+
val closure_inversion: #a:Type u#a -> r:relation a -> x:a -> y:a
+  -> Lemma (requires closure r x y)
+          (ensures  x == y \/ (exists z. r x z /\ closure r z y))
+

+stable_on_closure

+
val stable_on_closure: #a:Type u#a -> r:relation a -> p:(a -> Type0)
+  -> p_stable_on_r: (squash (forall x y.{:pattern (p y); (r x y)} p x /\ r x y ==> p y))
+  -> Lemma (forall x y.{:pattern (closure r x y)} p x /\ closure r x y ==> p y)
+ diff --git a/docs/FStar.ST.html b/docs/FStar.ST.html index be1d92e..4a8eea4 100644 --- a/docs/FStar.ST.html +++ b/docs/FStar.ST.html @@ -1,55 +1,111 @@ - - + + - - - - - - + FStar.ST + -

module FStar.ST

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
*** Global ST (GST) effect with put, get, witness, and recall ****
-
*** ST effect ****
+

+FStar.ST

+ +

+Global ST (GST) effect with put, get, witness, and recall ****

+
new_effect GST = STATE_h heap
+
let gst_pre           = st_pre_h heap
+let gst_post' (a:Type) (pre:Type) = st_post_h' heap a pre
+let gst_post  (a:Type) = st_post_h heap a
+let gst_wp (a:Type)   = st_wp_h heap a
+
unfold let lift_div_gst (a:Type) (wp:pure_wp a) (p:gst_post a) (h:heap) = wp (fun a -> p a h)
+sub_effect DIV ~> GST = lift_div_gst
+
let heap_rel (h1:heap) (h2:heap) =
+  forall (a:Type0) (rel:preorder a) (r:mref a rel). h1 `contains` r ==>
+                                               (h2 `contains` r /\ rel (sel h1 r) (sel h2 r))
+
assume val gst_get: unit    -> GST heap (fun p h0 -> p h0 h0)
+assume val gst_put: h1:heap -> GST unit (fun p h0 -> heap_rel h0 h1 /\ p () h1)
+
type heap_predicate = heap -> Type0
+
let stable (p:heap_predicate) =
+  forall (h1:heap) (h2:heap). (p h1 /\ heap_rel h1 h2) ==> p h2
+
[@@"opaque_to_smt"]
+let witnessed (p:heap_predicate{stable p}) : Type0 = W.witnessed heap_rel p
+
assume val gst_witness: p:heap_predicate -> GST unit (fun post h0 -> stable p /\ p h0 /\ (witnessed p ==> post () h0))
+assume val gst_recall:  p:heap_predicate -> GST unit (fun post h0 -> stable p /\ witnessed p /\ (p h0 ==> post () h0))
+
val lemma_functoriality (p:heap_predicate{stable p /\ witnessed p})
+                        (q:heap_predicate{stable q /\ (forall (h:heap). p h ==> q h)})
+  :Lemma (ensures (witnessed q))
+let lemma_functoriality p q =
+  reveal_opaque (`%witnessed) witnessed;
+  W.lemma_witnessed_weakening heap_rel p q
+

+ST effect ****

+
let st_pre   = gst_pre
+let st_post' = gst_post'
+let st_post  = gst_post
+let st_wp    = gst_wp
+
new_effect STATE = GST
+
unfold let lift_gst_state (a:Type) (wp:gst_wp a) = wp
+sub_effect GST ~> STATE = lift_gst_state
+
effect State (a:Type) (wp:st_wp a) = STATE a wp
+
effect ST (a:Type) (pre:st_pre) (post: (h:heap -> Tot (st_post' a (pre h)))) =
+  STATE a (fun (p:st_post a) (h:heap) -> pre h /\ (forall a h1. post h a h1 ==> p a h1))
+effect St (a:Type) = ST a (fun h -> True) (fun h0 r h1 -> True)
+
let contains_pred (#a:Type0) (#rel:preorder a) (r:mref a rel) = fun h -> h `contains` r
+
type mref (a:Type0) (rel:preorder a) = r:Heap.mref a rel{is_mm r = false /\ witnessed (contains_pred r)}
+
let recall (#a:Type) (#rel:preorder a) (r:mref a rel) :STATE unit (fun p h -> Heap.contains h r ==> p () h)
+  = gst_recall (contains_pred r)
+
let alloc (#a:Type) (#rel:preorder a) (init:a)
+  :ST (mref a rel)
+      (fun h -> True)
+      (fun h0 r h1 -> fresh r h0 h1 /\ modifies Set.empty h0 h1 /\ sel h1 r == init)
+  = let h0 = gst_get () in
+    let r, h1 = alloc rel h0 init false in
+    gst_put h1;
+    gst_witness (contains_pred r);
+    r
+
let read (#a:Type) (#rel:preorder a) (r:mref a rel) :STATE a (fun p h -> p (sel h r) h)
+  = let h0 = gst_get () in
+    gst_recall (contains_pred r);
+    Heap.lemma_sel_equals_sel_tot_for_contained_refs h0 r;
+    sel_tot h0 r
+
let write (#a:Type) (#rel:preorder a) (r:mref a rel) (v:a)
+  : ST unit
+    (fun h -> rel (sel h r) v)
+    (fun h0 x h1 -> rel (sel h0 r) v /\ h0 `contains` r /\
+                 modifies (Set.singleton (addr_of r)) h0 h1 /\ equal_dom h0 h1 /\
+                 sel h1 r == v)
+  = let h0 = gst_get () in
+    gst_recall (contains_pred r);
+    let h1 = upd_tot h0 r v in
+    Heap.lemma_distinct_addrs_distinct_preorders ();
+    Heap.lemma_distinct_addrs_distinct_mm ();
+    Heap.lemma_upd_equals_upd_tot_for_contained_refs h0 r v;
+    gst_put h1
+
let get (u:unit) :ST heap (fun h -> True) (fun h0 h h1 -> h0==h1 /\ h==h1) = gst_get ()
+
let op_Bang (#a:Type) (#rel:preorder a) (r:mref a rel)
+  : STATE a (fun p h -> p (sel h r) h)
+= read #a #rel r
+
let op_Colon_Equals (#a:Type) (#rel:preorder a) (r:mref a rel) (v:a)
+  : ST unit
+    (fun h -> rel (sel h r) v)
+    (fun h0 x h1 -> rel (sel h0 r) v /\ h0 `contains` r /\
+                 modifies (Set.singleton (addr_of r)) h0 h1 /\ equal_dom h0 h1 /\
+                 sel h1 r == v)
+= write #a #rel r v
+
type ref (a:Type0) = mref a (trivial_preorder a)
+
let modifies_none (h0:heap) (h1:heap) = modifies !{} h0 h1
+ diff --git a/docs/FStar.Seq.Base.html b/docs/FStar.Seq.Base.html index c27b611..94a320b 100644 --- a/docs/FStar.Seq.Base.html +++ b/docs/FStar.Seq.Base.html @@ -1,16 +1,153 @@ - - + + - - - - - + FStar.Seq.Base + -

module FStar.Seq.Base

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

A logical theory of sequences indexed by natural numbers in [0, n)

+

+FStar.Seq.Base

+

#set-options "--initial_fuel 0 --max_fuel 0 --initial_ifuel 1 --max_ifuel 1"

+ +
new val seq (a : Type u#a) : Type u#a
+

Destructors

+
val length: #a:Type -> seq a -> Tot nat
+
val index:  #a:Type -> s:seq a -> i:nat{i < length s} -> Tot a
+
val create: #a:Type -> nat -> a -> Tot (seq a)
+
private val init_aux (#a:Type) (len:nat) (k:nat{k < len}) (contents:(i:nat { i < len } -> Tot a))
+  :Tot (seq a)
+
inline_for_extraction val init: #a:Type -> len:nat -> contents: (i:nat { i < len } -> Tot a) -> Tot (seq a)
+
private val init_aux_ghost (#a:Type) (len:nat) (k:nat{k < len}) (contents:(i:nat { i < len } -> GTot a))
+  : GTot (seq a)
+
inline_for_extraction val init_ghost: #a:Type -> len:nat -> contents: (i:nat { i < len } -> GTot a) -> GTot (seq a)
+
val empty (#a:Type) : Tot (s:(seq a){length s=0})
+
[@@(deprecated "Seq.empty")]
+unfold
+let createEmpty (#a:Type)
+    : Tot (s:(seq a){length s=0})
+    = empty #a
+
val lemma_empty (#a:Type) (s:seq a) : Lemma (length s = 0 ==> s == empty #a)
+
val upd: #a:Type -> s:seq a -> n:nat{n < length s} -> a ->  Tot (seq a)
+
val append: #a:Type -> seq a -> seq a -> Tot (seq a)
+
let op_At_Bar (#a:Type) (s1:seq a) (s2:seq a) = append s1 s2
+
val slice:  #a:Type -> s:seq a -> i:nat -> j:nat{i <= j && j <= length s} -> Tot (seq a)
+

Lemmas about length

+
val lemma_create_len: #a:Type -> n:nat -> i:a -> Lemma
+  (requires True)
+  (ensures (length (create n i) = n))
+  [SMTPat (length (create n i))]
+
val lemma_init_len: #a:Type -> n:nat -> contents: (i:nat { i < n } -> Tot a) -> Lemma
+  (requires True)
+  (ensures (length (init n contents) = n))
+  [SMTPat (length (init n contents))]
+
private val lemma_init_aux_len (#a:Type) (n:nat) (k:nat{k < n}) (contents:(i:nat{ i < n } -> Tot a))
+  : Lemma (requires True)
+    (ensures (length (init_aux n k contents) = n - k))
+    [SMTPat (length (init_aux n k contents))]
+
val lemma_init_ghost_len: #a:Type -> n:nat -> contents: (i:nat { i < n } -> GTot a) -> Lemma
+  (requires True)
+  (ensures (length (init_ghost n contents) = n))
+  [SMTPat (length (init_ghost n contents))]
+
private val lemma_init_ghost_aux_len (#a:Type) (n:nat) (k:nat{k < n}) (contents:(i:nat{ i < n } -> GTot a))
+  : Lemma (requires True)
+    (ensures (length (init_aux_ghost n k contents) = n - k))
+    [SMTPat (length (init_aux_ghost n k contents))]
+
val lemma_len_upd: #a:Type -> n:nat -> v:a -> s:seq a{n < length s} -> Lemma
+  (requires True)
+  (ensures (length (upd s n v) = length s))
+  [SMTPat (length (upd s n v))]
+
val lemma_len_append: #a:Type -> s1:seq a -> s2:seq a -> Lemma
+  (requires True)
+  (ensures (length (append s1 s2) = length s1 + length s2))
+  [SMTPat (length (append s1 s2))]
+
val lemma_len_slice: #a:Type -> s:seq a -> i:nat -> j:nat{i <= j && j <= length s} -> Lemma
+  (requires True)
+  (ensures (length (slice s i j) = j - i))
+  [SMTPat (length (slice s i j))]
+

Lemmas about index

+
val lemma_index_create: #a:Type -> n:nat -> v:a -> i:nat{i < n} -> Lemma
+  (requires True)
+  (ensures (index (create n v) i == v))
+  [SMTPat (index (create n v) i)]
+
val lemma_index_upd1: #a:Type -> s:seq a -> n:nat{n < length s} -> v:a -> Lemma
+  (requires True)
+  (ensures (index (upd s n v) n == v))
+  [SMTPat (index (upd s n v) n)]
+
val lemma_index_upd2: #a:Type -> s:seq a -> n:nat{n < length s} -> v:a -> i:nat{i<>n /\ i < length s} -> Lemma
+  (requires True)
+  (ensures (index (upd s n v) i == index s i))
+  [SMTPat (index (upd s n v) i)]
+
val lemma_index_app1: #a:Type -> s1:seq a -> s2:seq a -> i:nat{i < length s1} -> Lemma
+  (requires True)
+  (ensures (index (append s1 s2) i == index s1 i))
+  [SMTPat (index (append s1 s2) i)]
+
val lemma_index_app2: #a:Type -> s1:seq a -> s2:seq a -> i:nat{i < length s1 + length s2 /\ length s1 <= i} -> Lemma
+  (requires True)
+  (ensures (index (append s1 s2) i == index s2 (i - length s1)))
+  [SMTPat (index (append s1 s2) i)]
+
val lemma_index_slice: #a:Type -> s:seq a -> i:nat -> j:nat{i <= j /\ j <= length s} -> k:nat{k < j - i} -> Lemma
+  (requires True)
+  (ensures (index (slice s i j) k == index s (k + i)))
+  [SMTPat (index (slice s i j) k)]
+
val hasEq_lemma: a:Type -> Lemma (requires (hasEq a)) (ensures (hasEq (seq a))) [SMTPat (hasEq  (seq a))]
+
[@@ remove_unused_type_parameters [0; 1; 2]]
+val equal (#a:Type) (s1:seq a) (s2:seq a) : Tot prop
+

decidable equality

+
private val eq_i:
+  #a:eqtype -> s1:seq a -> s2:seq a{length s1 = length s2}
+  -> i:nat{i <= length s1}
+  -> Tot (r:bool{r <==> (forall j. (j >= i /\ j < length s1) ==> (index s1 j = index s2 j))})
+
val eq: #a:eqtype -> s1:seq a -> s2:seq a -> Tot (r:bool{r <==> equal s1 s2})
+
val lemma_eq_intro: #a:Type -> s1:seq a -> s2:seq a -> Lemma
+     (requires (length s1 = length s2
+               /\ (forall (i:nat{i < length s1}).{:pattern (index s1 i); (index s2 i)} (index s1 i == index s2 i))))
+     (ensures (equal s1 s2))
+     [SMTPat (equal s1 s2)]
+
val lemma_eq_refl: #a:Type -> s1:seq a -> s2:seq a -> Lemma
+     (requires (s1 == s2))
+     (ensures (equal s1 s2))
+     [SMTPat (equal s1 s2)]
+
val lemma_eq_elim: #a:Type -> s1:seq a -> s2:seq a -> Lemma
+     (requires (equal s1 s2))
+     (ensures (s1==s2))
+     [SMTPat (equal s1 s2)]
+

Properties of append

+
val append_assoc
+  (#a: Type)
+  (s1 s2 s3: seq a)
+: Lemma
+  (ensures (append (append s1 s2) s3 == append s1 (append s2 s3)))
+
val append_empty_l
+  (#a: Type)
+  (s: seq a)
+: Lemma
+  (ensures (append empty s == s))
+
val append_empty_r
+  (#a: Type)
+  (s: seq a)
+: Lemma
+  (ensures (append s empty == s))
+
val init_index (#a:Type) (len:nat) (contents:(i:nat { i < len } -> Tot a))
+  : Lemma (requires True)
+    (ensures (forall (i:nat{i < len}). index (init len contents) i == contents i))
+
val init_index_ (#a:Type) (len:nat) (contents:(i:nat { i < len } -> Tot a)) (j: nat)
+  : Lemma (requires j < len)
+    (ensures (index (init len contents) j == contents j))
+    [SMTPat (index (init len contents) j)]
+
val init_ghost_index (#a:Type) (len:nat) (contents:(i:nat { i < len } -> GTot a))
+  : Lemma (requires True)
+    (ensures (forall (i:nat{i < len}). index (init_ghost len contents) i == contents i))
+
val init_ghost_index_ (#a:Type) (len:nat) (contents:(i:nat { i < len } -> GTot a)) (j: nat)
+  : Lemma (requires j < len)
+    (ensures (index (init_ghost len contents) j == contents j))
+    [SMTPat (index (init_ghost len contents) j)]
+
val lemma_equal_instances_implies_equal_types (_:unit)
+  :Lemma (forall (a:Type) (b:Type) (s1:seq a) (s2:seq b). s1 === s2 ==> a == b)
+ diff --git a/docs/FStar.Seq.Permutation.html b/docs/FStar.Seq.Permutation.html new file mode 100644 index 0000000..3d85318 --- /dev/null +++ b/docs/FStar.Seq.Permutation.html @@ -0,0 +1,93 @@ + + + + + FStar.Seq.Permutation + + + +

+FStar.Seq.Permutation

+ +

Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at

+
http://www.apache.org/licenses/LICENSE-2.0
+
+

Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License.

+

Author: N. Swamy

+

This module defines a permutation on sequences as a bijection among +the sequence indices relating equal elements.

+

It defines a few utilities to work with such permutations.

+

Notably:

+
    +
  1. +

    Given two sequence with equal element counts, it constructs a +permutation.

    +
    2. +
  2. +

    Folding the multiplication of a commutative monoid over a +sequence and its permutation produces the same result

    +
    3. +
+

A bounded natural number

+
let nat_at_most (n:nat) = m:nat { m < n }
+

A function from the indices of s to itself

+
let index_fun #a (s:seq a) = nat_at_most (Seq.length s) -> nat_at_most (Seq.length s)
+

An abstract predicate defining when an index_fun is a permutation

+
val is_permutation (#a:Type) (s0:seq a) (s1:seq a) (f:index_fun s0) : prop
+

Revealing the intepretation of is_permutation

+
val reveal_is_permutation (#a:Type) (s0 s1:seq a) (f:index_fun s0)
+  : Lemma (is_permutation s0 s1 f <==>
+

lengths of the sequences are the same

+
Seq.length s0 == Seq.length s1 /\
+

f is injective

+
(forall x y. {:pattern f x; f y}
+  x <> y ==> f x <> f y) /\
+

and f relates equal items in s0 and s1

+
(forall (i:nat{i < Seq.length s0}).{:pattern (Seq.index s1 (f i))}
+   Seq.index s0 i == Seq.index s1 (f i)))
+

A seqperm is an index_fun that is also a permutation

+
let seqperm (#a:Type) (s0:seq a) (s1:seq a) =
+  f:index_fun s0 { is_permutation s0 s1 f }
+

We can construct a permutation from +sequences whose element counts are the same

+
val permutation_from_equal_counts
+      (#a:eqtype)
+      (s0:seq a) (s1:seq a{(forall x. count x s0 == count x s1)})
+  : Tot (seqperm s0 s1)
+

Now, some utilities related to commutative monoids and permutations

+ +

folding a m.mult over a sequence

+
let foldm_snoc (#a:Type) (m:CM.cm a) (s:seq a) = foldr_snoc m.mult s m.unit
+

folding m over the concatenation of s1 and s2 +can be decomposed into a fold over s1 and a fold over s2

+
val foldm_snoc_append (#a:Type) (m:CM.cm a) (s1 s2: seq a)
+  : Lemma
+    (ensures foldm_snoc m (append s1 s2) == m.mult (foldm_snoc m s1) (foldm_snoc m s2))
+

folds over concatenated lists can is symmetric

+
val foldm_snoc_sym (#a:Type) (m:CM.cm a) (s1 s2: seq a)
+  : Lemma
+    (ensures foldm_snoc m (append s1 s2) == foldm_snoc m (append s2 s1))
+

And, finally, if s0 and s1 are permutations, +then folding m over them is identical

+
val foldm_snoc_perm (#a:_)
+               (m:CM.cm a)
+               (s0:seq a)
+               (s1:seq a)
+               (p:seqperm s0 s1)
+  : Lemma
+    (ensures foldm_snoc m s0  == foldm_snoc m s1)
+ + + diff --git a/docs/FStar.Seq.Properties.html b/docs/FStar.Seq.Properties.html index 2d0eb2f..e4ce453 100644 --- a/docs/FStar.Seq.Properties.html +++ b/docs/FStar.Seq.Properties.html @@ -1,58 +1,613 @@ - - + + - - - - - - + FStar.Seq.Properties + -

module FStar.Seq.Properties

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
 More properties, with new naming conventions
-
pragma
-

Dealing efficiently with seq_of_list by meta-evaluating conjunctions over an entire list.

-
let ((sortWith (#a:eqtype) (f:Unidentified product: [a] Unidentified product: [a] (Tot int)) (s:seq a)):(Tot (seq a))):seq_of_list (List.Tot.Base.sortWith f (seq_to_list s))
-

**** sortWith *****

+

+FStar.Seq.Properties

+ +
let lseq (a: Type) (l: nat) : Type =
+    s: Seq.seq a { Seq.length s == l }
+
let indexable (#a:Type) (s:Seq.seq a) (j:int) = 0 <= j /\ j < Seq.length s
+
val lemma_append_inj_l: #a:Type -> s1:seq a -> s2:seq a -> t1:seq a -> t2:seq a{length s1 = length t1 /\ equal (append s1 s2) (append t1 t2)} -> i:nat{i < length s1}
+  -> Lemma (index s1 i == index t1 i)
+
val lemma_append_inj_r: #a:Type -> s1:seq a -> s2:seq a -> t1:seq a -> t2:seq a{length s1 = length t1 /\ length s2 = length t2 /\ equal (append s1 s2) (append t1 t2)} -> i:nat{i < length s2}
+  -> Lemma (ensures  (index s2 i == index t2 i))
+
val lemma_append_len_disj: #a:Type -> s1:seq a -> s2:seq a -> t1:seq a -> t2:seq a {(length s1 = length t1 \/ length s2 = length t2) /\ (equal (append s1 s2) (append t1 t2))}
+  -> Lemma (ensures (length s1 = length t1 /\ length s2 = length t2))
+
val lemma_append_inj: #a:Type -> s1:seq a -> s2:seq a -> t1:seq a -> t2:seq a {length s1 = length t1 \/ length s2 = length t2}
+  -> Lemma (requires (equal (append s1 s2) (append t1 t2)))
+           (ensures (equal s1 t1 /\ equal s2 t2))
+
let head (#a:Type) (s:seq a{length s > 0}) : Tot a = index s 0
+
let tail (#a:Type) (s:seq a{length s > 0}) : Tot (seq a) = slice s 1 (length s)
+
val lemma_head_append: #a:Type -> s1:seq a{length s1 > 0} -> s2:seq a -> Lemma
+  (head (append s1 s2) == head s1)
+
val lemma_tail_append: #a:Type -> s1:seq a{length s1 > 0} -> s2:seq a -> Lemma
+  (tail (append s1 s2) == append (tail s1) s2)
+
let last (#a:Type) (s:seq a{length s > 0}) : Tot a = index s (length s - 1)
+
let cons (#a:Type) (x:a) (s:seq a) : Tot (seq a) = append (create 1 x) s
+
val lemma_cons_inj: #a:Type -> v1:a -> v2:a -> s1:seq a -> s2:seq a
+  -> Lemma (requires (equal (cons v1 s1) (cons v2 s2)))
+          (ensures (v1 == v2 /\ equal s1 s2))
+
let split (#a:Type) (s:seq a) (i:nat{(0 <= i /\ i <= length s)}) : Tot (seq a * seq a)
+  = slice s 0 i, slice s i (length s)
+
val lemma_split : #a:Type -> s:seq a -> i:nat{(0 <= i /\ i <= length s)} -> Lemma
+  (ensures (append (fst (split s i)) (snd (split s i)) == s))
+
let split_eq (#a:Type) (s:seq a) (i:nat{(0 <= i /\ i <= length s)})
+: Pure
+  (seq a * seq a)
+  (requires True)
+  (ensures (fun x -> (append (fst x) (snd x) == s)))
+= let x = split s i in
+  lemma_split s i;
+  x
+
let rec count (#a:eqtype) (x:a) (s:seq a) : Tot nat (decreases (length s))
+= if length s = 0 then 0
+  else if head s = x
+  then 1 + count x (tail s)
+  else count x (tail s)
+
let mem (#a:eqtype) (x:a) (l:seq a) : Tot bool = count x l > 0
+
val mem_index (#a:eqtype) (x:a) (s:seq a)
+    : Lemma (requires (mem x s))
+            (ensures (exists i. index s i == x))
+

index_mem: +A utility function that finds the first index of +x in s, given that we know the x is actually contained in s

+
let rec index_mem (#a:eqtype) (x:a) (s:seq a)
+    : Pure nat
+           (requires (mem x s))
+           (ensures (fun i -> i < length s /\ index s i == x))
+           (decreases (length s))
+    = if head s = x then 0
+      else 1 + index_mem x (tail s)
+
let swap (#a:Type) (s:seq a) (i:nat{i<length s}) (j:nat{j<length s}) : Tot (seq a)
+= upd (upd s j (index s i)) i (index s j)
+
val lemma_slice_append: #a:Type -> s1:seq a{length s1 >= 1} -> s2:seq a -> Lemma
+  (ensures (equal (append s1 s2) (append (slice s1 0 1) (append (slice s1 1 (length s1)) s2))))
+
val lemma_slice_first_in_append: #a:Type -> s1:seq a -> s2:seq a -> i:nat{i <= length s1} -> Lemma
+  (ensures (equal (slice (append s1 s2) i (length (append s1 s2))) (append (slice s1 i (length s1)) s2)))
+
val slice_upd: #a:Type -> s:seq a -> i:nat -> j:nat{i <= j /\ j <= length s}
+  -> k:nat{k < length s} -> v:a -> Lemma
+  (requires k < i \/ j <= k)
+  (ensures  slice (upd s k v) i j == slice s i j)
+  [SMTPat (slice (upd s k v) i j)]
+
val upd_slice: #a:Type -> s:seq a -> i:nat -> j:nat{i <= j /\ j <= length s}
+  -> k:nat{k < j - i} -> v:a -> Lemma
+  (requires i + k < j)
+  (ensures  upd (slice s i j) k v == slice (upd s (i + k) v) i j)
+  [SMTPat (upd (slice s i j) k v)]
+

TODO: should be renamed cons_head_append, or something like that (because it is NOT related to (append (cons _ _) _))

+
val lemma_append_cons: #a:Type -> s1:seq a{length s1 > 0} -> s2:seq a -> Lemma
+  (requires True)
+  (ensures (equal (append s1 s2) (cons (head s1) (append (tail s1) s2))))
+
val lemma_tl: #a:Type -> hd:a -> tl:seq a -> Lemma
+  (ensures (equal (tail (cons hd tl)) tl))
+
let rec sorted (#a:Type) (f:a -> a -> Tot bool) (s:seq a)
+: Tot bool (decreases (length s))
+= if length s <= 1
+  then true
+  else let hd = head s in
+       f hd (index s 1) && sorted f (tail s)
+
val sorted_feq (#a:Type)
+               (f g : (a -> a -> Tot bool))
+               (s:seq a{forall x y. f x y == g x y})
+   : Lemma (ensures (sorted f s <==> sorted g s))
+
val lemma_append_count: #a:eqtype -> lo:seq a -> hi:seq a -> Lemma
+  (requires True)
+  (ensures (forall x. count x (append lo hi) = (count x lo + count x hi)))
+
val lemma_append_count_aux: #a:eqtype -> x:a -> lo:seq a -> hi:seq a -> Lemma
+  (requires True)
+  (ensures (count x (append lo hi) = (count x lo + count x hi)))
+
val lemma_mem_inversion: #a:eqtype -> s:seq a{length s > 0} -> Lemma
+  (ensures (forall x. mem x s = (x=head s || mem x (tail s))))
+
val lemma_mem_count: #a:eqtype -> s:seq a -> f:(a -> Tot bool) -> Lemma
+  (requires (forall (i:nat{i<length s}). f (index s i)))
+  (ensures (forall (x:a). mem x s ==> f x))
+
val lemma_count_slice: #a:eqtype -> s:seq a -> i:nat{i<=length s} -> Lemma
+  (requires True)
+  (ensures (forall x. count x s = count x (slice s 0 i) + count x (slice s i (length s))))
+
type total_order (a:eqtype) (f: (a -> a -> Tot bool)) =
+    (forall a. f a a)                                           (* reflexivity   *)
+    /\ (forall a1 a2. (f a1 a2 /\ a1<>a2)  <==> not (f a2 a1))  (* anti-symmetry *)
+    /\ (forall a1 a2 a3. f a1 a2 /\ f a2 a3 ==> f a1 a3)        (* transitivity  *)
+type tot_ord (a:eqtype) = f:(a -> a -> Tot bool){total_order a f}
+
val sorted_concat_lemma: #a:eqtype
+                      -> f:(a -> a -> Tot bool){total_order a f}
+                      -> lo:seq a{sorted f lo}
+                      -> pivot:a
+                      -> hi:seq a{sorted f hi}
+                      -> Lemma (requires (forall y. (mem y lo ==> f y pivot)
+                                                 /\ (mem y hi ==> f pivot y)))
+                               (ensures (sorted f (append lo (cons pivot hi))))
+
val split_5 : #a:Type -> s:seq a -> i:nat -> j:nat{i < j && j < length s} -> Pure (seq (seq a))
+  (requires True)
+  (ensures (fun x ->
+            (length x = 5
+             /\ equal s (append (index x 0) (append (index x 1) (append (index x 2) (append (index x 3) (index x 4)))))
+             /\ equal (index x 0) (slice s 0 i)
+             /\ equal (index x 1) (slice s i (i+1))
+             /\ equal (index x 2) (slice s (i+1) j)
+             /\ equal (index x 3) (slice s j (j + 1))
+             /\ equal (index x 4) (slice s (j + 1) (length s)))))
+
val lemma_swap_permutes_aux_frag_eq: #a:Type -> s:seq a -> i:nat{i<length s} -> j:nat{i <= j && j<length s}
+                          -> i':nat -> j':nat{i' <= j' /\ j'<=length s /\
+                                              (j < i'  //high slice
+                                              \/ j' <= i //low slice
+                                              \/ (i < i' /\ j' <= j)) //mid slice
+                                              }
+                          -> Lemma (ensures (slice s i' j' == slice (swap s i j) i' j'
+                                            /\ slice s i (i + 1) == slice (swap s i j) j (j + 1)
+                                            /\ slice s j (j + 1) == slice (swap s i j) i (i + 1)))
+
val lemma_swap_permutes_aux: #a:eqtype -> s:seq a -> i:nat{i<length s} -> j:nat{i <= j && j<length s} -> x:a -> Lemma
+  (requires True)
+  (ensures (count x s = count x (swap s i j)))
+
type permutation (a:eqtype) (s1:seq a) (s2:seq a) =
+       (forall i. count i s1 = count i s2)
+val lemma_swap_permutes (#a:eqtype) (s:seq a) (i:nat{i<length s}) (j:nat{i <= j && j<length s})
+  : Lemma (permutation a s (swap s i j))
+

perm_len: +A lemma that shows that two sequences that are permutations +of each other also have the same length

+
val perm_len (#a:eqtype) (s1 s2: seq a)
+  : Lemma (requires (permutation a s1 s2))
+          (ensures  (length s1 == length s2))
+
val cons_perm: #a:eqtype -> tl:seq a -> s:seq a{length s > 0} ->
+         Lemma (requires (permutation a tl (tail s)))
+               (ensures (permutation a (cons (head s) tl) s))
+
val lemma_mem_append : #a:eqtype -> s1:seq a -> s2:seq a
+      -> Lemma (ensures (forall x. mem x (append s1 s2) <==> (mem x s1 || mem x s2)))
+
val lemma_slice_cons: #a:eqtype -> s:seq a -> i:nat -> j:nat{i < j && j <= length s}
+  -> Lemma (ensures (forall x. mem x (slice s i j) <==> (x = index s i || mem x (slice s (i + 1) j))))
+
val lemma_slice_snoc: #a:eqtype -> s:seq a -> i:nat -> j:nat{i < j && j <= length s}
+  -> Lemma (ensures (forall x. mem x (slice s i j) <==> (x = index s (j - 1) || mem x (slice s i (j - 1)))))
+
val lemma_ordering_lo_snoc: #a:eqtype -> f:tot_ord a -> s:seq a -> i:nat -> j:nat{i <= j && j < length s} -> pv:a
+   -> Lemma (requires ((forall y. mem y (slice s i j) ==> f y pv) /\ f (index s j) pv))
+            (ensures ((forall y. mem y (slice s i (j + 1)) ==> f y pv)))
+
val lemma_ordering_hi_cons: #a:eqtype -> f:tot_ord a -> s:seq a -> back:nat -> len:nat{back < len && len <= length s} -> pv:a
+   -> Lemma (requires ((forall y. mem y (slice s (back + 1) len) ==> f pv y) /\ f pv (index s back)))
+            (ensures ((forall y. mem y (slice s back len) ==> f pv y)))
+
val swap_frame_lo : #a:Type -> s:seq a -> lo:nat -> i:nat{lo <= i} -> j:nat{i <= j && j < length s}
+     -> Lemma (ensures (slice s lo i == slice (swap s i j) lo i))
+
val swap_frame_lo' : #a:Type -> s:seq a -> lo:nat -> i':nat {lo <= i'} -> i:nat{i' <= i} -> j:nat{i <= j && j < length s}
+     -> Lemma (ensures (slice s lo i' == slice (swap s i j) lo i'))
+
val swap_frame_hi : #a:Type -> s:seq a -> i:nat -> j:nat{i <= j} -> k:nat{j < k} -> hi:nat{k <= hi /\ hi <= length s}
+     -> Lemma (ensures (slice s k hi == slice (swap s i j) k hi))
+
val lemma_swap_slice_commute  : #a:Type -> s:seq a -> start:nat -> i:nat{start <= i} -> j:nat{i <= j} -> len:nat{j < len && len <= length s}
+    -> Lemma (ensures (slice (swap s i j) start len == (swap (slice s start len) (i - start) (j - start))))
+
val lemma_swap_permutes_slice : #a:eqtype -> s:seq a -> start:nat -> i:nat{start <= i} -> j:nat{i <= j} -> len:nat{j < len && len <= length s}
+   -> Lemma (ensures (permutation a (slice s start len) (slice (swap s i j) start len)))
+

replaces the [i,j) sub-sequence of s1 with the corresponding sub-sequence of s2

+
let splice (#a:Type) (s1:seq a) (i:nat) (s2:seq a{length s1=length s2}) (j:nat{i <= j /\ j <= (length s2)})
+: Tot (seq a)
+= Seq.append (slice s1 0 i) (Seq.append (slice s2 i j) (slice s1 j (length s1)))
+

replace with sub

+
let replace_subseq (#a:Type0) (s:Seq.seq a) (i:nat) (j:nat{i <= j /\ j <= length s}) (sub:Seq.seq a{length sub == j - i}) :Tot (Seq.seq a)
+  = Seq.append (Seq.slice s 0 i) (Seq.append sub (Seq.slice s j (Seq.length s)))
+
val splice_refl : #a:Type -> s:seq a -> i:nat -> j:nat{i <= j && j <= length s}
+  -> Lemma
+  (ensures (s == splice s i s j))
+
val lemma_swap_splice : #a:Type -> s:seq a -> start:nat -> i:nat{start <= i} -> j:nat{i <= j} -> len:nat{j < len && len <= length s}
+   -> Lemma
+        (ensures (swap s i j == splice s start (swap s i j) len))
+
val lemma_seq_frame_hi: #a:Type -> s1:seq a -> s2:seq a{length s1 = length s2} -> i:nat -> j:nat{i <= j} -> m:nat{j <= m} -> n:nat{m < n && n <= length s1}
+  -> Lemma
+  (requires (s1 == (splice s2 i s1 j)))
+  (ensures  ((slice s1 m n == slice s2 m n) /\ (index s1 m == index s2 m)))
+
val lemma_seq_frame_lo: #a:Type -> s1:seq a -> s2:seq a{length s1 = length s2} -> i:nat -> j:nat{i <= j} -> m:nat{j < m} -> n:nat{m <= n && n <= length s1}
+  -> Lemma
+  (requires (s1 == (splice s2 m s1 n)))
+  (ensures  ((slice s1 i j == slice s2 i j) /\ (index s1 j == index s2 j)))
+
val lemma_tail_slice: #a:Type -> s:seq a -> i:nat -> j:nat{i < j && j <= length s}
+  -> Lemma
+  (requires True)
+  (ensures (tail (slice s i j) == slice s (i + 1) j))
+  [SMTPat (tail (slice s i j))]
+
val lemma_weaken_frame_right : #a:Type -> s1:seq a -> s2:seq a{length s1 = length s2} -> i:nat -> j:nat -> k:nat{i <= j && j <= k && k <= length s1}
+  -> Lemma
+  (requires (s1 == splice s2 i s1 j))
+  (ensures (s1 == splice s2 i s1 k))
+
val lemma_weaken_frame_left : #a:Type -> s1:seq a -> s2:seq a{length s1 = length s2} -> i:nat -> j:nat -> k:nat{i <= j && j <= k && k <= length s1}
+  -> Lemma
+  (requires (s1 == splice s2 j s1 k))
+  (ensures (s1 == splice s2 i s1 k))
+
val lemma_trans_frame : #a:Type -> s1:seq a -> s2:seq a -> s3:seq a{length s1 = length s2 /\ length s2 = length s3} -> i:nat -> j:nat{i <= j && j <= length s1}
+  -> Lemma
+  (requires ((s1 == splice s2 i s1 j) /\ s2 == splice s3 i s2 j))
+  (ensures (s1 == splice s3 i s1 j))
+
val lemma_weaken_perm_left: #a:eqtype -> s1:seq a -> s2:seq a{length s1 = length s2} -> i:nat -> j:nat -> k:nat{i <= j /\ j <= k /\ k <= length s1}
+  -> Lemma
+  (requires (s1 == splice s2 j s1 k /\ permutation a (slice s2 j k) (slice s1 j k)))
+  (ensures (permutation a (slice s2 i k) (slice s1 i k)))
+
val lemma_weaken_perm_right: #a:eqtype -> s1:seq a -> s2:seq a{length s1 = length s2} -> i:nat -> j:nat -> k:nat{i <= j /\ j <= k /\ k <= length s1}
+  -> Lemma
+  (requires (s1 == splice s2 i s1 j /\ permutation a (slice s2 i j) (slice s1 i j)))
+  (ensures (permutation a (slice s2 i k) (slice s1 i k)))
+
val lemma_trans_perm: #a:eqtype -> s1:seq a -> s2:seq a -> s3:seq a{length s1 = length s2 /\ length s2 = length s3} -> i:nat -> j:nat{i<=j && j <= length s1}
+ -> Lemma
+  (requires (permutation a (slice s1 i j) (slice s2 i j)
+             /\ permutation a (slice s2 i j) (slice s3 i j)))
+  (ensures (permutation a (slice s1 i j) (slice s3 i j)))
+

New addtions, please review

+
let snoc (#a:Type) (s:seq a) (x:a) : Tot (seq a) = Seq.append s (Seq.create 1 x)
+
val lemma_cons_snoc (#a:Type) (hd:a) (s:Seq.seq a) (tl:a)
+  : Lemma (requires True)
+          (ensures (Seq.equal (cons hd (snoc s tl))
+                              (snoc (cons hd s) tl)))
+
val lemma_tail_snoc: #a:Type -> s:Seq.seq a{Seq.length s > 0} -> x:a
+                     -> Lemma (ensures (tail (snoc s x) == snoc (tail s) x))
+
val lemma_snoc_inj: #a:Type -> s1:seq a -> s2:seq a -> v1:a -> v2:a
+  -> Lemma (requires (equal (snoc s1 v1) (snoc s2 v2)))
+          (ensures (v1 == v2 /\ equal s1 s2))
+
val lemma_mem_snoc : #a:eqtype -> s:Seq.seq a -> x:a ->
+   Lemma (ensures (forall y. mem y (snoc s x) <==> mem y s \/ x=y))
+
let rec find_l (#a:Type) (f:a -> Tot bool) (l:seq a)
+: Tot (o:option a{Some? o ==> f (Some?.v o)})
+  (decreases (Seq.length l))
+= if Seq.length l = 0 then None
+  else if f (head l) then Some (head l)
+  else find_l f (tail l)
+
let rec ghost_find_l (#a:Type) (f:a -> GTot bool) (l:seq a)
+: GTot (o:option a{Some? o ==> f (Some?.v o)})
+  (decreases (Seq.length l))
+= if Seq.length l = 0 then None
+  else if f (head l) then Some (head l)
+  else ghost_find_l f (tail l)
+
val find_append_some: #a:Type -> s1:seq a -> s2:seq a -> f:(a -> Tot bool) -> Lemma
+  (requires (Some? (find_l f s1)))
+  (ensures (find_l f (append s1 s2) == find_l f s1))
+
val find_append_none: #a:Type -> s1:seq a -> s2:seq a -> f:(a -> Tot bool) -> Lemma
+  (requires (None? (find_l f s1)))
+  (ensures (find_l f (append s1 s2) == find_l f s2))
+
val find_append_none_s2: #a:Type -> s1:seq a -> s2:seq a -> f:(a -> Tot bool) -> Lemma
+  (requires (None? (find_l f s2)))
+  (ensures  (find_l f (append s1 s2) == find_l f s1))
+
val find_snoc: #a:Type -> s:Seq.seq a -> x:a -> f:(a -> Tot bool)
+               -> Lemma (ensures (let res = find_l f (snoc s x) in
+                                 match res with
+                                 | None -> find_l f s == None /\ not (f x)
+                                 | Some y -> res == find_l f s \/ (f x /\ x==y)))
+
let un_snoc (#a:Type) (s:seq a{length s <> 0}) : Tot (r:(seq a * a){s == snoc (fst r) (snd r)}) =
+  let s', a = split s (length s - 1) in
+  assert (Seq.equal (snoc s' (Seq.index a 0)) s);
+  s', Seq.index a 0
+
val un_snoc_snoc (#a:Type) (s:seq a) (x:a) : Lemma (un_snoc (snoc s x) == (s, x))
+
let rec find_r (#a:Type) (f:a -> Tot bool) (l:seq a)
+: Tot (o:option a{Some? o ==> f (Some?.v o)})
+  (decreases (Seq.length l))
+= if Seq.length l = 0 then None
+  else let prefix, last = un_snoc l in
+       if f last then Some last
+       else find_r f prefix
+
type found (i:nat) = True
+
let rec seq_find_aux (#a:Type) (f:a -> Tot bool) (l:seq a) (ctr:nat{ctr <= Seq.length l})
+: Pure (option a)
+  (requires (forall (i:nat{ i < Seq.length l /\ i >= ctr}).
+               not (f (Seq.index l i) )))
+  (ensures (function
+            | None -> forall (i:nat{i < Seq.length l}).  not (f (Seq.index l i))
+            | Some x -> f x /\  (exists (i:nat{i < Seq.length l}). {:pattern (found i)}
+                                 found i /\ x == Seq.index l i)))
+= match ctr with
+  | 0 -> None
+  | _ -> let i = ctr - 1 in
+  if f (Seq.index l i)
+  then (
+     cut (found i);
+     Some (Seq.index l i))
+  else seq_find_aux f l i
+
let seq_find (#a:Type) (f:a -> Tot bool) (l:seq a)
+: Pure (option a)
+  (requires True)
+  (ensures (function
+            | None -> forall (i:nat{i < Seq.length l}). not (f (Seq.index l i))
+            | Some x -> f x /\ (exists (i:nat{i < Seq.length l}).{:pattern (found i)}
+                                 found i /\ x == Seq.index l i)))
+= seq_find_aux f l (Seq.length l)
+
val find_mem (#a:eqtype) (s:seq a) (f:a -> Tot bool) (x:a{f x})
+   : Lemma (requires (mem x s))
+           (ensures (Some? (seq_find f s) /\ f (Some?.v (seq_find f s))))
+
let for_all
+  (#a: Type)
+  (f: (a -> Tot bool))
+  (l: seq a)
+: Pure bool
+  (requires True)
+  (ensures (fun b -> (b == true <==> (forall (i: nat {i < Seq.length l} ) . f (index l i) == true))))
+= None? (seq_find (fun i -> not (f i)) l)
+
val seq_mem_k: #a:eqtype -> s:seq a -> n:nat{n < Seq.length s} ->
+    Lemma (requires True)
+          (ensures (mem (Seq.index s n) s))
+          [SMTPat (mem (Seq.index s n) s)]
+ +
let rec seq_to_list (#a:Type) (s:seq a)
+: Tot (l:list a{L.length l = length s})
+  (decreases (length s))
+= if length s = 0 then []
+  else index s 0::seq_to_list (slice s 1 (length s))
+
[@@"opaque_to_smt"]
+let rec seq_of_list (#a:Type) (l:list a) : Tot (s:seq a{L.length l = length s})  =
+  match l with
+  | [] -> Seq.empty #a
+  | hd::tl -> create 1 hd @| seq_of_list tl
+
val lemma_seq_of_list_induction (#a:Type) (l:list a)
+  :Lemma (requires True)
+         (ensures (let s = seq_of_list l in
+                   match l with
+                   | []    -> Seq.equal s empty
+                   | hd::tl -> s == cons hd (seq_of_list tl) /\
+                     head s == hd /\ tail s == (seq_of_list tl)))
+
val lemma_seq_list_bij: #a:Type -> s:seq a -> Lemma
+  (requires (True))
+  (ensures  (seq_of_list (seq_to_list s) == s))
+
val lemma_list_seq_bij: #a:Type -> l:list a -> Lemma
+  (requires (True))
+  (ensures  (seq_to_list (seq_of_list l) == l))
+
unfold let createL_post (#a:Type0) (l:list a) (s:seq a) : GTot Type0 =
+  normalize (L.length l = length s) /\ seq_to_list s == l /\ seq_of_list l == s
+
let createL (#a:Type0) (l:list a)
+: Pure (seq a)
+  (requires True)
+  (ensures (fun s -> createL_post #a l s))
+= let s = seq_of_list l in
+  lemma_list_seq_bij l;
+  s
+
val lemma_index_is_nth: #a:Type -> s:seq a -> i:nat{i < length s} -> Lemma
+  (requires True)
+  (ensures  (L.index (seq_to_list s) i == index s i))
+

////////////////////////////////////////////////////////////////////////////// +s contains x : Type0 +An undecidable version of mem, +for when the sequence payload is not an eqtype +//////////////////////////////////////////////////////////////////////////////

+
[@@ remove_unused_type_parameters [0; 1; 2]]
+val contains (#a:Type) (s:seq a) (x:a) : Tot Type0
+
val contains_intro (#a:Type) (s:seq a) (k:nat) (x:a)
+  : Lemma (k < Seq.length s /\ Seq.index s k == x
+            ==>
+           s `contains` x)
+
val contains_elim (#a:Type) (s:seq a) (x:a)
+  : Lemma (s `contains` x
+            ==>
+          (exists (k:nat). k < Seq.length s /\ Seq.index s k == x))
+
val lemma_contains_empty (#a:Type) : Lemma (forall (x:a). ~ (contains Seq.empty x))
+
val lemma_contains_singleton (#a:Type) (x:a) : Lemma (forall (y:a). contains (create 1 x) y ==> y == x)
+
val append_contains_equiv (#a:Type) (s1:seq a) (s2:seq a) (x:a)
+  : Lemma ((append s1 s2) `contains` x
+            <==>
+           (s1 `contains` x \/ s2 `contains` x))
+
val contains_snoc : #a:Type -> s:Seq.seq a -> x:a ->
+   Lemma (ensures (forall y. (snoc s x) `contains` y  <==> s `contains` y \/ x==y))
+
val lemma_find_l_contains (#a:Type) (f:a -> Tot bool) (l:seq a)
+  : Lemma (requires True) (ensures Some? (find_l f l) ==> l `contains` (Some?.v (find_l f l)))
+
val contains_cons (#a:Type) (hd:a) (tl:Seq.seq a) (x:a)
+  : Lemma ((cons hd tl) `contains` x
+           <==>
+           (x==hd \/ tl `contains` x))
+
val append_cons_snoc (#a:Type) (u: Seq.seq a) (x:a) (v:Seq.seq a)
+    : Lemma (Seq.equal (Seq.append u (cons x v))
+                       (Seq.append (snoc u x) v))
+
val append_slices (#a:Type) (s1:Seq.seq a) (s2:Seq.seq a)
+   : Lemma ( Seq.equal s1 (Seq.slice (Seq.append s1 s2) 0 (Seq.length s1)) /\
+             Seq.equal s2 (Seq.slice (Seq.append s1 s2) (Seq.length s1) (Seq.length s1 + Seq.length s2)) /\
+             (forall (i:nat) (j:nat).
+                i <= j /\ j <= Seq.length s2 ==>
+                Seq.equal (Seq.slice s2 i j)
+                          (Seq.slice (Seq.append s1 s2) (Seq.length s1 + i) (Seq.length s1 + j))))
+
val find_l_none_no_index (#a:Type) (s:Seq.seq a) (f:(a -> Tot bool)) :
+  Lemma (requires (None? (find_l f s)))
+        (ensures (forall (i:nat{i < Seq.length s}). not (f (Seq.index s i))))
+        (decreases (Seq.length s))
+

More properties, with new naming conventions

+
let suffix_of
+  (#a: Type)
+  (s_suff s: seq a)
+= exists s_pref . (s == append s_pref s_suff)
+
val cons_head_tail
+  (#a: Type)
+  (s: seq a {length s > 0})
+: Lemma
+  (requires True)
+  (ensures (s == cons (head s) (tail s)))
+  [SMTPat (cons (head s) (tail s))]
+
val head_cons
+  (#a: Type)
+  (x: a)
+  (s: seq a)
+: Lemma
+  (ensures (head (cons x s) == x))
+
val suffix_of_tail
+  (#a: Type)
+  (s: seq a {length s > 0})
+: Lemma
+  (requires True)
+  (ensures ((tail s) `suffix_of` s))
+  [SMTPat ((tail s) `suffix_of` s)]
+
val index_cons_l
+  (#a: Type)
+  (c: a)
+  (s: seq a)
+: Lemma
+  (ensures (index (cons c s) 0 == c))
+
val index_cons_r
+  (#a: Type)
+  (c: a)
+  (s: seq a)
+  (i: nat {1 <= i /\ i <= length s})
+: Lemma
+  (ensures (index (cons c s) i == index s (i - 1)))
+
val append_cons
+  (#a: Type)
+  (c: a)
+  (s1 s2: seq a)
+: Lemma
+  (ensures (append (cons c s1) s2 == cons c (append s1 s2)))
+
val index_tail
+  (#a: Type)
+  (s: seq a {length s > 0})
+  (i: nat {i < length s - 1} )
+: Lemma
+  (ensures (index (tail s) i == index s (i + 1)))
+
val mem_cons
+  (#a:eqtype)
+  (x:a)
+  (s:seq a)
+: Lemma
+  (ensures (forall y. mem y (cons x s) <==> mem y s \/ x=y))
+
val snoc_slice_index
+  (#a: Type)
+  (s: seq a)
+  (i: nat)
+  (j: nat {i <= j /\ j < length s} )
+: Lemma
+  (requires True)
+  (ensures (snoc (slice s i j) (index s j) == slice s i (j + 1)))
+  [SMTPat (snoc (slice s i j) (index s j))]
+
val cons_index_slice
+  (#a: Type)
+  (s: seq a)
+  (i: nat)
+  (j: nat {i < j /\ j <= length s} )
+  (k:nat{k == i+1})
+: Lemma
+  (requires True)
+  (ensures (cons (index s i) (slice s k j) == slice s i j))
+  [SMTPat (cons (index s i) (slice s k j))]
+
val slice_is_empty
+  (#a: Type)
+  (s: seq a)
+  (i: nat {i <= length s})
+: Lemma
+  (requires True)
+  (ensures (slice s i i == Seq.empty))
+  [SMTPat (slice s i i)]
+
val slice_length
+  (#a: Type)
+  (s: seq a)
+: Lemma
+  (requires True)
+  (ensures (slice s 0 (length s) == s))
+  [SMTPat (slice s 0 (length s))]
+
val slice_slice
+  (#a: Type)
+  (s: seq a)
+  (i1: nat)
+  (j1: nat {i1 <= j1 /\ j1 <= length s} )
+  (i2: nat)
+  (j2: nat {i2 <= j2 /\ j2 <= j1 - i1} )
+: Lemma
+  (requires True)
+  (ensures (slice (slice s i1 j1) i2 j2 == slice s (i1 + i2) (i1 + j2)))
+  [SMTPat (slice (slice s i1 j1) i2 j2)]
+
val lemma_seq_of_list_index (#a:Type) (l:list a) (i:nat{i < List.Tot.length l})
+  :Lemma (requires True)
+         (ensures  (index (seq_of_list l) i == List.Tot.index l i))
+         [SMTPat (index (seq_of_list l) i)]
+
[@@(deprecated "seq_of_list")]
+let of_list (#a:Type) (l:list a) :seq a = seq_of_list l
+
val seq_of_list_tl
+  (#a: Type)
+  (l: list a { List.Tot.length l > 0 } )
+: Lemma
+  (requires True)
+  (ensures (seq_of_list (List.Tot.tl l) == tail (seq_of_list l)))
+
val mem_seq_of_list
+  (#a: eqtype)
+  (x: a)
+  (l: list a)
+: Lemma
+  (requires True)
+  (ensures (mem x (seq_of_list l) == List.Tot.mem x l))
+  [SMTPat (mem x (seq_of_list l))]
+

Dealing efficiently with seq_of_list by meta-evaluating conjunctions over +an entire list.

+
let rec explode_and (#a: Type)
+  (i: nat)
+  (s: seq a { i <= length s })
+  (l: list a { List.Tot.length l + i = length s }):
+  Tot Type
+  (decreases (List.Tot.length l))
+= match l with
+  | [] -> True
+  | hd :: tl -> index s i == hd /\ explode_and (i + 1) s tl
+
unfold
+let pointwise_and s l =
+  norm [ iota; zeta; primops; delta_only [ `%(explode_and) ] ] (explode_and 0 s l)
+
val intro_of_list': #a:Type ->
+  i:nat ->
+  s:seq a ->
+  l:list a ->
+  Lemma
+    (requires (
+      List.Tot.length l + i = length s /\
+      i <= length s /\
+      explode_and i s l))
+    (ensures (
+      equal (seq_of_list l) (slice s i (length s))))
+
val intro_of_list (#a: Type) (s: seq a) (l: list a):
+  Lemma
+    (requires (
+      List.Tot.length l = length s /\
+      pointwise_and s l))
+    (ensures (
+      s == seq_of_list l))
+
val elim_of_list': #a:Type ->
+  i:nat ->
+  s:seq a ->
+  l:list a ->
+  Lemma
+    (requires (
+      List.Tot.length l + i = length s /\
+      i <= length s /\
+      slice s i (length s) == seq_of_list l))
+    (ensures (
+      explode_and i s l))
+
val elim_of_list (#a: Type) (l: list a):
+  Lemma
+    (ensures (
+      let s = seq_of_list l in
+      pointwise_and s l))
+

***** sortWith *****

+
let sortWith (#a:eqtype) (f:a -> a -> Tot int) (s:seq a) :Tot (seq a)
+  = seq_of_list (List.Tot.Base.sortWith f (seq_to_list s))
+
val lemma_seq_to_list_permutation (#a:eqtype) (s:seq a)
+  :Lemma (requires True) (ensures (forall x. count x s == List.Tot.Base.count x (seq_to_list s))) (decreases (length s))
+
val lemma_seq_of_list_permutation (#a:eqtype) (l:list a)
+  :Lemma (forall x. List.Tot.Base.count x l == count x (seq_of_list l))
+
val lemma_seq_of_list_sorted (#a:Type) (f:a -> a -> Tot bool) (l:list a)
+  :Lemma (requires (List.Tot.Properties.sorted f l)) (ensures  (sorted f (seq_of_list l)))
+
val lemma_seq_sortwith_correctness (#a:eqtype) (f:a -> a -> Tot int) (s:seq a)
+  :Lemma (requires (total_order a (List.Tot.Base.bool_of_compare f)))
+         (ensures  (let s' = sortWith f s in sorted (List.Tot.Base.bool_of_compare f) s' /\ permutation a s s'))
+

sort_lseq: +A wrapper of Seq.sortWith which proves that the output sequences +is a sorted permutation of the input sequence with the same length

+
let sort_lseq (#a:eqtype) #n (f:tot_ord a) (s:lseq a n)
+  : s':lseq a n{sorted f s' /\ permutation a s s'} =
+  lemma_seq_sortwith_correctness (L.compare_of_bool f) s;
+  let s' = sortWith (L.compare_of_bool f) s in
+  perm_len s s';
+  sorted_feq f (L.bool_of_compare (L.compare_of_bool f)) s';
+  s'
+
let rec foldr (#a #b:Type) (f:b -> a -> Tot a) (s:seq b) (init:a)
+  : Tot a (decreases (length s))
+  = if length s = 0 then init
+    else f (head s) (foldr f (tail s) init)
+
let rec foldr_snoc (#a #b:Type) (f:b -> a -> Tot a) (s:seq b) (init:a)
+  : Tot a (decreases (length s))
+  = if length s = 0 then init
+    else let s, last = un_snoc s in
+         f last (foldr_snoc f s init)
+ diff --git a/docs/FStar.Seq.Sorted.html b/docs/FStar.Seq.Sorted.html index 6fd2658..505237c 100644 --- a/docs/FStar.Seq.Sorted.html +++ b/docs/FStar.Seq.Sorted.html @@ -1,16 +1,117 @@ - - + + - - - - - + FStar.Seq.Sorted + -

module FStar.Seq.Sorted

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Seq.Sorted

+ +
type sorted_pred (#a:eqtype) (f:tot_ord a) (s:seq a) : Type0 =
+  forall (i j: (k:nat{k<length s})). i <= j ==> f (index s i) (index s j)
+
val sorted_pred_tail :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a{length s > 0} ->
+  Lemma (requires (sorted_pred #a f s)) (ensures (sorted_pred #a f (tail s)))
+let sorted_pred_tail #a f s = ()
+
val sorted_pred_sorted_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a ->
+  Lemma (requires (sorted_pred f s)) (ensures (sorted #a f s == true)) (decreases (length s))
+let rec sorted_pred_sorted_lemma #a f s =
+  if length s <= 1 then ()
+  else begin
+    assert (f (index s 0) (index s 1)) ;
+    sorted_pred_tail #a f s;
+    sorted_pred_sorted_lemma #a f (tail s)
+  end
+
let intro_sorted_pred (#a:eqtype) (f:tot_ord a) (s:seq a)
+  ($g:(i:nat{i < length s} -> j:nat{j < length s} -> Lemma (requires (i <= j)) (ensures (f (index s i) (index s j)))))
+  : Lemma (sorted_pred #a f s)
+= let aux (i j : (k:nat{k < length s})) (p:squash (i <= j)) : GTot (squash (f (index s i) (index s j))) =
+    FStar.Squash.give_proof p ;
+    g i j ;
+    FStar.Squash.get_proof (f (index s i) (index s j))
+  in
+  FStar.Classical.forall_intro_2 (fun (i j:(k:nat{k < length s})) ->
+    FStar.Classical.give_witness (FStar.Classical.arrow_to_impl (aux i j)) <: Lemma (i <= j ==> f (index s i) (index s j)))
+
val sorted_pred_cons_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a{length s > 1} ->
+  Lemma (requires (f (index s 0) (index s 1) /\ sorted_pred #a f (tail s))) (ensures (sorted_pred #a f s))
+let sorted_pred_cons_lemma #a f s =
+  let aux (i j : (k:nat{k < length s})) : Lemma (requires (i <= j)) (ensures (f (index s i) (index s j))) =
+    if i = 0 then
+      if j = 0 then ()
+      else assert (f (index s 0) (index (tail s) 0) /\ f (index (tail s) 0) (index (tail s) (j-1)))
+    else assert (f (index (tail s) (i - 1)) (index (tail s) (j - 1)))
+  in
+  intro_sorted_pred #a f s aux
+
val sorted_sorted_pred_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a ->
+  Lemma (requires (sorted #a f s == true)) (ensures (sorted_pred #a f s)) (decreases (length s))
+let rec sorted_sorted_pred_lemma #a f s =
+  if length s = 0 then ()
+  else if length s = 1 then ()
+  else (sorted_sorted_pred_lemma #a f (tail s) ; sorted_pred_cons_lemma #a f s)
+
val sorted_pred_slice_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a ->
+  i:nat{i < length s} ->
+  j:nat{i <= j /\ j <= length s} ->
+  Lemma (requires (sorted_pred #a f s)) (ensures (sorted_pred #a f (slice s i j)))
+let sorted_pred_slice_lemma #a f s i j = ()
+
val sorted_slice_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a ->
+  i:nat{i < length s} ->
+  j:nat{i <= j /\ j <= length s} ->
+  Lemma (requires (sorted #a f s == true)) (ensures (sorted #a f (slice s i j) == true))
+let sorted_slice_lemma #a f s i j =
+  sorted_sorted_pred_lemma #a f s ;
+  sorted_pred_slice_lemma #a f s i j ;
+  sorted_pred_sorted_lemma #a f (slice s i j)
+
val sorted_split_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s:seq a ->
+  i:nat{i < length s} ->
+  Lemma (requires (sorted #a f s == true))
+    (ensures (let s1, s2 = split s i in sorted #a f s1 == true /\ sorted #a f s2 == true))
+let sorted_split_lemma #a f s i =
+  sorted_slice_lemma #a f s 0 i ;
+  sorted_slice_lemma #a f s i (length s)
+
val sorted_pred_append_lemma :
+  #a:eqtype ->
+  f:tot_ord a ->
+  s1:seq a ->
+  s2:seq a ->
+  Lemma (requires (sorted_pred #a f s1 /\ sorted_pred #a f s2 /\ (length s1 > 0 /\ length s2 > 0 ==> f (last s1) (head s2))))
+    (ensures (sorted_pred #a f (append s1 s2)))
+let sorted_pred_append_lemma #a f s1 s2 =
+  let s = append s1 s2 in
+  let aux (i j:(k:nat{k < length s})) : Lemma (requires (i <= j)) (ensures (f (index s i) (index s j))) =
+    if i < length s1 then
+      if j < length s1 then
+        assert (f (index s1 i) (index s1 j))
+      else
+        (assert (f (index s1 i) (last s1)) ; assert (f (head s2) (index s2 (j - length s1))))
+    else
+      (assert (j >= length s1) ; assert (f (index s2 (i - length s1)) (index s2 (j - length s1))))
+  in
+  intro_sorted_pred #a f s aux
+ diff --git a/docs/FStar.Seq.html b/docs/FStar.Seq.html index 948f236..f98e8d2 100644 --- a/docs/FStar.Seq.html +++ b/docs/FStar.Seq.html @@ -1,16 +1,19 @@ - - + + - - - - - + FStar.Seq + -

module FStar.Seq

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Seq

+ + diff --git a/docs/FStar.Set.html b/docs/FStar.Set.html index 4282799..3520319 100644 --- a/docs/FStar.Set.html +++ b/docs/FStar.Set.html @@ -1,55 +1,96 @@ - - + + - - - - - - + FStar.Set + -

module FStar.Set

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
pragma
+

+FStar.Set

Computational sets (on eqtypes): membership is a boolean function

+
#set-options "--initial_fuel 0 --max_fuel 0 --initial_ifuel 0 --max_ifuel 0"
+
val set (a:eqtype)
+  : Type0
+
val equal (#a:eqtype) (s1:set a) (s2:set a)
+  : Type0
+

destructors

+
val mem (#a:eqtype) (x:a) (s:set a)
+  : Tot bool
+

constructors

+
val empty (#a:eqtype)
+  : Tot (set a)
+
val singleton (#a:eqtype) (x:a)
+  : Tot (set a)
+
val union      : #a:eqtype -> set a -> set a -> Tot (set a)
+val intersect  : #a:eqtype -> set a -> set a -> Tot (set a)
+val complement : #a:eqtype -> set a -> Tot (set a)
+

a property about sets

+
let disjoint (#a:eqtype) (s1: set a) (s2: set a) =
+  equal (intersect s1 s2) empty
+

ops

+
let subset (#a:eqtype) (s1:set a) (s2:set a) =
+  forall x. mem x s1 ==> mem x s2
+

Properties

+
val mem_empty: #a:eqtype -> x:a -> Lemma
+   (requires True)
+   (ensures (not (mem x empty)))
+   [SMTPat (mem x empty)]
+
val mem_singleton: #a:eqtype -> x:a -> y:a -> Lemma
+   (requires True)
+   (ensures (mem y (singleton x) = (x=y)))
+   [SMTPat (mem y (singleton x))]
+
val mem_union: #a:eqtype -> x:a -> s1:set a -> s2:set a -> Lemma
+   (requires True)
+   (ensures (mem x (union s1 s2) = (mem x s1 || mem x s2)))
+   [SMTPat (mem x (union s1 s2))]
+
val mem_intersect: #a:eqtype -> x:a -> s1:set a -> s2:set a -> Lemma
+   (requires True)
+   (ensures (mem x (intersect s1 s2) = (mem x s1 && mem x s2)))
+   [SMTPat (mem x (intersect s1 s2))]
+
val mem_complement: #a:eqtype -> x:a -> s:set a -> Lemma
+   (requires True)
+   (ensures (mem x (complement s) = not (mem x s)))
+   [SMTPat (mem x (complement s))]
+
val mem_subset: #a:eqtype -> s1:set a -> s2:set a -> Lemma
+   (requires (forall x. mem x s1 ==> mem x s2))
+   (ensures (subset s1 s2))
+   [SMTPat (subset s1 s2)]
+
val subset_mem: #a:eqtype -> s1:set a -> s2:set a -> Lemma
+   (requires (subset s1 s2))
+   (ensures (forall x. mem x s1 ==> mem x s2))
+   [SMTPat (subset s1 s2)]
+

extensionality

+
val lemma_equal_intro: #a:eqtype -> s1:set a -> s2:set a -> Lemma
+    (requires  (forall x. mem x s1 = mem x s2))
+    (ensures (equal s1 s2))
+    [SMTPat (equal s1 s2)]
+
val lemma_equal_elim: #a:eqtype -> s1:set a -> s2:set a -> Lemma
+    (requires (equal s1 s2))
+    (ensures  (s1 == s2))
+    [SMTPat (equal s1 s2)]
+
val lemma_equal_refl: #a:eqtype -> s1:set a -> s2:set a -> Lemma
+    (requires (s1 == s2))
+    (ensures  (equal s1 s2))
+    [SMTPat (equal s1 s2)]
+
val disjoint_not_in_both (a:eqtype) (s1:set a) (s2:set a)
+  : Lemma
+      (requires (disjoint s1 s2))
+      (ensures (forall (x:a).{:pattern (mem x s1) \/ (mem x s2)} mem x s1 ==> ~(mem x s2)))
+      [SMTPat (disjoint s1 s2)]
+

Converting lists to sets

+

WHY IS THIS HERE? It is not strictly part of the interface

+
#reset-options //restore fuel usage here
+let rec as_set' (#a:eqtype) (l:list a) : set a =
+  match l with
+  | [] -> empty
+  | hd::tl -> union (singleton hd) (as_set' tl)
+
unfold
+let as_set (#a:eqtype) (l:list a) = normalize_term (as_set' l)
+
let lemma_disjoint_subset (#a:eqtype) (s1:set a) (s2:set a) (s3:set a)
+  : Lemma (requires (disjoint s1 s2 /\ subset s3 s1))
+          (ensures  (disjoint s3 s2))
+  = ()
+ diff --git a/docs/FStar.Squash.html b/docs/FStar.Squash.html index dae0852..a589c74 100644 --- a/docs/FStar.Squash.html +++ b/docs/FStar.Squash.html @@ -1,16 +1,95 @@ - - + + - - - - - + FStar.Squash + -

module FStar.Squash

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Squash

+
+

The module provides an interface to work with squash types, F*'s +representation for proof-irrelevant propositions.

+

The type squash p is defined in Prims as _:unit{p}. As such, +the squash type captures the classical logic used in F*'s +refinement types, although the interface in this module isn't +specifically classical. The module FStar.Classical provides +further derived forms to manipulate squash types.

+

This is inspired in part by: Quotient Types: A Modular +Approach. Aleksey Nogin, TPHOLs 2002. +http://www.nuprl.org/documents/Nogin/QuotientTypes_02.pdf

+

Broadly, squash is a monad, support the usual return and +bind operations.

+

Additionally, it supports a push_squash operation that relates +arrow types and squash.

+
+

+return_squash

+

A proof of a can be forgotten to create a squashed proof of a

+
val return_squash (#a: Type) (x: a) : Tot (squash a)
+

+bind_squash

+

Sequential composition of squashed proofs

+
val bind_squash (#a #b: Type) (x: squash a) (f: (a -> GTot (squash b))) : Tot (squash b)
+

+push_squash

+

The push operation, together with bind_squash, allow deriving +some of the other operations, notably squash_double_arrow. We +rarely use the push_squash operation directly.

+
val push_squash (#a: Type) (#b: (a -> Type)) (f: (x: a -> Tot (squash (b x))))
+    : Tot (squash (x: a -> GTot (b x)))
+

One reading of push f is that for a function f that builds a +proof-irrelevant prooof of b x for all x:a, there exists a +proof-irrelevant proof of forall (x:a). b x.

+

Note: since f is not itself squashed, push_squash f is not +equal to f.

+
+

The pre- and postconditions of of Pure are equivalent to +squashed arguments and results.

+
+

+get_proof

+

get_proof p, in a context requiring p is equivalent to a proof +of squash p

+
val get_proof (p: Type) : Pure (squash p) (requires p) (ensures (fun _ -> True))
+

+give_proof

+

give_proof x, for x:squash p is a equivalent to ensuring +p.

+
val give_proof (#p: Type) (x: squash p) : Pure unit (requires True) (ensures (fun _ -> p))
+

+proof_irrelevance

+

All proofs of squash p are equal

+
val proof_irrelevance (p: Type) (x y: squash p) : Tot (squash (x == y))
+

+squash_double_arrow

+

Squashing the proof of the co-domain of squashed universal +quantifier is redundant---squash_double_arrow allows removing +it.

+
val squash_double_arrow (#a: Type) (#p: (a -> Type)) ($f: (squash (x: a -> GTot (squash (p x)))))
+    : GTot (squash (x: a -> GTot (p x)))
+

+push_sum

+

The analog of push_squash for sums (existential quantification

+
val push_sum (#a: Type) (#b: (a -> Type)) ($p: (dtuple2 a (fun (x: a) -> squash (b x))))
+    : Tot (squash (dtuple2 a b))
+

+squash_double_sum

+

The analog of squash_double_arrow for sums (existential quantification)

+
val squash_double_sum
+      (#a: Type)
+      (#b: (a -> Type))
+      ($p: (squash (dtuple2 a (fun (x: a) -> squash (b x)))))
+    : Tot (squash (dtuple2 a b))
+

+map_squash

+

squash is functorial; a ghost function can be mapped over a squash

+
val map_squash (#a #b: Type) (x: squash a) (f: (a -> GTot b)) : Tot (squash b)
+

+join_squash

+

squash is a monad: double squashing is redundant and can be removed.

+
val join_squash (#a: Type) (x: squash (squash a)) : Tot (squash a)
+ diff --git a/docs/FStar.SquashProperties.html b/docs/FStar.SquashProperties.html index 3b61489..6c4ceca 100644 --- a/docs/FStar.SquashProperties.html +++ b/docs/FStar.SquashProperties.html @@ -1,16 +1,149 @@ - - + + - - - - - + FStar.SquashProperties + -

module FStar.SquashProperties

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.SquashProperties

+ +
val join_squash : #a:Type -> squash (squash a) -> GTot (squash a)
+let join_squash #a s = bind_squash #(squash a) #a s (fun x -> x)
+
val squash_arrow : #a:Type -> #p:(a -> Type) ->
+  $f:(x:a -> GTot (squash (p x))) -> GTot (squash (x:a -> GTot (p x)))
+let squash_arrow #a #p f = squash_double_arrow (return_squash f)
+
val forall_intro : #a:Type -> #p:(a -> Type) ->
+  $f:(x:a -> Lemma (p x)) -> Lemma (x:a -> GTot (p x))(* (forall (x:a). p x) *)
+let forall_intro #a #p f =
+  let ff : (x:a -> GTot (squash (p x))) = (fun x -> f x; get_proof (p x)) in
+  give_proof #(x:a -> GTot (p x)) (squash_arrow #a #p ff)
+

currently unused +val squash_elim : a:Type -> #b:Type -> t1:b -> t2:b -> +( a -> Tot (ceq t1 t2)) -> +Tot (squash a -> Tot (ceq t1 t2))

+

assume val tt (t:Type) : squash t

+

assume val squash_mem_elim : a:Type -> #b:Type -> t1:b -> t2:b ->

+

(x:squash a -> t:(squash a -> Type) -> Tot (t ())) ->

+

Tot (x:squash a -> t:(squash a -> Type) -> Tot (t x))

+

get_proof and give_proof are phrased in terms of squash

+

The whole point of defining squash is to soundly allow define excluded_middle; +here this follows from get_proof and give_proof

+
val bool_of_or : #p:Type -> #q:Type -> c_or p q ->
+  Tot (b:bool{(b ==> p) /\ (not(b) ==> q)})
+let bool_of_or #p #q t =
+  match t with
+  | Left  _ -> true
+  | Right _ -> false
+
val excluded_middle : p:Type -> GTot (squash (b:bool{b <==> p}))
+let excluded_middle (p:Type) = map_squash (join_squash (get_proof (p \/ (~p)))) bool_of_or
+
val excluded_middle_squash : p:Type0 -> GTot (p \/ ~p)
+let excluded_middle_squash p =
+  bind_squash (excluded_middle p) (fun x ->
+  if x then
+    map_squash (get_proof p) (Left #p)
+  else
+    return_squash (Right #_ #(~p) (return_squash (fun (h:p) ->
+                                   give_proof (return_squash h);
+                                   false_elim #False ()))))
+

we thought we might prove proof irrelevance by Berardi ... but didn't manage

+

Conditional on any Type -- unused below

+
val ifProp: #p:Type0 -> b:Type0 -> e1:squash p -> e2:squash p -> GTot (squash p)
+let ifProp #p b e1 e2 =
+   bind_squash (excluded_middle_squash b)
+           (fun (x:c_or b (~ b)) ->
+        match x with
+            | Left _ -> e1
+        | Right _ -> e2)
+

The powerset operator

+
type pow (p:Type) = p -> GTot bool
+
noeq type retract 'a 'b : Type =
+  | MkR: i:('a -> GTot 'b) ->
+         j:('b -> GTot 'a) ->
+         inv:(x:'a -> GTot (ceq (j (i x)) x)) ->
+         retract 'a 'b
+
noeq type retract_cond 'a 'b : Type =
+  | MkC: i2:('a -> GTot 'b) ->
+         j2:('b -> GTot 'a) ->
+         inv2:(retract 'a 'b -> x:'a -> GTot (ceq (j2 (i2 x)) x)) ->
+         retract_cond 'a 'b
+

unused below

+
val ac: r:retract_cond 'a 'b -> retract 'a 'b -> x:'a ->
+          GTot (ceq ((MkC?.j2 r) (MkC?.i2 r x)) x)
+let ac (MkC _ _ inv2) = inv2
+
let false_elim (#a:Type) (f:False) : Tot a
+  = match f with
+
val l1: (a:Type0) -> (b:Type0) -> GTot (squash (retract_cond (pow a) (pow b)))
+let l1 (a:Type) (b:Type) =
+   bind_squash (excluded_middle_squash (retract (pow a) (pow b)))
+          (fun (x:c_or (retract (pow a) (pow b)) (~ (retract (pow a) (pow b)))) ->
+             match x with
+         | Left (MkR f0 g0 e) ->
+           return_squash (MkC f0 g0 (fun _ -> e))
+         | Right nr ->
+           let f0 (x:pow a) (y:b) = false in
+           let g0 (x:pow b) (y:a) = false in
+           map_squash nr (fun (f:(retract (pow a) (pow b) -> GTot False)) ->
+                  MkC f0 g0 (fun r x -> false_elim (f r))))
+

The paradoxical set

+
type u = p:Type -> Tot (squash (pow p))
+

NS: FAILS TO CHECK BEYOND HERE ... TODO, revisit

+

Bijection between U and (pow U)

+
assume val f : u -> Tot (squash (pow u))
+#set-options "--print_universes"
+

let f x = x u *) //fails here without a means of denoting univers

+

val g : squash (pow U) -> Tot U +let g sh = fun (x:Type) -> +let (slX:squash (pow U -> Tot (pow x))) = map_squash (l1 x U) MkC?.j2 in +let (srU:squash (pow U -> Tot (pow U))) = map_squash (l1 U U) MkC?.i2 in +bind_squash srU (fun rU -> +bind_squash slX (fun lX -> +bind_squash sh (fun h -> +return_squash (lX (rU h)))))

+

(* This only works if importing FStar.All.fst, which is nonsense *) +val r : U +let r = +let ff : (U -> Tot (squash bool)) = +(fun (u:U) -> map_squash (u U) (fun uu -> not (uu u))) in +g (squash_arrow ff)

+

CH: stopped here

+

val not_has_fixpoint : squash (ceq (r U r) (not (r U r)))

+

let not_has_fixpoint = Refl #bool #(r U r)

+

otherwise we could assume proof irrelevance as an axiom; +note that proof relevance shouldn't be derivable for squash types +val not_provable : unit ->

+

Tot (cnot (ceq (return_squash true) (return_squash false)))

+

val not_provable : unit ->

+

Tot (squash (cnot (ceq (return_squash true) (return_squash false))))

+

type cheq (#a:Type) (x:a) : #b:Type -> b -> Type = +| HRefl : cheq #a x #a x

+

val not_provable : unit ->

+

Tot (cimp (cheq (return_squash #(b:bool{b=true}) true)

+

(return_squash #(b:bool{b=false}) false)) (squash cfalse))

+

let not_provable () =

+

(fun h -> match h with

+

| HRefl ->

+

assert(return_squash #(b:bool{b=true}) true ==

+

return_squash #(b:bool{b=false}) false);

+

bind_squash (return_squash #(b:bool{b=true}) true) (fun btrue ->

+

bind_squash (return_squash #(b:bool{b=false}) false) (fun bfalse ->

+

assert (btrue <> bfalse); magic())))

+

TODO:

+ + diff --git a/docs/FStar.String.html b/docs/FStar.String.html index 4e93510..3ea89b0 100644 --- a/docs/FStar.String.html +++ b/docs/FStar.String.html @@ -1,16 +1,144 @@ - - + + - - - - - + FStar.String + -

module FStar.String

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.String

+ +

String is a primitive type in F*.

+

Most of the functions in this interface have a special status in +that they are:

+
    +
  1. +

    All the total functions in this module are handled by F*'s +normalizers and can be reduced during typechecking

    +
    2. +
  2. +

    All the total functions, plus two functions in the ML effect, +have native OCaml implementations in FStar_String.ml

    +
    3. +
+

These functions are, however, not suitable for use in Low* code, +since many of them incur implicit allocations that must be garbage +collected.

+

For strings in Low*, see LowStar.String, LowStar.Literal etc.

+
type char = FStar.Char.char
+
+

list_of_string and string_of_list: A pair of coercions to +expose and pack a string as a list of characters

+
+
val list_of_string : string -> Tot (list char)
+val string_of_list : list char -> Tot string
+
+

A pair

+
+
val string_of_list_of_string (s:string)
+  : Lemma (string_of_list (list_of_string s) == s)
+val list_of_string_of_list (l:list char)
+  : Lemma (list_of_string (string_of_list l) == l)
+
+

strlen s counts the number of utf8 values in a string +It is not the byte length of a string

+
+
let strlen s = List.length (list_of_string s)
+
+

length, an alias for strlen

+
+
unfold
+let length s = strlen s
+
+

maxlen: When applied to a literal s of less than n characters, +maxlen s n reduces to True before going to the SMT solver. +Otherwise, the left disjunct reduces partially but the right +disjunct remains as is, allowing to keep strlen s <= n in the +context.

+
+
unfold
+let maxlen s n = b2t (normalize_term (strlen s <= n)) \/ strlen s <= n
+
+

make l c: builds a string of length l with each character set +to c

+
+
val make: l:nat -> char -> Tot (s:string {length s = l})
+
+

string_of_char: A convenient abbreviation for make 1 c

+
+
let string_of_char (c:char) : Tot string = make 1 c
+
+

split cs s: splits the string by delimiters in cs

+
+
val split:   list char -> string -> Tot (list string)
+
+

concat s l concatentates the strings in l delimited by s

+
+
val concat:  string -> list string -> Tot string
+
+

compare s0 s1: lexicographic ordering on strings

+
+
val compare: string -> string -> Tot int
+
+

lowercase: transform each character to its lowercase variant

+
+
val lowercase:  string -> Tot string
+
+

uppercase: transform each character to its uppercase variant

+
+
val uppercase:  string -> Tot string
+
+

index s n: returns the nth character in s

+
+
val index: s:string -> n:nat {n < length s} -> Tot char
+
+

index_of s c: +The first index of c in s +returns -1 if the char is not found, for compatibility with C

+
+
val index_of: string -> char -> Tot int
+
+

sub s i len +Second argument is a length, not an index. +Returns a substring of length len beginning at i

+
+
val sub: s:string -> i:nat -> l:nat{i + l <= length s} -> Tot (r: string {length r = l})
+
+

collect f s: maps f over each character of s +from left to right, appending and flattening the result

+
+
[@@(deprecated "FStar.String.collect can be defined using list_of_string and List.collect")]
+val collect: (char -> FStar.All.ML string) -> string -> FStar.All.ML string
+
+

substring s i len +A partial variant of sub s i len without bounds checks. +May fail with index out of bounds

+
+
val substring: string -> int -> int -> Ex string
+
+

get s i: Similar to index except it may fail +if i is out of bounds

+
+
val get: string -> int -> Ex char
+
+

Some lemmas (admitted for now as we don't have a model)

+
+
val concat_length (s1 s2: string): Lemma
+  (ensures length (s1 ^ s2) = length s1 + length s2)
+
val list_of_concat (s1 s2: string): Lemma
+  (ensures list_of_string (s1 ^ s2) == list_of_string s1 @ list_of_string s2)
+
val index_string_of_list (l:list char) (i : nat{i < List.Tot.length l}) :
+  Lemma (
+

*) list_of_string_of_list l; // necessary to get equality between the lengt

+
index (string_of_list l) i == List.Tot.index l i)
+
let index_list_of_string (s:string) (i : nat{i < length s}) :
+  Lemma (List.Tot.index (list_of_string s) i == index s i) =
+  index_string_of_list (list_of_string s) i;
+  string_of_list_of_string s
+ diff --git a/docs/FStar.StrongExcludedMiddle.html b/docs/FStar.StrongExcludedMiddle.html index b10d2dc..8d62bd7 100644 --- a/docs/FStar.StrongExcludedMiddle.html +++ b/docs/FStar.StrongExcludedMiddle.html @@ -1,16 +1,15 @@ - - + + - - - - - + FStar.StrongExcludedMiddle + -

module FStar.StrongExcludedMiddle

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.StrongExcludedMiddle

+

WARNING: this breaks parametricity; use with care

+
assume val strong_excluded_middle : p:Type0 -> GTot (b:bool{b = true <==> p})
+ diff --git a/docs/FStar.TSet.html b/docs/FStar.TSet.html index 79487cc..f4e897a 100644 --- a/docs/FStar.TSet.html +++ b/docs/FStar.TSet.html @@ -1,16 +1,100 @@ - - + + - - - - - + FStar.TSet + -

module FStar.TSet

-

fsdoc: no-summary-found

+

+FStar.TSet

Propositional sets (on any types): membership is a predicate

+ +
#set-options "--initial_fuel 0 --max_fuel 0 --initial_ifuel 0 --max_ifuel 0"
+ +
[@@must_erase_for_extraction]
+val set (a:Type u#a) : Type u#(max 1 a)
+
val equal (#a:Type) (s1:set a) (s2:set a) : Type0
+

destructors

+
val mem : 'a -> set 'a -> Tot Type0
+

constructors

+
val empty      : #a:Type -> Tot (set a)
+val singleton  : #a:Type -> x:a -> Tot (set a)
+val union      : #a:Type -> x:set a -> y:set a -> Tot (set a)
+val intersect  : #a:Type -> x:set a -> y:set a -> Tot (set a)
+val complement : #a:Type -> x:set a -> Tot (set a)
+

ops

+
let subset (#a:Type) (s1:set a) (s2:set a) : Type0 = forall x. mem x s1 ==> mem x s2
+

Properties

+
val mem_empty: #a:Type -> x:a -> Lemma
+   (requires True)
+   (ensures (~ (mem x empty)))
+   [SMTPat (mem x empty)]
+
val mem_singleton: #a:Type -> x:a -> y:a -> Lemma
+   (requires True)
+   (ensures (mem y (singleton x) <==> (x==y)))
+   [SMTPat (mem y (singleton x))]
+
val mem_union: #a:Type -> x:a -> s1:set a -> s2:set a -> Lemma
+   (requires True)
+   (ensures (mem x (union s1 s2) == (mem x s1 \/ mem x s2)))
+   [SMTPat (mem x (union s1 s2))]
+
val mem_intersect: #a:Type -> x:a -> s1:set a -> s2:set a -> Lemma
+   (requires True)
+   (ensures (mem x (intersect s1 s2) == (mem x s1 /\ mem x s2)))
+   [SMTPat (mem x (intersect s1 s2))]
+
val mem_complement: #a:Type -> x:a -> s:set a -> Lemma
+   (requires True)
+   (ensures (mem x (complement s) == ~(mem x s)))
+   [SMTPat (mem x (complement s))]
+
val mem_subset: #a:Type -> s1:set a -> s2:set a -> Lemma
+   (requires (forall x. mem x s1 ==> mem x s2))
+   (ensures (subset s1 s2))
+   [SMTPat (subset s1 s2)]
+
val subset_mem: #a:Type -> s1:set a -> s2:set a -> Lemma
+   (requires (subset s1 s2))
+   (ensures (forall x. mem x s1 ==> mem x s2))
+   [SMTPat (subset s1 s2)]
+

extensionality

+
val lemma_equal_intro: #a:Type -> s1:set a -> s2:set a -> Lemma
+    (requires  (forall x. mem x s1 <==> mem x s2))
+    (ensures (equal s1 s2))
+    [SMTPat (equal s1 s2)]
+
val lemma_equal_elim: #a:Type -> s1:set a -> s2:set a -> Lemma
+    (requires (equal s1 s2))
+    (ensures  (s1 == s2))
+    [SMTPat (equal s1 s2)]
+
val lemma_equal_refl: #a:Type -> s1:set a -> s2:set a -> Lemma
+    (requires (s1 == s2))
+    (ensures  (equal s1 s2))
+    [SMTPat (equal s1 s2)]
+
val tset_of_set (#a:eqtype) (s:Set.set a) : Tot (set a)
+
val lemma_mem_tset_of_set (#a:eqtype) (s:Set.set a) (x:a)
+  :Lemma (requires True)
+         (ensures  (Set.mem x s <==> mem x (tset_of_set s)))
+         [SMTPat (mem x (tset_of_set s))]
+
val filter (#a:Type) (f:a -> Type0) (s:set a) : Tot (set a)
+
val lemma_mem_filter (#a:Type) (f:(a -> Type0)) (s:set a) (x:a)
+  :Lemma (requires True)
+         (ensures  (mem x (filter f s) <==> mem x s /\ f x))
+         [SMTPat (mem x (filter f s))]
+
val map (#a:Type) (#b:Type) (f:a -> Tot b) (s:set a) : Tot (set b)
+
val lemma_mem_map (#a:Type) (#b:Type) (f:(a -> Tot b)) (s:set a) (x:b)
+  :Lemma ((exists (y:a). {:pattern (mem y s)} mem y s /\ x == f y) <==> mem x (map f s))
+         [SMTPat (mem x (map f s))]
+
#reset-options
+let rec as_set' (#a:Type) (l:list a) : Tot (set a) =
+  match l with
+  | [] -> empty
+  | hd::tl -> union (singleton hd) (as_set' tl)
+

unfold let as_set (#a:Type) (l:list a) : set a =

+

Prims.norm zeta; iota; delta_only "FStar.TSet.as_set'"`` (as_set' l)

+ diff --git a/docs/FStar.Tactics.Arith.html b/docs/FStar.Tactics.Arith.html index 6dbeaad..469f35c 100644 --- a/docs/FStar.Tactics.Arith.html +++ b/docs/FStar.Tactics.Arith.html @@ -1,16 +1,51 @@ - - + + - - - - - + FStar.Tactics.Arith + -

module FStar.Tactics.Arith

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Arith

+ +

decide if the current goal is arith, drop the built representation of it

+
let is_arith_goal () : Tac bool =
+    let g = cur_goal () in
+    match run_tm (is_arith_prop g) with
+    | Inr _ -> true
+    | _ -> false
+
val split_arith : unit -> Tac unit
+let rec split_arith () =
+    if is_arith_goal () then
+        begin
+        prune "";
+        addns "Prims";
+        smt ()
+        end
+    else begin
+        let g = cur_goal () in
+        match term_as_formula g with
+        | True_ ->
+            trivial ()
+        | And l r ->
+            seq FStar.Tactics.split split_arith
+        | Implies p q ->
+            let _ = implies_intro () in
+            seq split_arith l_revert
+        | Forall x p ->
+            let bs = forall_intros () in
+            seq split_arith (fun () -> l_revert_all bs)
+        | _ ->
+            ()
+    end
+ diff --git a/docs/FStar.Tactics.BV.html b/docs/FStar.Tactics.BV.html index 605eb6b..e6ac77a 100644 --- a/docs/FStar.Tactics.BV.html +++ b/docs/FStar.Tactics.BV.html @@ -1,16 +1,188 @@ - - + + - - - - - + FStar.Tactics.BV + -

module FStar.Tactics.BV

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.BV

+ +

using uint_t' instead of uint_t breaks the tactic (goes to inl).

+

Congruence lemmas

+
val cong_bvand : #n:pos -> (#w:bv_t n) -> (#x:bv_t n) ->
+                   (#y:bv_t n) -> (#z:bv_t n) ->
+                   squash (w == y) -> squash (x == z) ->
+                   Lemma (bvand #n w x == bvand #n y z)
+let cong_bvand #n #w #x #y #z pf1 pf2 = ()
+
val cong_bvxor : #n:pos -> (#w:bv_t n) -> (#x:bv_t n) ->
+                   (#y:bv_t n) -> (#z:bv_t n) ->
+                   squash (w == y) -> squash (x == z) ->
+                   Lemma (bvxor w x == bvxor y z)
+let cong_bvxor #n #w #x #y #z pf1 pf2 = ()
+
val cong_bvor : #n:pos -> (#w:bv_t n) -> (#x:bv_t n) ->
+                   (#y:bv_t n) -> (#z:bv_t n) ->
+                   squash (w == y) -> squash (x == z) ->
+                   Lemma (bvor w x == bvor y z)
+let cong_bvor #n #w #x #y #z pf1 pf2 = ()
+
val cong_bvshl : #n:pos -> (#w:bv_t n) -> (#x:uint_t n) ->
+                 (#y:bv_t n) -> squash (w == y) ->
+                 Lemma (bvshl w x == bvshl y x)
+let cong_bvshl #n #w #x #y pf = ()
+
val cong_bvshr : #n:pos -> #w:bv_t n -> (#x:uint_t n) ->
+               #y:bv_t n -> squash (w == y) ->
+               Lemma (bvshr #n w x == bvshr #n y x)
+let cong_bvshr #n #w #x #y pf = ()
+
val cong_bvdiv : #n:pos -> #w:bv_t n -> (#x:uint_t n{x <> 0}) ->
+              #y:bv_t n -> squash (w == y) ->
+               Lemma (bvdiv #n w x == bvdiv #n y x)
+let cong_bvdiv #n #w #x #y pf = ()
+
val cong_bvmod : #n:pos -> #w:bv_t n -> (#x:uint_t n{x <> 0}) ->
+              #y:bv_t n -> squash (w == y) ->
+               Lemma (bvmod #n w x == bvmod #n y x)
+let cong_bvmod #n #w #x #y pf = ()
+
val cong_bvmul : #n:pos -> #w:bv_t n -> (#x:uint_t n) ->
+              #y:bv_t n -> squash (w == y) ->
+               Lemma (bvmul #n w x == bvmul #n y x)
+let cong_bvmul #n #w #x #y pf = ()
+
val cong_bvadd : #n:pos -> (#w:bv_t n) -> (#x:bv_t n) ->
+              (#y:bv_t n) -> (#z:bv_t n) ->
+              squash (w == y) -> squash (x == z) ->
+              Lemma (bvadd w x == bvadd y z)
+let cong_bvadd #n #w #x #y #z pf1 pf2 = ()
+
val cong_bvsub : #n:pos -> (#w:bv_t n) -> (#x:bv_t n) ->
+              (#y:bv_t n) -> (#z:bv_t n) ->
+              squash (w == y) -> squash (x == z) ->
+              Lemma (bvsub w x == bvsub y z)
+let cong_bvsub #n #w #x #y #z pf1 pf2 = ()
+

Used to reduce the initial equation to an equation on bitvectors

+
val eq_to_bv: #n:pos -> (#x:uint_t n) -> (#y:uint_t n) ->
+              squash (int2bv #n x == int2bv #n y) -> Lemma (x == y)
+let eq_to_bv #n #x #y pf = int2bv_lemma_2 #n x y
+
val lt_to_bv: #n:pos -> (#x:uint_t n) -> (#y:uint_t n) ->
+              (b2t (bvult #n (int2bv #n x) (int2bv #n y))) -> Lemma (x < y)
+let lt_to_bv #n #x #y pf = int2bv_lemma_ult_2 #n x y
+

Creates two fresh variables and two equations of the form int2bv +x = z /\ int2bv y = w. The above lemmas transform these two +equations before finally instantiating them through reflexivity, +leaving Z3 to solve z = w

+
val trans: #n:pos -> (#x:bv_t n) -> (#y:bv_t n) -> (#z:bv_t n) -> (#w:bv_t n) ->
+          squash (x == z) -> squash (y == w) -> squash (z == w) ->
+          Lemma (x == y)
+let trans #n #x #y #z #w pf1 pf2 pf3 = ()
+
val trans_lt: #n:pos -> (#x:bv_t n) -> (#y:bv_t n) -> (#z:bv_t n) -> (#w:bv_t n) ->
+          (eq2 #(bv_t n) x z) -> (eq2 #(bv_t n) y w) -> squash (bvult #n z w) ->
+          Lemma (bvult #n x y)
+let trans_lt #n #x #y #z #w pf1 pf2 pf3 = ()
+
val trans_lt2: #n:pos -> (#x:uint_t n) -> (#y:uint_t n) -> (#z:bv_t n) -> (#w:bv_t n) ->
+          squash (int2bv #n x == z) -> squash (int2bv #n y == w) -> (b2t (bvult #n z w)) ->
+          Lemma (x < y)
+let trans_lt2 #n #x #y #z #w pf1 pf2 pf3 = int2bv_lemma_ult_2 x y
+
let rec arith_expr_to_bv (e:expr) : Tac unit =
+    match e with
+    | NatToBv (MulMod e1 _) | MulMod e1 _ ->
+        apply_lemma (`int2bv_mul);
+        apply_lemma (`cong_bvmul);
+        arith_expr_to_bv e1
+    | NatToBv (Umod e1 _) | Umod e1 _ ->
+        apply_lemma (`int2bv_mod);
+        apply_lemma (`cong_bvmod);
+        arith_expr_to_bv e1
+    | NatToBv (Udiv e1 _) | Udiv e1 _ ->
+        apply_lemma (`int2bv_div);
+        apply_lemma (`cong_bvdiv);
+        arith_expr_to_bv e1
+    | NatToBv (Shl e1 _) | Shl e1 _ ->
+        apply_lemma (`int2bv_shl);
+        apply_lemma (`cong_bvshl);
+        arith_expr_to_bv e1
+    | NatToBv (Shr e1 _) | Shr e1 _ ->
+        apply_lemma (`int2bv_shr);
+        apply_lemma (`cong_bvshr);
+        arith_expr_to_bv e1
+    | NatToBv (Land e1 e2) | (Land e1 e2) ->
+        apply_lemma (`int2bv_logand);
+        apply_lemma (`cong_bvand);
+        arith_expr_to_bv e1;
+        arith_expr_to_bv e2
+    | NatToBv (Lxor e1 e2) | (Lxor e1 e2) ->
+        apply_lemma (`int2bv_logxor);
+        apply_lemma (`cong_bvxor);
+        arith_expr_to_bv e1;
+        arith_expr_to_bv e2
+    | NatToBv (Lor e1 e2) | (Lor e1 e2) ->
+        apply_lemma (`int2bv_logor);
+        apply_lemma (`cong_bvor);
+        arith_expr_to_bv e1;
+        arith_expr_to_bv e2
+    | NatToBv (Ladd e1 e2) | (Ladd e1 e2) ->
+        apply_lemma (`int2bv_add);
+        apply_lemma (`cong_bvadd);
+        arith_expr_to_bv e1;
+        arith_expr_to_bv e2
+    | NatToBv (Lsub e1 e2) | (Lsub e1 e2) ->
+        apply_lemma (`int2bv_sub);
+        apply_lemma (`cong_bvsub);
+        arith_expr_to_bv e1;
+        arith_expr_to_bv e2
+    | _ ->
+        trefl ()
+
let arith_to_bv_tac () : Tac unit = focus (fun () ->
+    norm [delta_only ["FStar.BV.bvult"]];
+    let g = cur_goal () in
+    let f = term_as_formula g in
+    match f with
+    | Comp (Eq _) l r ->
+     begin match run_tm (as_arith_expr l) with
+      | Inl s ->
+          dump s;
+          trefl ()
+      | Inr e ->
+

dump "inr arith_to_bv";

+
            seq (fun () -> arith_expr_to_bv e) trefl
+        end
+    | _ ->
+        fail ("arith_to_bv_tac: unexpected: " ^ term_to_string g)
+)
+

As things are right now, we need to be able to parse NatToBv +too. This can be useful, if we have mixed expressions so I'll leave it +as is for now

+
let bv_tac () = focus (fun () ->
+  mapply (`eq_to_bv);
+  mapply (`trans);
+  arith_to_bv_tac ();
+  arith_to_bv_tac ();
+  set_options "--smtencoding.elim_box true";
+  norm [delta] ;
+  smt ()
+)
+
let bv_tac_lt n = focus (fun () ->
+  let nn = pack_ln (Tv_Const (C_Int n)) in
+  let t = mk_app (`trans_lt2) [(nn, Q_Implicit)] in
+  apply_lemma t;
+  arith_to_bv_tac ();
+  arith_to_bv_tac ();
+  set_options "--smtencoding.elim_box true";
+  smt ()
+)
+
let to_bv_tac ()  = focus (fun () ->
+  apply_lemma (`eq_to_bv);
+  apply_lemma (`trans);
+  arith_to_bv_tac ();
+  arith_to_bv_tac ()
+)
+ diff --git a/docs/FStar.Tactics.Builtins.html b/docs/FStar.Tactics.Builtins.html index 11f1772..06d34ab 100644 --- a/docs/FStar.Tactics.Builtins.html +++ b/docs/FStar.Tactics.Builtins.html @@ -1,170 +1,420 @@ - - + + - - - - - - + FStar.Tactics.Builtins + -

module FStar.Tactics.Builtins

-

Tactic primitives

-

Every tactic primitive, i.e., those built into the compiler

-
val top_env:Unidentified product: [unit] (Tac env)
-

[top_env] returns the environment where the tactic started running. * This works even if no goals are present.

-
val push_binder:Unidentified product: [env] Unidentified product: [binder] env
-

[push_binder] extends the environment with a single binder. This is useful as one traverses the syntax of a term, pushing binders as one traverses a binder in a lambda, match, etc. Note, the environment here is disconnected to (though perhaps derived from) the environment in the proofstate

-
val fresh:Unidentified product: [unit] (Tac int)
-

[fresh ()] returns a fresh integer. It does not get reset when catching a failure.

-
val refine_intro:Unidentified product: [unit] (Tac unit)
-

[refine_intro] will turn a goal of shape [w : x:t{phi}] into [w : t] and [phi{w/x}]

-
val tc:Unidentified product: [env] Unidentified product: [term] (Tac term)
-

[tc] returns the type of a term in [env], or fails if it is untypeable.

-
val tcc:Unidentified product: [env] Unidentified product: [term] (Tac comp)
-

[tcc] like [tc], but returns the full computation type with the effect label and its arguments (WPs, etc) as well

-
val unshelve:Unidentified product: [term] (Tac unit)
-

[unshelve] creates a goal from a term for its given type. It can be used when the system decided not to present a goal, but you want one anyway. For example, if you request a uvar through [uvar_env] or [fresh_uvar], you might want to instantiate it explicitly.

-
val unquote:Unidentified product: [#a:Type] Unidentified product: [term] (Tac a)
-

[unquote t] with turn a quoted term [t] into an actual value, of any type. This will fail at tactic runtime if the quoted term does not typecheck to type [a].

-
val catch:Unidentified product: [#a:Type] Unidentified product: [(Unidentified product: [unit] (Tac a))] (TacS (either exn a))
-

[catch t] will attempt to run [t] and allow to recover from a failure. If [t] succeeds with return value [a], [catch t] returns [Inr a]. On failure, it returns [Inl msg], where [msg] is the error [t] raised. See also [or_else].

-
val trivial:Unidentified product: [unit] (Tac unit)
-

[trivial] will discharge the goal if it's exactly [True] after doing normalization and simplification of it.

-
val norm:Unidentified product: [list norm_step] (Tac unit)
-

[norm steps] will call the normalizer on the current goal's type and witness, with its reduction behaviour parameterized by the flags in [steps]. Currently, the flags (provided in Prims) are [simpl] (do logical simplifications) [whnf] (only reduce until weak head-normal-form) [primops] (performing primitive reductions, such as arithmetic and string operations) [delta] (unfold names) [zeta] (inline let bindings) [iota] (reduce match statements over constructors) [delta_only] (restrict delta to only unfold this list of fully-qualfied identifiers)

-
val norm_term_env:Unidentified product: [env] Unidentified product: [list norm_step] Unidentified product: [term] (Tac term)
-

[norm_term_env e steps t] will call the normalizer on the term [t] using the list of steps [steps], over environment [e]. The list has the same meaning as for [norm].

-
val norm_binder_type:Unidentified product: [list norm_step] Unidentified product: [binder] (Tac unit)
-

[norm_binder_type steps b] will call the normalizer on the type of the [b] binder for the current goal. Notably, this cannot be done via binder_retype and norm, because of uvars being resolved to lambda-abstractions.

-
val intro:Unidentified product: [unit] (Tac binder)
-

[intro] pushes the first argument of an arrow goal into the environment, turning [Gamma |- ?u : x:a -> b] into [Gamma, x:a |- ?u' : b]. Note that this does not work for logical implications/forall. See FStar.Tactics.Logic for that.

-
val intro_rec:Unidentified product: [unit] (Tac (*(binder, binder)))
-

Similar to intros, but allows to build a recursive function. Currently broken (c.f. issue #1103)

-
val rename_to:Unidentified product: [binder] Unidentified product: [string] (Tac unit)
-

[rename_to b nm] will rename the binder [b] to [nm] in the environment, goal, and witness in a safe manner. The only use of this is to make goals and terms more user readable.

-
val revert:Unidentified product: [unit] (Tac unit)
-

[revert] pushes out a binder from the environment into the goal type, so a behaviour opposite to [intros].

-
val binder_retype:Unidentified product: [binder] (Tac unit)
-

[binder_retype] changes the type of a binder in the context. After calling it with a binder of type t, the user is presented with a goal of the form t == ?u to be filled. The original goal (following that one) has the type of b in the context replaced by ?u.

-
val clear_top:Unidentified product: [unit] (Tac unit)
-

[clear_top] will drop the outermost binder from the environment. Can only be used if the goal does not at all depend on it.

-
val clear:Unidentified product: [binder] (Tac unit)
-

[clear] will drop the given binder from the context, is nothing depends on it.

-
val rewrite:Unidentified product: [binder] (Tac unit)
-

If [b] is a binder of type [v == r], [rewrite b] will rewrite the variable [v] for [r] everywhere in the current goal type and witness/

-
val t_exact:Unidentified product: [bool] Unidentified product: [bool] Unidentified product: [term] (Tac unit)
-

First boolean is whether to attempt to intrpoduce a refinement before solving. In that case, a goal for the refinement formula will be added. Second boolean is whether to set the expected type internally. Just use exact from FStar.Tactics.Derived if you don't know what's up with all this.

-
val t_apply:Unidentified product: [bool] Unidentified product: [bool] Unidentified product: [term] (Tac unit)
-

Inner primitive for [apply], takes a boolean specifying whether to not ask for implicits that appear free in posterior goals. Example: when the boolean is true, applying transitivity to [|- a = c] will give two goals, [|- a = ?u] and [|- ?u = c] without asking to instantiate [?u] since it will most likely be constrained later by solving these goals. In any case, we track [?u] and will fail if it's not solved later.

-

You probably want [apply] from FStar.Tactics.Derived.

-
val apply_lemma:Unidentified product: [term] (Tac unit)
-

[apply_lemma l] will solve a goal of type [squash phi] when [l] is a Lemma ensuring [phi]. The arguments to [l] and its requires clause are introduced as new goals. As a small optimization, [unit] arguments are discharged by the engine.

-
val print:Unidentified product: [string] (Tac unit)
-

[print str] has no effect on the proofstate, but will have the side effect of printing [str] on the compiler's standard output.

-
val debugging:Unidentified product: [unit] (Tac bool)
-

[debugging ()] returns true if the current module has the debug flag on, i.e. when [--debug MyModule --debug_level Tac] was passed in.

-
val dump:Unidentified product: [string] (Tac unit)
-

Similar to [print], but will dump a text representation of the proofstate along with the message.

-
val trefl:Unidentified product: [unit] (Tac unit)
-

Solves a goal [Gamma |= squash (l == r)] by attempting to unify [l] with [r]. This currently only exists because of some universe problems when trying to [apply] a reflexivity lemma.

-
val t_pointwise:Unidentified product: [direction] Unidentified product: [(Unidentified product: [unit] (Tac unit))] (Tac unit)
-

(TODO: explain bettter) When running [pointwise tau] For every subterm [t'] of the goal's type [t], the engine will build a goal [Gamma |= t' == ?u] and run [tau] on it. When the tactic proves the goal, the engine will rewrite [t'] for [?u] in the original goal type. This is done for every subterm, bottom-up. This allows to recurse over an unknown goal type. By inspecting the goal, the [tau] can then decide what to do (to not do anything, use [trefl]).

-
val topdown_rewrite:Unidentified product: [(Unidentified product: [ctrl:term] (Tac (*(bool, int))))] Unidentified product: [(Unidentified product: [rw:unit] (Tac unit))] (Tac unit)
-

[topdown_rewrite ctrl rw] is used to rewrite those sub-terms [t] of the goal on which [fst (ctrl t)] returns true.

-
On each such sub-term, [rw] is presented with an equality of goal
-of the form [Gamma |= t == ?u]. When [rw] proves the goal,
-the engine will rewrite [t] for [?u] in the original goal
-type.
-
-The goal formula is traversed top-down and the traversal can be
-controlled by [snd (ctrl t)]:
-
-When [snd (ctrl t) = 0], the traversal continues down through the
-position in the goal term.
-
-When [snd (ctrl t) = 1], the traversal continues to the next
-sub-tree of the goal.
-
-When [snd (ctrl t) = 2], no more rewrites are performed in the
-goal.
-
val dup:Unidentified product: [unit] (Tac unit)
-

Given the current goal [Gamma |- w : t], [dup] will turn this goal into [Gamma |- ?u : t] and [Gamma |= ?u == w]. It can thus be used to change a goal's witness in any way needed, by choosing some [?u] (possibly with exact) and then solving the other goal.

-
val prune:Unidentified product: [string] (Tac unit)
-

[prune "A.B.C"] will mark all top-level definitions in module [A.B.C] (and submodules of it) to not be encoded to the SMT, for the current goal. The string is a namespace prefix. [prune ""] will prune everything, but note that [prune "FStar.S"] will not prune ["FStar.Set"].

-
val addns:Unidentified product: [string] (Tac unit)
-

The opposite operation of [prune]. The latest one takes precedence.

-
val t_destruct:Unidentified product: [term] (Tac (list (*(fv, nat))))
-

Destruct a value of an inductive type by matching on it. The generated match has one branch for each constructor and is therefore trivially exhaustive, no VC is generated for that purpose. It returns a list with the fvars of each constructor and their arities, in the order they appear as goals.

-
val set_options:Unidentified product: [string] (Tac unit)
-

Set command line options for the current goal. Mostly useful to change SMT encoding options such as [set_options "--z3rlimit 20"].

-
val uvar_env:Unidentified product: [env] Unidentified product: [option typ] (Tac term)
-

Creates a new, unconstrained unification variable in environment [env]. The type of the uvar can optionally be provided in [o]. If not provided, a second uvar is created for the type.

-
val unify_env:Unidentified product: [env] Unidentified product: [term] Unidentified product: [term] (Tac bool)
-

Call the unifier on two terms. The returned boolean specifies whether unification was possible. When the tactic returns true, the terms have been unified, instantiating uvars as needed. When false, unification was not possible and no change to uvars occurs.

-
val launch_process:Unidentified product: [string] Unidentified product: [list string] Unidentified product: [string] (Tac string)
-

Launches an external process [prog] with arguments [args] and input [input] and returns the output. For security reasons, this can only be performed when the --unsafe_tactic_exec options was provided for the current F* invocation. The tactic will fail if this is not so.

-
val fresh_bv_named:Unidentified product: [string] Unidentified product: [typ] (Tac bv)
-

Get a fresh bv of some name and type. The name is only useful for pretty-printing, since there is a fresh unaccessible integer within the bv too.

-
val change:Unidentified product: [typ] (Tac unit)
-

Change the goal to another type, given that it is convertible to the current type.

-
val get_guard_policy:Unidentified product: [unit] (Tac guard_policy)
-

Get the current guard policy. The guard policy specifies what should be done when a VC arises internally from the tactic engine. Options are SMT (mark it as an SMT goal), Goal (add it as an extra goal) and Force (only allow trivial guards, that need no SMT.

-
val set_guard_policy:Unidentified product: [guard_policy] (Tac unit)
+

+FStar.Tactics.Builtins

+

Every tactic primitive, i.e., those built into the compiler +@summary Tactic primitives

+ +

+top_env

+

top_env returns the environment where the tactic started running.

+ +
val top_env : unit -> Tac env
+

+fresh

+

fresh () returns a fresh integer. It does not get reset when +catching a failure.

+
val fresh : unit -> Tac int
+

+refine_intro

+

refine_intro will turn a goal of shape w : x:t{phi} +into w : t and phi{w/x}

+
val refine_intro : unit -> Tac unit
+

+tc

+

tc returns the type of a term in env, +or fails if it is untypeable.

+
val tc : env -> term -> Tac term
+

+tcc

+

tcc like tc, but returns the full computation type +with the effect label and its arguments (WPs, etc) as well

+
val tcc : env -> term -> Tac comp
+

+unshelve

+

unshelve creates a goal from a term for its given type. +It can be used when the system decided not to present a goal, but +you want one anyway. For example, if you request a uvar through +uvar_env or fresh_uvar, you might want to instantiate it +explicitly.

+
val unshelve : term -> Tac unit
+

+unquote

+

unquote t with turn a quoted term t into an actual value, of +any type. This will fail at tactic runtime if the quoted term does not +typecheck to type a.

+
val unquote : #a:Type -> term -> Tac a
+

+catch

+

catch t will attempt to run t and allow to recover from a +failure. If t succeeds with return value a, catch t returns Inr a. On failure, it returns Inl msg, where msg is the error t +raised, and all unionfind effects are reverted. See also recover and +or_else.

+
val catch : #a:Type -> (unit -> Tac a) -> TacS (either exn a)
+

+recover

+

Like catch t, but will not discard unionfind effects on failure.

+
val recover : #a:Type -> (unit -> Tac a) -> TacS (either exn a)
+

+norm

+

norm steps will call the normalizer on the current goal's +type and witness, with its reduction behaviour parameterized +by the flags in steps. +Currently, the flags (provided in Prims) are +simpl (do logical simplifications) +whnf (only reduce until weak head-normal-form) +primops (performing primitive reductions, such as arithmetic and +string operations) +delta (unfold names) +zeta (unroll let rec bindings, but with heuristics to avoid loops) +zeta_full (unroll let rec bindings fully) +iota (reduce match statements over constructors) +delta_only (restrict delta to only unfold this list of fully-qualfied identifiers)

+
val norm  : list norm_step -> Tac unit
+

+norm_term_env

+

norm_term_env e steps t will call the normalizer on the term t +using the list of steps steps, over environment e. The list has the same meaning as for norm.

+
val norm_term_env  : env -> list norm_step -> term -> Tac term
+

+norm_binder_type

+

norm_binder_type steps b will call the normalizer on the type of the b +binder for the current goal. Notably, this cannot be done via binder_retype and norm, +because of uvars being resolved to lambda-abstractions.

+
val norm_binder_type  : list norm_step -> binder -> Tac unit
+

+intro

+

intro pushes the first argument of an arrow goal into the +environment, turning Gamma |- ?u : x:a -> b into Gamma, x:a |- ?u' : b. +Note that this does not work for logical implications/forall. See +FStar.Tactics.Logic for that.

+
val intro : unit -> Tac binder
+

+intro_rec

+

Similar to intros, but allows to build a recursive function. +Currently broken (c.f. issue #1103)

+
val intro_rec  : unit -> Tac (binder * binder)
+

+rename_to

+

rename_to b nm will rename the binder b to nm in +the environment, goal, and witness in a safe manner. The only use of this +is to make goals and terms more user readable. The primitive returns +the new binder, since the old one disappears from the context.

+
val rename_to  : binder -> string -> Tac binder
+

+revert

+

revert pushes out a binder from the environment into the goal type, +so a behaviour opposite to intros.

+
val revert  : unit -> Tac unit
+

+binder_retype

+

binder_retype changes the type of a binder in the context. After calling it +with a binder of type t, the user is presented with a goal of the form t == ?u +to be filled. The original goal (following that one) has the type of b in the +context replaced by ?u.

+
val binder_retype  : binder -> Tac unit
+

+clear_top

+

clear_top will drop the outermost binder from the environment. +Can only be used if the goal does not at all depend on it.

+
val clear_top : unit -> Tac unit
+

+clear

+

clear will drop the given binder from the context, is +nothing depends on it.

+
val clear : binder -> Tac unit
+

+rewrite

+

If b is a binder of type v == r, rewrite b will rewrite +the variable v for r everywhere in the current goal type and witness/

+
val rewrite : binder -> Tac unit
+

+t_exact

+

First boolean is whether to attempt to intrpoduce a refinement +before solving. In that case, a goal for the refinement formula will be +added. Second boolean is whether to set the expected type internally. +Just use exact from FStar.Tactics.Derived if you don't know what's up +with all this.

+
val t_exact : bool -> bool -> term -> Tac unit
+

+t_apply

+

Inner primitive for apply, takes a boolean specifying whether +to not ask for implicits that appear free in posterior goals, and a +boolean specifying whether it's forbidden to instantiate uvars in the +goal.

+
val t_apply : uopt:bool -> noinst:bool -> term -> Tac unit
+

Example: when uopt is true, applying transitivity to |- a = c +will give two goals, |- a = ?u and |- ?u = c without asking to +instantiate ?u since it will most likely be constrained later by +solving these goals. In any case, we track ?u and will fail if it's +not solved later.

+

Example: when noinst is true, applying a function returning +1 = 2 will fail on a goal of the shape 1 = ?u since it must +instantiate ?u. We use this in typeclass resolution.

+

You may want apply from FStar.Tactics.Derived, or one of +the other user facing variants.

+

+t_apply_lemma

+

t_apply_lemma ni nilhs l will solve a goal of type squash phi +when l is a Lemma ensuring phi. The arguments to l and its +requires clause are introduced as new goals. As a small optimization, +unit arguments are discharged by the engine. For the meanining of +the noinst boolean arg see t_apply, briefly, it does not allow to +instantiate uvars in the goal. The noinst_lhs flag is similar, it +forbids instantiating uvars but only on the LHS of the goal, provided +the goal is an equality. It is meant to be useful for rewrite-goals, of +the shape X = ?u. Setting noinst means noinst_lhs is ignored.

+
val t_apply_lemma : noinst:bool -> noinst_lhs:bool -> term -> Tac unit
+

TODO: do the unit thing too for apply.

+

+print

+

print str has no effect on the proofstate, but will have the side effect +of printing str on the compiler's standard output.

+
val print : string -> Tac unit
+

+debugging

+

debugging () returns true if the current module has the debug flag +on, i.e. when --debug MyModule --debug_level Tac was passed in.

+
val debugging : unit -> Tac bool
+

+dump

+

Similar to print, but will dump a text representation of the proofstate +along with the message.

+
val dump : string -> Tac unit
+

+dump_all

+

Similar to dump, but will print every unsolved implicit +in the proofstate, not only the visible/focused goals. When the +print_resolved boolean is true, it will also print every solved goal. +Warning, these can be a lot.

+
val dump_all : print_resolved:bool -> string -> Tac unit
+

+dump_uvars_of

+

Will print a goal for every unresolved implicit in the provided goal.

+
val dump_uvars_of : goal -> string -> Tac unit
+

+t_trefl

+

Solves a goal Gamma |= squash (l == r) by attempting to unify +l with r. This currently only exists because of some universe +problems when trying to apply a reflexivity lemma. When allow_guards +is true, it is allowed that (some) guards are raised during the +unification process and added as a single goal to be discharged later. +Currently, the only guards allowed here are for equating refinement +types (e.g. x:int{x>0} and x:int{0<x}.

+
val t_trefl : allow_guards:bool -> Tac unit
+

+t_commute_applied_match

+

Provides a proof for the equality +[(match e with ... | pi -> ei ...) a1 .. an +== (match e with ... | pi -> e1 a1 .. an)]. +This is particularly useful to rewrite the expression on the left to the +one on the right when the RHS is actually a unification variable.

+
val t_commute_applied_match : unit -> Tac unit
+

+ctrl_rewrite

+

ctrl_rewrite will traverse the current goal, and call ctrl

+ +
val ctrl_rewrite :
+    direction ->
+    (ctrl : term -> Tac (bool & ctrl_flag)) ->
+    (rw:unit -> Tac unit) ->
+    Tac unit
+

+dup

+

Given the current goal Gamma |- w : t, +dup will turn this goal into +Gamma |- ?u : t and +Gamma |= ?u == w. It can thus be used to change +a goal's witness in any way needed, by choosing +some ?u (possibly with exact) and then solving the other goal.

+
val dup : unit -> Tac unit
+

Proof namespace management

+

+prune

+

prune "A.B.C" will mark all top-level definitions in module +A.B.C (and submodules of it) to not be encoded to the SMT, for the current goal. +The string is a namespace prefix. prune "" will prune everything, but note +that prune "FStar.S" will not prune "FStar.Set".

+
val prune : string -> Tac unit
+

+addns

+

The opposite operation of prune. The latest one takes precedence.

+
val addns : string -> Tac unit
+

+t_destruct

+

Destruct a value of an inductive type by matching on it. The generated +match has one branch for each constructor and is therefore trivially +exhaustive, no VC is generated for that purpose. It returns a list +with the fvars of each constructor and their arities, in the order +they appear as goals.

+
val t_destruct : term -> Tac (list (fv * nat))
+

+set_options

+

Set command line options for the current goal. Mostly useful to +change SMT encoding options such as set_options "--z3rlimit 20".

+
val set_options : string -> Tac unit
+

+uvar_env

+

Creates a new, unconstrained unification variable in environment +env. The type of the uvar can optionally be provided in o. If not +provided, a second uvar is created for the type.

+
val uvar_env : env -> option typ -> Tac term
+

+unify_env

+

Call the unifier on two terms. The returned boolean specifies +whether unification was possible. When the tactic returns true, the +terms have been unified, instantiating uvars as needed. When false, +unification was not possible and no change to uvars occurs.

+
val unify_env : env -> t1:term -> t2:term -> Tac bool
+

+unify_guard_env

+

Similar to unify_env, but allows for some guards to be raised +during unification (see t_trefl for an explanation). Will add a new +goal with the guard.

+
val unify_guard_env : env -> t1:term -> t2:term -> Tac bool
+

+match_env

+

Check if t1 matches t2, i.e., whether t2 can have its uvars +instantiated into unifying with t1. When the tactic returns true, the +terms have been unified, instantiating uvars as needed. When false, +matching was not possible and no change to uvars occurs.

+
val match_env : env -> t1:term -> t2:term -> Tac bool
+

+launch_process

+

Launches an external process prog with arguments args and input +input and returns the output. For security reasons, this can only be +performed when the --unsafe_tactic_exec options was provided for the +current F* invocation. The tactic will fail if this is not so.

+
val launch_process : string -> list string -> string -> Tac string
+

+fresh_bv_named

+

Get a fresh bv of some name and type. The name is only useful +for pretty-printing, since there is a fresh unaccessible integer within +the bv too.

+
val fresh_bv_named : string -> typ -> Tac bv
+

+change

+

Change the goal to another type, given that it is convertible +to the current type.

+
val change : typ -> Tac unit
+

+get_guard_policy

+

Get the current guard policy. The guard policy specifies what should +be done when a VC arises internally from the tactic engine. Options +are SMT (mark it as an SMT goal), Goal (add it as an extra goal) +and Force (only allow trivial guards, that need no SMT.

+
val get_guard_policy : unit -> Tac guard_policy
+

+set_guard_policy

Set the current guard policy. See [get_guard_policy} for an explanation

-
val lax_on:Unidentified product: [unit] (Tac bool)
-

[lax_on] returns true iff the current environment has the --lax option set, and thus drops all verification conditions.

-
val tadmit_t:Unidentified product: [term] (Tac unit)
-

Admit the current goal and set the witness to the given term. Absolutely unsafe. Raises a warning.

-
val inspect:Unidentified product: [term] (Tac term_view)
+
val set_guard_policy : guard_policy -> Tac unit
+

+lax_on

+

lax_on returns true iff the current environment has the +--lax option set, and thus drops all verification conditions.

+
val lax_on : unit -> Tac bool
+

+tadmit_t

+

Admit the current goal and set the witness to the given term. +Absolutely unsafe. Raises a warning.

+
val tadmit_t : term -> Tac unit
+

+inspect

View a term in a fully-named representation

-
val pack:Unidentified product: [term_view] (Tac term)
+
val inspect : term -> Tac term_view
+

+pack

Pack a term view on a fully-named representation back into a term

-
val join:Unidentified product: [unit] (Tac unit)
-

Join the first two goals, which must be irrelevant, in a single one by finding a maximal prefix of their environment and reverting appropriately. Useful to minimize SMT queries that share internal obligations.

-
val set_goals:Unidentified product: [list goal] (Tac unit)
-

Set the current set of active goals at will. Obligations remain in the implicits.

-
val set_smt_goals:Unidentified product: [list goal] (Tac unit)
-

Set the current set of SMT goals at will. Obligations remain in the implicits. TODO: This is a really bad name, there's no special "SMT" about these goals.

-
val curms:Unidentified product: [unit] (Tac int)
-

[curms ()] returns the current (wall) time in millseconds

+
val pack    : term_view -> Tac term
+

+join

+

Join the first two goals, which must be irrelevant, in a single +one by finding a maximal prefix of their environment and reverting +appropriately. Useful to minimize SMT queries that share internal +obligations.

+
val join : unit -> Tac unit
+

Local metastate via a string-keyed map. lget fails if the +found element is not typeable at the requested type.

+
val lget     : #a:Type -> string -> Tac a
+val lset     : #a:Type -> string -> a -> Tac unit
+

+set_goals

+

Set the current set of active goals at will. Obligations remain +in the implicits.

+
val set_goals     : list goal -> Tac unit
+

+set_smt_goals

+

Set the current set of SMT goals at will. Obligations remain in the +implicits. TODO: This is a really bad name, there's no special "SMT" +about these goals.

+
val set_smt_goals : list goal -> Tac unit
+

+curms

+

curms () returns the current (wall) time in millseconds

+
val curms : unit -> Tac int
+

+set_urgency

+

set_urgency u sets the urgency of error messages. Usually set just +before raising an exception (see e.g. fail_silently).

+
val set_urgency : int -> Tac unit
+ diff --git a/docs/FStar.Tactics.Canon.html b/docs/FStar.Tactics.Canon.html index 35c0ec3..d7f89ac 100644 --- a/docs/FStar.Tactics.Canon.html +++ b/docs/FStar.Tactics.Canon.html @@ -1,16 +1,235 @@ - - + + - - - - - + FStar.Tactics.Canon + -

module FStar.Tactics.Canon

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Canon

+ +
private
+val distr : (#x : int) -> (#y : int) -> (#z : int) -> Lemma (x * (y + z) == x * y + x * z)
+private
+let distr #x #y #z = ()
+
private
+val distl : (#x : int) -> (#y : int) -> (#z : int) -> Lemma ((x + y) * z == x * z + y * z)
+private
+let distl #x #y #z = ()
+
private
+val ass_plus_l : (#x : int) -> (#y : int) -> (#z : int) -> Lemma (x + (y + z) == (x + y) + z)
+private
+let ass_plus_l #x #y #z = ()
+
private
+val ass_mult_l : (#x : int) -> (#y : int) -> (#z : int) -> Lemma (x * (y * z) == (x * y) * z)
+private
+let ass_mult_l #x #y #z = ()
+
private
+val comm_plus : (#x : int) -> (#y : int) -> Lemma (x + y == y + x)
+private
+let comm_plus #x #y = ()
+
private
+val sw_plus : (#x : int) -> (#y : int) -> (#z : int) -> Lemma ((x + y) + z == (x + z) + y)
+private
+let sw_plus #x #y #z = ()
+
private
+val sw_mult : (#x : int) -> (#y : int) -> (#z : int) -> Lemma ((x * y) * z == (x * z) * y)
+private
+let sw_mult #x #y #z = ()
+
private
+val comm_mult : (#x : int) -> (#y : int) -> Lemma (x * y == y * x)
+private
+let comm_mult #x #y = ()
+
private
+val trans : (#a:Type) -> (#x:a) -> (#z:a) -> (#y:a) ->
+                    squash (x == y) -> squash (y == z) -> Lemma (x == z)
+private
+let trans #a #x #z #y e1 e2 = ()
+
private
+val cong_plus : (#w:int) -> (#x:int) -> (#y:int) -> (#z:int) ->
+                squash (w == y) -> squash (x == z) ->
+                Lemma (w + x == y + z)
+private
+let cong_plus #w #x #y #z p q = ()
+
private
+val cong_mult : (#w:int) -> (#x:int) -> (#y:int) -> (#z:int) ->
+                squash (w == y) -> squash (x == z) ->
+                Lemma (w * x == y * z)
+private
+let cong_mult #w #x #y #z p q = ()
+
private
+val neg_minus_one : (#x:int) -> Lemma (-x == (-1) * x)
+private
+let neg_minus_one #x = ()
+
private
+val x_plus_zero : (#x:int) -> Lemma (x + 0 == x)
+private
+let x_plus_zero #x = ()
+
private
+val zero_plus_x : (#x:int) -> Lemma (0 + x == x)
+private
+let zero_plus_x #x = ()
+
private
+val x_mult_zero : (#x:int) -> Lemma (x * 0 == 0)
+private
+let x_mult_zero #x = ()
+
private
+val zero_mult_x : (#x:int) -> Lemma (0 * x == 0)
+private
+let zero_mult_x #x = ()
+
private
+val x_mult_one : (#x:int) -> Lemma (x * 1 == x)
+private
+let x_mult_one #x = ()
+
private
+val one_mult_x : (#x:int) -> Lemma (1 * x == x)
+private
+let one_mult_x #x = ()
+
private
+val minus_is_plus : (#x : int) -> (#y : int) -> Lemma (x - y == x + (-y))
+private
+let minus_is_plus #x #y = ()
+
private
+let step (t : unit -> Tac unit) : Tac unit =
+    apply_lemma (`trans);
+    t ()
+
private
+let step_lemma (lem : term) : Tac unit =
+    step (fun () -> apply_lemma lem)
+
private val canon_point : expr -> Tac expr
+private let rec canon_point e =
+    let skip () : Tac expr =
+        trefl (); e
+    in
+    match e with
+

Evaluate constants

+
| Plus (Lit a) (Lit b) ->
+    norm [primops];
+    trefl ();
+    Lit (a + b)
+
| Mult (Lit a) (Lit b) ->
+    norm [delta; primops]; // Need delta to turn op_Star into op_Multiply, as there's no primop for it
+    trefl ();
+    Lit (a * b)
+

Forget about negations

+
| Neg e ->
+    step_lemma (`neg_minus_one);
+    canon_point (Mult (Lit (-1)) e)
+

Distribute

+
| Mult a (Plus b c) ->
+    step_lemma (`distr);
+    step_lemma (`cong_plus);
+    let l = canon_point (Mult a b) in
+    let r = canon_point (Mult a c) in
+    canon_point (Plus l r)
+
| Mult (Plus a b) c ->
+    step_lemma (`distl);
+    step_lemma (`cong_plus);
+    let l = canon_point (Mult a c) in
+    let r = canon_point (Mult b c) in
+    canon_point (Plus l r)
+

Associate to the left

+
| Mult a (Mult b c) ->
+    step_lemma (`ass_mult_l);
+    step_lemma (`cong_mult);
+    let l = canon_point (Mult a b) in
+    let r = canon_point c in
+    canon_point (Mult l r)
+
| Plus a (Plus b c) ->
+    step_lemma (`ass_plus_l);
+    step_lemma (`cong_plus);
+    let l = canon_point (Plus a b) in
+    let r = canon_point c in
+    canon_point (Plus l r)
+
| Plus (Plus a b) c ->
+    if O.gt (compare_expr b c)
+    then begin
+        step_lemma (`sw_plus);
+        apply_lemma (`cong_plus);
+        let l = canon_point (Plus a c) in
+        trefl() ;
+        Plus l b
+    end
+    else skip ()
+
| Mult (Mult a b) c ->
+    if O.gt (compare_expr b c)
+    then begin
+        step_lemma (`sw_mult);
+        apply_lemma (`cong_mult);
+        let l = canon_point (Mult a c) in
+        trefl ();
+        Mult l b
+    end
+    else skip ()
+
| Plus a (Lit 0) ->
+    apply_lemma (`x_plus_zero);
+    a
+
| Plus (Lit 0) b ->
+    apply_lemma (`zero_plus_x);
+    b
+
| Plus a b ->
+    if O.gt (compare_expr a b)
+    then (apply_lemma (`comm_plus); Plus b a)
+    else skip ()
+
| Mult (Lit 0) _ ->
+    apply_lemma (`zero_mult_x);
+    Lit 0
+
| Mult _ (Lit 0) ->
+    apply_lemma (`x_mult_zero);
+    Lit 0
+
| Mult (Lit 1) r ->
+    apply_lemma (`one_mult_x);
+    r
+
| Mult l (Lit 1) ->
+    apply_lemma (`x_mult_one);
+    l
+
| Mult a b ->
+    if O.gt (compare_expr a b)
+    then (apply_lemma (`comm_mult); Mult b a)
+    else skip ()
+

Forget about subtraction

+
| Minus a b ->
+    step_lemma (`minus_is_plus);
+    step_lemma (`cong_plus);
+    trefl ();
+    let r = canon_point (Neg b) in
+    canon_point (Plus a r)
+
| _ ->
+    skip ()
+

On canon_point_entry, we interpret the LHS of the goal as an +arithmetic expression, of which we keep track in canon_point so we +avoid reinterpreting the goal, which gives a good speedup.

+

However, we are repeating work between canon_point_entry calls, since +in (L + R), we are called once for L, once for R, and once for the +sum which traverses both (their canonized forms, actually).

+

The proper way to solve this is have some state-passing in pointwise, +maybe having the inner tactic be of type (list a -> tactic a), where +the list is the collected results for all child calls.

+
let canon_point_entry () : Tac unit =
+    norm [];
+    let g = cur_goal () in
+    match term_as_formula g with
+    | Comp (Eq _) l r ->
+        begin match run_tm (is_arith_expr l) with
+        | Inr e -> (let _e = canon_point e in ())
+        | Inl _ -> trefl ()
+        end
+    | _ ->
+        fail ("impossible: " ^ term_to_string g)
+
let canon () : Tac unit =
+    pointwise canon_point_entry
+ diff --git a/docs/FStar.Tactics.CanonCommSemiring.html b/docs/FStar.Tactics.CanonCommSemiring.html index 8495a10..a4cd251 100644 --- a/docs/FStar.Tactics.CanonCommSemiring.html +++ b/docs/FStar.Tactics.CanonCommSemiring.html @@ -1,130 +1,1655 @@ - - + + - - - - - - + FStar.Tactics.CanonCommSemiring + -

module FStar.Tactics.CanonCommSemiring

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let canon_attr:()
+

+FStar.Tactics.CanonCommSemiring

+
+

A tactic to solve equalities on a commutative semiring (a, +, *, 0, 1)

+

The tactic canon_semiring is parameterized by the base type a and +a semiring theory cr a. This requires:

+ +

In contrast to the previous version of FStar.Tactics.CanonCommSemiring, +the tactic defined here canonizes products, additions and additive inverses, +collects coefficients in monomials, and eliminates trivial expressions.

+

This is based on the legacy (second) version of Coq's ring tactic:

+ +

See also the newest ring tactic in Coq, which is even more general +and efficient:

+ +
+ +

+canon_attr

An attribute for marking definitions to unfold by the tactic

-
let (norm_fully (#a:Type) (x:a)):x
+
irreducible let canon_attr = ()
+
+

Commutative semiring theory

+
+
let distribute_left_lemma (a:Type) (cm_add:cm a) (cm_mult:cm a) =
+  let ( + ) = cm_add.mult in
+  let ( * ) = cm_mult.mult in
+  x:a -> y:a -> z:a -> Lemma (x * (y + z) == x * y + x * z)
+
let distribute_right_lemma (a:Type) (cm_add:cm a) (cm_mult:cm a) =
+  let ( + ) = cm_add.mult in
+  let ( * ) = cm_mult.mult in
+  x:a -> y:a -> z:a -> Lemma ((x + y) * z == x * z + y * z)
+
let mult_zero_l_lemma (a:Type) (cm_add:cm a) (cm_mult:cm a) =
+  x:a -> Lemma (cm_mult.mult cm_add.unit x == cm_add.unit)
+
let add_opp_r_lemma (a:Type) (cm_add:cm a) (opp:(a -> a)) =
+  let ( + ) = cm_add.mult in
+  x:a -> Lemma (x + opp x == cm_add.unit)
+
[@@canon_attr]
+unopteq
+type cr (a:Type) =
+  | CR :
+    cm_add: cm a ->
+    cm_mult: cm a ->
+    opp: (a -> a) ->
+    add_opp: add_opp_r_lemma a cm_add opp ->
+    distribute: distribute_left_lemma a cm_add cm_mult ->
+    mult_zero_l: mult_zero_l_lemma a cm_add cm_mult ->
+    cr a
+
let distribute_right (#a:Type) (r:cr a) : distribute_right_lemma a r.cm_add r.cm_mult =
+  fun x y z ->
+    r.cm_mult.commutativity (r.cm_add.mult x y) z;
+    r.distribute z x y;
+    r.cm_mult.commutativity x z;
+    r.cm_mult.commutativity y z
+
+

Syntax of canonical ring expressions

+
+

+norm_fully

+
[@@canon_attr]
+unfold let norm_fully (#a:Type) (x:a) = x
+
let index: eqtype = nat
+ +
type varlist =
+  | Nil_var : varlist
+  | Cons_var : index -> varlist -> varlist
+ +
type canonical_sum a =
+  | Nil_monom : canonical_sum a
+  | Cons_monom : a -> varlist -> canonical_sum a -> canonical_sum a
+  | Cons_varlist : varlist -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec varlist_lt (x y:varlist) : bool =
+  match x, y with
+  | Nil_var, Cons_var _ _ -> true
+  | Cons_var i xs, Cons_var j ys ->
+    if i < j then true else i = j && varlist_lt xs ys
+  | _, _ -> false
+
[@@canon_attr]
+val varlist_merge: l1:varlist -> l2:varlist -> Tot varlist (decreases %[l1; l2; 0])
+
[@@canon_attr]
+val vm_aux: index -> t1:varlist -> l2:varlist -> Tot varlist (decreases %[t1; l2; 1])
+

Merges two lists of variables, preserving sortedness

+
[@@canon_attr]
+let rec varlist_merge l1 l2 =
+  match l1, l2 with
+  | _, Nil_var -> l1
+  | Nil_var, _ -> l2
+  | Cons_var v1 t1, Cons_var v2 t2 -> vm_aux v1 t1 l2
+and vm_aux v1 t1 l2 =
+  match l2 with
+  | Cons_var v2 t2 ->
+    if v1 < v2
+    then Cons_var v1 (varlist_merge t1 l2)
+    else Cons_var v2 (vm_aux v1 t1 t2)
+  | _ -> Cons_var v1 t1
+ -
val spolynomial_normalize:Unidentified product: [#a:eqtype] Unidentified product: [cr a] Unidentified product: [spolynomial a] canonical_sum a
+
[@@canon_attr]
+val canonical_sum_merge : #a:eqtype -> cr a
+  -> s1:canonical_sum a -> s2:canonical_sum a
+  -> Tot (canonical_sum a) (decreases %[s1; s2; 0])
+
[@@canon_attr]
+val csm_aux: #a:eqtype -> r:cr a -> c1:a -> l1:varlist -> t1:canonical_sum a
+  -> s2:canonical_sum a -> Tot (canonical_sum a) (decreases %[t1; s2; 1])
+
[@@canon_attr]
+let rec canonical_sum_merge #a r s1 s2 =
+  let aplus = r.cm_add.mult in
+  let aone  = r.cm_mult.unit in
+  match s1 with
+  | Cons_monom c1 l1 t1 -> csm_aux r c1 l1 t1 s2
+  | Cons_varlist l1 t1  -> csm_aux r aone l1 t1 s2
+  | Nil_monom -> s2
+
and csm_aux #a r c1 l1 t1 s2 =
+  let aplus = r.cm_add.mult in
+  let aone  = r.cm_mult.unit in
+  match s2 with
+  | Cons_monom c2 l2 t2 ->
+    if l1 = l2
+    then Cons_monom (norm_fully (aplus c1 c2)) l1 (canonical_sum_merge r t1 t2)
+    else
+      if varlist_lt l1 l2
+      then Cons_monom c1 l1 (canonical_sum_merge r t1 s2)
+      else Cons_monom c2 l2 (csm_aux #a r c1 l1 t1 t2)
+  | Cons_varlist l2 t2 ->
+    if l1 = l2
+    then Cons_monom (norm_fully (aplus c1 aone)) l1 (canonical_sum_merge r t1 t2)
+    else
+      if varlist_lt l1 l2
+      then Cons_monom c1 l1 (canonical_sum_merge r t1 s2)
+      else Cons_varlist l2 (csm_aux r c1 l1 t1 t2)
+  | Nil_monom ->
+

if c1 = aone then Cons_varlist l1 t1 else

+
Cons_monom c1 l1 t1
+

Inserts a monomial into the apropriate position in a canonical sum

+
val monom_insert: #a:eqtype -> r:cr a
+  -> c1:a -> l1:varlist -> s2:canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec monom_insert #a r c1 l1 s2 =
+  let aplus = r.cm_add.mult in
+  let aone  = r.cm_mult.unit in
+  match s2 with
+  | Cons_monom c2 l2 t2 ->
+    if l1 = l2
+    then Cons_monom (norm_fully (aplus c1 c2)) l1 t2
+    else
+      if varlist_lt l1 l2
+      then Cons_monom c1 l1 s2
+      else Cons_monom c2 l2 (monom_insert r c1 l1 t2)
+  | Cons_varlist l2 t2 ->
+    if l1 = l2
+    then Cons_monom (norm_fully (aplus c1 aone)) l1 t2
+    else
+      if varlist_lt l1 l2
+      then Cons_monom c1 l1 s2
+      else Cons_varlist l2 (monom_insert r c1 l1 t2)
+  | Nil_monom ->
+    if c1 = aone
+    then Cons_varlist l1 Nil_monom
+    else Cons_monom c1 l1 Nil_monom
+

Inserts a monomial without scalar into a canonical sum

+
val varlist_insert: #a:eqtype -> cr a -> varlist -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let varlist_insert #a r l1 s2 =
+  let aone = r.cm_mult.unit in
+  monom_insert r aone l1 s2
+

Multiplies a sum by a scalar c0

+
val canonical_sum_scalar: #a:Type -> cr a -> a -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec canonical_sum_scalar #a r c0 s =
+  let amult = r.cm_mult.mult in
+  match s with
+  | Cons_monom c l t -> Cons_monom (norm_fully (amult c0 c)) l (canonical_sum_scalar r c0 t)
+  | Cons_varlist l t -> Cons_monom c0 l (canonical_sum_scalar r c0 t)
+  | Nil_monom -> Nil_monom
+

Multiplies a sum by a monomial without scalar

+
val canonical_sum_scalar2: #a:eqtype -> cr a -> varlist
+  -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec canonical_sum_scalar2 #a r l0 s =
+  match s with
+  | Cons_monom c l t ->
+    monom_insert r c (varlist_merge l0 l) (canonical_sum_scalar2 r l0 t)
+  | Cons_varlist l t ->
+    varlist_insert r (varlist_merge l0 l) (canonical_sum_scalar2 r l0 t)
+  | Nil_monom -> Nil_monom
+

Multiplies a sum by a monomial with scalar

+
val canonical_sum_scalar3: #a:eqtype -> cr a -> a -> varlist
+  -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec canonical_sum_scalar3 #a r c0 l0 s =
+  let amult = r.cm_mult.mult in
+  match s with
+  | Cons_monom c l t ->
+    monom_insert r (norm_fully (amult c0 c)) (varlist_merge l0 l)
+                 (canonical_sum_scalar3 r c0 l0 t)
+  | Cons_varlist l t ->
+    monom_insert r c0 (varlist_merge l0 l)
+                 (canonical_sum_scalar3 r c0 l0 t)
+  | Nil_monom -> s
+

Multiplies two canonical sums

+
val canonical_sum_prod: #a:eqtype -> cr a
+  -> canonical_sum a -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec canonical_sum_prod #a r s1 s2 =
+  match s1 with
+  | Cons_monom c1 l1 t1 ->
+    canonical_sum_merge r (canonical_sum_scalar3 r c1 l1 s2)
+                          (canonical_sum_prod r t1 s2)
+  | Cons_varlist l1 t1 ->
+    canonical_sum_merge r (canonical_sum_scalar2 r l1 s2)
+                          (canonical_sum_prod r t1 s2)
+  | Nil_monom -> s1
+
+

Syntax of concrete semiring polynomials

+
+

This is the type where we reflect expressions before normalization

+
type spolynomial a =
+  | SPvar   : index -> spolynomial a
+  | SPconst : a -> spolynomial a
+  | SPplus  : spolynomial a -> spolynomial a -> spolynomial a
+  | SPmult  : spolynomial a -> spolynomial a -> spolynomial a
+

+spolynomial_normalize

Canonize a reflected expression

-
val canonical_sum_simplify:Unidentified product: [#a:eqtype] Unidentified product: [cr a] Unidentified product: [canonical_sum a] canonical_sum a
+
val spolynomial_normalize: #a:eqtype -> cr a -> spolynomial a -> canonical_sum a
+
[@@canon_attr]
+let rec spolynomial_normalize #a r p =
+  match p with
+  | SPvar i -> Cons_varlist (Cons_var i Nil_var) Nil_monom
+  | SPconst c -> Cons_monom c Nil_var Nil_monom
+  | SPplus l q ->
+    canonical_sum_merge r (spolynomial_normalize r l) (spolynomial_normalize r q)
+  | SPmult l q ->
+    canonical_sum_prod r (spolynomial_normalize r l) (spolynomial_normalize r q)
+

+canonical_sum_simplify

-
val spolynomial_simplify:Unidentified product: [#a:eqtype] Unidentified product: [cr a] Unidentified product: [spolynomial a] canonical_sum a
+
val canonical_sum_simplify: #a:eqtype -> cr a -> canonical_sum a -> canonical_sum a
+
[@@canon_attr]
+let rec canonical_sum_simplify #a r s =
+  let azero = r.cm_add.unit in
+  let aone  = r.cm_mult.unit in
+  let aplus = r.cm_add.mult in
+  match s with
+  | Cons_monom c l t ->
+    if norm_fully (c = azero) then canonical_sum_simplify r t
+    else
+      if norm_fully (c = aone)
+      then Cons_varlist l (canonical_sum_simplify r t)
+      else Cons_monom c l (canonical_sum_simplify r t)
+  | Cons_varlist l t -> Cons_varlist l (canonical_sum_simplify r t)
+  | Nil_monom -> s
+

+spolynomial_simplify

-
let (vmap a):*(list (*(var, a)), a)
+
val spolynomial_simplify: #a:eqtype -> cr a -> spolynomial a -> canonical_sum a
+
[@@canon_attr]
+let spolynomial_simplify #a r p =
+  canonical_sum_simplify r
+    (spolynomial_normalize r p)
+
+

Interpretation of varlists, monomials and canonical sums

+
+

+vmap

-
let ((update (#a:Type) (x:var) (xa:a) (vm:vmap a)):vmap a):let  (l, y) = vm in (FStar.Pervasives.Native.Mktuple2 (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 x xa)) l) y)
+
let vmap a = list (var * a) * a
+

+update

Add a new entry in a variable map

-
let ((quote_list (#a:Type) (ta:term) (quotea:Unidentified product: [a] (Tac term)) (xs:list a)):(Tac term)):match xs with []  -> mk_app ((`(Nil))) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 ta Q_Implicit)) (Prims.Nil )) | (Prims.Cons x xs')  -> mk_app ((`(Cons))) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 ta Q_Implicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 quotea x Q_Explicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 quote_list ta quotea xs' Q_Explicit)) (Prims.Nil ))))
+
let update (#a:Type) (x:var) (xa:a) (vm:vmap a) : vmap a =
+  let l, y = vm in (x, xa) :: l, y
+

+quote_list

Quotes a list

-
let ((quote_vm (#a:Type) (ta:term) (quotea:Unidentified product: [a] (Tac term)) (vm:vmap a)):(Tac term)):let  ((quote_map_entry (p:(*(nat, a)))):(Tac term)) = mk_app ((`(Mktuple2))) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 (`(nat)) Q_Implicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 ta Q_Implicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 pack ((Tv_Const ((C_Int (fst p))))) Q_Explicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 quotea (snd p) Q_Explicit)) (Prims.Nil ))))) in let  tyentry = mk_e_app ((`(tuple2))) (Prims.Cons ((`(nat))) (Prims.Cons ta (Prims.Nil ))) in let  tlist = quote_list tyentry quote_map_entry (fst vm) in let  tylist = mk_e_app ((`(list))) (Prims.Cons tyentry (Prims.Nil )) in mk_app ((`(Mktuple2))) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 tylist Q_Implicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 ta Q_Implicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 tlist Q_Explicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 quotea (snd vm) Q_Explicit)) (Prims.Nil )))))
+
let rec quote_list (#a:Type) (ta:term) (quotea:a -> Tac term) (xs:list a) :
+    Tac term =
+  match xs with
+  | [] -> mk_app (`Nil) [(ta, Q_Implicit)]
+  | x::xs' -> mk_app (`Cons) [(ta, Q_Implicit);
+                             (quotea x, Q_Explicit);
+                             (quote_list ta quotea xs', Q_Explicit)]
+

+quote_vm

Quotes a variable map

-
let (interp_var (#a:Type) (vm:vmap a) (i:index)):match List.Tot.assoc i (fst vm) with (Some x)  -> x | _  -> snd vm
+
let quote_vm (#a:Type) (ta: term) (quotea:a -> Tac term) (vm:vmap a) : Tac term =
+  let quote_map_entry (p:(nat * a)) : Tac term =
+    mk_app (`Mktuple2) [(`nat, Q_Implicit); (ta, Q_Implicit);
+      (pack (Tv_Const (C_Int (fst p))), Q_Explicit);
+      (quotea (snd p), Q_Explicit)] in
+  let tyentry = mk_e_app (`tuple2) [(`nat); ta] in
+  let tlist = quote_list tyentry quote_map_entry (fst vm) in
+  let tylist = mk_e_app (`list) [tyentry] in
+  mk_app (`Mktuple2) [(tylist, Q_Implicit); (ta, Q_Implicit);
+                      (tlist, Q_Explicit); (quotea (snd vm), Q_Explicit)]
+

+interp_var

-
let ((interp_cs (#a:Type) (r:cr a) (vm:vmap a) (s:canonical_sum a)):a):let  azero = r.cm_add.unit in match s with Nil_monom  -> azero | (Cons_varlist l t)  -> ics_aux r vm (interp_vl r vm l) t | (Cons_monom c l t)  -> ics_aux r vm (interp_m r vm c l) t
+
[@@canon_attr]
+let interp_var (#a:Type) (vm:vmap a) (i:index) =
+  match List.Tot.Base.assoc i (fst vm) with
+  | Some x -> x
+  | _ -> snd vm
+
[@@canon_attr]
+private
+let rec ivl_aux (#a:Type) (r:cr a) (vm:vmap a) (x:index) (t:varlist)
+  : Tot a (decreases t) =
+  let amult = r.cm_mult.mult in
+  match t with
+  | Nil_var -> interp_var vm x
+  | Cons_var x' t' -> amult (interp_var vm x) (ivl_aux r vm x' t')
+
[@@canon_attr]
+let interp_vl (#a:Type) (r:cr a) (vm:vmap a) (l:varlist) =
+  let aone  = r.cm_mult.unit in
+  match l with
+  | Nil_var -> aone
+  | Cons_var x t -> ivl_aux r vm x t
+
[@@canon_attr]
+let interp_m (#a:Type) (r:cr a) (vm:vmap a) (c:a) (l:varlist) =
+  let amult = r.cm_mult.mult in
+  match l with
+  | Nil_var -> c
+  | Cons_var x t -> amult c (ivl_aux r vm x t)
+
[@@canon_attr]
+let rec ics_aux (#a:Type) (r:cr a) (vm:vmap a) (x:a) (s:canonical_sum a)
+  : Tot a (decreases s) =
+  let aplus = r.cm_add.mult in
+  match s with
+  | Nil_monom -> x
+  | Cons_varlist l t -> aplus x (ics_aux r vm (interp_vl r vm l) t)
+  | Cons_monom c l t -> aplus x (ics_aux r vm (interp_m r vm c l) t)
+

+interp_cs

Interpretation of a canonical sum

-
let ((interp_sp (#a:Type) (r:cr a) (vm:vmap a) (p:spolynomial a)):a):let  aplus = r.cm_add.mult in let  amult = r.cm_mult.mult in match p with (SPconst c)  -> c | (SPvar i)  -> interp_var vm i | (SPplus p1 p2)  -> aplus (interp_sp r vm p1) (interp_sp r vm p2) | (SPmult p1 p2)  -> amult (interp_sp r vm p1) (interp_sp r vm p2)
+
[@@canon_attr]
+let interp_cs (#a:Type) (r:cr a) (vm:vmap a) (s:canonical_sum a) : a =
+  let azero = r.cm_add.unit in
+  match s with
+  | Nil_monom -> azero
+  | Cons_varlist l t -> ics_aux r vm (interp_vl r vm l) t
+  | Cons_monom c l t -> ics_aux r vm (interp_m r vm c l) t
+

+interp_sp

Interpretation of a polynomial

-
typepolynomial = Pvar:Unidentified product: [index] polynomial a | Pconst:Unidentified product: [a] polynomial a | Pplus:Unidentified product: [polynomial a] Unidentified product: [polynomial a] polynomial a | Pmult:Unidentified product: [polynomial a] Unidentified product: [polynomial a] polynomial a | Popp:Unidentified product: [polynomial a] polynomial a
+
[@@canon_attr]
+let rec interp_sp (#a:Type) (r:cr a) (vm:vmap a) (p:spolynomial a) : a =
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match p with
+  | SPconst c -> c
+  | SPvar i -> interp_var vm i
+  | SPplus p1 p2 -> aplus (interp_sp r vm p1) (interp_sp r vm p2)
+  | SPmult p1 p2 -> amult (interp_sp r vm p1) (interp_sp r vm p2)
+
+

Proof of correctness

+
+
val mult_one_l (#a:Type) (r:cr a) (x:a) :
+  Lemma (r.cm_mult.mult r.cm_mult.unit x == x)
+  [SMTPat (r.cm_mult.mult r.cm_mult.unit x)]
+let mult_one_l #a r x =
+  r.cm_mult.identity x
+
val mult_one_r (#a:Type) (r:cr a) (x:a) :
+  Lemma (r.cm_mult.mult x r.cm_mult.unit == x)
+  [SMTPat (r.cm_mult.mult x r.cm_mult.unit)]
+let mult_one_r #a r x =
+  r.cm_mult.commutativity r.cm_mult.unit x
+
val mult_zero_l (#a:Type) (r:cr a) (x:a) :
+  Lemma (r.cm_mult.mult r.cm_add.unit x == r.cm_add.unit)
+  [SMTPat (r.cm_mult.mult r.cm_add.unit x)]
+let mult_zero_l #a r x =
+  r.mult_zero_l x
+
val mult_zero_r (#a:Type) (r:cr a) (x:a) :
+  Lemma (r.cm_mult.mult x r.cm_add.unit == r.cm_add.unit)
+  [SMTPat (r.cm_mult.mult x r.cm_add.unit)]
+let mult_zero_r #a r x =
+  r.cm_mult.commutativity x r.cm_add.unit
+
val add_zero_l (#a:Type) (r:cr a) (x:a) :
+  Lemma (r.cm_add.mult r.cm_add.unit x == x)
+  [SMTPat (r.cm_add.mult r.cm_add.unit x)]
+let add_zero_l #a r x =
+  r.cm_add.identity  x
+
val add_zero_r (#a:Type) (r:cr a) (x:a) :
+  Lemma (r.cm_add.mult x r.cm_add.unit == x)
+  [SMTPat (r.cm_add.mult x r.cm_add.unit)]
+let add_zero_r #a r x =
+  r.cm_add.commutativity r.cm_add.unit x
+
val opp_unique (#a:Type) (r:cr a) (x y:a) : Lemma
+  (requires r.cm_add.mult x y == r.cm_add.unit)
+  (ensures  y == r.opp x)
+let opp_unique #a r x y =
+  let ( + ) = r.cm_add.mult in
+  let zero = r.cm_add.unit in
+  calc (==) {
+    y;
+    == { r.add_opp x }
+    y + (x + r.opp x);
+    == { r.cm_add.associativity y x (r.opp x) }
+    (y + x) + r.opp x;
+    == { r.cm_add.commutativity x y }
+    zero + r.opp x;
+    == { }
+    r.opp x;
+  }
+
val add_mult_opp (#a:Type) (r:cr a) (x:a) : Lemma
+  (r.cm_add.mult x (r.cm_mult.mult (r.opp r.cm_mult.unit) x) == r.cm_add.unit)
+let add_mult_opp #a r x =
+  let ( + ) = r.cm_add.mult in
+  let ( * ) = r.cm_mult.mult in
+  let zero = r.cm_add.unit in
+  let one = r.cm_mult.unit in
+  calc (==) {
+    x + r.opp one * x;
+    == { }
+    one * x + r.opp one * x;
+    == { distribute_right r one (r.opp one) x }
+    (one + r.opp one) * x;
+    == { r.add_opp one }
+    zero * x;
+    == { }
+    zero;
+  }
+
val ivl_aux_ok (#a:Type) (r:cr a) (vm:vmap a) (v:varlist) (i:index) : Lemma
+  (ivl_aux r vm i v == r.cm_mult.mult (interp_var vm i) (interp_vl r vm v))
+let ivl_aux_ok #a r vm v i = ()
+
val vm_aux_ok (#a:eqtype) (r:cr a) (vm:vmap a) (v:index) (t l:varlist) :
+  Lemma
+  (ensures
+    interp_vl r vm (vm_aux v t l) ==
+    r.cm_mult.mult (interp_vl r vm (Cons_var v t)) (interp_vl r vm l))
+  (decreases %[t; l; 1])
+
val varlist_merge_ok (#a:eqtype) (r:cr a) (vm:vmap a) (x y:varlist) :
+  Lemma
+  (ensures
+    interp_vl r vm (varlist_merge x y) ==
+    r.cm_mult.mult (interp_vl r vm x) (interp_vl r vm y))
+  (decreases %[x; y; 0])
+
let rec varlist_merge_ok #a r vm x y =
+  let amult = r.cm_mult.mult in
+  match x, y with
+  | Cons_var v1 t1, Nil_var -> ()
+  | Cons_var v1 t1, Cons_var v2 t2 ->
+    if v1 < v2
+    then
+      begin
+      varlist_merge_ok r vm t1 y;
+      assert (
+        interp_vl r vm (varlist_merge x y) ==
+        amult (interp_var vm v1) (amult (interp_vl r vm t1) (interp_vl r vm y)));
+      r.cm_mult.associativity
+        (interp_var vm v1) (interp_vl r vm t1) (interp_vl r vm y)
+      end
+    else
+      vm_aux_ok r vm v1 t1 y
+  | Nil_var, _ -> ()
+and vm_aux_ok #a r vm v1 t1 l2 =
+  match l2 with
+  | Cons_var v2 t2 ->
+    if v1 < v2
+    then
+      begin
+      varlist_merge_ok r vm t1 l2;
+      r.cm_mult.associativity
+        (interp_var vm v1) (interp_vl r vm t1) (interp_vl r vm l2)
+      end
+    else
+      begin
+      vm_aux_ok r vm v1 t1 t2;
+      calc (==) {
+        interp_vl r vm (Cons_var v2 (vm_aux v1 t1 t2));
+        == { }
+        ivl_aux r vm v2 (vm_aux v1 t1 t2);
+        == { }
+        r.cm_mult.mult (interp_var vm v2) (interp_vl r vm (vm_aux v1 t1 t2));
+        == { }
+        r.cm_mult.mult (interp_var vm v2) (r.cm_mult.mult (interp_vl r vm (Cons_var v1 t1)) (interp_vl r vm t2));
+        == { r.cm_mult.commutativity
+               (interp_vl r vm (Cons_var v1 t1)) (interp_vl r vm t2) }
+        r.cm_mult.mult (interp_var vm v2)
+          (r.cm_mult.mult (interp_vl r vm t2) (interp_vl r vm (Cons_var v1 t1)) );
+        == { r.cm_mult.associativity
+              (interp_var vm v2)
+              (interp_vl r vm t2) (interp_vl r vm (Cons_var v1 t1)) }
+        r.cm_mult.mult
+         (r.cm_mult.mult (interp_var vm v2) (interp_vl r vm t2))
+         (interp_vl r vm (Cons_var v1 t1));
+        == { r.cm_mult.commutativity
+            (interp_vl r vm (Cons_var v1 t1)) (interp_vl r vm (Cons_var v2 t2)) }
+        r.cm_mult.mult (interp_vl r vm (Cons_var v1 t1)) (interp_vl r vm (Cons_var v2 t2));
+      }
+      end
+  | _ -> ()
+
val ics_aux_ok: #a:eqtype -> r:cr a -> vm:vmap a -> x:a -> s:canonical_sum a ->
+  Lemma (ensures ics_aux r vm x s == r.cm_add.mult x (interp_cs r vm s))
+  (decreases s)
+let rec ics_aux_ok #a r vm x s =
+  match s with
+  | Nil_monom -> ()
+  | Cons_varlist l t ->
+    ics_aux_ok r vm (interp_vl r vm l) t
+  | Cons_monom c l t ->
+    ics_aux_ok r vm (interp_m r vm c l) t
+
val interp_m_ok: #a:eqtype -> r:cr a -> vm:vmap a -> x:a -> l:varlist ->
+  Lemma (interp_m r vm x l == r.cm_mult.mult x (interp_vl r vm l))
+let interp_m_ok #a r vm x l = ()
+
val aplus_assoc_4: #a:Type -> r:cr a -> w:a -> x:a -> y:a -> z:a -> Lemma
+  (let aplus = r.cm_add.mult in
+   aplus (aplus w x) (aplus y z) == aplus (aplus w y) (aplus x z))
+let aplus_assoc_4 #a r w x y z =
+  let aplus = r.cm_add.mult in
+  let assoc = r.cm_add.associativity in
+  let comm = r.cm_add.commutativity in
+  calc (==) {
+    aplus (aplus w x) (aplus y z);
+    == { assoc w x (aplus y z) }
+    aplus w (aplus x (aplus y z));
+    == { comm x (aplus y z) }
+    aplus w (aplus (aplus y z) x);
+    == { assoc w (aplus y z) x }
+    aplus (aplus w (aplus y z)) x;
+    == { assoc w y z }
+    aplus (aplus (aplus w y) z) x;
+    == { assoc (aplus w y) z x }
+    aplus (aplus w y) (aplus z x);
+    == { comm z x }
+    aplus (aplus w y) (aplus x z);
+  }
+
val canonical_sum_merge_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> s1:canonical_sum a -> s2:canonical_sum a ->
+  Lemma
+  (ensures
+    interp_cs r vm (canonical_sum_merge r s1 s2) ==
+    r.cm_add.mult (interp_cs r vm s1) (interp_cs r vm s2))
+  (decreases %[s1; s2; 0])
+
val csm_aux_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> c1:a -> l1:varlist -> t1:canonical_sum a -> s2:canonical_sum a ->
+  Lemma
+  (ensures
+    interp_cs r vm (csm_aux r c1 l1 t1 s2) ==
+    r.cm_add.mult (interp_cs r vm (Cons_monom c1 l1 t1)) (interp_cs r vm s2))
+  (decreases %[t1; s2; 1])
+
let rec canonical_sum_merge_ok #a r vm s1 s2 =
+  let aone  = r.cm_mult.unit in
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match s1 with
+  | Cons_monom c1 l1 t1 -> csm_aux_ok #a r vm c1 l1 t1 s2
+  | Cons_varlist l1 t1  ->
+    calc (==) {
+      interp_cs r vm (canonical_sum_merge r s1 s2);
+      == { }
+      interp_cs r vm (csm_aux r aone l1 t1 s2);
+      == { csm_aux_ok #a r vm aone l1 t1 s2 }
+      aplus (interp_cs r vm (Cons_monom aone l1 t1))
+            (interp_cs r vm s2);
+      == { ics_aux_ok r vm (interp_vl r vm l1) t1 }
+      aplus (interp_cs r vm (Cons_varlist l1 t1))
+            (interp_cs r vm s2);
+    }
+  | Nil_monom -> ()
+and csm_aux_ok #a r vm c1 l1 t1 s2 =
+  let aplus = r.cm_add.mult in
+  let aone  = r.cm_mult.unit in
+  let amult = r.cm_mult.mult in
+  match s2 with
+  | Nil_monom -> ()
+  | Cons_monom c2 l2 t2 ->
+    let s1 = Cons_monom c1 l1 t1 in
+    if l1 = l2 then
+    begin
+    calc (==) {
+      interp_cs r vm (csm_aux r c1 l1 t1 s2);
+      == { }
+      ics_aux r vm (interp_m r vm (aplus c1 c2) l1)
+                   (canonical_sum_merge r t1 t2);
+      == { ics_aux_ok r vm (interp_m r vm (aplus c1 c2) l1)
+                           (canonical_sum_merge r t1 t2) }
+      aplus (interp_m r vm (aplus c1 c2) l1)
+            (interp_cs r vm (canonical_sum_merge r t1 t2));
+      == { interp_m_ok r vm (aplus c1 c2) l1 }
+      aplus (amult (aplus c1 c2) (interp_vl r vm l1))
+            (interp_cs r vm (canonical_sum_merge r t1 t2));
+      == { canonical_sum_merge_ok r vm t1 t2 }
+      aplus (amult (aplus c1 c2) (interp_vl r vm l1))
+            (aplus (interp_cs r vm t1) (interp_cs r vm t2));
+      == { distribute_right r c1 c2 (interp_vl r vm l1) }
+      aplus (aplus (amult c1 (interp_vl r vm l1))
+                   (amult c2 (interp_vl r vm l2)))
+            (aplus (interp_cs r vm t1)
+                   (interp_cs r vm t2));
+      == { aplus_assoc_4 r
+             (amult c1 (interp_vl r vm l1))
+             (amult c2 (interp_vl r vm l2))
+             (interp_cs r vm t1)
+             (interp_cs r vm t2) }
+      aplus (aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm t1))
+            (aplus (amult c2 (interp_vl r vm l2)) (interp_cs r vm t2));
+      == { ics_aux_ok r vm (amult c1 (interp_vl r vm l1)) t1;
+           interp_m_ok r vm c1 l1 }
+      aplus (interp_cs r vm s1)
+            (aplus (amult c2 (interp_vl r vm l2)) (interp_cs r vm t2));
+      == { ics_aux_ok r vm (amult c2 (interp_vl r vm l2)) t2;
+           interp_m_ok r vm c2 l2 }
+      aplus (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+    end
+    else if varlist_lt l1 l2 then
+    begin
+    calc (==) {
+      interp_cs r vm (canonical_sum_merge r s1 s2);
+      == { }
+      ics_aux r vm (interp_m r vm c1 l1)
+                   (canonical_sum_merge r t1 s2);
+      == { ics_aux_ok r vm (interp_m r vm c1 l1)
+                           (canonical_sum_merge r t1 s2) }
+      aplus (interp_m r vm c1 l1)
+            (interp_cs r vm (canonical_sum_merge r t1 s2));
+      == { interp_m_ok r vm c1 l1 }
+      aplus (amult c1 (interp_vl r vm l1))
+            (interp_cs r vm (canonical_sum_merge r t1 s2));
+      == { canonical_sum_merge_ok r vm t1 s2 }
+      aplus (amult c1 (interp_vl r vm l1))
+            (aplus (interp_cs r vm t1) (interp_cs r vm s2));
+      == { r.cm_add.associativity
+             (amult c1 (interp_vl r vm l1))
+             (interp_cs r vm t1)
+             (interp_cs r vm s2)
+         }
+      aplus (aplus (amult c1 (interp_vl r vm l1))
+                   (interp_cs r vm t1))
+            (interp_cs r vm s2);
+      == { ics_aux_ok r vm (amult c1 (interp_vl r vm l1)) t1;
+           interp_m_ok r vm c1 l1 }
+      aplus (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+    end
+    else
+    begin
+    calc (==) {
+      interp_cs r vm (csm_aux r c1 l1 t1 s2);
+      == { }
+      ics_aux r vm (interp_m r vm c2 l2)
+                   (csm_aux r c1 l1 t1 t2);
+      == { ics_aux_ok r vm (interp_m r vm c2 l2)
+                           (csm_aux r c1 l1 t1 t2) }
+      aplus (interp_m r vm c2 l2)
+            (interp_cs r vm (csm_aux r c1 l1 t1 t2));
+      == { interp_m_ok r vm c2 l2 }
+      aplus (amult c2 (interp_vl r vm l2))
+            (interp_cs r vm (csm_aux r c1 l1 t1 t2));
+      == { csm_aux_ok r vm c1 l1 t1 t2 }
+      aplus (amult c2 (interp_vl r vm l2))
+            (aplus (interp_cs r vm s1) (interp_cs r vm t2));
+      == { r.cm_add.commutativity (interp_cs r vm s1) (interp_cs r vm t2) }
+      aplus (amult c2 (interp_vl r vm l2))
+            (aplus (interp_cs r vm t2) (interp_cs r vm s1));
+      == { r.cm_add.associativity
+             (amult c2 (interp_vl r vm l2))
+             (interp_cs r vm t2)
+             (interp_cs r vm s1)
+         }
+      aplus (aplus (amult c2 (interp_vl r vm l2))
+                   (interp_cs r vm t2))
+            (interp_cs r vm s1);
+      == { ics_aux_ok r vm (amult c1 (interp_vl r vm l1)) t1;
+           interp_m_ok r vm c1 l1 }
+      aplus (interp_cs r vm s2) (interp_cs r vm s1);
+      == { r.cm_add.commutativity (interp_cs r vm s1) (interp_cs r vm s2) }
+      aplus (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+    end
+  | Cons_varlist l2 t2 -> // Same as Cons_monom with c2 = aone
+    let c2 = aone in
+    let s1 = Cons_monom c1 l1 t1 in
+    if l1 = l2 then
+    begin
+    calc (==) {
+      interp_cs r vm (csm_aux r c1 l1 t1 s2);
+      == { }
+      ics_aux r vm (interp_m r vm (aplus c1 c2) l1)
+                   (canonical_sum_merge r t1 t2);
+      == { ics_aux_ok r vm (interp_m r vm (aplus c1 c2) l1)
+                           (canonical_sum_merge r t1 t2) }
+      aplus (interp_m r vm (aplus c1 c2) l1)
+            (interp_cs r vm (canonical_sum_merge r t1 t2));
+      == { interp_m_ok r vm (aplus c1 c2) l1 }
+      aplus (amult (aplus c1 c2) (interp_vl r vm l1))
+            (interp_cs r vm (canonical_sum_merge r t1 t2));
+      == { canonical_sum_merge_ok r vm t1 t2 }
+      aplus (amult (aplus c1 c2) (interp_vl r vm l1))
+            (aplus (interp_cs r vm t1) (interp_cs r vm t2));
+      == { distribute_right r c1 c2 (interp_vl r vm l1) }
+      aplus (aplus (amult c1 (interp_vl r vm l1))
+                   (amult c2 (interp_vl r vm l2)))
+            (aplus (interp_cs r vm t1)
+                   (interp_cs r vm t2));
+      == { aplus_assoc_4 r
+             (amult c1 (interp_vl r vm l1))
+             (amult c2 (interp_vl r vm l2))
+             (interp_cs r vm t1)
+             (interp_cs r vm t2) }
+      aplus (aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm t1))
+            (aplus (amult c2 (interp_vl r vm l2)) (interp_cs r vm t2));
+      == { ics_aux_ok r vm (amult c1 (interp_vl r vm l1)) t1;
+           interp_m_ok r vm c1 l1 }
+      aplus (interp_cs r vm s1)
+            (aplus (amult c2 (interp_vl r vm l2)) (interp_cs r vm t2));
+      == { ics_aux_ok r vm (amult c2 (interp_vl r vm l2)) t2;
+           interp_m_ok r vm c2 l2 }
+      aplus (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+    end
+    else if varlist_lt l1 l2 then
+    begin
+    calc (==) {
+      interp_cs r vm (canonical_sum_merge r s1 s2);
+      == { }
+      ics_aux r vm (interp_m r vm c1 l1)
+                   (canonical_sum_merge r t1 s2);
+      == { ics_aux_ok r vm (interp_m r vm c1 l1)
+                           (canonical_sum_merge r t1 s2) }
+      aplus (interp_m r vm c1 l1)
+            (interp_cs r vm (canonical_sum_merge r t1 s2));
+      == { interp_m_ok r vm c1 l1 }
+      aplus (amult c1 (interp_vl r vm l1))
+            (interp_cs r vm (canonical_sum_merge r t1 s2));
+      == { canonical_sum_merge_ok r vm t1 s2 }
+      aplus (amult c1 (interp_vl r vm l1))
+            (aplus (interp_cs r vm t1) (interp_cs r vm s2));
+      == { r.cm_add.associativity
+             (amult c1 (interp_vl r vm l1))
+             (interp_cs r vm t1)
+             (interp_cs r vm s2)
+         }
+      aplus (aplus (amult c1 (interp_vl r vm l1))
+                   (interp_cs r vm t1))
+            (interp_cs r vm s2);
+      == { ics_aux_ok r vm (amult c1 (interp_vl r vm l1)) t1;
+           interp_m_ok r vm c1 l1 }
+      aplus (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+    end
+    else
+    begin
+    calc (==) {
+      interp_cs r vm (csm_aux r c1 l1 t1 s2);
+      == { }
+      ics_aux r vm (interp_m r vm c2 l2)
+                   (csm_aux r c1 l1 t1 t2);
+      == { ics_aux_ok r vm (interp_m r vm c2 l2)
+                           (csm_aux r c1 l1 t1 t2) }
+      aplus (interp_m r vm c2 l2)
+            (interp_cs r vm (csm_aux r c1 l1 t1 t2));
+      == { interp_m_ok r vm c2 l2 }
+      aplus (amult c2 (interp_vl r vm l2))
+            (interp_cs r vm (csm_aux r c1 l1 t1 t2));
+      == { csm_aux_ok r vm c1 l1 t1 t2 }
+      aplus (amult c2 (interp_vl r vm l2))
+            (aplus (interp_cs r vm s1) (interp_cs r vm t2));
+      == { r.cm_add.commutativity (interp_cs r vm s1) (interp_cs r vm t2) }
+      aplus (amult c2 (interp_vl r vm l2))
+            (aplus (interp_cs r vm t2) (interp_cs r vm s1));
+      == { r.cm_add.associativity
+             (amult c2 (interp_vl r vm l2))
+             (interp_cs r vm t2)
+             (interp_cs r vm s1)
+         }
+      aplus (aplus (amult c2 (interp_vl r vm l2))
+                   (interp_cs r vm t2))
+            (interp_cs r vm s1);
+      == { ics_aux_ok r vm (amult c1 (interp_vl r vm l1)) t1;
+           interp_m_ok r vm c1 l1 }
+      aplus (interp_cs r vm s2) (interp_cs r vm s1);
+      == { r.cm_add.commutativity (interp_cs r vm s1) (interp_cs r vm s2) }
+      aplus (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+    end
+
val monom_insert_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> c1:a -> l1:varlist -> s2:canonical_sum a ->
+  Lemma
+  (interp_cs r vm (monom_insert r c1 l1 s2) ==
+   r.cm_add.mult (r.cm_mult.mult c1 (interp_vl r vm l1)) (interp_cs r vm s2))
+let rec monom_insert_ok #a r vm c1 l1 s2 =
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  let aone  = r.cm_mult.unit in
+  match s2 with
+  | Cons_monom c2 l2 t2 ->
+    if l1 = l2
+    then
+      calc (==) {
+        interp_cs r vm (monom_insert r c1 l1 s2);
+        == { }
+        interp_cs r vm (Cons_monom (aplus c1 c2) l1 t2);
+        == { }
+        ics_aux r vm (interp_m r vm (aplus c1 c2) l1) t2;
+        == { ics_aux_ok r vm (interp_m r vm (aplus c1 c2) l1) t2 }
+        aplus (interp_m r vm (aplus c1 c2) l1) (interp_cs r vm t2);
+        == { interp_m_ok r vm (aplus c1 c2) l1 }
+        aplus (amult (aplus c1 c2) (interp_vl r vm l2)) (interp_cs r vm t2);
+        == { distribute_right r c1 c2 (interp_vl r vm l2) }
+        aplus (aplus (amult c1 (interp_vl r vm l1))
+                     (amult c2 (interp_vl r vm l2)))
+              (interp_cs r vm t2);
+        == { r.cm_add.associativity
+               (amult c1 (interp_vl r vm l1))
+               (amult c2 (interp_vl r vm l2))
+               (interp_cs r vm t2) }
+        aplus (amult c1 (interp_vl r vm l1))
+              (aplus (amult c2 (interp_vl r vm l2))
+                     (interp_cs r vm t2));
+        == { ics_aux_ok r vm (interp_m r vm c2 l2) t2 }
+        aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm s2);
+      }
+    else
+     if varlist_lt l1 l2 then ()
+     else
+       calc (==) {
+        interp_cs r vm (monom_insert r c1 l1 s2);
+        == { }
+        interp_cs r vm (Cons_monom c2 l2 (monom_insert r c1 l1 t2));
+        == { }
+        aplus (amult c2 (interp_vl r vm l2))
+              (interp_cs r vm (monom_insert r c1 l1 t2));
+        == { monom_insert_ok r vm c1 l1 t2 }
+        aplus (amult c2 (interp_vl r vm l2))
+              (aplus (amult c1 (interp_vl r vm l1))
+                     (interp_cs r vm t2));
+        == { r.cm_add.commutativity
+               (amult c1 (interp_vl r vm l1))
+               (interp_cs r vm t2) }
+        aplus (amult c2 (interp_vl r vm l2))
+              (aplus (interp_cs r vm t2)
+                     (amult c1 (interp_vl r vm l1)));
+        == { r.cm_add.associativity
+              (amult c2 (interp_vl r vm l2))
+              (interp_cs r vm t2)
+              (amult c1 (interp_vl r vm l1)) }
+        aplus (aplus (amult c2 (interp_vl r vm l2))
+                     (interp_cs r vm t2))
+              (amult c1 (interp_vl r vm l1));
+        == { ics_aux_ok r vm (interp_m r vm c2 l2) t2 }
+        aplus (interp_cs r vm s2) (amult c1 (interp_vl r vm l1));
+        == { r.cm_add.commutativity
+              (interp_cs r vm s2)
+              (amult c1 (interp_vl r vm l1)) }
+        aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm s2);
+       }
+  | Cons_varlist l2 t2 -> // Same as Cons_monom with c2 = aone
+    let c2 = aone in
+    if l1 = l2
+    then
+      calc (==) {
+        interp_cs r vm (monom_insert r c1 l1 s2);
+        == { }
+        interp_cs r vm (Cons_monom (aplus c1 c2) l1 t2);
+        == { }
+        ics_aux r vm (interp_m r vm (aplus c1 c2) l1) t2;
+        == { ics_aux_ok r vm (interp_m r vm (aplus c1 c2) l1) t2 }
+        aplus (interp_m r vm (aplus c1 c2) l1) (interp_cs r vm t2);
+        == { interp_m_ok r vm (aplus c1 c2) l1 }
+        aplus (amult (aplus c1 c2) (interp_vl r vm l2)) (interp_cs r vm t2);
+        == { distribute_right r c1 c2 (interp_vl r vm l2) }
+        aplus (aplus (amult c1 (interp_vl r vm l1))
+                     (amult c2 (interp_vl r vm l2)))
+              (interp_cs r vm t2);
+        == { r.cm_add.associativity
+               (amult c1 (interp_vl r vm l1))
+               (amult c2 (interp_vl r vm l2))
+               (interp_cs r vm t2) }
+        aplus (amult c1 (interp_vl r vm l1))
+              (aplus (amult c2 (interp_vl r vm l2))
+                     (interp_cs r vm t2));
+        == { ics_aux_ok r vm (interp_m r vm c2 l2) t2 }
+        aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm s2);
+      }
+    else
+     if varlist_lt l1 l2 then ()
+     else
+       calc (==) {
+        interp_cs r vm (monom_insert r c1 l1 s2);
+        == { }
+        interp_cs r vm (Cons_monom c2 l2 (monom_insert r c1 l1 t2));
+        == { }
+        aplus (amult c2 (interp_vl r vm l2))
+              (interp_cs r vm (monom_insert r c1 l1 t2));
+        == { monom_insert_ok r vm c1 l1 t2 }
+        aplus (amult c2 (interp_vl r vm l2))
+              (aplus (amult c1 (interp_vl r vm l1))
+                     (interp_cs r vm t2));
+        == { r.cm_add.commutativity
+               (amult c1 (interp_vl r vm l1))
+               (interp_cs r vm t2) }
+        aplus (amult c2 (interp_vl r vm l2))
+              (aplus (interp_cs r vm t2)
+                     (amult c1 (interp_vl r vm l1)));
+        == { r.cm_add.associativity
+              (amult c2 (interp_vl r vm l2))
+              (interp_cs r vm t2)
+              (amult c1 (interp_vl r vm l1)) }
+        aplus (aplus (amult c2 (interp_vl r vm l2))
+                     (interp_cs r vm t2))
+              (amult c1 (interp_vl r vm l1));
+        == { ics_aux_ok r vm (interp_m r vm c2 l2) t2 }
+        aplus (interp_cs r vm s2) (amult c1 (interp_vl r vm l1));
+        == { r.cm_add.commutativity
+              (interp_cs r vm s2)
+              (amult c1 (interp_vl r vm l1)) }
+        aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm s2);
+       }
+  | Nil_monom -> ()
+
val varlist_insert_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> l1:varlist -> s2:canonical_sum a ->
+  Lemma (interp_cs r vm (varlist_insert r l1 s2) ==
+         r.cm_add.mult (interp_vl r vm l1) (interp_cs r vm s2))
+let varlist_insert_ok #a r vm l1 s2 =
+  let aone = r.cm_mult.unit in
+  monom_insert_ok r vm aone l1 s2
+
val canonical_sum_scalar_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> c0:a -> s:canonical_sum a ->
+  Lemma (
+    interp_cs r vm (canonical_sum_scalar r c0 s) ==
+    r.cm_mult.mult c0 (interp_cs r vm s))
+let rec canonical_sum_scalar_ok #a r vm c0 s =
+  let aone  = r.cm_mult.unit in
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match s with
+  | Cons_monom c l t ->
+    calc (==) {
+      interp_cs r vm (canonical_sum_scalar r c0 s);
+      == { }
+      interp_cs r vm (Cons_monom (amult c0 c) l (canonical_sum_scalar r c0 t));
+      == { }
+      aplus (amult (amult c0 c) (interp_vl r vm l))
+            (interp_cs r vm (canonical_sum_scalar r c0 t));
+      == { r.cm_mult.associativity c0 c (interp_vl r vm l) }
+      aplus (amult c0 (amult c (interp_vl r vm l)))
+            (interp_cs r vm (canonical_sum_scalar r c0 t));
+      == { canonical_sum_scalar_ok r vm c0 t }
+      aplus (amult c0 (amult c (interp_vl r vm l)))
+            (amult c0 (interp_cs r vm t));
+      == { r.distribute c0 (amult c (interp_vl r vm l))
+                              (interp_cs r vm t) }
+      amult c0 (aplus (amult c (interp_vl r vm l)) (interp_cs r vm t));
+      == { }
+      amult c0 (interp_cs r vm s);
+    }
+  | Cons_varlist l t -> // Same as Cons_monom c l t with c = r.cm_mult.unit
+    let c = aone in
+        calc (==) {
+      interp_cs r vm (canonical_sum_scalar r c0 s);
+      == { }
+      interp_cs r vm (Cons_monom (amult c0 c) l (canonical_sum_scalar r c0 t));
+      == { }
+      aplus (amult (amult c0 c) (interp_vl r vm l))
+            (interp_cs r vm (canonical_sum_scalar r c0 t));
+      == { r.cm_mult.associativity c0 c (interp_vl r vm l) }
+      aplus (amult c0 (amult c (interp_vl r vm l)))
+            (interp_cs r vm (canonical_sum_scalar r c0 t));
+      == { canonical_sum_scalar_ok r vm c0 t }
+      aplus (amult c0 (amult c (interp_vl r vm l)))
+            (amult c0 (interp_cs r vm t));
+      == { r.distribute c0 (amult c (interp_vl r vm l))
+                              (interp_cs r vm t) }
+      amult c0 (aplus (amult c (interp_vl r vm l)) (interp_cs r vm t));
+      == { }
+      amult c0 (interp_cs r vm s);
+    }
+  | Nil_monom -> ()
+
val canonical_sum_scalar2_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> l0:varlist -> s:canonical_sum a ->
+  Lemma (
+    interp_cs r vm (canonical_sum_scalar2 r l0 s) ==
+    r.cm_mult.mult (interp_vl r vm l0) (interp_cs r vm s))
+let rec canonical_sum_scalar2_ok #a r vm l0 s =
+  let aone  = r.cm_mult.unit in
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match s with
+  | Cons_monom c l t ->
+    calc (==) {
+      interp_cs r vm (canonical_sum_scalar2 r l0 s);
+      == { }
+      interp_cs r vm
+        (monom_insert r c (varlist_merge l0 l) (canonical_sum_scalar2 r l0 t));
+      == { monom_insert_ok r vm c (varlist_merge l0 l) (canonical_sum_scalar2 r l0 t) }
+      aplus (amult c (interp_vl r vm (varlist_merge l0 l)))
+            (interp_cs r vm (canonical_sum_scalar2 r l0 t));
+      == { varlist_merge_ok r vm l0 l }
+      aplus (amult c (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (interp_cs r vm (canonical_sum_scalar2 r l0 t));
+      == { canonical_sum_scalar2_ok r vm l0 t }
+      aplus (amult c (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.cm_mult.associativity c (interp_vl r vm l0)
+             (interp_vl r vm l) }
+      aplus (amult (amult c (interp_vl r vm l0)) (interp_vl r vm l))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.cm_mult.commutativity (interp_vl r vm l0) c }
+      aplus (amult (amult (interp_vl r vm l0) c) (interp_vl r vm l))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.cm_mult.associativity (interp_vl r vm l0) c (interp_vl r vm l) }
+      aplus (amult (interp_vl r vm l0) (amult c (interp_vl r vm l)))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.distribute (interp_vl r vm l0)
+             (amult c (interp_vl r vm l)) (interp_cs r vm t) }
+      amult (interp_vl r vm l0)
+            (aplus (amult c (interp_vl r vm l)) (interp_cs r vm t));
+      == {  }
+      amult (interp_vl r vm l0) (interp_cs r vm s);
+    }
+  | Cons_varlist l t -> // Same as Cons_monom c l t with c = aone
+    let c = aone in
+    calc (==) {
+      interp_cs r vm (canonical_sum_scalar2 r l0 s);
+      == { }
+      interp_cs r vm
+        (monom_insert r c (varlist_merge l0 l) (canonical_sum_scalar2 r l0 t));
+      == { monom_insert_ok r vm c (varlist_merge l0 l) (canonical_sum_scalar2 r l0 t) }
+      aplus (amult c (interp_vl r vm (varlist_merge l0 l)))
+            (interp_cs r vm (canonical_sum_scalar2 r l0 t));
+      == { varlist_merge_ok r vm l0 l }
+      aplus (amult c (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (interp_cs r vm (canonical_sum_scalar2 r l0 t));
+      == { canonical_sum_scalar2_ok r vm l0 t }
+      aplus (amult c (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.cm_mult.associativity c (interp_vl r vm l0)
+             (interp_vl r vm l) }
+      aplus (amult (amult c (interp_vl r vm l0)) (interp_vl r vm l))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.cm_mult.commutativity (interp_vl r vm l0) c }
+      aplus (amult (amult (interp_vl r vm l0) c) (interp_vl r vm l))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.cm_mult.associativity (interp_vl r vm l0) c (interp_vl r vm l) }
+      aplus (amult (interp_vl r vm l0) (amult c (interp_vl r vm l)))
+            (amult (interp_vl r vm l0) (interp_cs r vm t));
+      == { r.distribute (interp_vl r vm l0)
+             (amult c (interp_vl r vm l)) (interp_cs r vm t) }
+      amult (interp_vl r vm l0)
+            (aplus (amult c (interp_vl r vm l)) (interp_cs r vm t));
+      == {  }
+      amult (interp_vl r vm l0) (interp_cs r vm s);
+    }
+  | Nil_monom -> ()
+
val canonical_sum_scalar3_ok: #a:eqtype -> r:cr a -> vm:vmap a
+  -> c0:a -> l0:varlist -> s:canonical_sum a ->
+  Lemma (
+    interp_cs r vm (canonical_sum_scalar3 r c0 l0 s) ==
+    r.cm_mult.mult (r.cm_mult.mult c0 (interp_vl r vm l0)) (interp_cs r vm s))
+let rec canonical_sum_scalar3_ok #a r vm c0 l0 s =
+  let aone  = r.cm_mult.unit in
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match s with
+  | Cons_monom c l t ->
+    calc (==) {
+      interp_cs r vm (canonical_sum_scalar3 r c0 l0 s);
+      == { }
+      interp_cs r vm
+        (monom_insert r (amult c0 c) (varlist_merge l0 l)
+          (canonical_sum_scalar3 r c0 l0 t));
+      == { monom_insert_ok r vm (amult c0 c) (varlist_merge l0 l) (canonical_sum_scalar3 r c0 l0 t) }
+      aplus (amult (amult c0 c) (interp_vl r vm (varlist_merge l0 l)))
+            (interp_cs r vm (canonical_sum_scalar3 r c0 l0 t));
+      == { varlist_merge_ok r vm l0 l }
+      aplus (amult (amult c0 c) (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (interp_cs r vm (canonical_sum_scalar3 r c0 l0 t));
+      == { canonical_sum_scalar3_ok r vm c0 l0 t }
+      aplus (amult (amult c0 c) (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.associativity (amult c0 c)
+             (interp_vl r vm l0) (interp_vl r vm l) }
+      aplus (amult (amult (amult c0 c) (interp_vl r vm l0)) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.commutativity c0 c }
+      aplus (amult (amult (amult c c0) (interp_vl r vm l0)) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.associativity c c0 (interp_vl r vm l0) }
+      aplus (amult (amult c (amult c0 (interp_vl r vm l0))) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.commutativity c (amult c0 (interp_vl r vm l0)) }
+      aplus (amult (amult (amult c0 (interp_vl r vm l0)) c) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.associativity (amult c0 (interp_vl r vm l0)) c (interp_vl r vm l) }
+      aplus (amult (amult c0 (interp_vl r vm l0)) (amult c (interp_vl r vm l)))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.distribute (amult c0 (interp_vl r vm l0))
+             (amult c (interp_vl r vm l)) (interp_cs r vm t) }
+      amult (amult c0 (interp_vl r vm l0))
+            (aplus (amult c (interp_vl r vm l)) (interp_cs r vm t));
+      == {  }
+      amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm s);
+    }
+  | Cons_varlist l t -> // Same as Cons_monom c l t with c = aone
+    let c = aone in
+    calc (==) {
+      interp_cs r vm (canonical_sum_scalar3 r c0 l0 s);
+      == { }
+      interp_cs r vm
+        (monom_insert r (amult c0 c) (varlist_merge l0 l)
+          (canonical_sum_scalar3 r c0 l0 t));
+      == { monom_insert_ok r vm (amult c0 c) (varlist_merge l0 l) (canonical_sum_scalar3 r c0 l0 t) }
+      aplus (amult (amult c0 c) (interp_vl r vm (varlist_merge l0 l)))
+            (interp_cs r vm (canonical_sum_scalar3 r c0 l0 t));
+      == { varlist_merge_ok r vm l0 l }
+      aplus (amult (amult c0 c) (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (interp_cs r vm (canonical_sum_scalar3 r c0 l0 t));
+      == { canonical_sum_scalar3_ok r vm c0 l0 t }
+      aplus (amult (amult c0 c) (amult (interp_vl r vm l0) (interp_vl r vm l)))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.associativity (amult c0 c)
+             (interp_vl r vm l0) (interp_vl r vm l) }
+      aplus (amult (amult (amult c0 c) (interp_vl r vm l0)) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.commutativity c0 c }
+      aplus (amult (amult (amult c c0) (interp_vl r vm l0)) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.associativity c c0 (interp_vl r vm l0) }
+      aplus (amult (amult c (amult c0 (interp_vl r vm l0))) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.commutativity c (amult c0 (interp_vl r vm l0)) }
+      aplus (amult (amult (amult c0 (interp_vl r vm l0)) c) (interp_vl r vm l))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.cm_mult.associativity (amult c0 (interp_vl r vm l0)) c (interp_vl r vm l) }
+      aplus (amult (amult c0 (interp_vl r vm l0)) (amult c (interp_vl r vm l)))
+            (amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm t));
+      == { r.distribute (amult c0 (interp_vl r vm l0))
+             (amult c (interp_vl r vm l)) (interp_cs r vm t) }
+      amult (amult c0 (interp_vl r vm l0))
+            (aplus (amult c (interp_vl r vm l)) (interp_cs r vm t));
+      == {  }
+      amult (amult c0 (interp_vl r vm l0)) (interp_cs r vm s);
+    }
+  | Nil_monom -> ()
+
val canonical_sum_prod_ok: #a:eqtype -> r:cr a -> vm:vmap a ->
+  s1:canonical_sum a -> s2:canonical_sum a ->
+  Lemma (interp_cs r vm (canonical_sum_prod r s1 s2) ==
+         r.cm_mult.mult (interp_cs r vm s1) (interp_cs r vm s2))
+let rec canonical_sum_prod_ok #a r vm s1 s2 =
+  let aone  = r.cm_mult.unit in
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match s1 with
+  | Cons_monom c1 l1 t1 ->
+    calc (==) {
+      interp_cs r vm (canonical_sum_prod r s1 s2);
+      == { }
+      interp_cs r vm
+        (canonical_sum_merge r (canonical_sum_scalar3 r c1 l1 s2)
+                               (canonical_sum_prod r t1 s2));
+      == { canonical_sum_merge_ok r vm
+             (canonical_sum_scalar3 r c1 l1 s2)
+             (canonical_sum_prod r t1 s2) }
+      aplus (interp_cs r vm (canonical_sum_scalar3 r c1 l1 s2))
+            (interp_cs r vm (canonical_sum_prod r t1 s2));
+      == { canonical_sum_scalar3_ok r vm c1 l1 s2;
+           canonical_sum_prod_ok r vm t1 s2 }
+      aplus (amult (amult c1 (interp_vl r vm l1)) (interp_cs r vm s2))
+            (amult (interp_cs r vm t1) (interp_cs r vm s2));
+      == { distribute_right r (amult c1 (interp_vl r vm l1))
+             (interp_cs r vm t1) (interp_cs r vm s2) }
+      amult (aplus (amult c1 (interp_vl r vm l1)) (interp_cs r vm t1))
+            (interp_cs r vm s2);
+      == { }
+      amult (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+  | Cons_varlist l1 t1 ->
+    calc (==) {
+      interp_cs r vm (canonical_sum_prod r s1 s2);
+      == { }
+      interp_cs r vm
+        (canonical_sum_merge r (canonical_sum_scalar2 r l1 s2)
+                               (canonical_sum_prod r t1 s2));
+      == { canonical_sum_merge_ok r vm
+             (canonical_sum_scalar2 r l1 s2)
+             (canonical_sum_prod r t1 s2) }
+      aplus (interp_cs r vm (canonical_sum_scalar2 r l1 s2))
+            (interp_cs r vm (canonical_sum_prod r t1 s2));
+      == { canonical_sum_scalar2_ok r vm l1 s2;
+           canonical_sum_prod_ok r vm t1 s2 }
+      aplus (amult (interp_vl r vm l1) (interp_cs r vm s2))
+            (amult (interp_cs r vm t1) (interp_cs r vm s2));
+      == { distribute_right r (interp_vl r vm l1)
+             (interp_cs r vm t1) (interp_cs r vm s2) }
+      amult (aplus (interp_vl r vm l1) (interp_cs r vm t1))
+            (interp_cs r vm s2);
+      == { }
+      amult (interp_cs r vm s1) (interp_cs r vm s2);
+    }
+  | Nil_monom -> ()
+
val spolynomial_normalize_ok: #a:eqtype -> r:cr a -> vm:vmap a -> p:spolynomial a ->
+  Lemma (interp_cs r vm (spolynomial_normalize r p) == interp_sp r vm p)
+let rec spolynomial_normalize_ok #a r vm p =
+  match p with
+  | SPvar _ -> ()
+  | SPconst _ -> ()
+  | SPplus l q ->
+    canonical_sum_merge_ok r vm
+      (spolynomial_normalize r l) (spolynomial_normalize r q);
+    spolynomial_normalize_ok r vm l;
+    spolynomial_normalize_ok r vm q
+  | SPmult l q ->
+    canonical_sum_prod_ok r vm
+      (spolynomial_normalize r l) (spolynomial_normalize r q);
+    spolynomial_normalize_ok r vm l;
+    spolynomial_normalize_ok r vm q
+
val canonical_sum_simplify_ok: #a:eqtype -> r:cr a -> vm:vmap a -> s:canonical_sum a ->
+  Lemma (interp_cs r vm (canonical_sum_simplify r s) == interp_cs r vm s)
+let rec canonical_sum_simplify_ok #a r vm s =
+  let azero = r.cm_add.unit in
+  let aone  = r.cm_mult.unit in
+  match s with
+  | Cons_monom c _ t -> canonical_sum_simplify_ok r vm t
+  | Cons_varlist _ t -> canonical_sum_simplify_ok r vm t
+  | Nil_monom -> ()
+
val spolynomial_simplify_ok: #a:eqtype -> r:cr a -> vm:vmap a -> p:spolynomial a ->
+  Lemma (interp_cs r vm (spolynomial_simplify r p) == interp_sp r vm p)
+let spolynomial_simplify_ok #a r vm p =
+  canonical_sum_simplify_ok r vm (spolynomial_normalize r p);
+  spolynomial_normalize_ok r vm p
+

+polynomial

-
val polynomial_normalize:Unidentified product: [#a:eqtype] Unidentified product: [cr a] Unidentified product: [polynomial a] canonical_sum a
+
type polynomial a =
+  | Pvar   : index -> polynomial a
+  | Pconst : a -> polynomial a
+  | Pplus  : polynomial a -> polynomial a -> polynomial a
+  | Pmult  : polynomial a -> polynomial a -> polynomial a
+  | Popp   : polynomial a -> polynomial a
+

+polynomial_normalize

Canonize a reflected expression

-
val spolynomial_of:Unidentified product: [#a:eqtype] Unidentified product: [cr a] Unidentified product: [polynomial a] spolynomial a
+
val polynomial_normalize: #a:eqtype -> cr a -> polynomial a -> canonical_sum a
+
[@@canon_attr]
+let rec polynomial_normalize #a r p =
+  match p with
+  | Pvar i -> Cons_varlist (Cons_var i Nil_var) Nil_monom
+  | Pconst c -> Cons_monom c Nil_var Nil_monom
+  | Pplus l q ->
+    canonical_sum_merge r (polynomial_normalize r l) (polynomial_normalize r q)
+  | Pmult l q ->
+    canonical_sum_prod r (polynomial_normalize r l) (polynomial_normalize r q)
+  | Popp p ->
+    canonical_sum_scalar3 r (r.opp r.cm_mult.unit) Nil_var (polynomial_normalize r p)
+
val polynomial_simplify: #a:eqtype -> cr a -> polynomial a -> canonical_sum a
+
[@@canon_attr]
+let polynomial_simplify #a r p =
+  canonical_sum_simplify r
+    (polynomial_normalize r p)
+

+spolynomial_of

Translate to a representation without additive inverses

-
let ((interp_p (#a:Type) (r:cr a) (vm:vmap a) (p:polynomial a)):a):let  aplus = r.cm_add.mult in let  amult = r.cm_mult.mult in match p with (Pconst c)  -> c | (Pvar i)  -> interp_var vm i | (Pplus p1 p2)  -> aplus (interp_p r vm p1) (interp_p r vm p2) | (Pmult p1 p2)  -> amult (interp_p r vm p1) (interp_p r vm p2) | (Popp p)  -> r.opp (interp_p r vm p)
+
val spolynomial_of: #a:eqtype -> cr a -> polynomial a -> spolynomial a
+
[@@canon_attr]
+let rec spolynomial_of #a r p =
+  match p with
+  | Pvar i -> SPvar i
+  | Pconst c -> SPconst c
+  | Pplus l q -> SPplus (spolynomial_of r l) (spolynomial_of r q)
+  | Pmult l q -> SPmult (spolynomial_of r l) (spolynomial_of r q)
+  | Popp p -> SPmult (SPconst (r.opp r.cm_mult.unit)) (spolynomial_of r p)
+

+interp_p

Interpretation of a polynomial

-
let ((find_aux (n:nat) (x:term) (xs:list term)):(Tot (option nat) (decreases xs))):match xs with []  -> None | (Prims.Cons x' xs')  -> if term_eq x x' then (Some n) else find_aux (+(n, 1)) x xs'
+
[@@canon_attr]
+let rec interp_p (#a:Type) (r:cr a) (vm:vmap a) (p:polynomial a) : a =
+  let aplus = r.cm_add.mult in
+  let amult = r.cm_mult.mult in
+  match p with
+  | Pconst c -> c
+  | Pvar i -> interp_var vm i
+  | Pplus p1 p2 -> aplus (interp_p r vm p1) (interp_p r vm p2)
+  | Pmult p1 p2 -> amult (interp_p r vm p1) (interp_p r vm p2)
+  | Popp p -> r.opp (interp_p r vm p)
+
val spolynomial_of_ok: #a:eqtype -> r:cr a -> vm:vmap a -> p:polynomial a ->
+  Lemma (interp_p r vm p == interp_sp r vm (spolynomial_of r p))
+let rec spolynomial_of_ok #a r vm p =
+  match p with
+  | Pconst c -> ()
+  | Pvar i -> ()
+  | Pplus p1 p2 ->
+    spolynomial_of_ok r vm p1;
+    spolynomial_of_ok r vm p2
+  | Pmult p1 p2 ->
+    spolynomial_of_ok r vm p1;
+    spolynomial_of_ok r vm p2
+  | Popp p ->
+    spolynomial_of_ok r vm p;
+    let x = interp_sp r vm (spolynomial_of r p) in
+    let y = r.cm_mult.mult (r.opp r.cm_mult.unit) x in
+    add_mult_opp r x;
+    opp_unique r x y
+
val polynomial_normalize_ok: #a:eqtype -> r:cr a -> vm:vmap a -> p:polynomial a ->
+  Lemma (interp_cs r vm (polynomial_normalize r p) ==
+         interp_cs r vm (spolynomial_normalize r (spolynomial_of r p)))
+let rec polynomial_normalize_ok #a r vm p =
+  match p with
+  | Pvar _ -> ()
+  | Pconst _ -> ()
+  | Pplus l q ->
+    canonical_sum_merge_ok r vm
+      (polynomial_normalize r l)
+      (polynomial_normalize r q);
+    canonical_sum_merge_ok r vm
+      (spolynomial_normalize r (spolynomial_of r l))
+      (spolynomial_normalize r (spolynomial_of r q));
+    polynomial_normalize_ok r vm l;
+    polynomial_normalize_ok r vm q
+
| Pmult l q ->
+  canonical_sum_prod_ok r vm
+    (polynomial_normalize r l)
+    (polynomial_normalize r q);
+  canonical_sum_prod_ok r vm
+    (spolynomial_normalize r (spolynomial_of r l))
+    (spolynomial_normalize r (spolynomial_of r q));
+  polynomial_normalize_ok r vm l;
+  polynomial_normalize_ok r vm q
+
| Popp p1 ->
+  let l = SPconst (r.opp r.cm_mult.unit) in
+  polynomial_normalize_ok r vm p1;
+  canonical_sum_prod_ok r vm
+    (spolynomial_normalize r l)
+    (polynomial_normalize r p1);
+  canonical_sum_prod_ok r vm
+    (spolynomial_normalize r l)
+    (spolynomial_normalize r (spolynomial_of r p1))
+
val polynomial_simplify_ok: #a:eqtype -> r:cr a -> vm:vmap a -> p:polynomial a ->
+  Lemma (interp_cs r vm (polynomial_simplify r p) == interp_p r vm p)
+let polynomial_simplify_ok #a r vm p =
+  calc (==) {
+    interp_cs r vm (polynomial_simplify r p);
+    == { }
+    interp_cs r vm (canonical_sum_simplify r (polynomial_normalize r p));
+    == { canonical_sum_simplify_ok r vm (polynomial_normalize r p) }
+    interp_cs r vm (polynomial_normalize r p);
+    == { polynomial_normalize_ok r vm p }
+    interp_cs r vm (spolynomial_normalize r (spolynomial_of r p));
+    == { spolynomial_normalize_ok r vm (spolynomial_of r p) }
+    interp_sp r vm (spolynomial_of r p);
+    == { spolynomial_of_ok r vm p }
+    interp_p r vm p;
+  }
+
+

Tactic definition

+
+

Only dump when debugging is on

+
let ddump m = if debugging () then dump m
+

+find_aux

-
let ((reification_aux (#a:Type) (unquotea:Unidentified product: [term] (Tac a)) (ts:list term) (vm:vmap a) (add:term) (opp:term) (mone:term) (mult:term) (t:term)):(Tac (*(*(polynomial a, list term), vmap a)))):let  (hd, tl) = collect_app_ref t in match (FStar.Pervasives.Native.Mktuple2 inspect hd list_unref tl) with ((Tv_FVar fv), [(t1, _); (t2, _)])  -> let  ((binop (op:Unidentified product: [polynomial a] Unidentified product: [polynomial a] polynomial a)):(Tac (*(*(polynomial a, list term), vmap a)))) = let  (e1, ts, vm) = reification_aux unquotea ts vm add opp mone mult t1 in let  (e2, ts, vm) = reification_aux unquotea ts vm add opp mone mult t2 in ((FStar.Pervasives.Native.Mktuple3 op e1 e2 ts vm)) in if term_eq (pack ((Tv_FVar fv))) add then binop Pplus else if term_eq (pack ((Tv_FVar fv))) mult then binop Pmult else make_fvar t unquotea ts vm | ((Tv_FVar fv), [(t1, _)])  -> let  ((monop (op:Unidentified product: [polynomial a] polynomial a)):(Tac (*(*(polynomial a, list term), vmap a)))) = let  (e, ts, vm) = reification_aux unquotea ts vm add opp mone mult t1 in ((FStar.Pervasives.Native.Mktuple3 op e ts vm)) in if term_eq (pack ((Tv_FVar fv))) opp then monop Popp else make_fvar t unquotea ts vm | ((Tv_Const _), [])  -> (FStar.Pervasives.Native.Mktuple3 (Pconst (unquotea t)) ts vm) | (_, _)  -> make_fvar t unquotea ts vm
+
let rec find_aux (n:nat) (x:term) (xs:list term) : Tot (option nat) (decreases xs) =
+  match xs with
+  | [] -> None
+  | x'::xs' -> if term_eq x x' then Some n else find_aux (n+1) x xs'
+
let find = find_aux 0
+
let make_fvar (#a:Type) (t:term) (unquotea:term -> Tac a) (ts:list term)
+  (vm:vmap a) : Tac (polynomial a * list term * vmap a) =
+  match find t ts with
+  | Some v -> (Pvar v, ts, vm)
+  | None ->
+    let vfresh = length ts in
+    let z = unquotea t in
+    (Pvar vfresh, ts @ [t], update vfresh z vm)
+

+reification_aux

This expects that add, opp, mone mult, and t have already been normalized

-
let steps:(Prims.Cons primops (Prims.Cons iota (Prims.Cons zeta (Prims.Cons delta_attr (Prims.Cons `%%canon_attr (Prims.Nil )) (Prims.Cons delta_only (Prims.Cons `%%FStar.Mul.op_Star (Prims.Cons `%%FStar.Algebra.CommMonoid.int_plus_cm (Prims.Cons `%%FStar.Algebra.CommMonoid.int_multiply_cm (Prims.Cons `%%FStar.Algebra.CommMonoid.__proj__CM__item__mult (Prims.Cons `%%FStar.Algebra.CommMonoid.__proj__CM__item__unit (Prims.Cons `%%__proj__CR__item__cm_add (Prims.Cons `%%__proj__CR__item__opp (Prims.Cons `%%__proj__CR__item__cm_mult (Prims.Cons `%%FStar.List.Tot.Base.assoc (Prims.Cons `%%FStar.Pervasives.Native.fst (Prims.Cons `%%FStar.Pervasives.Native.snd (Prims.Cons `%%FStar.Pervasives.Native.__proj__Mktuple2__item___1 (Prims.Cons `%%FStar.Pervasives.Native.__proj__Mktuple2__item___2 (Prims.Cons `%%FStar.List.Tot.Base.op_At (Prims.Cons `%%FStar.List.Tot.Base.append (Prims.Nil )))))))))))))))) (Prims.Nil ))))))
+
let rec reification_aux (#a:Type) (unquotea:term -> Tac a) (ts:list term) (vm:vmap a) (add opp mone mult t: term) : Tac (polynomial a * list term * vmap a) =
+

ddump ("term = " ^ term_to_string t ^ "\n"); +ddump ("add = " ^ term_to_string add ^ " +\nmul = " ^ term_to_string mult); +ddump ("fv = " ^ term_to_string (pack (Tv_FVar fv)));

+
let hd, tl = collect_app_ref t in
+match inspect hd, list_unref tl with
+| Tv_FVar fv, [(t1, _) ; (t2, _)] ->
+  let binop (op:polynomial a -> polynomial a -> polynomial a) : Tac (polynomial a * list term * vmap a) =
+    let (e1, ts, vm) = reification_aux unquotea ts vm add opp mone mult t1 in
+    let (e2, ts, vm) = reification_aux unquotea ts vm add opp mone mult t2 in
+    (op e1 e2, ts, vm)
+    in
+  if term_eq (pack (Tv_FVar fv)) add then binop Pplus else
+  if term_eq (pack (Tv_FVar fv)) mult then binop Pmult else
+  make_fvar t unquotea ts vm
+| Tv_FVar fv, [(t1, _)] ->
+  let monop (op:polynomial a -> polynomial a) : Tac (polynomial a * list term * vmap a) =
+    let (e, ts, vm) = reification_aux unquotea ts vm add opp mone mult t1 in
+    (op e, ts, vm)
+    in
+  if term_eq (pack (Tv_FVar fv)) opp then monop Popp else
+  make_fvar t unquotea ts vm
+| Tv_Const _, [] -> Pconst (unquotea t), ts, vm
+| _, _ -> make_fvar t unquotea ts vm
+

+steps

+
let steps =
+  [
+    primops;
+    iota;
+    zeta;
+    delta_attr [`%canon_attr];
+    delta_only [
+      `%FStar.Mul.op_Star;                        // For integer ring
+      `%FStar.Algebra.CommMonoid.int_plus_cm;     // For integer ring
+      `%FStar.Algebra.CommMonoid.int_multiply_cm; // For integer ring
+      `%FStar.Algebra.CommMonoid.__proj__CM__item__mult;
+      `%FStar.Algebra.CommMonoid.__proj__CM__item__unit;
+      `%__proj__CR__item__cm_add;
+      `%__proj__CR__item__opp;
+      `%__proj__CR__item__cm_mult;
+      `%FStar.List.Tot.Base.assoc;
+      `%FStar.Pervasives.Native.fst;
+      `%FStar.Pervasives.Native.snd;
+      `%FStar.Pervasives.Native.__proj__Mktuple2__item___1;
+      `%FStar.Pervasives.Native.__proj__Mktuple2__item___2;
+      `%FStar.List.Tot.Base.op_At;
+      `%FStar.List.Tot.Base.append;
+    ]
+  ]
+
let canon_norm () : Tac unit = norm steps
+
let reification (#a:Type)
+  (unquotea:term -> Tac a) (quotea:a -> Tac term) (tadd topp tmone tmult:term) (munit:a) (ts:list term) : Tac (list (polynomial a) * vmap a) =
+

Be careful not to normalize operations too much +E.g. we don't want to turn ( +% ) into (a + b) % prime +or we won't be able to spot ring operations +ddump ("add = " ^ term_to_string add ^ "\nmult = " ^ term_to_string mult);

+
let add  = tadd in
+let opp  = topp in
+let mone = tmone in
+let mult = tmult in
+let ts = Tactics.Util.map (norm_term steps) ts in
+let (es, _, vm) =
+  Tactics.Util.fold_left
+    (fun (es, vs, vm) t ->
+      let (e, vs, vm) = reification_aux unquotea vs vm add opp mone mult t
+      in (e::es, vs, vm))
+    ([],[], ([], munit)) ts
+in (List.Tot.Base.rev es, vm)
+

The implicit argument in the application of Pconst is crucial

+
let rec quote_polynomial (#a:Type) (ta:term) (quotea:a -> Tac term) (e:polynomial a) : Tac term =
+  match e with
+  | Pconst c -> mk_app (`Pconst) [(ta, Q_Implicit); (quotea c, Q_Explicit)]
+  | Pvar x -> mk_e_app (`Pvar) [pack (Tv_Const (C_Int x))]
+  | Pplus e1 e2 ->
+    mk_e_app (`Pplus) [quote_polynomial ta quotea e1; quote_polynomial ta quotea e2]
+  | Pmult e1 e2 ->
+    mk_e_app (`Pmult) [quote_polynomial ta quotea e1; quote_polynomial ta quotea e2]
+  | Popp e -> mk_e_app (`Popp) [quote_polynomial ta quotea e]
+

Constructs the 3 main goals of the tactic

+
let semiring_reflect (#a:eqtype) (r:cr a) (vm:vmap a) (e1 e2:polynomial a) (a1 a2:a)
+    (_ : squash (
+      interp_cs r vm (polynomial_simplify r e1) ==
+      interp_cs r vm (polynomial_simplify r e2)))
+    (_ : squash (a1 == interp_p r vm e1))
+    (_ : squash (a2 == interp_p r vm e2)) :
+    squash (a1 == a2)
+  =
+  polynomial_simplify_ok r vm e1;
+  polynomial_simplify_ok r vm e2
+

@@plugin

+
let canon_semiring_aux
+    (a: Type) (ta: term) (unquotea: term -> Tac a) (quotea: a -> Tac term)
+    (tr tadd topp tmone tmult: term)
+    (munit: a)
+  : Tac unit
+=
+  focus (fun () ->
+  norm []; // Do not normalize anything implicitly
+  let g = cur_goal () in
+  match term_as_formula g with
+  | Comp (Eq (Some t)) t1 t2 ->
+    begin
+

ddump ("t1 = " ^ term_to_string t1 ^ "\nt2 = " ^ term_to_string t2);

+
    ddump (term_to_string t1);
+    ddump (term_to_string t2);
+    let r : cr a = unquote tr in
+    ddump ("vm = " ^ term_to_string (quote vm) ^ "\n" ^
+           "before = " ^ term_to_string (norm_term steps
+                (quote (interp_p r vm e1 == interp_p r vm e2))));
+    dump ("expected after = " ^ term_to_string (norm_term steps
+      (quote (
+          interp_cs r vm (polynomial_simplify r e1) ==
+          interp_cs r vm (polynomial_simplify r e2)))));
+
+

ddump ("te1 = " ^ term_to_string te1); +ddump ("te2 = " ^ term_to_string te2); +ddump "Before canonization"; +ddump "After canonization"; +ddump "Before normalizing left-hand side"; +ddump "After normalizing left-hand side"; +ddump "Before normalizing right-hand side"; +ddump "After normalizing right-hand side";

+
    if term_eq t ta then
+    begin
+    match reification unquotea quotea tadd topp tmone tmult munit [t1; t2] with
+    | ([e1; e2], vm) ->
+      let tvm = quote_vm ta quotea vm in
+      let te1 = quote_polynomial ta quotea e1 in
+      let te2 = quote_polynomial ta quotea e2 in
+      mapply (`(semiring_reflect
+        #(`#ta) (`#tr) (`#tvm) (`#te1) (`#te2) (`#t1) (`#t2)));
+      canon_norm ();
+      later ();
+      canon_norm ();
+      trefl ();
+      canon_norm ();
+      trefl ()
+    | _ -> fail "Unexpected"
+    end
+    else fail "Found equality, but terms do not have the expected type"
+  end
+| _ -> fail "Goal should be an equality")
+
let canon_semiring (#a:eqtype) (r:cr a) : Tac unit =
+  canon_semiring_aux a
+    (quote a) (unquote #a) (fun (x:a) -> quote x) (quote r)
+    (norm_term steps (quote r.cm_add.mult))
+    (norm_term steps (quote r.opp))
+    (norm_term steps (quote (r.opp r.cm_mult.unit)))
+    (norm_term steps (quote r.cm_mult.mult))
+    r.cm_add.unit
+
+

Ring of integers

+
+
[@@canon_attr]
+let int_cr : cr int =
+  CR int_plus_cm int_multiply_cm op_Minus (fun x -> ()) (fun x y z -> ()) (fun x -> ())
+
private
+let eq_nat_via_int (a b : nat) (eq : squash (eq2 #int a b)) : Lemma (eq2 #nat a b) = ()
+
let int_semiring () : Tac unit =
+

Check to see if goal is a nat equality, change the equality to int beforehand

+
match term_as_formula (cur_goal ()) with
+| Comp (Eq (Some t)) _ _ ->
+    if term_eq t (`Prims.nat)
+    then (apply_lemma (`eq_nat_via_int); canon_semiring int_cr)
+    else canon_semiring int_cr
+| _ ->
+    canon_semiring int_cr
+
#set-options "--tactic_trace_d 0 --no_smt"
+
let test (a:int) =
+  let open FStar.Mul in
+  assert (a + - a + 2 * a + - a == -a + 2 * a) by (int_semiring ())
+ diff --git a/docs/FStar.Tactics.CanonCommSwaps.html b/docs/FStar.Tactics.CanonCommSwaps.html index a441aaf..f729f36 100644 --- a/docs/FStar.Tactics.CanonCommSwaps.html +++ b/docs/FStar.Tactics.CanonCommSwaps.html @@ -1,16 +1,129 @@ - - + + - - - - - + FStar.Tactics.CanonCommSwaps + -

module FStar.Tactics.CanonCommSwaps

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.CanonCommSwaps

+ +
let swap (n:nat) :Type = x:nat{x < n-1}
+
let rec apply_swap_aux (#a:Type) (n:nat) (xs:list a) (s:swap (length xs + n)) :
+    Pure (list a) (requires True)
+                  (ensures (fun zs -> length zs == length xs)) (decreases xs) =
+  match xs with
+  | [] | [_] -> xs
+  | x1 :: x2 :: xs' -> if n = (s <: nat)
+                       then x2 :: x1 :: xs'
+                       else x1 :: apply_swap_aux (n+1) (x2 :: xs') s
+
let apply_swap (#a:Type) = apply_swap_aux #a 0
+
let rec apply_swaps (#a:Type) (xs:list a) (ss:list (swap (length xs))) :
+    Pure (list a) (requires True)
+                  (ensures (fun zs -> length zs == length xs)) (decreases ss) =
+  match ss with
+  | [] -> xs
+  | s::ss' -> apply_swaps (apply_swap xs s) ss'
+
let equal_counts (#a:eqtype) (xs ys:list a) : Type0 =
+  (forall (e:a).{:pattern (count e xs) \/ (count e ys)} count e xs == count e ys)
+
let extend_equal_counts (#a:eqtype) (h:a) (xs ys:list a) : Lemma
+  (requires equal_counts xs ys)
+  (ensures equal_counts (h::xs) (h::ys))
+  =
+  ()
+
let retract_equal_counts (#a:eqtype) (h:a) (xs ys:list a) : Lemma
+  (requires equal_counts (h::xs) (h::ys))
+  (ensures equal_counts xs ys)
+  =
+  assert (forall (e:a).{:pattern (count e xs) \/ (count e ys)} count e (h::xs) == count e (h::ys))
+
unfold let swap_for (#a:eqtype) (xs:list a) = swap (length xs)
+unfold let swaps_for (#a:eqtype) (xs:list a) = list (swap_for xs)
+
let rec append_swaps (#a:eqtype) (xs:list a) (ss1 ss2:swaps_for xs) : Lemma
+  (ensures apply_swaps xs (ss1 @ ss2) == apply_swaps (apply_swaps xs ss1) ss2)
+  (decreases ss1)
+  =
+  match ss1 with
+  | [] -> ()
+  | h::t -> append_swaps (apply_swap xs h) t ss2
+
let rec lift_swap_cons (#a:eqtype) (n:nat) (h:a) (xs:list a) (s:swap (length xs + n)) : Lemma
+  (requires n <= s)
+  (ensures apply_swap_aux n (h::xs) (s + 1) == h::(apply_swap_aux n xs s))
+  (decreases xs)
+  =
+  match xs with
+  | [] -> ()
+  | x::xt -> if n < s then lift_swap_cons (n + 1) x xt s
+
let rec lift_swaps_cons (#a:eqtype) (h:a) (xs:list a) (ss:swaps_for xs) : Pure (swaps_for (h::xs))
+  (requires True)
+  (ensures (fun ss' ->
+    apply_swaps (h::xs) ss' == h::(apply_swaps xs ss)
+  ))
+  (decreases ss)
+  =
+  match ss with
+  | [] -> []
+  | s::st ->
+    (
+      lift_swap_cons 0 h xs s;
+      (s + 1)::(lift_swaps_cons h (apply_swap xs s) st)
+    )
+
let rec swap_to_front (#a:eqtype) (h:a) (xs:list a) : Pure (swaps_for xs)
+  (requires count h xs >= 1)
+  (ensures (fun ss ->
+    let ys = apply_swaps xs ss in
+    equal_counts xs ys /\
+    Cons? ys /\
+    hd ys == h
+  ))
+  =
+  match xs with
+  | [] -> []
+  | x::xt ->
+    (
+      if x = h then []
+      else
+      (
+        let ss = swap_to_front h xt in // ss turns xt into h::xt'
+        let ss' = lift_swaps_cons x xt ss in // ss' turns x::xt into x::h::xt'
+        let s:swap_for xs = 0 in
+        append_swaps xs ss' [s];
+        ss' @ [s]
+      )
+    )
+
let rec equal_counts_implies_swaps (#a:eqtype) (xs ys:list a) : Pure (swaps_for xs)
+  (requires equal_counts xs ys)
+  (ensures (fun ss -> ys == apply_swaps xs ss))
+  (decreases ys)
+  =
+  match ys with
+  | [] ->
+    (
+      match xs with
+      | [] -> []
+      | x::xt ->
+        (
+          assert (count x xs >= 1);
+          []
+        )
+    )
+  | y::yt ->
+    (
+      assert (count y ys >= 1);
+      assert (count y xs >= 1);
+      let ss0 = swap_to_front y xs in               // find y in xs, swap it to the front
+      let xs' = apply_swaps xs ss0 in               // hd xs' == y
+      let xt = tl xs' in                            // xs' == y::xt
+      retract_equal_counts y xt yt;                 // prove (equal_counts xt yt)
+      let ss1 = equal_counts_implies_swaps xt yt in // prove (yt == apply_swaps xt ss1)
+      let ss1' = lift_swaps_cons y xt ss1 in        // y::yt == apply_swaps (y::xt) ss1'
+

ys == apply_swaps (apply_swaps xs ss0) ss1'

+
  append_swaps xs ss0 ss1';
+  ss0 @ ss1'
+)
+ diff --git a/docs/FStar.Tactics.CanonMonoid.html b/docs/FStar.Tactics.CanonMonoid.html index e5b0e3f..a8bbcfe 100644 --- a/docs/FStar.Tactics.CanonMonoid.html +++ b/docs/FStar.Tactics.CanonMonoid.html @@ -1,16 +1,117 @@ - - + + - - - - - + FStar.Tactics.CanonMonoid + -

module FStar.Tactics.CanonMonoid

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.CanonMonoid

+ +

Only dump when debugging is on

+
let dump m = if debugging () then dump m
+

"A Monoid Expression Simplifier" ported from +http://adam.chlipala.net/cpdt/html/Cpdt.Reflection.html

+
type exp (a:Type) : Type =
+  | Unit : exp a
+  | Var : a -> exp a
+  | Mult : exp a -> exp a -> exp a
+
let rec exp_to_string (#a:Type) (a_to_string:a->string) (e:exp a) =
+  match e with
+  | Unit -> "Unit"
+  | Var x -> "Var " ^ a_to_string x
+  | Mult e1 e2 -> "Mult (" ^ exp_to_string a_to_string e1
+                   ^ ") (" ^ exp_to_string a_to_string e2 ^ ")"
+
let rec mdenote (#a:Type) (m:monoid a) (e:exp a) : a =
+  match e with
+  | Unit -> Monoid?.unit m
+  | Var x -> x
+  | Mult e1 e2 -> Monoid?.mult m (mdenote m e1) (mdenote m e2)
+
let rec mldenote (#a:Type) (m:monoid a) (xs:list a) : a =
+  match xs with
+  | [] -> Monoid?.unit m
+  | [x] -> x
+  | x::xs' -> Monoid?.mult m x (mldenote m xs')
+
let rec flatten (#a:Type) (e:exp a) : list a =
+  match e with
+  | Unit -> []
+  | Var x -> [x]
+  | Mult e1 e2 -> flatten e1 @ flatten e2
+

This proof internally uses the monoid laws; the SMT solver picks up +on them because they are written as squashed formulas in the +definition of monoid; need to be careful with this since these are +quantified formulas without any patterns. Dangerous stuff!

+
let rec flatten_correct_aux (#a:Type) (m:monoid a) ml1 ml2 :
+  Lemma (mldenote m (ml1 @ ml2) == Monoid?.mult m (mldenote m ml1)
+                                                  (mldenote m ml2)) =
+  match ml1 with
+  | [] -> ()
+  | e::es1' -> flatten_correct_aux m es1' ml2
+
let rec flatten_correct (#a:Type) (m:monoid a) (e:exp a) :
+    Lemma (mdenote m e == mldenote m (flatten e)) =
+  match e with
+  | Unit | Var _ -> ()
+  | Mult e1 e2 -> flatten_correct_aux m (flatten e1) (flatten e2);
+                  flatten_correct m e1; flatten_correct m e2
+
let monoid_reflect (#a:Type) (m:monoid a) (e1 e2:exp a)
+    (_ : squash (mldenote m (flatten e1) == mldenote m (flatten e2)))
+    : squash (mdenote m e1 == mdenote m e2) =
+  flatten_correct m e1; flatten_correct m e2
+

This expects that mult, unit, and me have already been normalized

+
let rec reification_aux (#a:Type) (mult unit me : term) : Tac (exp a) =
+  let hd, tl = collect_app_ref me in
+  let tl = list_unref tl in
+  match inspect hd, tl with
+  | Tv_FVar fv, [(me1, Q_Explicit) ; (me2, Q_Explicit)] ->
+    if term_eq (pack (Tv_FVar fv)) mult
+    then Mult (reification_aux mult unit me1) (reification_aux mult unit me2)
+    else Var (unquote me)
+  | _, _ ->
+    if term_eq me unit
+    then Unit
+    else Var (unquote me)
+
let reification (#a:Type) (m:monoid a) (me:term) : Tac (exp a) =
+    let mult = norm_term [delta;zeta;iota] (quote (Monoid?.mult m)) in
+    let unit = norm_term [delta;zeta;iota] (quote (Monoid?.unit m)) in
+    let me   = norm_term [delta;zeta;iota] me in
+

dump ("mult = " ^ term_to_string mult ^ +"; unit = " ^ term_to_string unit ^ +"; me = " ^ term_to_string me);

+
reification_aux mult unit me
+
let canon_monoid (#a:Type) (m:monoid a) : Tac unit =
+  norm [];
+  let g = cur_goal () in
+  match term_as_formula g with
+  | Comp (Eq (Some t)) me1 me2 ->
+      if term_eq t (quote a) then
+        let r1 = reification m me1 in
+        let r2 = reification m me2 in
+        change_sq (quote (mdenote m r1 == mdenote m r2));
+        apply (`monoid_reflect);
+        norm [delta_only ["CanonMonoid.mldenote";
+                          "CanonMonoid.flatten";
+                          "FStar.List.Tot.Base.op_At";
+                          "FStar.List.Tot.Base.append"]]
+      else fail "Goal should be an equality at the right monoid type"
+  | _ -> fail "Goal should be an equality"
+
let lem0 (a b c d : int) =
+  assert_by_tactic (0 + a + b + c + d == (0 + a) + (b + c + 0) + (d + 0))
+  (fun _ -> canon_monoid int_plus_monoid (* string_of_int *); trefl())
+

TODO: would be nice to just find all terms of monoid type in the +goal and replace them with their canonicalization; +basically use flatten_correct instead of monoid_reflect +- even better, the user would have control over the place(s) +where the canonicalization is done

+ diff --git a/docs/FStar.Tactics.Common.html b/docs/FStar.Tactics.Common.html new file mode 100644 index 0000000..464c2bc --- /dev/null +++ b/docs/FStar.Tactics.Common.html @@ -0,0 +1,19 @@ + + + + + FStar.Tactics.Common + + + +

+FStar.Tactics.Common

+

This module is realized by FStar.Tactics.Common in the F* sources. +Any change must be reflected there.

+
exception NotAListLiteral
+

We should attempt to not use this one and define more exceptions +above.

+
exception TacticFailure of string
+ + + diff --git a/docs/FStar.Tactics.Derived.html b/docs/FStar.Tactics.Derived.html index 18acb39..fa6d72b 100644 --- a/docs/FStar.Tactics.Derived.html +++ b/docs/FStar.Tactics.Derived.html @@ -1,114 +1,958 @@ - - + + - - - - - - + FStar.Tactics.Derived + -

module FStar.Tactics.Derived

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((_cur_goal ()):(Tac goal)):match goals () with []  -> fail "no more goals" | (Prims.Cons g _)  -> g
+

+FStar.Tactics.Derived

+ +
exception Goal_not_trivial
+
let goals () : Tac (list goal) = goals_of (get ())
+let smt_goals () : Tac (list goal) = smt_goals_of (get ())
+
let fail (#a:Type) (m:string) =
+  raise #a (TacticFailure m)
+
let fail_silently (#a:Type) (m:string) =
+  set_urgency 0;
+  raise #a (TacticFailure m)
+

+_cur_goal

Return the current goal, not its type. (Ignores SMT goals)

-
let ((cur_env ()):(Tac env)):goal_env (_cur_goal ())
-

[cur_env] returns the current goal's environment

-
let ((cur_goal ()):(Tac typ)):goal_type (_cur_goal ())
-

[cur_goal] returns the current goal's type

-
let ((cur_witness ()):(Tac term)):goal_witness (_cur_goal ())
-

[cur_witness] returns the current goal's witness

-
let ((cur_goal_safe ()):(TacH goal ((requires ((fun ps -> ~((==(goals_of ps, (Prims.Nil )))))))) ((ensures ((fun ps0 r -> exists g.{:pattern } ==(r, (Success g ps0)))))))):match goals_of (get ()) with (Prims.Cons g _)  -> g
-

[cur_goal_safe] will always return the current goal, without failing. It must be statically verified that there indeed is a goal in order to call it.

-
let ((cur_binders ()):(Tac binders)):binders_of_env (cur_env ())
-

[cur_binders] returns the list of binders in the current goal.

-
let ((with_policy pol (f:Unidentified product: [unit] (Tac 'a))):(Tac 'a)):let  old_pol = get_guard_policy () in set_guard_policy pol; let  r = f () in set_guard_policy old_pol; r
+
let _cur_goal () : Tac goal =
+    match goals () with
+    | []   -> fail "no more goals"
+    | g::_ -> g
+

+cur_env

+

cur_env returns the current goal's environment

+
let cur_env () : Tac env = goal_env (_cur_goal ())
+

+cur_goal

+

cur_goal returns the current goal's type

+
let cur_goal () : Tac typ = goal_type (_cur_goal ())
+

+cur_witness

+

cur_witness returns the current goal's witness

+
let cur_witness () : Tac term = goal_witness (_cur_goal ())
+

+cur_goal_safe

+

cur_goal_safe will always return the current goal, without failing. +It must be statically verified that there indeed is a goal in order to +call it.

+
let cur_goal_safe () : TacH goal (requires (fun ps -> ~(goals_of ps == [])))
+                                 (ensures (fun ps0 r -> exists g. r == Success g ps0))
+ = match goals_of (get ()) with
+   | g :: _ -> g
+

+cur_binders

+

cur_binders returns the list of binders in the current goal.

+
let cur_binders () : Tac binders =
+    binders_of_env (cur_env ())
+

+with_policy

Set the guard policy only locally, without affecting calling code

-
let ((dismiss ()):(Tac unit)):match goals () with []  -> fail "dismiss: no more goals" | (Prims.Cons _ gs)  -> set_goals gs
-

Ignore the current goal. If left unproven, this will fail after the tactic finishes.

-
let ((flip ()):(Tac unit)):let  gs = goals () in match goals () with []|
- [_]  -> fail "flip: less than two goals" | (Prims.Cons g1 (Prims.Cons g2 gs))  -> set_goals ((Prims.Cons g2 (Prims.Cons g1 gs)))
+
let with_policy pol (f : unit -> Tac 'a) : Tac 'a =
+    let old_pol = get_guard_policy () in
+    set_guard_policy pol;
+    let r = f () in
+    set_guard_policy old_pol;
+    r
+

+exact

+

exact e will solve a goal Gamma |- w : t if e has type exactly +t in Gamma.

+
let exact (t : term) : Tac unit =
+    with_policy SMT (fun () -> t_exact true false t)
+

+exact_with_ref

+

exact_with_ref e will solve a goal Gamma |- w : t if e has +type t' where t' is a subtype of t in Gamma. This is a more +flexible variant of exact.

+
let exact_with_ref (t : term) : Tac unit =
+    with_policy SMT (fun () -> t_exact true true t)
+
let trivial () : Tac unit =
+  norm [iota; zeta; reify_; delta; primops; simplify; unmeta];
+  let g = cur_goal () in
+  match term_as_formula g with
+  | True_ -> exact (`())
+  | _ -> raise Goal_not_trivial
+

Another hook to just run a tactic without goals, just by reusing with_tactic

+
let run_tactic (t:unit -> Tac unit)
+  : Pure unit
+         (requires (set_range_of (with_tactic (fun () -> trivial (); t ()) (squash True)) (range_of t)))
+         (ensures (fun _ -> True))
+  = ()
+

+dismiss

+

Ignore the current goal. If left unproven, this will fail after +the tactic finishes.

+
let dismiss () : Tac unit =
+    match goals () with
+    | [] -> fail "dismiss: no more goals"
+    | _::gs -> set_goals gs
+

+flip

Flip the order of the first two goals.

-
let ((qed ()):(Tac unit)):match goals () with []  -> () | _  -> fail "qed: not done!"
+
let flip () : Tac unit =
+    let gs = goals () in
+    match goals () with
+    | [] | [_]   -> fail "flip: less than two goals"
+    | g1::g2::gs -> set_goals (g2::g1::gs)
+

+qed

Succeed if there are no more goals left, and fail otherwise.

-
let ((debug (m:string)):(Tac unit)):if debugging () then print m else ()
-

[debug str] is similar to [print str], but will only print the message if the [--debug] option was given for the current module AND [--debug_level Tac] is on.

-
let ((smt ()):(Tac unit)):match (FStar.Pervasives.Native.Mktuple2 goals () smt_goals ()) with ([], _)  -> fail "smt: no active goals" | ((Prims.Cons g gs), gs')  -> set_goals gs; set_smt_goals ((Prims.Cons g gs'))
-

[smt] will mark the current goal for being solved through the SMT. This does not immediately run the SMT: it just dumps the goal in the SMT bin. Note, if you dump a proof-relevant goal there, the engine will later raise an error.

-
let ((later ()):(Tac unit)):match goals () with (Prims.Cons g gs)  -> set_goals (@(gs, (Prims.Cons g (Prims.Nil )))) | _  -> fail "later: no goals"
+
let qed () : Tac unit =
+    match goals () with
+    | [] -> ()
+    | _ -> fail "qed: not done!"
+

+debug

+

debug str is similar to print str, but will only print the message +if the --debug option was given for the current module AND +--debug_level Tac is on.

+
let debug (m:string) : Tac unit =
+    if debugging () then print m
+

+smt

+

smt will mark the current goal for being solved through the SMT. +This does not immediately run the SMT: it just dumps the goal in the +SMT bin. Note, if you dump a proof-relevant goal there, the engine will +later raise an error.

+
let smt () : Tac unit =
+    match goals (), smt_goals () with
+    | [], _ -> fail "smt: no active goals"
+    | g::gs, gs' ->
+        begin
+        set_goals gs;
+        set_smt_goals (g :: gs')
+        end
+
let idtac () : Tac unit = ()
+

+later

Push the current goal to the back.

-
let ((exact (t:term)):(Tac unit)):with_policy SMT ((fun () -> t_exact true false t))
-

[exact e] will solve a goal [Gamma |- w : t] if [e] has type exactly [t] in [Gamma].

-
let ((exact_with_ref (t:term)):(Tac unit)):with_policy SMT ((fun () -> t_exact true true t))
-

[exact_with_ref e] will solve a goal [Gamma |- w : t] if [e] has type [t'] where [t'] is a subtype of [t] in [Gamma]. This is a more flexible variant of [exact].

-
let ((apply (t:term)):(Tac unit)):t_apply true false t
-

[apply f] will attempt to produce a solution to the goal by an application of [f] to any amount of arguments (which need to be solved as further goals). The amount of arguments introduced is the least such that [f a_i] unifies with the goal's type.

-
let ((apply_raw (t:term)):(Tac unit)):t_apply false false t
-

[apply_raw f] is like [apply], but will ask for all arguments regardless of whether they appear free in further goals. See the explanation in [t_apply].

-
let ((exact_guard (t:term)):(Tac unit)):with_policy Goal ((fun () -> t_exact true false t))
-

Like [exact], but allows for the term [e] to have a type [t] only under some guard [g], adding the guard as a goal.

-
let ((divide (n:int) (l:Unidentified product: [unit] (Tac 'a)) (r:Unidentified product: [unit] (Tac 'b))):(Tac (*('a, 'b)))):if <(n, 0) then fail "divide: negative n" else (); let  (gs, sgs) = (FStar.Pervasives.Native.Mktuple2 goals () smt_goals ()) in let  (gs1, gs2) = List.Tot.splitAt n gs in set_goals gs1; set_smt_goals (Prims.Nil ); let  x = l () in let  (gsl, sgsl) = (FStar.Pervasives.Native.Mktuple2 goals () smt_goals ()) in set_goals gs2; set_smt_goals (Prims.Nil ); let  y = r () in let  (gsr, sgsr) = (FStar.Pervasives.Native.Mktuple2 goals () smt_goals ()) in set_goals (@(gsl, gsr)); set_smt_goals (@(sgs, @(sgsl, sgsr))); ((FStar.Pervasives.Native.Mktuple2 x y))
-

[divide n t1 t2] will split the current set of goals into the [n] first ones, and the rest. It then runs [t1] on the first set, and [t2] on the second, returning both results (and concatenating remaining goals).

-
let ((focus (t:Unidentified product: [unit] (Tac 'a))):(Tac 'a)):match goals () with []  -> fail "focus: no goals" | (Prims.Cons g gs)  -> let  sgs = smt_goals () in set_goals (Prims.Cons g (Prims.Nil )); set_smt_goals (Prims.Nil ); let  x = t () in set_goals (@(goals (), gs)); set_smt_goals (@(smt_goals (), sgs)); x
-

[focus t] runs [t ()] on the current active goal, hiding all others and restoring them at the end.

-
let (dump1 (m:string)):focus ((fun () -> dump m))
-

Similar to [dump], but only dumping the current goal.

-
let ((seq (f:Unidentified product: [unit] (Tac unit)) (g:Unidentified product: [unit] (Tac unit))):(Tac unit)):focus ((fun () -> f (); iterAll g))
-

Runs tactic [t1] on the current goal, and then tactic [t2] on each subgoal produced by [t1]. Each invocation of [t2] runs on a proofstate with a single goal (they're "focused").

-
let ((ngoals ()):(Tac int)):List.length (goals ())
-

[ngoals ()] returns the number of goals

-
let ((ngoals_smt ()):(Tac int)):List.length (smt_goals ())
-

[ngoals_smt ()] returns the number of SMT goals

-
let (join_all_smt_goals ()):let  (gs, sgs) = (FStar.Pervasives.Native.Mktuple2 goals () smt_goals ()) in set_smt_goals (Prims.Nil ); set_goals sgs; repeat' join; let  sgs' = goals () in set_goals gs; set_smt_goals sgs'
-

Join all of the SMT goals into one. This helps when all of them are expected to be similar, and therefore easier to prove at once by the SMT solver. TODO: would be nice to try to join them in a more meaningful way, as the order can matter.

-
let ((is_guard ()):(Tac bool)):Tactics.Types.is_guard (_cur_goal ())
-

[is_guard] returns whether the current goal arised from a typechecking guard

-
let ((rewrite' (b:binder)):(Tac unit)):(<|>(<|>(((fun () -> rewrite b)), ((fun () -> binder_retype b; apply_lemma ((`(__eq_sym))); rewrite b))), ((fun () -> fail "rewrite' failed")))) ()
-

Like [rewrite], but works with equalities [v == e] and [e == v]

-
let ((l_to_r (lems:list term)):(Tac unit)):let  ((first_or_trefl ()):(Tac unit)) = fold_left ((fun k l () -> or_else ((fun () -> apply_lemma l)) k)) trefl lems () in pointwise first_or_trefl
-

Rewrites left-to-right, and bottom-up, given a set of lemmas stating equalities. The lemmas need to prove propositional equalities, that is, using [==].

-
let ((grewrite_eq (b:binder)):(Tac unit)):match term_as_formula (type_of_binder b) with (Comp (Eq _) l r)  -> grewrite l r; iseq (Prims.Cons idtac (Prims.Cons ((fun () -> exact (binder_to_term b))) (Prims.Nil ))) | _  -> fail "failed in grewrite_eq"
-

A wrapper to [grewrite] which takes a binder of an equality type

-
let ((branch_on_match ()):(Tac unit)):focus ((fun () -> let  x = get_match_body () in let  _ = t_destruct x in iterAll ((fun () -> let  bs = repeat intro in let  b = last bs in grewrite_eq b; norm (Prims.Cons iota (Prims.Nil ))))))
-

When the goal is [match e with | p1 -> e1 ... | pn -> en], destruct it into [n] goals for each possible case, including an hypothesis for [e] matching the correposnding pattern.

+
let later () : Tac unit =
+    match goals () with
+    | g::gs -> set_goals (gs @ [g])
+    | _ -> fail "later: no goals"
+

+apply

+

apply f will attempt to produce a solution to the goal by an application +of f to any amount of arguments (which need to be solved as further goals). +The amount of arguments introduced is the least such that f a_i unifies +with the goal's type.

+
let apply (t : term) : Tac unit =
+    t_apply true false t
+
let apply_noinst (t : term) : Tac unit =
+    t_apply true true t
+

+apply_lemma

+

apply_lemma l will solve a goal of type squash phi when l is a +Lemma ensuring phi. The arguments to l and its requires clause are +introduced as new goals. As a small optimization, unit arguments are +discharged by the engine. Just a thin wrapper around t_apply_lemma.

+
let apply_lemma (t : term) : Tac unit =
+    t_apply_lemma false false t
+

+trefl

+

See docs for t_trefl

+
let trefl () : Tac unit =
+  t_trefl false
+

+trefl_guard

+

See docs for t_trefl

+
let trefl_guard () : Tac unit =
+  t_trefl true
+

+commute_applied_match

+

See docs for t_commute_applied_match

+
let commute_applied_match () : Tac unit =
+  t_commute_applied_match ()
+

+apply_lemma_noinst

+

Similar to apply_lemma, but will not instantiate uvars in the +goal while applying.

+
let apply_lemma_noinst (t : term) : Tac unit =
+    t_apply_lemma true false t
+
let apply_lemma_rw (t : term) : Tac unit =
+    t_apply_lemma false true t
+

+apply_raw

+

apply_raw f is like apply, but will ask for all arguments +regardless of whether they appear free in further goals. See the +explanation in t_apply.

+
let apply_raw (t : term) : Tac unit =
+    t_apply false false t
+

+exact_guard

+

Like exact, but allows for the term e to have a type t only +under some guard g, adding the guard as a goal.

+
let exact_guard (t : term) : Tac unit =
+    with_policy Goal (fun () -> t_exact true false t)
+

+t_pointwise

+

(TODO: explain bettter) When running pointwise tau For every +subterm t' of the goal's type t, the engine will build a goal Gamma |= t' == ?u and run tau on it. When the tactic proves the goal, +the engine will rewrite t' for ?u in the original goal type. This +is done for every subterm, bottom-up. This allows to recurse over an +unknown goal type. By inspecting the goal, the tau can then decide +what to do (to not do anything, use trefl).

+
let t_pointwise (d:direction) (tau : unit -> Tac unit) : Tac unit =
+  let ctrl (t:term) : Tac (bool & ctrl_flag) =
+    true, Continue
+  in
+  let rw () : Tac unit =
+    tau ()
+  in
+  ctrl_rewrite d ctrl rw
+

+topdown_rewrite

+

topdown_rewrite ctrl rw is used to rewrite those sub-terms t +of the goal on which fst (ctrl t) returns true.

+
let topdown_rewrite (ctrl : term -> Tac (bool * int))
+                    (rw:unit -> Tac unit) : Tac unit
+  = let ctrl' (t:term) : Tac (bool & ctrl_flag) =
+      let b, i = ctrl t in
+      let f =
+        match i with
+        | 0 -> Continue
+        | 1 -> Skip
+        | 2 -> Abort
+        | _ -> fail "topdown_rewrite: bad value from ctrl"
+      in
+      b, f
+    in
+    ctrl_rewrite TopDown ctrl' rw
+

On each such sub-term, rw is presented with an equality of goal +of the form Gamma |= t == ?u. When rw proves the goal, +the engine will rewrite t for ?u in the original goal +type.

+

The goal formula is traversed top-down and the traversal can be +controlled by snd (ctrl t):

+

When snd (ctrl t) = 0, the traversal continues down through the +position in the goal term.

+

When snd (ctrl t) = 1, the traversal continues to the next +sub-tree of the goal.

+

When snd (ctrl t) = 2, no more rewrites are performed in the +goal.

+
let pointwise  (tau : unit -> Tac unit) : Tac unit = t_pointwise BottomUp tau
+let pointwise' (tau : unit -> Tac unit) : Tac unit = t_pointwise TopDown  tau
+
let cur_module () : Tac name =
+    moduleof (top_env ())
+
let open_modules () : Tac (list name) =
+    env_open_modules (top_env ())
+
let rec repeatn (#a:Type) (n : int) (t : unit -> Tac a) : Tac (list a) =
+    if n <= 0
+    then []
+    else t () :: repeatn (n - 1) t
+
let fresh_uvar (o : option typ) : Tac term =
+    let e = cur_env () in
+    uvar_env e o
+
let unify (t1 t2 : term) : Tac bool =
+    let e = cur_env () in
+    unify_env e t1 t2
+
let unify_guard (t1 t2 : term) : Tac bool =
+    let e = cur_env () in
+    unify_guard_env e t1 t2
+
let tmatch (t1 t2 : term) : Tac bool =
+    let e = cur_env () in
+    match_env e t1 t2
+

+divide

+

divide n t1 t2 will split the current set of goals into the n +first ones, and the rest. It then runs t1 on the first set, and t2 +on the second, returning both results (and concatenating remaining goals).

+
let divide (n:int) (l : unit -> Tac 'a) (r : unit -> Tac 'b) : Tac ('a * 'b) =
+    if n < 0 then
+      fail "divide: negative n";
+    let gs, sgs = goals (), smt_goals () in
+    let gs1, gs2 = List.Tot.Base.splitAt n gs in
+
set_goals gs1; set_smt_goals [];
+let x = l () in
+let gsl, sgsl = goals (), smt_goals () in
+
set_goals gs2; set_smt_goals [];
+let y = r () in
+let gsr, sgsr = goals (), smt_goals () in
+
set_goals (gsl @ gsr); set_smt_goals (sgs @ sgsl @ sgsr);
+(x, y)
+
let rec iseq (ts : list (unit -> Tac unit)) : Tac unit =
+    match ts with
+    | t::ts -> let _ = divide 1 t (fun () -> iseq ts) in ()
+    | []    -> ()
+

+focus

+

focus t runs t () on the current active goal, hiding all others +and restoring them at the end.

+
let focus (t : unit -> Tac 'a) : Tac 'a =
+    match goals () with
+    | [] -> fail "focus: no goals"
+    | g::gs ->
+        let sgs = smt_goals () in
+        set_goals [g]; set_smt_goals [];
+        let x = t () in
+        set_goals (goals () @ gs); set_smt_goals (smt_goals () @ sgs);
+        x
+

+dump1

+

Similar to dump, but only dumping the current goal.

+
let dump1 (m : string) = focus (fun () -> dump m)
+
let rec mapAll (t : unit -> Tac 'a) : Tac (list 'a) =
+    match goals () with
+    | [] -> []
+    | _::_ -> let (h, t) = divide 1 t (fun () -> mapAll t) in h::t
+
let rec iterAll (t : unit -> Tac unit) : Tac unit =
+

Could use mapAll, but why even build that list

+
match goals () with
+| [] -> ()
+| _::_ -> let _ = divide 1 t (fun () -> iterAll t) in ()
+
let iterAllSMT (t : unit -> Tac unit) : Tac unit =
+    let gs, sgs = goals (), smt_goals () in
+    set_goals sgs;
+    set_smt_goals [];
+    iterAll t;
+    let gs', sgs' = goals (), smt_goals () in
+    set_goals gs;
+    set_smt_goals (gs'@sgs')
+

+seq

+

Runs tactic t1 on the current goal, and then tactic t2 on each +subgoal produced by t1. Each invocation of t2 runs on a proofstate +with a single goal (they're "focused").

+
let seq (f : unit -> Tac unit) (g : unit -> Tac unit) : Tac unit =
+    focus (fun () -> f (); iterAll g)
+
let exact_args (qs : list aqualv) (t : term) : Tac unit =
+    focus (fun () ->
+        let n = List.Tot.Base.length qs in
+        let uvs = repeatn n (fun () -> fresh_uvar None) in
+        let t' = mk_app t (zip uvs qs) in
+        exact t';
+        iter (fun uv -> if is_uvar uv
+                        then unshelve uv
+                        else ()) (L.rev uvs)
+    )
+
let exact_n (n : int) (t : term) : Tac unit =
+    exact_args (repeatn n (fun () -> Q_Explicit)) t
+

+ngoals

+

ngoals () returns the number of goals

+
let ngoals () : Tac int = List.Tot.Base.length (goals ())
+

+ngoals_smt

+

ngoals_smt () returns the number of SMT goals

+
let ngoals_smt () : Tac int = List.Tot.Base.length (smt_goals ())
+
let fresh_bv t : Tac bv =
+

These bvs are fresh anyway through a separate counter, +* but adding the integer allows for more readability when +* generating code

+
let i = fresh () in
+fresh_bv_named ("x" ^ string_of_int i) t
+
let fresh_binder_named nm t : Tac binder =
+    mk_binder (fresh_bv_named nm t)
+
let fresh_binder t : Tac binder =
+

See comment in fresh_bv

+
let i = fresh () in
+fresh_binder_named ("x" ^ string_of_int i) t
+
let fresh_implicit_binder_named nm t : Tac binder =
+    mk_implicit_binder (fresh_bv_named nm t)
+
let fresh_implicit_binder t : Tac binder =
+

See comment in fresh_bv

+
let i = fresh () in
+fresh_implicit_binder_named ("x" ^ string_of_int i) t
+
let guard (b : bool) : TacH unit (requires (fun _ -> True))
+                                 (ensures (fun ps r -> if b
+                                                       then Success? r /\ Success?.ps r == ps
+                                                       else Failed? r))
+

^ the proofstate on failure is not exactly equal (has the psc set)

+
=
+if not b then
+    fail "guard failed"
+else ()
+
let try_with (f : unit -> Tac 'a) (h : exn -> Tac 'a) : Tac 'a =
+    match catch f with
+    | Inl e -> h e
+    | Inr x -> x
+
let trytac (t : unit -> Tac 'a) : Tac (option 'a) =
+    try Some (t ())
+    with
+    | _ -> None
+
let or_else (#a:Type) (t1 : unit -> Tac a) (t2 : unit -> Tac a) : Tac a =
+    try t1 ()
+    with | _ -> t2 ()
+
val (<|>) : (unit -> Tac 'a) ->
+            (unit -> Tac 'a) ->
+            (unit -> Tac 'a)
+let (<|>) t1 t2 = fun () -> or_else t1 t2
+
let first (ts : list (unit -> Tac 'a)) : Tac 'a =
+    L.fold_right (<|>) ts (fun () -> fail "no tactics to try") ()
+
let rec repeat (#a:Type) (t : unit -> Tac a) : Tac (list a) =
+    match catch t with
+    | Inl _ -> []
+    | Inr x -> x :: repeat t
+
let repeat1 (#a:Type) (t : unit -> Tac a) : Tac (list a) =
+    t () :: repeat t
+
let repeat' (f : unit -> Tac 'a) : Tac unit =
+    let _ = repeat f in ()
+
let norm_term (s : list norm_step) (t : term) : Tac term =
+    let e =
+        try cur_env ()
+        with | _ -> top_env ()
+    in
+    norm_term_env e s t
+

+join_all_smt_goals

+

Join all of the SMT goals into one. This helps when all of them are +expected to be similar, and therefore easier to prove at once by the SMT +solver. TODO: would be nice to try to join them in a more meaningful +way, as the order can matter.

+
let join_all_smt_goals () =
+  let gs, sgs = goals (), smt_goals () in
+  set_smt_goals [];
+  set_goals sgs;
+  repeat' join;
+  let sgs' = goals () in // should be a single one
+  set_goals gs;
+  set_smt_goals sgs'
+
let discard (tau : unit -> Tac 'a) : unit -> Tac unit =
+    fun () -> let _ = tau () in ()
+

TODO: do we want some value out of this?

+
let rec repeatseq (#a:Type) (t : unit -> Tac a) : Tac unit =
+    let _ = trytac (fun () -> (discard t) `seq` (discard (fun () -> repeatseq t))) in ()
+
let tadmit () = tadmit_t (`())
+
let admit1 () : Tac unit =
+    tadmit ()
+
let admit_all () : Tac unit =
+    let _ = repeat tadmit in
+    ()
+

+is_guard

+

is_guard returns whether the current goal arised from a typechecking guard

+
let is_guard () : Tac bool =
+    Tactics.Types.is_guard (_cur_goal ())
+
let skip_guard () : Tac unit =
+    if is_guard ()
+    then smt ()
+    else fail ""
+
let guards_to_smt () : Tac unit =
+    let _ = repeat skip_guard in
+    ()
+
let simpl   () : Tac unit = norm [simplify; primops]
+let whnf    () : Tac unit = norm [weak; hnf; primops; delta]
+let compute () : Tac unit = norm [primops; iota; delta; zeta]
+
let intros () : Tac (list binder) = repeat intro
+
let intros' () : Tac unit = let _ = intros () in ()
+let destruct tm : Tac unit = let _ = t_destruct tm in ()
+let destruct_intros tm : Tac unit = seq (fun () -> let _ = t_destruct tm in ()) intros'
+
private val __cut : (a:Type) -> (b:Type) -> (a -> b) -> a -> b
+private let __cut a b f x = f x
+
let tcut (t:term) : Tac binder =
+    let g = cur_goal () in
+    let tt = mk_e_app (`__cut) [t; g] in
+    apply tt;
+    intro ()
+
let pose (t:term) : Tac binder =
+    apply (`__cut);
+    flip ();
+    exact t;
+    intro ()
+
let intro_as (s:string) : Tac binder =
+    let b = intro () in
+    rename_to b s
+
let pose_as (s:string) (t:term) : Tac binder =
+    let b = pose t in
+    rename_to b s
+
let for_each_binder (f : binder -> Tac 'a) : Tac (list 'a) =
+    map f (cur_binders ())
+
let rec revert_all (bs:binders) : Tac unit =
+    match bs with
+    | [] -> ()
+    | _::tl -> revert ();
+               revert_all tl
+

Some syntax utility functions

+
let bv_to_term (bv : bv) : Tac term = pack (Tv_Var bv)
+let binder_to_term (b : binder) : Tac term = let bv, _ = inspect_binder b in bv_to_term bv
+

Cannot define this inside assumption due to #1091

+
private
+let rec __assumption_aux (bs : binders) : Tac unit =
+    match bs with
+    | [] ->
+        fail "no assumption matches goal"
+    | b::bs ->
+        let t = binder_to_term b in
+        try exact t with | _ ->
+        try (apply (`FStar.Squash.return_squash);
+             exact t) with | _ ->
+        __assumption_aux bs
+
let assumption () : Tac unit =
+    __assumption_aux (cur_binders ())
+
let destruct_equality_implication (t:term) : Tac (option (formula * term)) =
+    match term_as_formula t with
+    | Implies lhs rhs ->
+        let lhs = term_as_formula' lhs in
+        begin match lhs with
+        | Comp (Eq _) _ _ -> Some (lhs, rhs)
+        | _ -> None
+        end
+    | _ -> None
+
private
+let __eq_sym #t (a b : t) : Lemma ((a == b) == (b == a)) =
+  FStar.PropositionalExtensionality.apply (a==b) (b==a)
+

+rewrite'

+

Like rewrite, but works with equalities v == e and e == v

+
let rewrite' (b:binder) : Tac unit =
+    ((fun () -> rewrite b)
+     <|> (fun () -> binder_retype b;
+                    apply_lemma (`__eq_sym);
+                    rewrite b)
+     <|> (fun () -> fail "rewrite' failed"))
+    ()
+
let rec try_rewrite_equality (x:term) (bs:binders) : Tac unit =
+    match bs with
+    | [] -> ()
+    | x_t::bs ->
+        begin match term_as_formula (type_of_binder x_t) with
+        | Comp (Eq _) y _ ->
+            if term_eq x y
+            then rewrite x_t
+            else try_rewrite_equality x bs
+        | _ ->
+            try_rewrite_equality x bs
+        end
+
let rec rewrite_all_context_equalities (bs:binders) : Tac unit =
+    match bs with
+    | [] -> ()
+    | x_t::bs -> begin
+        (try rewrite x_t with | _ -> ());
+        rewrite_all_context_equalities bs
+    end
+
let rewrite_eqs_from_context () : Tac unit =
+    rewrite_all_context_equalities (cur_binders ())
+
let rewrite_equality (t:term) : Tac unit =
+    try_rewrite_equality t (cur_binders ())
+
let unfold_def (t:term) : Tac unit =
+    match inspect t with
+    | Tv_FVar fv ->
+        let n = implode_qn (inspect_fv fv) in
+        norm [delta_fully [n]]
+    | _ -> fail "unfold_def: term is not a fv"
+

+l_to_r

+

Rewrites left-to-right, and bottom-up, given a set of lemmas stating +equalities. The lemmas need to prove propositional equalities, that +is, using ==.

+
let l_to_r (lems:list term) : Tac unit =
+    let first_or_trefl () : Tac unit =
+        fold_left (fun k l () ->
+                    (fun () -> apply_lemma_rw l)
+                    `or_else` k)
+                  trefl lems () in
+    pointwise first_or_trefl
+
let mk_squash (t : term) : term =
+    let sq : term = pack_ln (Tv_FVar (pack_fv squash_qn)) in
+    mk_e_app sq [t]
+
let mk_sq_eq (t1 t2 : term) : term =
+    let eq : term = pack_ln (Tv_FVar (pack_fv eq2_qn)) in
+    mk_squash (mk_e_app eq [t1; t2])
+
let grewrite (t1 t2 : term) : Tac unit =
+    let e = tcut (mk_sq_eq t1 t2) in
+    let e = pack_ln (Tv_Var (bv_of_binder e)) in
+    pointwise (fun () -> try exact e with | _ -> trefl ())
+
private
+let __un_sq_eq (#a:Type) (x y : a) (_ : (x == y)) : Lemma (x == y) = ()
+

+grewrite_eq

+

A wrapper to grewrite which takes a binder of an equality type

+
let grewrite_eq (b:binder) : Tac unit =
+  match term_as_formula (type_of_binder b) with
+  | Comp (Eq _) l r ->
+    grewrite l r;
+    iseq [idtac; (fun () -> exact (binder_to_term b))]
+  | _ ->
+    begin match term_as_formula' (type_of_binder b) with
+    | Comp (Eq _) l r ->
+      grewrite l r;
+      iseq [idtac; (fun () -> apply_lemma (`__un_sq_eq);
+                              exact (binder_to_term b))]
+    | _ ->
+      fail "grewrite_eq: binder type is not an equality"
+    end
+
private val push1 : (#p:Type) -> (#q:Type) ->
+                        squash (p ==> q) ->
+                        squash p ->
+                        squash q
+private let push1 #p #q f u = ()
+
private val push1' : (#p:Type) -> (#q:Type) ->
+                         (p ==> q) ->
+                         squash p ->
+                         squash q
+private let push1' #p #q f u = ()
+ +

Before anything, try a vanilla apply and apply_lemma

+
val apply_squash_or_lem : d:nat -> term -> Tac unit
+let rec apply_squash_or_lem d t =
+
try apply t with | _ ->
+try apply (`FStar.Squash.return_squash); apply t with | _ ->
+try apply_lemma t with | _ ->
+

Fuel cutoff, just in case.

+
if d <= 0 then fail "mapply: out of fuel" else begin
+
let ty = tc (cur_env ()) t in
+let tys, c = collect_arr ty in
+match inspect_comp c with
+| C_Lemma pre post _ ->
+   begin
+   let post = `((`#post) ()) in (* unthunk *)
+   let post = norm_term [] post in
+

Is the lemma an implication? We can try to intro

+
match term_as_formula' post with
+| Implies p q ->
+    apply_lemma (`push1);
+    apply_squash_or_lem (d-1) t
+
   | _ ->
+       fail "mapply: can't apply (1)"
+   end
+| C_Total rt _ ->
+   begin match unsquash rt with
+

If the function returns a squash, just apply it, since our goals are squashed

+
| Some rt ->
+

DUPLICATED, refactor! +Is the lemma an implication? We can try to intro

+
begin
+let rt = norm_term [] rt in
+
match term_as_formula' rt with
+| Implies p q ->
+    apply_lemma (`push1);
+    apply_squash_or_lem (d-1) t
+
| _ ->
+    fail "mapply: can't apply (1)"
+end
+

If not, we can try to introduce the squash ourselves first

+
| None ->
+

DUPLICATED, refactor! +Is the lemma an implication? We can try to intro

+
begin
+let rt = norm_term [] rt in
+
match term_as_formula' rt with
+| Implies p q ->
+    apply_lemma (`push1);
+    apply_squash_or_lem (d-1) t
+
     | _ ->
+         apply (`FStar.Squash.return_squash);
+         apply t
+     end
+   end
+| _ -> fail "mapply: can't apply (2)"
+end
+

m is for magic

+
let mapply (t : term) : Tac unit =
+    apply_squash_or_lem 10 t
+
private
+let admit_dump_t () : Tac unit =
+  dump "Admitting";
+  apply (`admit)
+
val admit_dump : #a:Type -> (#[admit_dump_t ()] x : (unit -> Admit a)) -> unit -> Admit a
+let admit_dump #a #x () = x ()
+
private
+let magic_dump_t () : Tac unit =
+  dump "Admitting";
+  apply (`magic);
+  exact (`());
+  ()
+
val magic_dump : #a:Type -> (#[magic_dump_t ()] x : a) -> unit -> Tot a
+let magic_dump #a #x () = x
+
let change_with t1 t2 : Tac unit =
+    focus (fun () ->
+        grewrite t1 t2;
+        iseq [idtac; trivial]
+    )
+
let change_sq (t1 : term) : Tac unit =
+    change (mk_e_app (`squash) [t1])
+
let finish_by (t : unit -> Tac 'a) : Tac 'a =
+    let x = t () in
+    or_else qed (fun () -> fail "finish_by: not finished");
+    x
+
let solve_then #a #b (t1 : unit -> Tac a) (t2 : a -> Tac b) : Tac b =
+    dup ();
+    let x = focus (fun () -> finish_by t1) in
+    let y = t2 x in
+    trefl ();
+    y
+
let add_elem (t : unit -> Tac 'a) : Tac 'a = focus (fun () ->
+    apply (`Cons);
+    focus (fun () ->
+      let x = t () in
+      qed ();
+      x
+    )
+  )
+ +
let specialize (#a:Type) (f:a) (l:list string) :unit -> Tac unit
+  = fun () -> solve_then (fun () -> exact (quote f)) (fun () -> norm [delta_only l; iota; zeta])
+
let tlabel (l:string) =
+    match goals () with
+    | [] -> fail "tlabel: no goals"
+    | h::t ->
+        set_goals (set_label l h :: t)
+
let tlabel' (l:string) =
+    match goals () with
+    | [] -> fail "tlabel': no goals"
+    | h::t ->
+        let h = set_label (l ^ get_label h) h in
+        set_goals (h :: t)
+
let focus_all () : Tac unit =
+    set_goals (goals () @ smt_goals ());
+    set_smt_goals []
+
private
+let rec extract_nth (n:nat) (l : list 'a) : option ('a * list 'a) =
+  match n, l with
+  | _, [] -> None
+  | 0, hd::tl -> Some (hd, tl)
+  | _, hd::tl -> begin
+    match extract_nth (n-1) tl with
+    | Some (hd', tl') -> Some (hd', hd::tl')
+    | None -> None
+  end
+
let bump_nth (n:pos) : Tac unit =
+

n-1 since goal numbering begins at 1

+
match extract_nth (n - 1) (goals ()) with
+| None -> fail "bump_nth: not that many goals"
+| Some (h, t) -> set_goals (h :: t)
+
let on_sort_bv (f : term -> Tac term) (xbv:bv) : Tac bv =
+  let bvv = inspect_bv xbv in
+  let bvv = { bvv with bv_sort = f bvv.bv_sort } in
+  let bv = pack_bv bvv in
+  bv
+
let on_sort_binder (f : term -> Tac term) (b:binder) : Tac binder =
+  let bv, (q, attrs) = inspect_binder b in
+  let bv = on_sort_bv f bv in
+  let b = pack_binder bv q attrs in
+  b
+
let rec visit_tm (ff : term -> Tac term) (t : term) : Tac term =
+  let tv = inspect_ln t in
+  let tv' =
+    match tv with
+    | Tv_FVar _ -> tv
+    | Tv_Var bv ->
+        let bv = on_sort_bv (visit_tm ff) bv in
+        Tv_Var bv
+
| Tv_BVar bv ->
+    let bv = on_sort_bv (visit_tm ff) bv in
+    Tv_BVar bv
+
    | Tv_Type () -> Tv_Type ()
+    | Tv_Const c -> Tv_Const c
+    | Tv_Uvar i u -> Tv_Uvar i u
+    | Tv_Unknown -> Tv_Unknown
+    | Tv_Arrow b c ->
+        let b = on_sort_binder (visit_tm ff) b in
+        let c = visit_comp ff c in
+        Tv_Arrow b c
+    | Tv_Abs b t ->
+        let b = on_sort_binder (visit_tm ff) b in
+        let t = visit_tm ff t in
+        Tv_Abs b t
+    | Tv_App l (r, q) ->
+         let l = visit_tm ff l in
+         let r = visit_tm ff r in
+         Tv_App l (r, q)
+    | Tv_Refine b r ->
+        let b = on_sort_bv (visit_tm ff) b in
+        let r = visit_tm ff r in
+        Tv_Refine b r
+    | Tv_Let r attrs b def t ->
+        let b = on_sort_bv (visit_tm ff) b in
+        let def = visit_tm ff def in
+        let t = visit_tm ff t in
+        Tv_Let r attrs b def t
+    | Tv_Match sc ret_opt brs ->
+        let sc = visit_tm ff sc in
+        let ret_opt = map_opt (fun ret ->
+          match ret with
+          | Inl t, tacopt -> Inl (visit_tm ff t), map_opt (visit_tm ff) tacopt
+          | Inr c, tacopt -> Inr (visit_comp ff c), map_opt (visit_tm ff) tacopt) ret_opt in
+        let brs = map (visit_br ff) brs in
+        Tv_Match sc ret_opt brs
+    | Tv_AscribedT e t topt ->
+        let e = visit_tm ff e in
+        let t = visit_tm ff t in
+        Tv_AscribedT e t topt
+    | Tv_AscribedC e c topt ->
+        let e = visit_tm ff e in
+        Tv_AscribedC e c topt
+  in
+  ff (pack_ln tv')
+and visit_br (ff : term -> Tac term) (b:branch) : Tac branch =
+  let (p, t) = b in
+  let p = visit_pat ff p in
+  let t = visit_tm ff t in
+  (p, t)
+and visit_pat (ff : term -> Tac term) (p:pattern) : Tac pattern =
+  match p with
+  | Pat_Constant c -> p
+  | Pat_Cons fv l ->
+      let l = (map (fun(p,b) -> (visit_pat ff p, b)) l) in
+      Pat_Cons fv l
+  | Pat_Var bv ->
+      let bv = on_sort_bv (visit_tm ff) bv in
+      Pat_Var bv
+  | Pat_Wild bv ->
+      let bv = on_sort_bv (visit_tm ff) bv in
+      Pat_Wild bv
+  | Pat_Dot_Term bv term ->
+      let bv = on_sort_bv (visit_tm ff) bv in
+      let term = visit_tm ff term in
+      Pat_Dot_Term bv term
+and visit_comp (ff : term -> Tac term) (c : comp) : Tac comp =
+  let cv = inspect_comp c in
+  let cv' =
+    match cv with
+    | C_Total ret decr ->
+        let ret = visit_tm ff ret in
+        let decr = map (visit_tm ff) decr in
+        C_Total ret decr
+
| C_GTotal ret decr ->
+    let ret = visit_tm ff ret in
+    let decr = map (visit_tm ff) decr in
+    C_GTotal ret decr
+
| C_Lemma pre post pats ->
+    let pre = visit_tm ff pre in
+    let post = visit_tm ff post in
+    let pats = visit_tm ff pats in
+    C_Lemma pre post pats
+
  | C_Eff us eff res args ->
+      let res = visit_tm ff res in
+      let args = map (fun (a, q) -> (visit_tm ff a, q)) args in
+      C_Eff us eff res args
+in
+pack_comp cv'
+
let rec destruct_list (t : term) : Tac (list term) =
+    let head, args = collect_app t in
+    match inspect_ln head, args with
+    | Tv_FVar fv, [(a1, Q_Explicit); (a2, Q_Explicit)]
+    | Tv_FVar fv, [(_, Q_Implicit); (a1, Q_Explicit); (a2, Q_Explicit)] ->
+      if inspect_fv fv = cons_qn
+      then a1 :: destruct_list a2
+      else raise NotAListLiteral
+    | Tv_FVar fv, _ ->
+      if inspect_fv fv = nil_qn
+      then []
+      else raise NotAListLiteral
+    | _ ->
+      raise NotAListLiteral
+
private let get_match_body () : Tac term =
+  match FStar.Reflection.Formula.unsquash (cur_goal ()) with
+  | None -> fail ""
+  | Some t -> match inspect t with
+             | Tv_Match sc _ _ -> sc
+             | _ -> fail "Goal is not a match"
+
private let rec last (x : list 'a) : Tac 'a =
+    match x with
+    | [] -> fail "last: empty list"
+    | [x] -> x
+    | _::xs -> last xs
+

+branch_on_match

+

When the goal is match e with | p1 -> e1 ... | pn -> en, +destruct it into n goals for each possible case, including an +hypothesis for e matching the correposnding pattern.

+
let branch_on_match () : Tac unit =
+    focus (fun () ->
+      let x = get_match_body () in
+      let _ = t_destruct x in
+      iterAll (fun () ->
+        let bs = repeat intro in
+        let b = last bs in (* this one is the equality *)
+        grewrite_eq b;
+        norm [iota])
+    )
+

+nth_binder

+

When the argument i is non-negative, nth_binder grabs the nth +binder in the current goal. When it is negative, it grabs the (-i-1)th +binder counting from the end of the goal. That is, nth_binder (-1) +will return the last binder, nth_binder (-2) the second to last, and +so on.

+
let nth_binder (i:int) : Tac binder =
+  let bs = cur_binders () in
+  let k : int = if i >= 0 then i else List.Tot.Base.length bs + i in
+  let k : nat = if k < 0 then fail "not enough binders" else k in
+  match List.Tot.Base.nth bs k with
+  | None -> fail "not enough binders"
+  | Some b -> b
+
exception Appears
+

+name_appears_in

+

Decides whether a top-level name nm syntactically +appears in the term t.

+
let name_appears_in (nm:name) (t:term) : Tac bool =
+  let ff (t : term) : Tac term =
+    match t with
+    | Tv_FVar fv ->
+      if inspect_fv fv = nm then
+        raise Appears;
+      t
+    | t -> t
+  in
+  try ignore (visit_tm ff t); false with
+  | Appears -> true
+  | e -> raise e
+

+mk_abs

+

mk_abs x1; ...; xn t returns the term fun x1 ... xn -> t

+
let rec mk_abs (args : list binder) (t : term) : Tac term (decreases args) =
+  match args with
+  | [] -> t
+  | a :: args' ->
+    let t' = mk_abs args' t in
+    pack (Tv_Abs a t')
+ diff --git a/docs/FStar.Tactics.Effect.html b/docs/FStar.Tactics.Effect.html index 4dc1b26..3acb585 100644 --- a/docs/FStar.Tactics.Effect.html +++ b/docs/FStar.Tactics.Effect.html @@ -1,16 +1,169 @@ - - + + - - - - - + FStar.Tactics.Effect + -

module FStar.Tactics.Effect

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Effect

+ +

This module is extracted, don't add any assume vals or extraction

+ +
private
+let __tac (a:Type) = proofstate -> M (__result a)
+

monadic return

+
private
+let __ret (a:Type) (x:a) : __tac a = fun (s:proofstate) -> Success x s
+

monadic bind

+
private
+let __bind (a:Type) (b:Type) (r1 r2:range) (t1:__tac a) (t2:a -> __tac b) : __tac b =
+    fun ps ->
+        let ps = set_proofstate_range ps (FStar.Range.prims_to_fstar_range r1) in
+        let ps = incr_depth ps in
+        let r = t1 ps in
+        match r with
+        | Success a ps' ->
+            let ps' = set_proofstate_range ps' (FStar.Range.prims_to_fstar_range r2) in
+

Force evaluation of __tracepoint q even on the interpreter

+
    begin match tracepoint ps' with
+    | true -> t2 a (decr_depth ps')
+    end
+| Failed e ps' -> Failed e ps'
+

Actions

+
private
+let __get () : __tac proofstate = fun s0 -> Success s0 s0
+
private
+let __raise (a:Type0) (e:exn) : __tac a = fun (ps:proofstate) -> Failed #a e ps
+
private
+let __tac_wp a = proofstate -> (__result a -> Tot Type0) -> Tot Type0
+

The DMFF-generated bind_wp doesn't the contain the "don't

+ +
private
+unfold let g_bind (a:Type) (b:Type) (wp:__tac_wp a) (f:a -> __tac_wp b) = fun ps post ->
+    wp ps (fun m' -> match m' with
+                     | Success a q -> f a q post
+                     | Failed e q -> post (Failed e q))
+
private
+unfold let g_compact (a:Type) (wp:__tac_wp a) : __tac_wp a =
+    fun ps post -> forall k. (forall (r:__result a).{:pattern (guard_free (k r))} post r ==> k r) ==> wp ps k
+
private
+unfold let __TAC_eff_override_bind_wp (a:Type) (b:Type) (wp:__tac_wp a) (f:a -> __tac_wp b) =
+    g_compact b (g_bind a b wp f)
+
[@@ dm4f_bind_range ]
+new_effect {
+  TAC : a:Type -> Effect
+  with repr     = __tac
+     ; bind     = __bind
+     ; return   = __ret
+     ; __raise  = __raise
+     ; __get    = __get
+}
+

Hoare variant

+
effect TacH (a:Type) (pre : proofstate -> Tot Type0) (post : proofstate -> __result a -> Tot Type0) =
+    TAC a (fun ps post' -> pre ps /\ (forall r. post ps r ==> post' r))
+

"Total" variant

+
effect Tac (a:Type) = TacH a (requires (fun _ -> True)) (ensures (fun _ _ -> True))
+

Metaprograms that succeed

+
effect TacS (a:Type) = TacH a (requires (fun _ -> True)) (ensures (fun _ps r -> Success? r))
+

A variant that doesn't prove totality (nor type safety!)

+
effect TacF (a:Type) = TacH a (requires (fun _ -> False)) (ensures (fun _ _ -> True))
+
unfold
+let lift_div_tac (a:Type) (wp:pure_wp a) : __tac_wp a =
+    fun ps p -> wp (fun x -> p (Success x ps))
+
sub_effect DIV ~> TAC = lift_div_tac
+
let get = TAC?.__get
+let raise (#a:Type) (e:exn) = TAC?.__raise a e
+
val with_tactic (t : unit -> Tac unit) (p:Type u#a) : Type u#a
+

This syntactic marker will generate a goal of the shape x == ?u for

+ +
val rewrite_with_tactic (t:unit -> Tac unit) (#a:Type) (x:a) : a
+

This will run the tactic in order to (try to) produce a term of type

+ +
val synth_by_tactic : (#t:Type) -> (unit -> Tac unit) -> Tot t
+
val assert_by_tactic (p:Type) (t:unit -> Tac unit)
+  : Pure unit
+         (requires (set_range_of (with_tactic t (squash p)) (range_of t)))
+         (ensures (fun _ -> p))
+

We don't peel off all with_tactics in negative positions, so give

+ +
val by_tactic_seman : tau:(unit -> Tac unit) -> phi:Type -> Lemma (with_tactic tau phi ==> phi)
+                                                                  [SMTPat (with_tactic tau phi)]
+

One can always bypass the well-formedness of metaprograms. It does

+ +
let assume_safe (#a:Type) (tau:unit -> TacF a) : Tac a = admit (); tau ()
+
private let tac a b = a -> Tac b
+private let tactic a = tac unit a
+

A hook to preprocess a definition before it is typechecked and

+ +
val preprocess_with (tau : term -> Tac term) : Tot unit
+

A hook to postprocess a definition, after typechecking, and rewrite

+ +
val postprocess_with (tau : unit -> Tac unit) : Tot unit
+

Similar semantics to postprocess_with, but the metaprogram only

+ +
val postprocess_for_extraction_with (tau : unit -> Tac unit) : Tot unit
+
#set-options "--no_tactics"
+
val unfold_with_tactic (t:unit -> Tac unit) (p:Type)
+  : Lemma (requires p)
+          (ensures (with_tactic t p))
+
val unfold_rewrite_with_tactic (t:unit -> Tac unit) (#a:Type) (p:a)
+  : Lemma (rewrite_with_tactic t p == p)
+ diff --git a/docs/FStar.Tactics.Logic.html b/docs/FStar.Tactics.Logic.html index 87208c0..bff848e 100644 --- a/docs/FStar.Tactics.Logic.html +++ b/docs/FStar.Tactics.Logic.html @@ -1,16 +1,266 @@ - - + + - - - - - + FStar.Tactics.Logic + -

module FStar.Tactics.Logic

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Logic

+ +
let cur_formula () : Tac formula = term_as_formula (cur_goal ())
+
private val revert_squash : (#a:Type) -> (#b : (a -> Type)) ->
+                            (squash (forall (x:a). b x)) ->
+                            x:a -> squash (b x)
+let revert_squash #a #b s x = let x : (_:unit{forall x. b x}) = s in ()
+
let l_revert () : Tac unit =
+    revert ();
+    apply (`revert_squash)
+
let rec l_revert_all (bs:binders) : Tac unit =
+    match bs with
+    | []    -> ()
+    | _::tl -> begin l_revert (); l_revert_all tl end
+
private let fa_intro_lem (#a:Type) (#p:a -> Type) (f:(x:a -> squash (p x))) : Lemma (forall (x:a). p x) =
+  FStar.Classical.lemma_forall_intro_gtot
+    ((fun x -> FStar.IndefiniteDescription.elim_squash (f x)) <: (x:a -> GTot (p x)))
+
let forall_intro () : Tac binder =
+    apply_lemma (`fa_intro_lem);
+    intro ()
+
let forall_intro_as (s:string) : Tac binder =
+    apply_lemma (`fa_intro_lem);
+    intro_as s
+
let forall_intros () : Tac binders = repeat1 forall_intro
+
private val split_lem : (#a:Type) -> (#b:Type) ->
+                        squash a -> squash b -> Lemma (a /\ b)
+let split_lem #a #b sa sb = ()
+
let split () : Tac unit =
+    try apply_lemma (`split_lem)
+    with | _ -> fail "Could not split goal"
+
private val imp_intro_lem : (#a:Type) -> (#b : Type) ->
+                            (a -> squash b) ->
+                            Lemma (a ==> b)
+let imp_intro_lem #a #b f =
+  FStar.Classical.give_witness (FStar.Classical.arrow_to_impl (fun (x:squash a) -> FStar.Squash.bind_squash x f))
+
let implies_intro () : Tac binder =
+    apply_lemma (`imp_intro_lem);
+    intro ()
+
let implies_intros () : Tac binders = repeat1 implies_intro
+
let l_intro () = forall_intro `or_else` implies_intro
+let l_intros () = repeat l_intro
+

This should be next to mapply... bring mapply here?

+ +
let mintro () : Tac binder =
+    first [intro; implies_intro; forall_intro; (fun () -> fail "cannot intro")]
+
let mintros () : Tac (list binder) =
+    repeat mintro
+
let squash_intro () : Tac unit =
+    apply (`FStar.Squash.return_squash)
+
let l_exact (t:term) =
+    try exact t with
+    | _ -> (squash_intro (); exact t)
+
let hyp (b:binder) : Tac unit = l_exact (binder_to_term b)
+
private
+let __lemma_to_squash #req #ens (_ : squash req) (h : (unit -> Lemma (requires req) (ensures ens))) : squash ens =
+  h ()
+
let pose_lemma (t : term) : Tac binder =
+  let c = tcc (cur_env ()) t in
+  let pre, post =
+    match inspect_comp c with
+    | C_Lemma pre post _ -> pre, post
+    | _ -> fail ""
+  in
+  let post = `((`#post) ()) in (* unthunk *)
+  let post = norm_term [] post in
+

If the precondition is trivial, do not cut by it

+
match term_as_formula' pre with
+| True_ ->
+  pose (`(__lemma_to_squash #(`#pre) #(`#post) () (fun () -> (`#t))))
+| _ ->
+  let reqb = tcut (`squash (`#pre)) in
+
let b = pose (`(__lemma_to_squash #(`#pre) #(`#post) (`#(binder_to_term reqb)) (fun () -> (`#t)))) in
+flip ();
+ignore (trytac trivial);
+b
+
let explode () : Tac unit =
+    ignore (
+    repeatseq (fun () -> first [(fun () -> ignore (l_intro ()));
+                                (fun () -> ignore (split ()))]))
+
let rec visit (callback:unit -> Tac unit) : Tac unit =
+    focus (fun () ->
+            or_else callback
+                   (fun () ->
+                    let g = cur_goal () in
+                    match term_as_formula g with
+                    | Forall b phi ->
+                        let binders = forall_intros () in
+                        seq (fun () -> visit callback) (fun () -> l_revert_all binders)
+                    | And p q ->
+                        seq split (fun () -> visit callback)
+                    | Implies p q ->
+                        let _ = implies_intro () in
+                        seq (fun () -> visit callback) l_revert
+                    | _ ->
+                        ()
+                   )
+          )
+
let rec simplify_eq_implication () : Tac unit =
+    let e = cur_env () in
+    let g = cur_goal () in
+    let r = destruct_equality_implication g in
+    match r with
+    | None ->
+        fail "Not an equality implication"
+    | Some (_, rhs) ->
+        let eq_h = implies_intro () in // G, eq_h:x=e |- P
+        rewrite eq_h; // G, eq_h:x=e |- P[e/x]
+        clear_top (); // G |- P[e/x]
+        visit simplify_eq_implication
+
let rewrite_all_equalities () : Tac unit =
+    visit simplify_eq_implication
+
let rec unfold_definition_and_simplify_eq (tm:term) : Tac unit =
+    let g = cur_goal () in
+    match term_as_formula g with
+    | App hd arg ->
+        if term_eq hd tm
+        then trivial ()
+        else ()
+    | _ -> begin
+        let r = destruct_equality_implication g in
+        match r with
+        | None -> fail "Not an equality implication"
+        | Some (_, rhs) ->
+            let eq_h = implies_intro () in
+            rewrite eq_h;
+            clear_top ();
+            visit (fun () -> unfold_definition_and_simplify_eq tm)
+        end
+
private val vbind : (#p:Type) -> (#q:Type) -> squash p -> (p -> squash q) -> Lemma q
+let vbind #p #q sq f = FStar.Classical.give_witness_from_squash (FStar.Squash.bind_squash sq f)
+
let unsquash (t:term) : Tac term =
+    let v = `vbind in
+    apply_lemma (mk_e_app v [t]);
+    let b = intro () in
+    pack_ln (Tv_Var (bv_of_binder b))
+
private val or_ind : (#p:Type) -> (#q:Type) -> (#phi:Type) ->
+                     (p \/ q) ->
+                     (squash (p ==> phi)) ->
+                     (squash (q ==> phi)) ->
+                     Lemma phi
+let or_ind #p #q #phi o l r = ()
+
let cases_or (o:term) : Tac unit =
+    apply_lemma (mk_e_app (`or_ind) [o])
+
private val bool_ind : (b:bool) -> (phi:Type) -> (squash (b == true  ==> phi)) ->
+                                                 (squash (b == false ==> phi)) ->
+                                                 Lemma phi
+let bool_ind b phi l r = ()
+
let cases_bool (b:term) : Tac unit =
+    let bi = `bool_ind in
+    seq (fun () -> apply_lemma (mk_e_app bi [b]))
+        (fun () -> let _ = trytac (fun () -> let b = implies_intro () in rewrite b; clear_top ()) in ())
+
private val or_intro_1 : (#p:Type) -> (#q:Type) -> squash p -> Lemma (p \/ q)
+let or_intro_1 #p #q _ = ()
+
private val or_intro_2 : (#p:Type) -> (#q:Type) -> squash q -> Lemma (p \/ q)
+let or_intro_2 #p #q _ = ()
+
let left () : Tac unit =
+    apply_lemma (`or_intro_1)
+
let right () : Tac unit =
+    apply_lemma (`or_intro_2)
+
private val __and_elim : (#p:Type) -> (#q:Type) -> (#phi:Type) ->
+                              (p /\ q) ->
+                              squash (p ==> q ==> phi) ->
+                              Lemma phi
+let __and_elim #p #q #phi p_and_q f = ()
+
private val __and_elim' : (#p:Type) -> (#q:Type) -> (#phi:Type) ->
+                              squash (p /\ q) ->
+                              squash (p ==> q ==> phi) ->
+                              Lemma phi
+let __and_elim' #p #q #phi p_and_q f = ()
+
let and_elim (t : term) : Tac unit =
+    begin
+     try apply_lemma (`(__and_elim (`#t)))
+     with | _ -> apply_lemma (`(__and_elim' (`#t)))
+    end
+
let destruct_and (t : term) : Tac (binder * binder) =
+    and_elim t;
+    (implies_intro (), implies_intro ())
+
private val __witness : (#a:Type) -> (x:a) -> (#p:(a -> Type)) -> squash (p x) -> squash (exists (x:a). p x)
+private let __witness #a x #p _ = ()
+
let witness (t : term) : Tac unit =
+    apply_raw (`__witness);
+    exact t
+
private
+let __elim_exists' #t (#pred : t -> Type0) #goal (h : (exists x. pred x))
+                          (k : (x:t -> pred x -> squash goal)) : squash goal =
+  FStar.Squash.bind_squash #(x:t & pred x) h (fun (|x, pf|) -> k x pf)
+

returns witness and proof as binders

+
let elim_exists (t : term) : Tac (binder & binder) =
+  apply_lemma (`(__elim_exists' (`#(t))));
+  let x = intro () in
+  let pf = intro () in
+  (x, pf)
+
private
+let __forall_inst #t (#pred : t -> Type0) (h : (forall x. pred x)) (x : t) : squash (pred x) =
+    ()
+

GM: annoying that this doesn't just work by SMT

+
private
+let __forall_inst_sq #t (#pred : t -> Type0) (h : squash (forall x. pred x)) (x : t) : squash (pred x) =
+    FStar.Squash.bind_squash h (fun (f : (forall x. pred x)) -> __forall_inst f x)
+
let instantiate (fa : term) (x : term) : Tac binder =
+    try pose (`__forall_inst_sq (`#fa) (`#x)) with | _ ->
+    try pose (`__forall_inst (`#fa) (`#x)) with | _ ->
+    fail "could not instantiate"
+
private
+let sklem0 (#a:Type) (#p : a -> Type0) ($v : (exists (x:a). p x)) (phi:Type0) :
+  Lemma (requires (forall x. p x ==> phi))
+        (ensures phi) = ()
+
private
+let rec sk_binder' (acc:binders) (b:binder) : Tac (binders * binder) =
+  focus (fun () ->
+    try
+      apply_lemma (`(sklem0 (`#(binder_to_term b))));
+      if ngoals () <> 1 then fail "no";
+      clear b;
+      let bx = forall_intro () in
+      let b' = implies_intro () in
+      sk_binder' (bx::acc) b' (* We might have introduced a new existential, so possibly recurse *)
+    with | _ -> (acc, b) (* If the above failed, just return *)
+  )
+

Skolemizes a given binder for an existential, returning the introduced new binders

+ +
let sk_binder b = sk_binder' [] b
+
let skolem () =
+  let bs = binders_of_env (cur_env ()) in
+  map sk_binder bs
+
private
+val lemma_from_squash : #a:Type -> #b:(a -> Type) -> (x:a -> squash (b x)) -> x:a -> Lemma (b x)
+private
+let lemma_from_squash #a #b f x = let _ = f x in assert (b x)
+
private
+let easy_fill () =
+    let _ = repeat intro in
+

If the goal is a -> Lemma b, intro will fail, try to use this switch

+
let _ = trytac (fun () -> apply (`lemma_from_squash); intro ()) in
+smt ()
+
val easy : #a:Type -> (#[easy_fill ()] _ : a) -> a
+let easy #a #x = x
+ diff --git a/docs/FStar.Tactics.PatternMatching.html b/docs/FStar.Tactics.PatternMatching.html index 4dd2f92..7f6ff31 100644 --- a/docs/FStar.Tactics.PatternMatching.html +++ b/docs/FStar.Tactics.PatternMatching.html @@ -1,112 +1,843 @@ - - + + - - - - - - + FStar.Tactics.PatternMatching + -

module FStar.Tactics.PatternMatching

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
let ((mustfail #a (t:Unidentified product: [unit] (Tac a)) (message:string)):(Tac unit)):match trytac t with (Some _)  -> fail message | None  -> ()
+
+

+========================== +Pattern-matching tactics

+

:Author: Clément Pit-Claudel +:Contact: clement.pitclaudel@live.com +:Date: 2017-10-13

+
+

+FStar.Tactics.PatternMatching

+ +
+

+Contents

+

1 Contents +2 Motivation +3 Some utility functions +4 Pattern types +5 Pattern matching exceptions +5.1 Types of exceptions +5.2 The exception monad +5.3 Liftings +6 Pattern interpretation +7 Pattern-matching problems +7.1 Definitions +7.2 Resolution +8 A DSL for pattern-matching +8.1 Pattern notations +8.2 Problem notations +8.3 Continuations +9 Putting it all together +10 Examples +10.1 Simple examples +10.2 A real-life example +11 Possible extensions +12 Notes

+

+Motivation

+

Suppose you have a goal of the form squash (a == b). How do you capture +a and b for further inspection?

+

Here's a basic (but cumbersome!) implementation:

+
+
let fetch_eq_side () : Tac (term * term) =
+  let g = cur_goal () in
+  match inspect g with
+  | Tv_App squash (g, _) ->
+    (match inspect squash with
+     | Tv_FVar squash ->
+       if fv_to_string squash = flatten_name squash_qn then
+         (match inspect g with
+          | Tv_App eq_type_x (y, _) ->
+            (match inspect eq_type_x with
+             | Tv_App eq_type (x, _) ->
+               (match inspect eq_type with
+                | Tv_App eq (typ, _) ->
+                  (match inspect eq with
+                   | Tv_FVar eq ->
+                     if fv_to_string eq = flatten_name eq2_qn then
+                       (x, y)
+                     else fail "not an equality"
+                   | _ -> fail "not an app2 of fvar: ")
+                | _ -> fail "not an app3")
+             | _ -> fail "not an app2")
+          | _ -> fail "not an app under squash")
+       else fail "not a squash"
+     | _ -> fail "not an app of fvar at top level")
+  | _ -> fail "not an app at top level"
+
+

…and here's how you could use it:

+
+

let _ =

+

assert_by_tactic (1 + 1 == 2)

+

(fun () -> let l, r = fetch_eq_side () in

+

print (term_to_string l ^ " / " ^ term_to_string r))

+
+

This file defines pattern-matching primitives that let you write the same +thing like this…

+

.. code:: fstar

+

let fetch_eq_side' #a () : Tac (term * term) = +gpm (fun (left right: a) (g: pm_goal (squash (left == right))) -> +(quote left, quote right) <: Tac (term * term))

+

let _ = +assert_by_tactic (1 + 1 == 2) +(fun () -> let l, r = fetch_eq_side' #int () in +print (term_to_string l ^ " / " ^ term_to_string r))

+

…or, more succinctly, like this:

+

.. code:: fstar

+

let _ = +assert_by_tactic (1 + 1 == 2) +(gpm (fun (left right: int) (g: pm_goal (squash (left == right))) -> +let l, r = quote left, quote right in +print (term_to_string l ^ " / " ^ term_to_string r) <: Tac unit))

+
+

Many of the tactics are written in the Tac effect, which isn't +well-supported in SMT. FIXME: remove this once Tac is marked as a stable +effect. +GM: Tac is now stable, but some VCs are still tough on z3, so there are a few admit()s.

+
+

+Some utility functions

+

(Skip over this part on a quick read — these are just convenience functions)

+
+

+mustfail

Ensure that tactic t fails. *

-
let ((exact_hyp (a:Type0) (h:binder)):(Tac unit)):let  hd = quote ((FStar.Squash.return_squash #a)) in exact (mk_app hd (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 (pack ((Tv_Var (bv_of_binder h)))) Q_Explicit)) (Prims.Nil )))
+
let mustfail #a (t: unit -> Tac a) (message: string) : Tac unit =
+    match trytac t with
+    | Some _ -> fail message
+    | None -> ()
+
+

The following two tactics are needed because of issues with the Tac +effect.

+
+
let implies_intro' () : Tac unit =
+  let _ = implies_intro () in ()
+
let repeat' #a (f: unit -> Tac a) : Tac unit =
+  let _ = repeat f in ()
+
let and_elim' (h: binder) : Tac unit =
+  and_elim (pack (Tv_Var (bv_of_binder h)));
+  clear h
+

+exact_hyp

Use a hypothesis at type a to satisfy a goal at type squash a

-
let ((exact_hyp' (h:binder)):(Tac unit)):exact (pack ((Tv_Var (bv_of_binder h))))
+
let exact_hyp (a: Type0) (h: binder) : Tac unit =
+  let hd = quote (FStar.Squash.return_squash #a) in
+  exact (mk_app hd [((pack (Tv_Var (bv_of_binder h))), Q_Explicit)])
+

+exact_hyp'

Use a hypothesis h (of type a) to satisfy a goal at type a

-
let ((interp_pattern_aux (pat:pattern) (cur_bindings:bindings) (tm:term)):(Tac (match_res bindings))):admit (); let  (interp_any () cur_bindings tm) = return (Prims.Nil ) in let  (interp_var (v:varname) cur_bindings tm) = match List.Tot.assoc v cur_bindings with (Some tm')  -> if term_eq tm tm' then return cur_bindings else raise ((NonLinearMismatch ((FStar.Pervasives.Native.Mktuple3 v tm tm')))) | None  -> return ((Prims.Cons ((FStar.Pervasives.Native.Mktuple2 v tm)) cur_bindings)) in let  (interp_qn (qn:qn) cur_bindings tm) = match inspect tm with (Tv_FVar fv)  -> if =(fv_to_string fv, qn) then return cur_bindings else raise ((NameMismatch ((FStar.Pervasives.Native.Mktuple2 qn (fv_to_string fv))))) | _  -> raise ((SimpleMismatch ((FStar.Pervasives.Native.Mktuple2 pat tm)))) in let  (interp_type cur_bindings tm) = match inspect tm with (Tv_Type ())  -> return cur_bindings | _  -> raise ((SimpleMismatch ((FStar.Pervasives.Native.Mktuple2 pat tm)))) in let  (interp_app (p_hd:(p:pattern:{<<(p, pat)})) (p_arg:(p:pattern:{<<(p, pat)})) cur_bindings tm) = match inspect tm with (Tv_App hd (arg, _))  -> with_hd <- interp_pattern_aux p_hd cur_bindings hd; with_arg <- interp_pattern_aux p_arg with_hd arg; return with_arg | _  -> raise ((SimpleMismatch ((FStar.Pervasives.Native.Mktuple2 pat tm)))) in match pat with PAny  -> interp_any () cur_bindings tm | (PVar var)  -> interp_var var cur_bindings tm | (PQn qn)  -> interp_qn qn cur_bindings tm | PType  -> interp_type cur_bindings tm | (PApp p_hd p_arg)  -> interp_app p_hd p_arg cur_bindings tm | _  -> fail "?"
-

Match a pattern against a term. cur_bindings is a list of bindings collected while matching previous parts of the pattern. Returns a result in the exception monad. *

-
let ((interp_pattern (pat:pattern)):Unidentified product: [term] (Tac (match_res bindings))):(fun (tm:term) -> rev_bindings <- interp_pattern_aux pat (Prims.Nil ) tm; return (List.Tot.rev rev_bindings))
-

Match a pattern pat against a term. Returns a result in the exception monad. *

-
let ((match_term pat (tm:term)):(Tac bindings)):match interp_pattern pat (norm_term (Prims.Nil ) tm) with (Success bb)  -> bb | (Failure ex)  -> Tactics.fail (string_of_match_exception ex)
-

Match a term tm against a pattern pat. Raises an exception if the match fails. This is mostly useful for debugging: use mgw to capture matches. *

-
let ((assoc_varname_fail (#b:Type) (key:varname) (ls:list (*(varname, b)))):(Tac b)):match List.Tot.assoc key ls with None  -> fail (^("Not found: ", key)) | (Some x)  -> x
+
let exact_hyp' (h: binder): Tac unit =
+  exact (pack (Tv_Var (bv_of_binder h)))
+
+

+Pattern types

+

Patterns are defined using a simple inductive type, mirroring the structure +of term_view.

+
+
type varname = string
+
type qn = string
+
type pattern =
+| PAny: pattern
+| PVar: name: varname -> pattern
+| PQn: qn: qn -> pattern
+| PType: pattern
+| PApp: hd: pattern -> arg: pattern -> pattern
+
let desc_of_pattern = function
+| PAny -> "anything"
+| PVar _ -> "a variable"
+| PQn qn -> "a constant (" ^ qn ^ ")"
+| PType -> "Type"
+| PApp _ _ -> "a function application"
+
let rec string_of_pattern = function
+| PAny -> "__"
+| PVar x -> "?" ^ x
+| PQn qn -> qn
+| PType -> "Type"
+| PApp l r -> "(" ^ string_of_pattern l ^ " "
+                 ^ string_of_pattern r ^ ")"
+
+

+Pattern matching exceptions

+

Pattern-matching is defined as a pure, monadic function (because of issues +with combining DM4F effects, but also because it helps with debugging). +This section defines the exception monad.

+

+Types of exceptions

+
+
noeq type match_exception =
+| NameMismatch of qn * qn
+| SimpleMismatch of pattern * term
+| NonLinearMismatch of varname * term * term
+| UnsupportedTermInPattern of term
+| IncorrectTypeInAbsPatBinder of typ
+
let term_head t : Tac string =
+  match inspect t with
+  | Tv_Var bv -> "Tv_Var"
+  | Tv_BVar fv -> "Tv_BVar"
+  | Tv_FVar fv -> "Tv_FVar"
+  | Tv_App f x -> "Tv_App"
+  | Tv_Abs x t -> "Tv_Abs"
+  | Tv_Arrow x t -> "Tv_Arrow"
+  | Tv_Type () -> "Tv_Type"
+  | Tv_Refine x t -> "Tv_Refine"
+  | Tv_Const cst -> "Tv_Const"
+  | Tv_Uvar i t -> "Tv_Uvar"
+  | Tv_Let r attrs b t1 t2 -> "Tv_Let"
+  | Tv_Match t _ branches -> "Tv_Match"
+  | Tv_AscribedT _ _ _ -> "Tv_AscribedT"
+  | Tv_AscribedC _ _ _ -> "Tv_AscribedC"
+  | Tv_Unknown -> "Tv_Unknown"
+
let string_of_match_exception = function
+  | NameMismatch (qn1, qn2) ->
+    "Match failure (name mismatch): expecting " ^
+    qn1 ^ ", found " ^ qn2
+  | SimpleMismatch (pat, tm) ->
+    "Match failure (sort mismatch): expecting " ^
+    desc_of_pattern pat ^ ", got " ^ term_to_string tm
+  | NonLinearMismatch (nm, t1, t2) ->
+    "Match failure (nonlinear mismatch): variable " ^ nm ^
+    " needs to match both " ^ (term_to_string t1) ^
+    " and " ^ (term_to_string t2)
+  | UnsupportedTermInPattern tm ->
+    "Match failure (unsupported term in pattern): " ^
+    term_to_string tm ^ " (" ^ term_head tm ^ ")"
+  | IncorrectTypeInAbsPatBinder typ ->
+    "Incorrect type in pattern-matching binder: " ^
+    term_to_string typ ^ " (use one of ``var``, ``hyp …``, or ``goal …``)"
+
+

+The exception monad

+
+
noeq type match_res a =
+| Success of a
+| Failure of match_exception
+
let return #a (x: a) : match_res a =
+  Success x
+
let bind (#a #b: Type)
+         (f: match_res a)
+         (g: a -> Tac (match_res b))
+    : Tac (match_res b) =
+  match f with
+  | Success aa -> g aa
+  | Failure ex -> Failure ex
+
let raise #a (ex: match_exception) : match_res a =
+  Failure ex
+
+

+Liftings

+

There's a natural lifting from the exception monad into the tactic effect:

+
+
let lift_exn_tac #a #b (f: a -> match_res b) (aa: a) : Tac b =
+  match f aa with
+  | Success bb -> bb
+  | Failure ex -> Tactics.fail (string_of_match_exception ex)
+
let lift_exn_tactic #a #b (f: a -> match_res b) (aa: a) : Tac b =
+  match f aa with
+  | Success bb -> bb
+  | Failure ex -> Tactics.fail (string_of_match_exception ex)
+
+

+Pattern interpretation

+

This section implement pattern-matching. This is strictly a one term, one +pattern implementation — handling cases in which mutliple hypotheses match +the same pattern is done later.

+
+
type bindings = list (varname * term)
+let string_of_bindings (bindings: bindings) =
+  String.concat "\n"
+    (map (fun (nm, tm) -> (">> " ^ nm ^ ": " ^ term_to_string tm))
+                  bindings)
+

+interp_pattern_aux

+

Match a pattern against a term. +cur_bindings is a list of bindings collected while matching previous parts of +the pattern. Returns a result in the exception monad. *

+
let rec interp_pattern_aux (pat: pattern) (cur_bindings: bindings) (tm:term)
+    : Tac (match_res bindings) =
+  admit();
+  let interp_any () cur_bindings tm =
+    return [] in
+  let interp_var (v: varname) cur_bindings tm =
+    match List.Tot.Base.assoc v cur_bindings with
+    | Some tm' -> if term_eq tm tm' then return cur_bindings
+                 else raise (NonLinearMismatch (v, tm, tm'))
+    | None -> return ((v, tm) :: cur_bindings) in
+  let interp_qn (qn: qn) cur_bindings tm =
+    match inspect tm with
+    | Tv_FVar fv ->
+      if fv_to_string fv = qn then return cur_bindings
+      else raise (NameMismatch (qn, (fv_to_string fv)))
+    | _ -> raise (SimpleMismatch (pat, tm)) in
+  let interp_type cur_bindings tm =
+    match inspect tm with
+    | Tv_Type () -> return cur_bindings
+    | _ -> raise (SimpleMismatch (pat, tm)) in
+  let interp_app (p_hd p_arg: (p:pattern{p << pat})) cur_bindings tm =
+    match inspect tm with
+    | Tv_App hd (arg, _) ->
+      with_hd <-- interp_pattern_aux p_hd cur_bindings hd;
+      with_arg <-- interp_pattern_aux p_arg with_hd arg;
+      return with_arg
+    | _ -> raise (SimpleMismatch (pat, tm)) in
+    match pat with
+    | PAny -> interp_any () cur_bindings tm
+    | PVar var -> interp_var var cur_bindings tm
+    | PQn qn -> interp_qn qn cur_bindings tm
+    | PType -> interp_type cur_bindings tm
+    | PApp p_hd p_arg -> interp_app p_hd p_arg cur_bindings tm
+

GM: Jul 11 2018, sadly this is needed, seems this monad layered +on top of Tac causesq queries to be hard on Z3

+
| _ -> fail "?"
+

+interp_pattern

+

Match a pattern pat against a term. +Returns a result in the exception monad. *

+
let interp_pattern (pat: pattern) : term -> Tac (match_res bindings) =
+  fun (tm: term) ->
+    rev_bindings <-- interp_pattern_aux pat [] tm;
+    return (List.Tot.Base.rev rev_bindings)
+

+match_term

+

Match a term tm against a pattern pat. +Raises an exception if the match fails. This is mostly useful for debugging: +use mgw to capture matches. *

+
let match_term pat (tm : term) : Tac bindings =
+    match interp_pattern pat (norm_term [] tm) with
+    | Success bb -> bb
+    | Failure ex -> Tactics.fail (string_of_match_exception ex)
+
+

+Pattern-matching problems

+

Generalizing past single-term single-pattern problems, we obtain the +following notions of pattern-matching problems and solutions:

+
+
let debug msg : Tac unit = () // print msg
+
+

+Definitions

+
+
let absvar = binder
+type hypothesis = binder
+
+

A matching problem is composed of holes (mp_vars), hypothesis patterns +(mp_hyps), and a goal pattern (mp_goal).

+
+
noeq type matching_problem =
+  { mp_vars: list varname;
+    mp_hyps: list (varname * pattern);
+    mp_goal: option pattern }
+
let string_of_matching_problem mp =
+  let vars =
+    String.concat ", " mp.mp_vars in
+  let hyps =
+    String.concat "\n        "
+      (List.Tot.Base.map (fun (nm, pat) ->
+        nm ^ ": " ^ (string_of_pattern pat)) mp.mp_hyps) in
+  let goal = match mp.mp_goal with
+             | None -> "_"
+             | Some pat -> string_of_pattern pat in
+  "\n{ vars: " ^ vars ^ "\n" ^
+  "  hyps: " ^ hyps ^ "\n" ^
+  "  goal: " ^ goal ^ " }"
+
+

A solution is composed of terms captured to mach the holes, and binders +captured to match hypothesis patterns.

+
+
noeq type matching_solution =
+  { ms_vars: list (varname * term);
+    ms_hyps: list (varname * hypothesis) }
+
let string_of_matching_solution ms =
+  let vars =
+    String.concat "\n            "
+      (map (fun (varname, tm) ->
+        varname ^ ": " ^ (term_to_string tm)) ms.ms_vars) in
+  let hyps =
+    String.concat "\n        "
+      (map (fun (nm, binder) ->
+        nm ^ ": " ^ (binder_to_string binder)) ms.ms_hyps) in
+  "\n{ vars: " ^ vars ^ "\n" ^
+  "  hyps: " ^ hyps ^ " }"
+

+assoc_varname_fail

Find a varname in an association list; fail if it can't be found. *

-
let ((solve_mp_for_single_hyp #a (name:varname) (pat:pattern) (hypotheses:list hypothesis) (body:Unidentified product: [matching_solution] (Tac a)) (part_sol:matching_solution)):(Tac a)):match hypotheses with []  -> fail #a "No matching hypothesis" | (Prims.Cons h hs)  -> or_else ((fun () -> match interp_pattern_aux pat part_sol.ms_vars (type_of_binder h) with (Failure ex)  -> fail (^("Failed to match hyp: ", (string_of_match_exception ex))) | (Success bindings)  -> let  ms_hyps = (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 name h)) part_sol.ms_hyps) in body ({part_sol with ms_vars=bindings ms_hyps=ms_hyps}))) ((fun () -> solve_mp_for_single_hyp name pat hs body part_sol))
+
let assoc_varname_fail (#b: Type) (key: varname) (ls: list (varname * b))
+    : Tac b =
+  match List.Tot.Base.assoc key ls with
+  | None -> fail ("Not found: " ^ key)
+  | Some x -> x
+
let ms_locate_hyp (a: Type) (solution: matching_solution)
+                  (name: varname) : Tac binder =
+  assoc_varname_fail name solution.ms_hyps
+
let ms_locate_var (a: Type) (solution: matching_solution)
+                  (name: varname) : Tac a =
+  unquote #a (assoc_varname_fail name solution.ms_vars)
+
let ms_locate_unit (a: Type) _solution _binder_name : Tac unit =
+  ()
+
+

+Resolution

+

Solving a matching problem is a two-steps process: find an initial +assignment for holes based on the goal pattern, then find a set of +hypotheses matching hypothesis patterns.

+

Note that the implementation takes a continuation of type +matching_solution -> Tac a. This continuation is needed because we want +users to be able to provide extra criteria on matching solutions (most +commonly, this criterion is that a particular tactic should run +successfuly).

+

This makes it easy to implement a simple for of search through the context, +where one can find a hypothesis matching a particular predicate by +constructing a trivial matching problem and passing the predicate as the +continuation.

+
+

+solve_mp_for_single_hyp

Scan hypotheses for a match for pat that lets body succeed.

-

name is used to refer to the hypothesis matched in the final solution. part_sol includes bindings gathered while matching previous solutions. *

-
let ((solve_mp_for_hyps #a (mp_hyps:list (*(varname, pattern))) (hypotheses:list hypothesis) (body:Unidentified product: [matching_solution] (Tac a)) (partial_solution:matching_solution)):(Tac a)):match mp_hyps with []  -> body partial_solution | (Prims.Cons (name, pat) pats)  -> solve_mp_for_single_hyp name pat hypotheses (solve_mp_for_hyps pats hypotheses body) partial_solution
-

Scan hypotheses for matches for mp_hyps that lets body succeed. *

-
let ((solve_mp #a (problem:matching_problem) (hypotheses:binders) (goal:term) (body:Unidentified product: [matching_solution] (Tac a))):(Tac a)):let  goal_ps = match problem.mp_goal with None  -> {ms_vars=(Prims.Nil ) ms_hyps=(Prims.Nil )} | (Some pat)  -> match interp_pattern pat goal with (Failure ex)  -> fail (^("Failed to match goal: ", (string_of_match_exception ex))) | (Success bindings)  -> {ms_vars=bindings ms_hyps=(Prims.Nil )} in solve_mp_for_hyps #a problem.mp_hyps hypotheses body goal_ps
+
let rec solve_mp_for_single_hyp #a
+                                (name: varname)
+                                (pat: pattern)
+                                (hypotheses: list hypothesis)
+                                (body: matching_solution -> Tac a)
+                                (part_sol: matching_solution)
+    : Tac a =
+  match hypotheses with
+  | [] ->
+    fail #a "No matching hypothesis"
+  | h :: hs ->
+    or_else // Must be in ``Tac`` here to run `body`
+      (fun () ->
+         match interp_pattern_aux pat part_sol.ms_vars (type_of_binder h) with
+         | Failure ex ->
+           fail ("Failed to match hyp: " ^ (string_of_match_exception ex))
+         | Success bindings ->
+           let ms_hyps = (name, h) :: part_sol.ms_hyps in
+           body ({ part_sol with ms_vars = bindings; ms_hyps = ms_hyps }))
+      (fun () ->
+         solve_mp_for_single_hyp name pat hs body part_sol)
+

name is used to refer to the hypothesis matched in the final solution. +part_sol includes bindings gathered while matching previous solutions. *

+

+solve_mp_for_hyps

+

Scan hypotheses for matches for mp_hyps that lets body +succeed. *

+
let rec solve_mp_for_hyps #a
+                          (mp_hyps: list (varname * pattern))
+                          (hypotheses: list hypothesis)
+                          (body: matching_solution -> Tac a)
+                          (partial_solution: matching_solution)
+    : Tac a =
+  match mp_hyps with
+  | [] -> body partial_solution
+  | (name, pat) :: pats ->
+    solve_mp_for_single_hyp name pat hypotheses
+      (solve_mp_for_hyps pats hypotheses body)
+      partial_solution
+

+solve_mp

Solve a matching problem.

-

The solution returned is constructed to ensure that the continuation body succeeds: this implements the usual backtracking-match semantics. *

-
let ((pattern_of_term_ex tm):(Tac (match_res pattern))):match inspect tm with (Tv_Var bv)  -> return ((PVar (name_of_bv bv))) | (Tv_FVar fv)  -> let  qn = fv_to_string fv in return (if =(qn, any_qn) then PAny else (PQn qn)) | (Tv_Type ())  -> return PType | (Tv_App f (x, _))  -> let  is_any = match inspect f with (Tv_FVar fv)  -> =(fv_to_string fv, any_qn) | _  -> false in if is_any then return PAny else (fpat <- pattern_of_term_ex f; xpat <- pattern_of_term_ex x; return ((PApp fpat xpat))) | _  -> raise ((UnsupportedTermInPattern tm))
+
let solve_mp #a (problem: matching_problem)
+                (hypotheses: binders) (goal: term)
+                (body: matching_solution -> Tac a)
+    : Tac a =
+  let goal_ps =
+    match problem.mp_goal with
+    | None -> { ms_vars = []; ms_hyps = [] }
+    | Some pat ->
+      match interp_pattern pat goal with
+      | Failure ex -> fail ("Failed to match goal: " ^ (string_of_match_exception ex))
+      | Success bindings -> { ms_vars = bindings; ms_hyps = [] } in
+  solve_mp_for_hyps #a problem.mp_hyps hypotheses body goal_ps
+

The solution returned is constructed to ensure that the continuation body +succeeds: this implements the usual backtracking-match semantics. *

+
+

+A DSL for pattern-matching

+

Using pattern-matching problems as defined above is relatively cumbersome, +so we now introduce a lightweight notation, in two steps: pattern notations, +and matching-problem notations.

+

+Pattern notations

+

The first part of our pattern-matching syntax is pattern notations: we +provide a reflective function which constructs a pattern from a term: +variables are holes, free variables are constants, and applications are +application patterns.

+
+

This is a hack to allow users to capture anything.

+
assume val __ : #t:Type -> t
+let any_qn = `%__
+

+pattern_of_term_ex

Compile a term tm into a pattern. *

-
let ((beta_reduce (tm:term)):(Tac term)):norm_term (Prims.Nil ) tm
-

β-reduce a term tm. This is useful to remove needles function applications introduced by F, like (fun a b c -> a) 1 2 3.

-
let ((pattern_of_term tm):(Tac pattern)):match pattern_of_term_ex tm with (Success bb)  -> bb | (Failure ex)  -> Tactics.fail (string_of_match_exception ex)
+
let rec pattern_of_term_ex tm : Tac (match_res pattern) =
+  match inspect tm with
+  | Tv_Var bv ->
+    return (PVar (name_of_bv bv))
+  | Tv_FVar fv ->
+    let qn = fv_to_string fv in
+    return (if qn = any_qn then PAny else PQn qn)
+  | Tv_Type () ->
+    return PType
+  | Tv_App f (x, _) ->
+    let is_any = match inspect f with
+                 | Tv_FVar fv -> fv_to_string fv = any_qn
+                 | _ -> false in
+    if is_any then
+      return PAny
+    else
+      (fpat <-- pattern_of_term_ex f;
+       xpat <-- pattern_of_term_ex x;
+       return (PApp fpat xpat))
+  | _ -> raise (UnsupportedTermInPattern tm)
+

+beta_reduce

+

β-reduce a term tm. +This is useful to remove needles function applications introduced by F*, like +(fun a b c -> a) 1 2 3. *

+
let beta_reduce (tm: term) : Tac term =
+  norm_term [] tm
+

+pattern_of_term

Compile a term tm into a pattern. *

-
let ((binders_and_body_of_abs tm):(Tac (*(binders, term)))):match inspect tm with (Tv_Abs binder tm)  -> let  (binders, body) = binders_and_body_of_abs tm in (FStar.Pervasives.Native.Mktuple2 (Prims.Cons binder binders) body) | _  -> (FStar.Pervasives.Native.Mktuple2 (Prims.Nil ) tm)
+
let pattern_of_term tm : Tac pattern =
+    match pattern_of_term_ex tm with
+    | Success bb -> bb
+    | Failure ex -> Tactics.fail (string_of_match_exception ex)
+
+

+Problem notations

+

We then introduce a DSL for matching problems, best explained on the +following example::

+

(fun (a b c: ①) (h1 h2 h3: hyp ②) (g: pm_goal ③) → ④)

+

This notation is intended to express a pattern-matching problems with three +holes a, b, and c of type â‘ , matching hypotheses h1, h2, +and h3 against pattern â‘¡ and the goal against the pattern â‘¢. The body +of the notation (â‘£) is then run with appropriate terms bound to a, +b, and c, appropriate binders bound to h1, h2, and h3, +and () bound to g.

+

We call these patterns abspats (abstraction patterns), and we provide +facilities to parse them into matching problems, and to run their bodies +against a particular matching solution.

+
+

We used to annotate variables with an explicit 'var' marker, but then that +var annotation leaked into the types of other hypotheses due to type +inference, requiring non-trivial normalization.

+

let var (a: Type) = a

+
let hyp (a: Type) = binder
+let pm_goal (a: Type) = unit
+
let hyp_qn  = `%hyp
+let goal_qn = `%pm_goal
+
noeq type abspat_binder_kind =
+| ABKVar of typ
+| ABKHyp
+| ABKGoal
+
let string_of_abspat_binder_kind = function
+  | ABKVar _ -> "varname"
+  | ABKHyp -> "hyp"
+  | ABKGoal -> "goal"
+
noeq type abspat_argspec =
+  { asa_name: absvar;
+    asa_kind: abspat_binder_kind }
+

We must store this continuation, because recomputing it yields different +names when the binders are re-opened.

+
type abspat_continuation =
+  list abspat_argspec * term
+
let classify_abspat_binder binder : Tac (abspat_binder_kind * term) =
+  let varname = "v" in
+  let hyp_pat = PApp (PQn hyp_qn) (PVar varname) in
+  let goal_pat = PApp (PQn goal_qn) (PVar varname) in
+
let typ = type_of_binder binder in
+match interp_pattern hyp_pat typ with
+| Success [(_, hyp_typ)] -> ABKHyp, hyp_typ
+| Success _ -> fail "classifiy_abspat_binder: impossible (1)"
+| Failure _ ->
+  match interp_pattern goal_pat typ with
+  | Success [(_, goal_typ)] -> ABKGoal, goal_typ
+  | Success _ -> fail "classifiy_abspat_binder: impossible (2)"
+  | Failure _ -> ABKVar typ, typ
+

+binders_and_body_of_abs

Split an abstraction tm into a list of binders and a body. *

-
let ((matching_problem_of_abs (tm:term)):(Tac (*(matching_problem, abspat_continuation)))):let  (binders, body) = binders_and_body_of_abs (cleanup_abspat tm) in debug (^("Got binders: ", (String.concat ", " (map ((fun b -> (name_of_binder b : (Tac string)))) binders)))); let  classified_binders = map ((fun binder -> let  bv_name = name_of_binder binder in debug (^("Got binder: ", ^(bv_name, ^("; type is ", term_to_string (type_of_binder binder))))); let  (binder_kind, typ) = classify_abspat_binder binder in ((FStar.Pervasives.Native.Mktuple4 binder bv_name binder_kind typ)))) binders in let  problem = fold_left ((fun problem (binder, bv_name, binder_kind, typ) -> debug (^("Compiling binder ", ^(name_of_binder binder, ^(", classified as ", ^(string_of_abspat_binder_kind binder_kind, ^(", with type ", term_to_string typ)))))); match binder_kind with (ABKVar _)  -> {problem with mp_vars=(Prims.Cons bv_name problem.mp_vars)} | ABKHyp  -> {problem with mp_hyps=(Prims.Cons ((FStar.Pervasives.Native.Mktuple2 bv_name (pattern_of_term typ))) problem.mp_hyps)} | ABKGoal  -> {problem with mp_goal=(Some (pattern_of_term typ))})) ({mp_vars=(Prims.Nil ) mp_hyps=(Prims.Nil ) mp_goal=None}) classified_binders in let  continuation = let  ((abspat_argspec_of_binder xx):(Tac abspat_argspec)) = match xx with (binder, xx, binder_kind, yy)  -> {asa_name=binder asa_kind=binder_kind} in ((FStar.Pervasives.Native.Mktuple2 map abspat_argspec_of_binder classified_binders tm)) in let  mp = {mp_vars=List.rev #varname problem.mp_vars mp_hyps=List.rev #(*(varname, pattern)) problem.mp_hyps mp_goal=problem.mp_goal} in debug (^("Got matching problem: ", (string_of_matching_problem mp))); (FStar.Pervasives.Native.Mktuple2 mp continuation)
+
let rec binders_and_body_of_abs tm : Tac (binders * term) =
+  match inspect tm with
+  | Tv_Abs binder tm ->
+    let binders, body = binders_and_body_of_abs tm in
+    binder :: binders, body
+  | _ -> [], tm
+
let cleanup_abspat (t: term) : Tac term =
+  norm_term [] t
+

+matching_problem_of_abs

Parse a notation into a matching problem and a continuation.

-

Pattern-matching notations are of the form (fun binders… -> continuation), where binders are of one of the forms var …, hyp …, or goal …. var binders are typed holes to be used in other binders; hyp binders indicate a pattern to be matched against hypotheses; and goal binders match the goal.

-

A reduction phase is run to ensure that the pattern looks reasonable; it is needed because F* tends to infer arguments in β-expanded form.

-

The continuation returned can't directly be applied to a pattern-matching solution; see interp_abspat_continuation below for that. *

-
let ((arg_type_of_binder_kind binder_kind):(Tac term)):match binder_kind with (ABKVar typ)  -> typ | ABKHyp  -> (`(binder)) | ABKGoal  -> (`(unit))
+
let matching_problem_of_abs (tm: term)
+    : Tac (matching_problem * abspat_continuation) =
+

Pattern-matching notations are of the form (fun binders… -> continuation), +where binders are of one of the forms var …, hyp …, or goal …. +var binders are typed holes to be used in other binders; hyp binders +indicate a pattern to be matched against hypotheses; and goal binders match +the goal.

+

A reduction phase is run to ensure that the pattern looks reasonable; it is +needed because F* tends to infer arguments in β-expanded form.

+

The continuation returned can't directly be applied to a pattern-matching +solution; see [interp_abspat_continuation](#interp_abspat_continuation) below for that. *

+
let binders, body = binders_and_body_of_abs (cleanup_abspat tm) in
+debug ("Got binders: " ^ (String.concat ", "
+       (map (fun b -> name_of_binder b <: Tac string) binders)));
+
let classified_binders =
+  map (fun binder ->
+      let bv_name = name_of_binder binder in
+      debug ("Got binder: " ^ bv_name ^ "; type is " ^
+             term_to_string (type_of_binder binder));
+      let binder_kind, typ = classify_abspat_binder binder in
+      (binder, bv_name, binder_kind, typ))
+    binders in
+
let problem =
+  fold_left
+    (fun problem (binder, bv_name, binder_kind, typ) ->
+       debug ("Compiling binder " ^ name_of_binder binder ^
+              ", classified as " ^ string_of_abspat_binder_kind binder_kind ^
+              ", with type " ^ term_to_string typ);
+       match binder_kind with
+       | ABKVar _ -> { problem with mp_vars = bv_name :: problem.mp_vars }
+       | ABKHyp -> { problem with mp_hyps = (bv_name, (pattern_of_term typ))
+                                           :: problem.mp_hyps }
+       | ABKGoal -> { problem with mp_goal = Some (pattern_of_term typ) })
+    ({ mp_vars = []; mp_hyps = []; mp_goal = None })
+    classified_binders in
+
let continuation =
+  let abspat_argspec_of_binder xx : Tac abspat_argspec =
+  match xx with | (binder, xx, binder_kind, yy)  ->
+    { asa_name = binder; asa_kind = binder_kind } in
+  (map abspat_argspec_of_binder classified_binders, tm) in
+
let mp =
+  { mp_vars = List.Tot.Base.rev #varname problem.mp_vars;
+    mp_hyps = List.Tot.Base.rev #(varname * pattern) problem.mp_hyps;
+    mp_goal = problem.mp_goal } in
+
debug ("Got matching problem: " ^ (string_of_matching_problem mp));
+mp, continuation
+
+

+Continuations

+

Parsing an abspat yields a matching problem and a continuation of type +abspat_continuation, which is essentially just a list of binders and a +term (the body of the abstraction pattern).

+
+

+arg_type_of_binder_kind

Get the (quoted) type expected by a specific kind of abspat binder. *

-
let (locate_fn_of_binder_kind binder_kind):match binder_kind with (ABKVar _)  -> (`(ms_locate_var)) | ABKHyp  -> (`(ms_locate_hyp)) | ABKGoal  -> (`(ms_locate_unit))
+
let arg_type_of_binder_kind binder_kind : Tac term =
+  match binder_kind with
+  | ABKVar typ -> typ
+  | ABKHyp -> `binder
+  | ABKGoal -> `unit
+

+locate_fn_of_binder_kind

Retrieve the function used to locate a value for a given abspat binder. *

-
let ((abspat_arg_of_abspat_argspec solution_term (argspec:abspat_argspec)):(Tac term)):let  loc_fn = locate_fn_of_binder_kind argspec.asa_kind in let  name_tm = pack ((Tv_Const ((C_String (name_of_binder argspec.asa_name))))) in let  locate_args = (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 arg_type_of_binder_kind argspec.asa_kind Q_Explicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 solution_term Q_Explicit)) (Prims.Cons ((FStar.Pervasives.Native.Mktuple2 name_tm Q_Explicit)) (Prims.Nil )))) in mk_app loc_fn locate_args
-

Construct a term fetching the value of an abspat argument from a quoted matching solution solution_term. *

-
let ((specialize_abspat_continuation' (continuation:abspat_continuation) (solution_term:term)):(Tac term)):let  (mk_arg argspec) = ((FStar.Pervasives.Native.Mktuple2 abspat_arg_of_abspat_argspec solution_term argspec Q_Explicit)) in let  (argspecs, body) = continuation in mk_app body (map mk_arg argspecs)
-

Specialize a continuation of type abspat_continuation. This constructs a fully applied version of continuation, but it requires a quoted solution to be passed in. *

-
let ((specialize_abspat_continuation (continuation:abspat_continuation)):(Tac term)):let  solution_binder = fresh_binder ((`(matching_solution))) in let  solution_term = pack ((Tv_Var (bv_of_binder solution_binder))) in let  applied = specialize_abspat_continuation' continuation solution_term in let  thunked = pack ((Tv_Abs solution_binder applied)) in debug (^("Specialized into ", (term_to_string thunked))); let  normalized = beta_reduce thunked in debug (^("… which reduces to ", (term_to_string normalized))); thunked
-

Specialize a continuation of type abspat_continuation. This yields a quoted function taking a matching solution and running its body with appropriate bindings. *

-
let ((interp_abspat_continuation (a:Type0) (continuation:abspat_continuation)):(Tac (Unidentified product: [matching_solution] (Tac a)))):let  applied = specialize_abspat_continuation continuation in unquote #(Unidentified product: [matching_solution] (Tac a)) applied
-

Interpret a continuation of type abspat_continuation. This yields a function taking a matching solution and running the body of the continuation with appropriate bindings. *

-
let ((interp_abspat #a (abspat:a)):(Tac (*(matching_problem, abspat_continuation)))):matching_problem_of_abs (quote (abspat))
+
let locate_fn_of_binder_kind binder_kind =
+  match binder_kind with
+  | ABKVar _ -> `ms_locate_var
+  | ABKHyp   -> `ms_locate_hyp
+  | ABKGoal  -> `ms_locate_unit
+

+abspat_arg_of_abspat_argspec

+

Construct a term fetching the value of an abspat argument from a quoted +matching solution solution_term. *

+
let abspat_arg_of_abspat_argspec solution_term (argspec: abspat_argspec)
+    : Tac term =
+  let loc_fn = locate_fn_of_binder_kind argspec.asa_kind in
+  let name_tm = pack (Tv_Const (C_String (name_of_binder argspec.asa_name))) in
+  let locate_args = [(arg_type_of_binder_kind argspec.asa_kind, Q_Explicit);
+                     (solution_term, Q_Explicit); (name_tm, Q_Explicit)] in
+  mk_app loc_fn locate_args
+

+specialize_abspat_continuation'

+

Specialize a continuation of type abspat_continuation. +This constructs a fully applied version of continuation, but it requires a +quoted solution to be passed in. *

+
let specialize_abspat_continuation' (continuation: abspat_continuation)
+                                    (solution_term:term)
+    : Tac term =
+  let mk_arg argspec =
+    (abspat_arg_of_abspat_argspec solution_term argspec, Q_Explicit) in
+  let argspecs, body = continuation in
+  mk_app body (map mk_arg argspecs)
+

+specialize_abspat_continuation

+

Specialize a continuation of type abspat_continuation. This yields a +quoted function taking a matching solution and running its body with appropriate +bindings. *

+
let specialize_abspat_continuation (continuation: abspat_continuation)
+    : Tac term =
+  let solution_binder = fresh_binder (`matching_solution) in
+  let solution_term = pack (Tv_Var (bv_of_binder solution_binder)) in
+  let applied = specialize_abspat_continuation' continuation solution_term in
+  let thunked = pack (Tv_Abs solution_binder applied) in
+  debug ("Specialized into " ^ (term_to_string thunked));
+  let normalized = beta_reduce thunked in
+  debug ("… which reduces to " ^ (term_to_string normalized));
+  thunked
+

+interp_abspat_continuation

+

Interpret a continuation of type abspat_continuation. +This yields a function taking a matching solution and running the body of the +continuation with appropriate bindings. *

+
let interp_abspat_continuation (a:Type0) (continuation: abspat_continuation)
+    : Tac (matching_solution -> Tac a) =
+  let applied = specialize_abspat_continuation continuation in
+  unquote #(matching_solution -> Tac a) applied
+
+

+Putting it all together

+

We now have all we need to use pattern-matching, short of a few convenience functions:

+
+

+interp_abspat

Construct a matching problem from an abspat. *

-
let ((match_abspat #b #a (abspat:a) (k:Unidentified product: [abspat_continuation] (Tac (Unidentified product: [matching_solution] (Tac b))))):(Tac b)):let  goal = cur_goal () in let  hypotheses = binders_of_env (cur_env ()) in let  (problem, continuation) = interp_abspat abspat in admit (); solve_mp #matching_solution problem hypotheses goal (k continuation)
-

Construct an solve a matching problem. This higher-order function isn't very usable on its own — it's mostly a convenience function to avoid duplicating the problem-parsing code. *

-
let ((inspect_abspat_problem #a (abspat:a)):(Tac matching_problem)):fst (interp_abspat #a abspat)
+
let interp_abspat #a (abspat: a)
+    : Tac (matching_problem * abspat_continuation) =
+  matching_problem_of_abs (quote abspat)
+

+match_abspat

+

Construct an solve a matching problem. +This higher-order function isn't very usable on its own — it's mostly a +convenience function to avoid duplicating the problem-parsing code. *

+
let match_abspat #b #a (abspat: a)
+                 (k: abspat_continuation -> Tac (matching_solution -> Tac b))
+    : Tac b =
+  let goal = cur_goal () in
+  let hypotheses = binders_of_env (cur_env ()) in
+  let problem, continuation = interp_abspat abspat in
+  admit();  //NS: imprecision in the encoding of the impure result function type
+  solve_mp #matching_solution problem hypotheses goal (k continuation)
+

+inspect_abspat_problem

Inspect the matching problem produced by parsing an abspat. *

-
let ((inspect_abspat_solution #a (abspat:a)):(Tac matching_solution)):match_abspat abspat ((fun _ -> (((fun solution -> solution)) : (Tac _))))
+
let inspect_abspat_problem #a (abspat: a) : Tac matching_problem =
+  fst (interp_abspat #a abspat)
+

+inspect_abspat_solution

Inspect the matching solution produced by parsing and solving an abspat. *

-
let ((gpm #b #a (abspat:a) ()):(Tac b)):let  (continuation, solution) = match_abspat abspat tpair in interp_abspat_continuation b continuation solution
-

Solve a greedy pattern-matching problem and run its continuation. This if for pattern-matching problems in the Tac effect. *

-
let ((pm #b #a (abspat:a)):(Tac b)):match_abspat abspat (interp_abspat_continuation b)
-

Solve a greedy pattern-matching problem and run its continuation. This if for pattern-matching problems in the Tac effect. *

+
let inspect_abspat_solution #a (abspat: a) : Tac matching_solution =
+  match_abspat abspat (fun _ -> (fun solution -> solution <: Tac _) <: Tac _)
+
let tpair #a #b (x : a) : Tac (b -> Tac (a * b)) =
+  fun (y: b) -> (x, y)
+
+

Our first convenient entry point!

+

This takes an abspat, parses it, computes a solution, and runs the body of +the abspat with appropriate bindings. It implements what others call ‘lazy’ +pattern-matching, so called because the success of the body of the pattern +isn't taken into account when deciding whether a particular set of matched +hypothesis should be retained. In other words, it picks the first matching +set of hypotheses, and commits to it.

+

If you think that sounds like a greedy algorithm, it does. That's why it's +called ‘gpm’ below: greedy pattern-matching.

+
+

+gpm

+

Solve a greedy pattern-matching problem and run its continuation. +This if for pattern-matching problems in the Tac effect. *

+
let gpm #b #a (abspat: a) () : Tac b =
+  let continuation, solution = match_abspat abspat tpair in
+  interp_abspat_continuation b continuation solution
+
+

And here's the non-greedy version of the same. It's informative to compare +the implementations! This one will only find assignments that let the body +run successfuly.

+
+

+pm

+

Solve a greedy pattern-matching problem and run its continuation. +This if for pattern-matching problems in the Tac effect. *

+
let pm #b #a (abspat: a) : Tac b =
+  match_abspat abspat (interp_abspat_continuation b)
+
+

+Examples

+

We conclude with a small set of examples.

+
+
+

+Simple examples

+

Here's the example from the intro, which we can now run!

+
+
let fetch_eq_side' #a : Tac (term * term) =
+  gpm (fun (left right: a) (g: pm_goal (squash (left == right))) ->
+         (quote left, quote right)) ()
+

TODO: GM: The following definition breaks extraction with

+

FStar.Tactics.Effect.fst(20,16-20,21): (Error 76) Ill-typed application: application is FStar.Tactics.PatternMatching.fetch_eq_side' (FStar.Tactics.Types.incr_depth (FStar.Tactics.Types.set_proofstate_range +ps +(FStar.Range.prims_to_fstar_range FStar.Tactics.PatternMatching.fst(811,26-811,45)))) +remaining args are FStar.Tactics.Types.incr_depth (FStar.Tactics.Types.set_proofstate_range ps +(FStar.Range.prims_to_fstar_range FStar.Tactics.PatternMatching.fst(811,26-811,45))) +ml type of head is (FStar_Reflection_Types.term * FStar_Reflection_Types.term)

+

let _ =

+

assert_by_tactic (1 + 1 == 2)

+

(fun () -> let l, r = fetch_eq_side' #int in

+

print (term_to_string l ^ " / " ^ term_to_string r))

+

let _ =

+

assert_by_tactic (1 + 1 == 2)

+

(gpm (fun (left right: int) (g: pm_goal (squash (left == right))) ->

+

let l, r = quote left, quote right in

+

print (term_to_string l ^ " / " ^ term_to_string r) <: Tac unit))

+
+

Commenting out the following example and comparing [pm](#pm) and [gpm](#gpm) can be +instructive:

+
+

let test_bt (a: Type0) (b: Type0) (c: Type0) (d: Type0) = +assert_by_tactic ((a ==> d) ==> (b ==> d) ==> (c ==> d) ==> a ==> d) +(fun () -> repeat' implies_intro'; +gpm (fun (a b: Type0) (h: hyp (a ==> b)) -> +print (binder_to_string h); +fail "fail here" <: Tac unit); +qed ())

+
+

+A real-life example

+

The following tactics combines mutliple simple building blocks to solve a +goal. Each use of lpm recognizes a specific pattern; and each tactic is +tried in succession, until one succeeds. The whole process is repeated as +long as at least one tactic succeeds.

+
+
let example (#a:Type0) (#b:Type0) (#c:Type0) :unit =
+  assert_by_tactic (a /\ b ==> c == b ==> c)
+    (fun () -> repeat' (fun () ->
+                 gpm #unit (fun (a: Type) (h: hyp (squash a)) ->
+                              clear h <: Tac unit) `or_else`
+                 (fun () -> gpm #unit (fun (a b: Type0) (g: pm_goal (squash (a ==> b))) ->
+                              implies_intro' () <: Tac unit) `or_else`
+                 (fun () -> gpm #unit (fun (a b: Type0) (h: hyp (a /\ b)) ->
+                              and_elim' h <: Tac unit) `or_else`
+                 (fun () -> gpm #unit (fun (a b: Type0) (h: hyp (a == b)) (g: pm_goal (squash a)) ->
+                              rewrite h <: Tac unit) `or_else`
+                 (fun () -> gpm #unit (fun (a: Type0) (h: hyp a) (g: pm_goal (squash a)) ->
+                              exact_hyp a h <: Tac unit) ())))));
+               qed ())
+
+

+Possible extensions

+

The following tasks would make for interesting extensions of this +experiment:

+ +
+ diff --git a/docs/FStar.Tactics.Print.html b/docs/FStar.Tactics.Print.html new file mode 100644 index 0000000..31bfd06 --- /dev/null +++ b/docs/FStar.Tactics.Print.html @@ -0,0 +1,89 @@ + + + + + FStar.Tactics.Print + + + +

+FStar.Tactics.Print

+ +
private
+let paren (s:string) : string = "(" ^ s ^ ")"
+

TODO: making this a local definition in print_list fails to extract.

+
private
+let rec print_list_aux (f:'a -> Tac string) (xs:list 'a) : Tac string =
+  match xs with
+  | [] -> ""
+  | [x] -> f x
+  | x::xs -> f x ^ "; " ^ print_list_aux f xs
+
private
+let print_list (f:'a -> Tac string) (l:list 'a) : Tac string =
+   "[" ^ print_list_aux f l ^ "]"
+
let rec term_to_ast_string (t:term) : Tac string =
+  match inspect t with
+  | Tv_Var bv -> "Tv_Var " ^ bv_to_string bv
+  | Tv_BVar bv -> "Tv_BVar " ^ bv_to_string bv
+  | Tv_FVar fv -> "Tv_FVar " ^ fv_to_string fv
+  | Tv_App hd (a, _) -> "Tv_App " ^ paren (term_to_ast_string hd ^ ", " ^ term_to_ast_string a)
+  | Tv_Abs x e -> "Tv_Abs " ^ paren (binder_to_string x ^ ", " ^ term_to_ast_string e)
+  | Tv_Arrow x c -> "Tv_Arrow " ^ paren (binder_to_string x ^ ", " ^ comp_to_ast_string c)
+  | Tv_Type _ -> "Type"
+  | Tv_Refine x e -> "Tv_Refine " ^ paren (bv_to_string x ^ ", " ^ term_to_ast_string e)
+  | Tv_Const c -> const_to_ast_string c
+  | Tv_Uvar i _ -> "Tv_Uvar " ^ string_of_int i
+  | Tv_Let recf _ x e1 e2 ->
+           "Tv_Let " ^ paren (string_of_bool recf ^ ", " ^
+                              bv_to_string x ^ ", " ^
+                              term_to_ast_string e1 ^ ", " ^
+                              term_to_ast_string e2)
+  | Tv_Match e ret_opt brs ->
+    let tacopt_to_string tacopt : Tac string =
+      match tacopt with
+      | None -> ""
+      | Some tac -> " by " ^ (term_to_ast_string tac) in
+    "Tv_Match " ^
+      paren (
+        term_to_ast_string e ^
+        ", " ^
+        (match ret_opt with
+         | None -> "None"
+         | Some (Inl t, tacopt) -> (term_to_ast_string t) ^ (tacopt_to_string tacopt)
+         | Some (Inr c, tacopt) -> (comp_to_ast_string c) ^ (tacopt_to_string tacopt)) ^
+        ", " ^
+        branches_to_ast_string brs)
+  | Tv_AscribedT e t _ -> "Tv_AscribedT " ^ paren (term_to_ast_string e ^ ", " ^ term_to_ast_string t)
+  | Tv_AscribedC e c _ -> "Tv_AscribedC " ^ paren (term_to_ast_string e ^ ", " ^ comp_to_ast_string c)
+  | Tv_Unknown -> "_"
+
and branches_to_ast_string (brs:list branch) : Tac string =
+  print_list branch_to_ast_string brs
+
and branch_to_ast_string (b:branch) : Tac string =
+  let p, e = b in
+  paren ("_pat, " ^ term_to_ast_string e)
+
and comp_to_ast_string (c:comp) : Tac string =
+  match inspect_comp c with
+  | C_Total t _ -> "Tot " ^ term_to_ast_string t
+  | C_GTotal t _ -> "GTot " ^ term_to_ast_string t
+  | C_Lemma pre post _ -> "Lemma " ^ term_to_ast_string pre ^ " " ^ term_to_ast_string post
+  | C_Eff _ eff res _ -> "Effect " ^ paren (implode_qn eff ^ ", " ^ term_to_ast_string res)
+
and const_to_ast_string (c:vconst) : Tac string =
+  match c with
+  | C_Unit -> "C_Unit"
+  | C_Int i -> "C_Int " ^ string_of_int i
+  | C_True -> "C_True"
+  | C_False -> "C_False"
+  | C_String s -> "C_String " ^ s
+  | C_Range _ -> "C_Range _"
+  | C_Reify -> "C_Reify"
+  | C_Reflect name -> "C_Reflect " ^ implode_qn name
+ + + diff --git a/docs/FStar.Tactics.Result.html b/docs/FStar.Tactics.Result.html index 64a614e..9053cdb 100644 --- a/docs/FStar.Tactics.Result.html +++ b/docs/FStar.Tactics.Result.html @@ -1,16 +1,31 @@ - - + + - - - - - + FStar.Tactics.Result + -

module FStar.Tactics.Result

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Result

+

This file is never extracted. It's a copy of the one with the same name in +the compiler. It lives here so that one doesn't need to adjust their load +path to use tactics from ulib.

+ +
noeq type __result a =
+    | Success : v:a -> ps:proofstate -> __result a
+    | Failed  : exn:exn         (* Error *)
+              -> ps:proofstate  (* The proofstate at time of failure *)
+              -> __result a
+

A bit of help for the SMT, unsure if still needed

+
let result_split #a (r:__result a)
+  : Lemma (Success? r \/ Failed? r)
+          [SMTPat (Success? r); SMTPat (Failed? r)]
+  = ()
+ diff --git a/docs/FStar.Tactics.Simplifier.html b/docs/FStar.Tactics.Simplifier.html index 655f50f..cc00322 100644 --- a/docs/FStar.Tactics.Simplifier.html +++ b/docs/FStar.Tactics.Simplifier.html @@ -1,16 +1,240 @@ - - + + - - - - - + FStar.Tactics.Simplifier + -

module FStar.Tactics.Simplifier

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Simplifier

+ +

A correct-by-construction logical simplifier +*

+ +
val lem_iff_refl : #a:Type -> Lemma (a <==> a)
+let lem_iff_refl #a = ()
+
val lem_iff_trans : #a:Type -> #b:Type -> #c:Type -> squash (a <==> b) -> squash (b <==> c)
+                                                            -> Lemma (a <==> c)
+let lem_iff_trans #a #b #c _ _ = ()
+
let tiff () : Tac unit =
+    apply_lemma (`lem_iff_refl)
+
let step () : Tac unit =
+    apply_lemma (`lem_iff_trans)
+
val lem_true_and_p : #p:Type -> Lemma ((True /\ p) <==> p)
+let lem_true_and_p #p = ()
+
val lem_p_and_true : #p:Type -> Lemma ((p /\ True) <==> p)
+let lem_p_and_true #p = ()
+
val lem_false_and_p : #p:Type -> Lemma ((False /\ p) <==> False)
+let lem_false_and_p #p = ()
+
val lem_p_and_false : #p:Type -> Lemma ((p /\ False) <==> False)
+let lem_p_and_false #p = ()
+
val lem_true_or_p : #p:Type -> Lemma ((True \/ p) <==> True)
+let lem_true_or_p #p = ()
+
val lem_p_or_true : #p:Type -> Lemma ((p \/ True) <==> True)
+let lem_p_or_true #p = ()
+
val lem_false_or_p : #p:Type -> Lemma ((False \/ p) <==> p)
+let lem_false_or_p #p = ()
+
val lem_p_or_false : #p:Type -> Lemma ((p \/ False) <==> p)
+let lem_p_or_false #p = ()
+
val lem_true_imp_p : #p:Type -> Lemma ((True ==> p) <==> p)
+let lem_true_imp_p #p = ()
+
val lem_p_imp_true : #p:Type -> Lemma ((p ==> True) <==> True)
+let lem_p_imp_true #p = ()
+
val lem_false_imp_p : #p:Type -> Lemma ((False ==> p) <==> True)
+let lem_false_imp_p #p = ()
+
val lem_fa_true : #a:Type -> Lemma ((forall (x:a). True) <==> True)
+let lem_fa_true #a = ()
+
val lem_fa_false : #a:Type -> (x:a) -> Lemma ((forall (x:a). False) <==> False)
+let lem_fa_false #a x = ()
+
val lem_ex_false : #a:Type -> Lemma ((exists (x:a). False) <==> False)
+let lem_ex_false #a = ()
+
val lem_ex_true : #a:Type -> (x:a) -> Lemma ((exists (x:a). True) <==> True)
+let lem_ex_true #a x = ()
+
val lem_neg_false : unit -> Lemma (~False <==> True)
+let lem_neg_false () = ()
+
val lem_neg_true : unit -> Lemma (~True <==> False)
+let lem_neg_true () = ()
+
val lem_true_iff_p : #p:Type -> Lemma ((True <==> p) <==> p)
+let lem_true_iff_p #p = ()
+
val lem_false_iff_p : #p:Type -> Lemma ((False <==> p) <==> ~p)
+let lem_false_iff_p #p = ()
+
val lem_p_iff_true : #p:Type -> Lemma ((p <==> True) <==> p)
+let lem_p_iff_true #p = ()
+
val lem_p_iff_false : #p:Type -> Lemma ((p <==> False) <==> ~p)
+let lem_p_iff_false #p = ()
+
val and_cong (#p #q #p' #q' : Type) : squash (p <==> p') ->
+                                      squash (q <==> q') ->
+                                      Lemma ((p /\ q) <==> (p' /\ q'))
+let and_cong #p #q #p' #q' _ _ = ()
+
val or_cong (#p #q #p' #q' : Type) : squash (p <==> p') ->
+                                     squash (q <==> q') ->
+                                     Lemma ((p \/ q) <==> (p' \/ q'))
+let or_cong #p #q #p' #q' _ _ = ()
+
val imp_cong (#p #q #p' #q' : Type) : squash (p <==> p') ->
+                                      squash (q <==> q') ->
+                                      Lemma ((p ==> q) <==> (p' ==> q'))
+let imp_cong #p #q #p' #q' _ _ = ()
+
val fa_cong (#a : Type) (#p #q : a -> Type) :
+    (x:a -> squash (p x <==> q x)) ->
+    Lemma ((forall (x:a). p x) <==> (forall (x:a). q x))
+let fa_cong #a #p #q f = admit() //fix, this should certainly be provable
+
val ex_cong (#a : Type) (#p #q : a -> Type) :
+    (x:a -> squash (p x <==> q x)) ->
+    Lemma ((exists (x:a). p x) <==> (exists (x:a). q x))
+let ex_cong #a #p #q f = admit() //fix, this should certainly be provable
+
val neg_cong (#p #q:Type) : squash (p <==> q) -> Lemma (~p <==> ~q)
+let neg_cong #p #q _ = ()
+
val iff_cong (#p #p' #q #q' : Type) : squash (p <==> p') -> squash (q <==> q') -> Lemma ((p <==> q) <==> (p' <==> q'))
+let iff_cong #p #p' #q #q' _ _ = ()
+

Absolutely hideous, do something about normalization

+
val is_true : term -> Tac bool
+let is_true t =
+    begin match term_as_formula' t with
+    | True_ -> true
+    | _ -> begin match inspect_ln t with
+           | Tv_App l r ->
+            begin match inspect_ln l with
+            | Tv_Abs b t ->
+                begin match term_as_formula' t with
+                | True_ -> true
+                | _ -> false
+                end
+            | _ -> false
+            end
+           | _ -> false
+           end
+    end
+
val is_false : term -> Tac bool
+let is_false t =
+    begin match term_as_formula' t with
+    | False_ -> true
+    | _ -> begin match inspect_ln t with
+           | Tv_App l r ->
+            begin match inspect_ln l with
+            | Tv_Abs b t ->
+                begin match term_as_formula' t with
+                | False_ -> true
+                | _ -> false
+                end
+            | _ -> false
+            end
+           | _ -> false
+           end
+    end
+
val inhabit : unit -> Tac unit
+let inhabit () =
+    let t = cur_goal () in
+    match inspect_ln t with
+    | Tv_FVar fv ->
+        let qn = inspect_fv fv in
+             if qn = int_lid  then exact (`42)
+        else if qn = bool_lid then exact (`true)
+        else if qn = unit_lid then exact (`())
+        else fail ""
+    | _ -> fail ""
+
val simplify_point : unit -> Tac unit
+val recurse : unit -> Tac unit
+
let rec simplify_point () =
+

dump "1 ALIVE";

+
recurse ();
+norm [];
+let g = cur_goal () in
+let f = term_as_formula g in
+

print ("1 g = " ^ term_to_string g);

+

print ("1 f = " ^ formula_to_string f);

+
match f with
+| Iff l r ->
+    begin match term_as_formula' l with
+    | And p q ->
+             if is_true p  then apply_lemma (`lem_true_and_p)
+        else if is_true q  then apply_lemma (`lem_p_and_true)
+        else if is_false p then apply_lemma (`lem_false_and_p)
+        else if is_false q then apply_lemma (`lem_p_and_false)
+        else tiff ()
+
| Or p q ->
+         if is_true p  then apply_lemma (`lem_true_or_p)
+    else if is_true q  then apply_lemma (`lem_p_or_true)
+    else if is_false p then apply_lemma (`lem_false_or_p)
+    else if is_false q then apply_lemma (`lem_p_or_false)
+    else tiff ()
+
| Implies p q ->
+         if is_true p  then apply_lemma (`lem_true_imp_p)
+    else if is_true q  then apply_lemma (`lem_p_imp_true)
+    else if is_false p then apply_lemma (`lem_false_imp_p)
+    else tiff ()
+
| Forall b p ->
+         if is_true p  then apply_lemma (`lem_fa_true)
+    else if is_false p then or_else (fun () -> apply_lemma (`lem_fa_false); inhabit ()) tiff
+    else tiff ()
+
| Exists b p ->
+         if is_false p then apply_lemma (`lem_ex_false)
+    else if is_true  p then or_else (fun () -> apply_lemma (`lem_ex_true); inhabit ()) tiff
+    else tiff ()
+
| Not p ->
+         if is_true p  then apply_lemma (`lem_neg_true)
+    else if is_false p then apply_lemma (`lem_neg_false)
+    else tiff ()
+
| Iff p q ->
+

After applying the lemma, we might still have more simpl to do, +so add an intermediate step.

+
step ();
+     if is_true p  then apply_lemma (`lem_true_iff_p)
+else if is_true q  then apply_lemma (`lem_p_iff_true)
+else if is_false p then apply_lemma (`lem_false_iff_p)
+else if is_false q then apply_lemma (`lem_p_iff_false)
+else tiff ();
+simplify_point ()
+
    | _ -> tiff ()
+    end
+| _ -> fail "simplify_point: failed precondition: goal should be `g <==> ?u`"
+
and recurse () : Tac unit =
+

dump "2 ALIVE";

+
step ();
+norm [];
+let g = cur_goal () in
+let f = term_as_formula g in
+

print ("2 g = " ^ term_to_string g);

+

print ("2 f = " ^ formula_to_string f);

+
match f with
+| Iff l r ->
+    begin match term_as_formula' l with
+    | And _ _ ->
+        seq (fun () -> apply_lemma (`and_cong)) simplify_point
+
| Or _ _ ->
+    seq (fun () -> apply_lemma (`or_cong)) simplify_point
+
| Implies _ _ ->
+    seq (fun () -> apply_lemma (`imp_cong)) simplify_point
+
| Forall _ _ ->
+    apply_lemma (`fa_cong);
+    let _ = intro () in
+    simplify_point ()
+
| Exists _ _ ->
+    apply_lemma (`ex_cong);
+    let _ = intro () in
+    simplify_point ()
+
| Not _ ->
+    apply_lemma (`neg_cong);
+    simplify_point ()
+
| Iff _ _ ->
+    seq (fun () -> apply_lemma (`iff_cong)) simplify_point
+
    | _ -> tiff ()
+    end
+| _ -> fail "recurse: failed precondition: goal should be `g <==> ?u`"
+
val equiv : #p:Type -> #q:Type -> squash (p <==> q) -> squash q -> Lemma p
+let equiv #p #q _ _ = ()
+
let simplify () : Tac unit =
+    apply_lemma (`equiv);
+    simplify_point ()
+ diff --git a/docs/FStar.Tactics.SyntaxHelpers.html b/docs/FStar.Tactics.SyntaxHelpers.html index c57107e..b116e31 100644 --- a/docs/FStar.Tactics.SyntaxHelpers.html +++ b/docs/FStar.Tactics.SyntaxHelpers.html @@ -1,16 +1,77 @@ - - + + - - - - - + FStar.Tactics.SyntaxHelpers + -

module FStar.Tactics.SyntaxHelpers

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.SyntaxHelpers

+ +

These are fully-named variants of functions found in FStar.Reflection

+
private
+let rec collect_arr' (bs : list binder) (c : comp) : Tac (list binder * comp) =
+    begin match inspect_comp c with
+    | C_Total t _ ->
+        begin match inspect t with
+        | Tv_Arrow b c ->
+            collect_arr' (b::bs) c
+        | _ ->
+            (bs, c)
+        end
+    | _ -> (bs, c)
+    end
+
val collect_arr_bs : typ -> Tac (list binder * comp)
+let collect_arr_bs t =
+    let (bs, c) = collect_arr' [] (pack_comp (C_Total t [])) in
+    (List.Tot.Base.rev bs, c)
+
val collect_arr : typ -> Tac (list typ * comp)
+let collect_arr t =
+    let (bs, c) = collect_arr' [] (pack_comp (C_Total t [])) in
+    let ts = List.Tot.Base.map type_of_binder bs in
+    (List.Tot.Base.rev ts, c)
+
private
+let rec collect_abs' (bs : list binder) (t : term) : Tac (list binder * term) (decreases t) =
+    match inspect t with
+    | Tv_Abs b t' ->
+        collect_abs' (b::bs) t'
+    | _ -> (bs, t)
+
val collect_abs : term -> Tac (list binder * term)
+let collect_abs t =
+    let (bs, t') = collect_abs' [] t in
+    (List.Tot.Base.rev bs, t')
+

Copied from FStar.Tactics.Derived

+
private
+let fail (#a:Type) (m:string) = raise #a (TacticFailure m)
+
let rec mk_arr (bs: list binder) (cod : comp) : Tac term =
+    match bs with
+    | [] -> fail "mk_arr, empty binders"
+    | [b] -> pack (Tv_Arrow b cod)
+    | (b::bs) -> pack (Tv_Arrow b (pack_comp (C_Total (mk_arr bs cod) [])))
+
let rec mk_tot_arr (bs: list binder) (cod : term) : Tac term =
+    match bs with
+    | [] -> cod
+    | (b::bs) -> pack (Tv_Arrow b (pack_comp (C_Total (mk_tot_arr bs cod) [])))
+
let lookup_lb_view (lbs:list letbinding) (nm:name) : Tac lb_view =
+  let o = FStar.List.Tot.Base.find
+             (fun lb ->
+              let lbv = inspect_lb lb in
+              (inspect_fv lbv.lb_fv) = nm)
+             lbs
+  in
+  match o with
+  | Some lb -> inspect_lb lb
+  | None -> fail "lookup_lb_view: Name not in let group"
+ diff --git a/docs/FStar.Tactics.Typeclasses.html b/docs/FStar.Tactics.Typeclasses.html index 6627b67..f9fc60c 100644 --- a/docs/FStar.Tactics.Typeclasses.html +++ b/docs/FStar.Tactics.Typeclasses.html @@ -1,54 +1,145 @@ - - + + - - - - - - + FStar.Tactics.Typeclasses + -

module FStar.Tactics.Typeclasses

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
** Generating methods from a class ***
+

+FStar.Tactics.Typeclasses

+ +

The attribute that marks instances

+
irreducible
+let tcinstance : unit = ()
+
let rec first (f : 'a -> Tac 'b) (l : list 'a) : Tac 'b =
+    match l with
+    | [] -> fail "no cands"
+    | x::xs -> (fun () -> f x) `or_else` (fun () -> first f xs)
+

TODO: memoization?. And better errors.

+
private
+let rec tcresolve' (seen:list term) (fuel:int) : Tac unit =
+    if fuel <= 0 then
+        fail "out of fuel";
+    debug ("fuel = " ^ string_of_int fuel);
+    let g = cur_goal () in
+    if FStar.List.Tot.Base.existsb (term_eq g) seen then
+      fail "loop";
+    let seen = g :: seen in
+    local seen fuel `or_else` (fun () -> global seen fuel `or_else` (fun () -> fail ("could not solve constraint: " ^ term_to_string g)))
+and local (seen:list term) (fuel:int) () : Tac unit =
+    let bs = binders_of_env (cur_env ()) in
+    first (fun b -> trywith seen fuel (pack (Tv_Var (bv_of_binder b)))) bs
+and global (seen:list term) (fuel:int) () : Tac unit =
+    let cands = lookup_attr (`tcinstance) (cur_env ()) in
+    first (fun fv -> trywith seen fuel (pack (Tv_FVar fv))) cands
+and trywith (seen:list term) (fuel:int) (t:term) : Tac unit =
+    debug ("Trying to apply hypothesis/instance: " ^ term_to_string t);
+    (fun () -> apply_noinst t) `seq` (fun () -> tcresolve' seen (fuel-1))
+
[@@plugin]
+let tcresolve () : Tac unit =
+    try tcresolve' [] 16
+    with
+    | TacticFailure s -> fail ("Typeclass resolution failed: " ^ s)
+    | e -> raise e
+

Solve an explicit argument by typeclass resolution

+
unfold let solve (#a:Type) (#[tcresolve ()] ev : a) : Tot a = ev
+

+Generating methods from a class ***

+

In TAC, not Tot

+
let rec mk_abs (bs : list binder) (body : term) : Tac term (decreases bs) =
+    match bs with
+    | [] -> body
+    | b::bs -> pack (Tv_Abs b (mk_abs bs body))
+
let rec last (l : list 'a) : Tac 'a =
+  match l with
+  | [] -> fail "last: empty list"
+  | [x] -> x
+  | _::xs -> last xs
+
[@@plugin]
+let mk_class (nm:string) : Tac decls =
+    let ns = explode_qn nm in
+    let r = lookup_typ (top_env ()) ns in
+    guard (Some? r);
+    let Some se = r in
+    let to_propagate = List.Tot.filter (function Inline_for_extraction | NoExtract -> true | _ -> false) (sigelt_quals se) in
+    let sv = inspect_sigelt se in
+    guard (Sg_Inductive? sv);
+    let Sg_Inductive name us params ty ctors = sv in
+

dump ("got it, name = " ^ implode_qn name);

+

dump ("got it, ty = " ^ term_to_string ty);

+
let ctor_name = last name in
+

Must have a single constructor +dump ("got ctor " ^ implode_qn c_name ^ " of type " ^ term_to_string ty);

+
guard (List.Tot.Base.length ctors = 1);
+let [(c_name, ty)] = ctors in
+
let bs, cod = collect_arr_bs ty in
+let r = inspect_comp cod in
+guard (C_Total? r);
+let C_Total cod _ = r in (* must be total *)
+

print ("n_univs = " ^ string_of_int (List.Tot.Base.length us));

+
let base : string = "__proj__Mk" ^ ctor_name ^ "__item__" in
+

Make a sigelt for each method

+
T.map (fun b ->
+

dump ("b = " ^ term_to_string (type_of_binder b));

+
let s = name_of_binder b in
+

dump ("b = " ^ s);

+
let ns = cur_module () in
+let sfv = pack_fv (ns @ [s]) in
+let dbv = fresh_bv_named "d" cod in
+let tcr = (`tcresolve) in
+let tcdict = pack_binder dbv (Q_Meta tcr) [] in
+let proj_name = cur_module () @ [base ^ s] in
+let proj = pack (Tv_FVar (pack_fv proj_name)) in
+
let proj_ty =
+  match lookup_typ (top_env ()) proj_name with
+  | None -> fail "mk_class: proj not found?"
+  | Some se ->
+    match inspect_sigelt se with
+    | Sg_Let _ lbs ->  begin
+      let ({lb_fv=_;lb_us=_;lb_typ=typ;lb_def=_}) =
+        lookup_lb_view lbs proj_name in typ
+      end
+    | _ -> fail "mk_class: proj not Sg_Let?"
+in
+

dump ("proj_ty = " ^ term_to_string proj_ty);

+
let ty =
+  let bs, cod = collect_arr_bs proj_ty in
+  let ps, bs = List.Tot.Base.splitAt (List.Tot.Base.length params) bs in
+  match bs with
+  | [] -> fail "mk_class: impossible, no binders"
+  | b1::bs' ->
+      let (bv, aq) = inspect_binder b1 in
+      let b1 = pack_binder bv (Q_Meta tcr) [] in
+      mk_arr (ps@(b1::bs')) cod
+in
+
let def : term =
+  let bs = (map (fun b -> binder_set_qual Q_Implicit b) params)
+                  @ [tcdict] in
+  mk_abs bs (mk_e_app proj [binder_to_term tcdict])
+in
+

dump ("def = " ^ term_to_string def); +dump ("ty = " ^ term_to_string ty);

+
let ty : term = ty in
+let def : term = def in
+let sfv : fv = sfv in
+
let lbv = {lb_fv=sfv;lb_us=us;lb_typ=ty;lb_def=def} in
+let lb = pack_lb lbv in
+let se = pack_sigelt (Sg_Let false [lb]) in
+let se = set_sigelt_quals to_propagate se in
+let _, (_, attrs) = inspect_binder b in
+let se = set_sigelt_attrs attrs se in
+

dump ("trying to return : " ^ term_to_string (quote se));

+
              se
+) bs
+ diff --git a/docs/FStar.Tactics.Types.html b/docs/FStar.Tactics.Types.html index fb0eb0c..1dd0789 100644 --- a/docs/FStar.Tactics.Types.html +++ b/docs/FStar.Tactics.Types.html @@ -1,16 +1,51 @@ - - + + - - - - - + FStar.Tactics.Types + -

module FStar.Tactics.Types

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Types

+ +
assume new type proofstate
+assume new type goal
+

Returns the active goals

+
val goals_of     : proofstate -> list goal
+

Returns the goals marked for SMT

+
val smt_goals_of : proofstate -> list goal
+

Inspecting a goal

+
val goal_env     : goal -> env
+val goal_type    : goal -> typ
+val goal_witness : goal -> term
+val is_guard     : goal -> bool (* A bit of helper info: did this goal come from a VC guard? *)
+
val get_label    : goal -> string
+val set_label    : string -> goal -> goal
+

Tracing

+
val incr_depth : proofstate -> proofstate
+val decr_depth : proofstate -> proofstate
+

tracepoint always returns true. We do not use unit to prevent +erasure.

+
val tracepoint : proofstate -> b:bool{b == true}
+val set_proofstate_range : proofstate -> FStar.Range.range -> proofstate
+
type direction =
+    | TopDown
+    | BottomUp
+
type ctrl_flag =
+    | Continue
+    | Skip
+    | Abort
+
type guard_policy =
+    | SMT
+    | Goal
+    | Force
+    | Drop // unsound! careful!
+ diff --git a/docs/FStar.Tactics.Util.html b/docs/FStar.Tactics.Util.html index d06c650..317d6d7 100644 --- a/docs/FStar.Tactics.Util.html +++ b/docs/FStar.Tactics.Util.html @@ -1,16 +1,102 @@ - - + + - - - - - + FStar.Tactics.Util + -

module FStar.Tactics.Util

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics.Util

+ +
#set-options "--z3rlimit 25 --fuel 0 --ifuel 0"
+

Tac list functions, since there's no effect polymorphism

+
val map: ('a -> Tac 'b) -> list 'a -> Tac (list 'b)
+#push-options "--ifuel 1"
+let rec map f x = match x with
+  | [] -> []
+  | a::tl -> f a::map f tl
+#pop-options
+
val __mapi: nat -> (nat -> 'a -> Tac 'b) -> list 'a -> Tac (list 'b)
+#push-options "--ifuel 1"
+let rec __mapi i f x = match x with
+  | [] -> []
+  | a::tl -> f i a::__mapi (i+1) f tl
+#pop-options
+
val mapi: (nat -> 'a -> Tac 'b) -> list 'a -> Tac (list 'b)
+let mapi f l = __mapi 0 f l
+
val iter : ('a -> Tac unit) -> list 'a -> Tac unit
+#push-options "--ifuel 1"
+let rec iter f x = match x with
+  | [] -> ()
+  | a::tl -> f a; iter f tl
+#pop-options
+
val iteri_aux: int -> (int -> 'a -> Tac unit) -> list 'a -> Tac unit
+#push-options "--ifuel 1"
+let rec iteri_aux i f x = match x with
+  | [] -> ()
+  | a::tl -> f i a; iteri_aux (i+1) f tl
+#pop-options
+
val iteri: (int -> 'a -> Tac unit) -> list 'a -> Tac unit
+let iteri f x = iteri_aux 0 f x
+
val fold_left: ('a -> 'b -> Tac 'a) -> 'a -> l:list 'b -> Tac 'a
+#push-options "--ifuel 1"
+let rec fold_left f x l = match l with
+  | [] -> x
+  | hd::tl -> fold_left f (f x hd) tl
+#pop-options
+
val fold_right: ('a -> 'b -> Tac 'b) -> list 'a -> 'b -> Tac 'b
+#push-options "--ifuel 1"
+let rec fold_right f l x = match l with
+  | [] -> x
+  | hd::tl -> f hd (fold_right f tl x)
+#pop-options
+

There's no unconditionally total zip like this in Tot.Base, why? Anyway use this

+
val zip : (#a:Type) -> (#b:Type) -> list a -> list b -> Tac (list (a * b))
+#push-options "--ifuel 1"
+let rec zip #a #b l1 l2 = match l1, l2 with
+    | x::xs, y::ys -> (x,y) :: (zip xs ys)
+    | _ -> []
+#pop-options
+
val filter: ('a -> Tac bool) -> list 'a -> Tac (list 'a)
+#push-options "--ifuel 1"
+let rec filter f = function
+  | [] -> []
+  | hd::tl -> if f hd then hd::(filter f tl) else filter f tl
+#pop-options
+
#push-options "--ifuel 1"
+private let rec filter_map_acc (f:'a -> Tac (option 'b)) (acc:list 'b) (l:list 'a)
+    : Tac (list 'b) =
+  match l with
+  | [] ->
+      rev acc
+  | hd :: tl ->
+      match f hd with
+      | Some hd ->
+          filter_map_acc f (hd :: acc) tl
+      | None ->
+          filter_map_acc f acc tl
+#pop-options
+
let filter_map (f:'a -> Tac (option 'b)) (l:list 'a) : Tac (list 'b) =
+  filter_map_acc f [] l
+
val tryPick: ('a -> Tac (option 'b)) -> list 'a -> Tac (option 'b)
+#push-options "--ifuel 1"
+let rec tryPick f l = match l with
+    | [] -> None
+    | hd::tl ->
+       match f hd with
+         | Some x -> Some x
+         | None -> tryPick f tl
+#pop-options
+
let map_opt (f:'a -> Tac 'b) (x:option 'a) : Tac (option 'b) =
+  match x with
+  | None -> None
+  | Some x -> Some (f x)
+ diff --git a/docs/FStar.Tactics.html b/docs/FStar.Tactics.html index 07ae95b..e62b163 100644 --- a/docs/FStar.Tactics.html +++ b/docs/FStar.Tactics.html @@ -1,16 +1,58 @@ - - + + - - - - - + FStar.Tactics + -

module FStar.Tactics

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tactics

+

I don't expect many uses of tactics without syntax handling

+ + diff --git a/docs/FStar.Tcp.html b/docs/FStar.Tcp.html index 16466a2..f8e55af 100644 --- a/docs/FStar.Tcp.html +++ b/docs/FStar.Tcp.html @@ -1,16 +1,45 @@ - - + + - - - - - + FStar.Tcp + -

module FStar.Tcp

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Tcp

+ +
new val networkStream: eqtype
+new val tcpListener: Type0
+
val set_nonblock: networkStream -> unit
+val clear_nonblock: networkStream -> unit
+

Server side

+
val listen: string -> nat -> EXT tcpListener
+val acceptTimeout: nat -> tcpListener -> EXT networkStream
+val accept: tcpListener -> EXT networkStream
+val stop: tcpListener -> EXT unit
+

Client side

+
val connectTimeout: nat -> string -> nat -> EXT networkStream
+val connect: string -> nat -> EXT networkStream
+

Input/Output

+

adding support for (potentially) non-blocking I/O +NB for now, send fails on partial writes, and loops on EAGAIN/EWOULDBLOCK.

+
type recv_result (max:nat) =
+  | RecvWouldBlock
+  | RecvError of string
+  | Received of b:bytes {length b <= max}
+val recv_async: networkStream -> max:nat -> EXT (recv_result max)
+
val recv: networkStream -> max:nat -> EXT (optResult string (b:bytes {length b <= max}))
+val send: networkStream -> bytes -> EXT (optResult string unit)
+val close: networkStream -> EXT unit
+

Create a network stream from a given stream. +Only used by the application interface TLSharp. +assume val create: System.IO.Stream -> NetworkStream

+ diff --git a/docs/FStar.UInt.html b/docs/FStar.UInt.html index 1f20390..c0f0014 100644 --- a/docs/FStar.UInt.html +++ b/docs/FStar.UInt.html @@ -1,59 +1,471 @@ - - + + - - - - - - + FStar.UInt + -

module FStar.UInt

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
val to_vec_mod_pow2:Unidentified product: [#n:nat] Unidentified product: [a:uint_t n] Unidentified product: [m:pos] Unidentified product: [i:i:nat:{/\(<=(-(n, m), i), <(i, n))}] (Lemma ((requires (==(%(a, pow2 m), 0)))) ((ensures (==(index (to_vec a) i, false)))) (Prims.Cons (SMTPat (index (to_vec #n a) i)) (Prims.Cons (SMTPat (==(%(a, pow2 m), 0))) (Prims.Nil ))))
-

Used in the next two lemmas

-
val to_vec_lt_pow2:Unidentified product: [#n:nat] Unidentified product: [a:uint_t n] Unidentified product: [m:nat] Unidentified product: [i:i:nat:{<(i, -(n, m))}] (Lemma ((requires (<(a, pow2 m)))) ((ensures (==(index (to_vec a) i, false)))) (Prims.Cons (SMTPat (index (to_vec #n a) i)) (Prims.Cons (SMTPat (<(a, pow2 m))) (Prims.Nil ))))
-

Used in the next two lemmas

-
pragma
+

+FStar.UInt

+

NOTE: anything that you fix/update here should be reflected in FStar.Int.fsti, which is mostly

+ +
val pow2_values: x:nat -> Lemma
+  (let p = pow2 x in
+   match x with
+   | 0  -> p=1
+   | 1  -> p=2
+   | 8  -> p=256
+   | 16 -> p=65536
+   | 31 -> p=2147483648
+   | 32 -> p=4294967296
+   | 63 -> p=9223372036854775808
+   | 64 -> p=18446744073709551616
+   | 128 -> p=0x100000000000000000000000000000000
+   | _  -> True)
+  [SMTPat (pow2 x)]
+
+

Specs

+

Note: lacking any type of functors for F*, this is a copy/paste of FStar.Int.fst, where the relevant bits that changed are:

+ +
+
let max_int (n:nat) : Tot int = pow2 n - 1
+let min_int (n:nat) : Tot int = 0
+
let fits (x:int) (n:nat) : Tot bool = min_int n <= x && x <= max_int n
+let size (x:int) (n:nat) : Tot Type0 = b2t(fits x n)
+

Machine integer type

+
type uint_t (n:nat) = x:int{size x n}
+
+

Constants

+
+
let zero (n:nat) : Tot (uint_t n) = 0
+
let pow2_n (#n:pos) (p:nat{p < n}) : Tot (uint_t n) =
+  pow2_le_compat (n - 1) p; pow2 p
+
let one (n:pos) : Tot (uint_t n) = 1
+
let ones (n:nat) : Tot (uint_t n) = max_int n
+

Increment and decrement

+
let incr (#n:nat) (a:uint_t n) : Pure (uint_t n)
+  (requires (b2t (a < max_int n))) (ensures (fun _ -> True))
+  = a + 1
+
let decr (#n:nat) (a:uint_t n) : Pure (uint_t n)
+  (requires (b2t (a > min_int n))) (ensures (fun _ -> True))
+  = a - 1
+
val incr_underspec: #n:nat -> a:uint_t n -> Pure (uint_t n)
+  (requires (b2t (a < max_int n)))
+  (ensures (fun b -> a + 1 = b))
+
val decr_underspec: #n:nat -> a:uint_t n -> Pure (uint_t n)
+  (requires (b2t (a > min_int n)))
+  (ensures (fun b -> a - 1 = b))
+
let incr_mod (#n:nat) (a:uint_t n) : Tot (uint_t n) = (a + 1) % (pow2 n)
+
let decr_mod (#n:nat) (a:uint_t n) : Tot (uint_t n) = (a - 1) % (pow2 n)
+

Addition primitives

+
let add (#n:nat) (a:uint_t n) (b:uint_t n) : Pure (uint_t n)
+  (requires (size (a + b) n))
+  (ensures (fun _ -> True))
+  =  a + b
+
val add_underspec: #n:nat -> a:uint_t n -> b:uint_t n -> Pure (uint_t n)
+  (requires True)
+  (ensures (fun c ->
+    size (a + b) n ==> a + b = c))
+
let add_mod (#n:nat) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  (a + b) % (pow2 n)
+

Subtraction primitives

+
let sub (#n:nat) (a:uint_t n) (b:uint_t n) : Pure (uint_t n)
+  (requires (size (a - b) n))
+  (ensures (fun _ -> True))
+  = a - b
+
val sub_underspec: #n:nat -> a:uint_t n -> b:uint_t n -> Pure (uint_t n)
+  (requires True)
+  (ensures (fun c ->
+    size (a - b) n ==> a - b = c))
+
let sub_mod (#n:nat) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  (a - b) % (pow2 n)
+

Multiplication primitives

+
let mul (#n:nat) (a:uint_t n) (b:uint_t n) : Pure (uint_t n)
+  (requires (size (a * b) n))
+  (ensures (fun _ -> True))
+  = a * b
+
val mul_underspec: #n:nat -> a:uint_t n -> b:uint_t n -> Pure (uint_t n)
+  (requires True)
+  (ensures (fun c ->
+    size (a * b) n ==> a * b = c))
+
let mul_mod (#n:nat) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  (a * b) % (pow2 n)
+
private
+val lt_square_div_lt (a:nat) (b:pos) : Lemma
+  (requires (a < b * b))
+  (ensures (a / b < b))
+
#push-options "--fuel 0 --ifuel 0"
+let mul_div (#n:nat) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  FStar.Math.Lemmas.lemma_mult_lt_sqr a b (pow2 n);
+  lt_square_div_lt (a * b) (pow2 n);
+  (a * b) / (pow2 n)
+#pop-options
+

Division primitives

+
let div (#n:nat) (a:uint_t n) (b:uint_t n{b <> 0}) : Pure (uint_t n)
+  (requires (size (a / b) n))
+  (ensures (fun c -> b <> 0 ==> a / b = c))
+  = a / b
+
val div_underspec: #n:nat -> a:uint_t n -> b:uint_t n{b <> 0} -> Pure (uint_t n)
+  (requires True)
+  (ensures (fun c ->
+    (b <> 0 /\ size (a / b) n) ==> a / b = c))
+
val div_size: #n:pos -> a:uint_t n -> b:uint_t n{b <> 0} ->
+  Lemma (requires (size a n)) (ensures (size (a / b) n))
+
let udiv (#n:pos) (a:uint_t n) (b:uint_t n{b <> 0}) : Tot (c:uint_t n{b <> 0 ==> a / b = c}) =
+  div_size #n a b;
+  a / b
+

Modulo primitives

+
let mod (#n:nat) (a:uint_t n) (b:uint_t n{b <> 0}) : Tot (uint_t n) =
+  a - ((a/b) * b)
+

Comparison operators

+
let eq #n (a:uint_t n) (b:uint_t n) : Tot bool = (a = b)
+let gt #n (a:uint_t n) (b:uint_t n) : Tot bool = (a > b)
+let gte #n (a:uint_t n) (b:uint_t n) : Tot bool = (a >= b)
+let lt #n (a:uint_t n) (b:uint_t n) : Tot bool = (a < b)
+let lte #n (a:uint_t n) (b:uint_t n) : Tot bool = (a <= b)
+
+

Casts

+
+
let to_uint_t (m:nat) (a:int) : Tot (uint_t m) = a % pow2 m
+ +

WARNING: Mind the big endian vs little endian definition

+

Casts

+
let rec to_vec (#n:nat) (num:uint_t n) : Tot (bv_t n) =
+  if n = 0 then Seq.empty #bool
+  else Seq.append (to_vec #(n - 1) (num / 2)) (Seq.create 1 (num % 2 = 1))
+
let rec from_vec (#n:nat) (vec:bv_t n) : Tot (uint_t n) =
+  if n = 0 then 0
+  else 2 * from_vec #(n - 1) (slice vec 0 (n - 1)) + (if index vec (n - 1) then 1 else 0)
+
val to_vec_lemma_1: #n:nat -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires a = b) (ensures equal (to_vec a) (to_vec b))
+
val to_vec_lemma_2: #n:nat -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires equal (to_vec a) (to_vec b)) (ensures a = b)
+
val inverse_aux: #n:nat -> vec:bv_t n -> i:nat{i < n} ->
+  Lemma (requires True) (ensures index vec i = index (to_vec (from_vec vec)) i)
+        [SMTPat (index (to_vec (from_vec vec)) i)]
+
val inverse_vec_lemma: #n:nat -> vec:bv_t n ->
+  Lemma (requires True) (ensures equal vec (to_vec (from_vec vec)))
+        [SMTPat (to_vec (from_vec vec))]
+
val inverse_num_lemma: #n:nat -> num:uint_t n ->
+  Lemma (requires True) (ensures num = from_vec (to_vec num))
+        [SMTPat (from_vec (to_vec num))]
+
val from_vec_lemma_1: #n:nat -> a:bv_t n -> b:bv_t n ->
+  Lemma (requires equal a b) (ensures from_vec a = from_vec b)
+
val from_vec_lemma_2: #n:nat -> a:bv_t n -> b:bv_t n ->
+  Lemma (requires from_vec a = from_vec b) (ensures equal a b)
+ +
val from_vec_aux: #n:nat -> a:bv_t n -> s1:nat{s1 < n} -> s2:nat{s2 < s1} ->
+  Lemma (requires True)
+        (ensures (from_vec #s2 (slice a 0 s2)) * pow2 (n - s2) + (from_vec #(s1 - s2) (slice a s2 s1)) * pow2 (n - s1) + (from_vec #(n - s1) (slice a s1 n)) = ((from_vec #s2 (slice a 0 s2)) * pow2 (s1 - s2) + (from_vec #(s1 - s2) (slice a s2 s1))) * pow2 (n - s1) + (from_vec #(n - s1) (slice a s1 n)))
+
val seq_slice_lemma: #n:nat -> a:bv_t n -> s1:nat{s1 < n} -> t1:nat{t1 >= s1 && t1 <= n} -> s2:nat{s2 < t1 - s1} -> t2:nat{t2 >= s2 && t2 <= t1 - s1} ->
+  Lemma (equal (slice (slice a s1 t1) s2 t2) (slice a (s1 + s2) (s1 + t2)))
+
val from_vec_propriety: #n:pos -> a:bv_t n -> s:nat{s < n} ->
+  Lemma (requires True)
+        (ensures from_vec a = (from_vec #s (slice a 0 s)) * pow2 (n - s) + from_vec #(n - s) (slice a s n))
+        (decreases (n - s))
+
val append_lemma: #n:pos -> #m:pos -> a:bv_t n -> b:bv_t m ->
+  Lemma (from_vec #(n + m) (append a b) = (from_vec #n a) * pow2 m + (from_vec #m b))
+
val slice_left_lemma: #n:pos -> a:bv_t n -> s:pos{s < n} ->
+  Lemma (requires True)
+        (ensures from_vec #s (slice a 0 s) = (from_vec #n a) / (pow2 (n - s)))
+
val slice_right_lemma: #n:pos -> a:bv_t n -> s:pos{s < n} ->
+  Lemma (requires True)
+        (ensures from_vec #s (slice a (n - s) n) = (from_vec #n a) % (pow2 s))
+

Relations between constants in BitVector and in UInt.

+
val zero_to_vec_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True) (ensures index (to_vec (zero n)) i = index (zero_vec #n) i)
+        [SMTPat (index (to_vec (zero n)) i)]
+
val zero_from_vec_lemma: #n:pos ->
+  Lemma (requires True) (ensures from_vec (zero_vec #n) = zero n)
+        [SMTPat (from_vec (zero_vec #n))]
+
val one_to_vec_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures index (to_vec (one n)) i = index (elem_vec #n (n - 1)) i)
+        [SMTPat (index (to_vec (one n)) i)]
+
val pow2_to_vec_lemma: #n:pos -> p:nat{p < n} -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures index (to_vec (pow2_n #n p)) i = index (elem_vec #n (n - p - 1)) i)
+        [SMTPat (index (to_vec (pow2_n #n p)) i)]
+
val pow2_from_vec_lemma: #n:pos -> p:nat{p < n} ->
+  Lemma (requires True) (ensures from_vec (elem_vec #n p) = pow2_n #n (n - p - 1))
+        [SMTPat (from_vec (elem_vec #n p))]
+
val ones_to_vec_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures index (to_vec (ones n)) i = index (ones_vec #n) i)
+        [SMTPat (index (to_vec (ones n)) i)]
+
val ones_from_vec_lemma: #n:pos ->
+  Lemma (requires True) (ensures from_vec (ones_vec #n) = ones n)
+        [SMTPat (from_vec (ones_vec #n))]
+

(nth a i) returns a boolean indicating the i-th bit of a.

+
let nth (#n:pos) (a:uint_t n) (i:nat{i < n}) : Tot bool =
+  index (to_vec #n a) i
+
val nth_lemma: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires forall (i:nat{i < n}). nth a i = nth b i)
+        (ensures a = b)
+

Lemmas for constants

+
val zero_nth_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True) (ensures nth (zero n) i = false)
+        [SMTPat (nth (zero n) i)]
+
val pow2_nth_lemma: #n:pos -> p:nat{p < n} -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (i = n - p - 1 ==> nth (pow2_n #n p) i = true) /\
+                 (i <> n - p - 1 ==> nth (pow2_n #n p) i = false))
+        [SMTPat (nth (pow2_n #n p) i)]
+
val one_nth_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (i = n - 1 ==> nth (one n) i = true) /\
+                 (i < n - 1 ==> nth (one n) i = false))
+        [SMTPat (nth (one n) i)]
+
val ones_nth_lemma: #n:pos -> i:nat{i < n} ->
+  Lemma (requires True) (ensures (nth (ones n) i) = true)
+        [SMTPat (nth (ones n) i)]
+

Bitwise operators

+
let logand (#n:pos) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  from_vec #n (logand_vec #n (to_vec #n a) (to_vec #n b))
+
let logxor (#n:pos) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  from_vec #n (logxor_vec #n (to_vec #n a) (to_vec #n b))
+
let logor (#n:pos) (a:uint_t n) (b:uint_t n) : Tot (uint_t n) =
+  from_vec #n (logor_vec #n (to_vec #n a) (to_vec #n b))
+
let lognot (#n:pos) (a:uint_t n) : Tot (uint_t n) =
+  from_vec #n (lognot_vec #n (to_vec #n a))
+

Bitwise operators definitions

+
val logand_definition: #n:pos -> a:uint_t n -> b:uint_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (nth (logand a b) i = (nth a i && nth b i)))
+        [SMTPat (nth (logand a b) i)]
+
val logxor_definition: #n:pos -> a:uint_t n -> b:uint_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (nth (logxor a b) i = (nth a i <> nth b i)))
+        [SMTPat (nth (logxor a b) i)]
+
val logor_definition: #n:pos -> a:uint_t n -> b:uint_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (nth (logor a b) i = (nth a i || nth b i)))
+        [SMTPat (nth (logor a b) i)]
+
val lognot_definition: #n:pos -> a:uint_t n -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (nth (lognot a) i = not(nth a i)))
+        [SMTPat (nth (lognot a) i)]
+

Two's complement unary minus

+
inline_for_extraction
+let minus (#n:pos) (a:uint_t n) : Tot (uint_t n) =
+  add_mod (lognot a) 1
+

Bitwise operators lemmas

+

TODO: lemmas about the relations between different operators

+

Bitwise AND operator

+
val logand_commutative: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires True) (ensures (logand #n a b = logand #n b a))
+
val logand_associative: #n:pos -> a:uint_t n -> b:uint_t n -> c:uint_t n ->
+  Lemma (requires True)
+        (ensures (logand #n (logand #n a b) c = logand #n a (logand #n b c)))
+
val logand_self: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logand #n a a = a))
+
val logand_lemma_1: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logand #n a (zero n) = zero n))
+
val logand_lemma_2: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logand #n a (ones n) = a))
+

subset_vec_le_lemma proves that a subset of bits is numerically smaller or equal.

+
val subset_vec_le_lemma: #n:pos -> a:bv_t n -> b:bv_t n ->
+  Lemma (requires is_subset_vec #n a b) (ensures (from_vec a) <= (from_vec b))
+

logand_le proves the the result of AND is less than or equal to both arguments.

+
val logand_le: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires True)
+        (ensures (logand a b) <= a /\ (logand a b) <= b)
+

Bitwise XOR operator

+
val logxor_commutative: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires True) (ensures (logxor #n a b = logxor #n b a))
+
val logxor_associative: #n:pos -> a:uint_t n -> b:uint_t n -> c:uint_t n ->
+  Lemma (requires True) (ensures (logxor #n (logxor #n a b) c = logxor #n a (logxor #n b c)))
+
val logxor_self: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logxor #n a a = zero n))
+
val logxor_lemma_1: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logxor #n a (zero n) = a))
+
val logxor_lemma_2: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logxor #n a (ones n) = lognot #n a))
+
private let xor (b:bool) (b':bool) : Tot bool = b <> b'
+
private val xor_lemma (a:bool) (b:bool) : Lemma
+  (requires (True))
+  (ensures  (xor (xor a b) b = a))
+  [SMTPat (xor (xor a b) b)]
+
val logxor_inv: #n:pos -> a:uint_t n -> b:uint_t n -> Lemma
+  (a = logxor #n (logxor #n a b) b)
+
val logxor_neq_nonzero: #n:pos -> a:uint_t n -> b:uint_t n -> Lemma
+   (a <> b ==> logxor a b <> 0)
+

Bitwise OR operators

+
val logor_commutative: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires True) (ensures (logor #n a b = logor #n b a))
+
val logor_associative: #n:pos -> a:uint_t n -> b:uint_t n -> c:uint_t n ->
+  Lemma (requires True)
+        (ensures (logor #n (logor #n a b) c = logor #n a (logor #n b c)))
+
val logor_self: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logor #n a a = a))
+
val logor_lemma_1: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logor #n a (zero n) = a))
+
val logor_lemma_2: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (logor #n a (ones n) = ones n))
+

superset_vec_le_lemma proves that a superset of bits is numerically greater than or equal.

+
val superset_vec_ge_lemma: #n:pos -> a:bv_t n -> b:bv_t n ->
+  Lemma (requires is_superset_vec #n a b)
+        (ensures (from_vec a) >= (from_vec b))
+

logor_ge proves that the result of an OR is greater than or equal to both arguments.

+
val logor_ge: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (requires True)
+        (ensures (logor a b) >= a /\ (logor a b) >= b)
+

Bitwise NOT operator

+
val lognot_self: #n:pos -> a:uint_t n ->
+  Lemma (requires True) (ensures (lognot #n (lognot #n a) = a))
+
val lognot_lemma_1: #n:pos ->
+  Lemma (requires True) (ensures (lognot #n (zero n) = ones n))
+

+index_to_vec_ones

Used in the next two lemmas

+
private val index_to_vec_ones: #n:pos -> m:nat{m <= n} -> i:nat{i < n} ->
+  Lemma (requires True)
+        (ensures (pow2 m <= pow2 n /\
+          (i < n - m ==> index (to_vec #n (pow2 m - 1)) i == false) /\
+          (n - m <= i ==> index (to_vec #n (pow2 m - 1)) i == true)))
+        [SMTPat (index (to_vec #n (pow2 m - 1)) i)]
+
val logor_disjoint: #n:pos -> a:uint_t n -> b:uint_t n -> m:pos{m < n} ->
+  Lemma (requires (a % pow2 m == 0 /\ b < pow2 m))
+        (ensures  (logor #n a b == a + b))
+
val logand_mask: #n:pos -> a:uint_t n -> m:pos{m < n} ->
+  Lemma (pow2 m < pow2 n /\ logand #n a (pow2 m - 1) == a % pow2 m)
+

Shift operators

+
let shift_left (#n:pos) (a:uint_t n) (s:nat) : Tot (uint_t n) =
+  from_vec (shift_left_vec #n (to_vec #n a) s)
+
let shift_right (#n:pos) (a:uint_t n) (s:nat) : Tot (uint_t n) =
+  from_vec (shift_right_vec #n (to_vec #n a) s)
+

Shift operators lemmas

+
val shift_left_lemma_1: #n:pos -> a:uint_t n -> s:nat -> i:nat{i < n && i >= n - s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_left #n a s) i = false))
+        [SMTPat (nth (shift_left #n a s) i)]
+
val shift_left_lemma_2: #n:pos -> a:uint_t n -> s:nat -> i:nat{i < n && i < n - s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_left #n a s) i = nth #n a (i + s)))
+        [SMTPat (nth (shift_left #n a s) i)]
+
val shift_right_lemma_1: #n:pos -> a:uint_t n -> s:nat -> i:nat{i < n && i < s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_right #n a s) i = false))
+        [SMTPat (nth (shift_right #n a s) i)]
+
val shift_right_lemma_2: #n:pos -> a:uint_t n -> s:nat -> i:nat{i < n && i >= s} ->
+  Lemma (requires True)
+        (ensures (nth (shift_right #n a s) i = nth #n a (i - s)))
+        [SMTPat (nth (shift_right #n a s) i)]
+

Lemmas with shift operators and bitwise operators

+
val shift_left_logand_lemma: #n:pos -> a:uint_t n -> b:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures (shift_left #n (logand #n a b) s = logand #n (shift_left #n a s) (shift_left #n b s)))
+
val shift_right_logand_lemma: #n:pos -> a:uint_t n -> b:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures (shift_right #n (logand #n a b) s = logand #n (shift_right #n a s) (shift_right #n b s)))
+
val shift_left_logxor_lemma: #n:pos -> a:uint_t n -> b:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures (shift_left #n (logxor #n a b) s = logxor #n (shift_left #n a s) (shift_left #n b s)))
+
val shift_right_logxor_lemma: #n:pos -> a:uint_t n -> b:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures (shift_right #n (logxor #n a b) s = logxor #n (shift_right #n a s) (shift_right #n b s)))
+
val shift_left_logor_lemma: #n:pos -> a:uint_t n -> b:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures (shift_left #n (logor #n a b) s = logor #n (shift_left #n a s) (shift_left #n b s)))
+
val shift_right_logor_lemma: #n:pos -> a:uint_t n -> b:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures (shift_right #n (logor #n a b) s = logor #n (shift_right #n a s) (shift_right #n b s)))
+

Lemmas about value after shift operations

+
val shift_left_value_aux_1: #n:pos -> a:uint_t n -> s:nat{s >= n} ->
+  Lemma (requires True)
+        (ensures shift_left #n a s = (a * pow2 s) % pow2 n)
+
val shift_left_value_aux_2: #n:pos -> a:uint_t n ->
+  Lemma (requires True)
+        (ensures shift_left #n a 0 = (a * pow2 0) % pow2 n)
+
val shift_left_value_aux_3: #n:pos -> a:uint_t n -> s:pos{s < n} ->
+  Lemma (requires True)
+        (ensures shift_left #n a s = (a * pow2 s) % pow2 n)
+
val shift_left_value_lemma: #n:pos -> a:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures shift_left #n a s = (a * pow2 s) % pow2 n)
+        [SMTPat (shift_left #n a s)]
+
val shift_right_value_aux_1: #n:pos -> a:uint_t n -> s:nat{s >= n} ->
+  Lemma (requires True)
+        (ensures shift_right #n a s = a / pow2 s)
+
val shift_right_value_aux_2: #n:pos -> a:uint_t n ->
+  Lemma (requires True)
+        (ensures shift_right #n a 0 = a / pow2 0)
+
val shift_right_value_aux_3: #n:pos -> a:uint_t n -> s:pos{s < n} ->
+  Lemma (requires True)
+        (ensures shift_right #n a s = a / pow2 s)
+
val shift_right_value_lemma: #n:pos -> a:uint_t n -> s:nat ->
+  Lemma (requires True)
+        (ensures shift_right #n a s = a / pow2 s)
+        [SMTPat (shift_right #n a s)]
+

Lemmas about the most significant bit in various situations

+
let msb (#n:pos) (a:uint_t n) : Tot bool = nth a 0
+
val lemma_msb_pow2: #n:pos -> a:uint_t n ->
+  Lemma (msb a <==> a >= pow2 (n-1))
+
val lemma_minus_zero: #n:pos -> a:uint_t n ->
+  Lemma (minus a = 0 ==> a = 0)
+
val lemma_msb_gte: #n:pos{n > 1} -> a:uint_t n -> b:uint_t n ->
+  Lemma ((a >= b && not (msb a)) ==> not (msb b))
+

Lemmas toward showing ~n + 1 = -a

+
val lemma_uint_mod: #n:pos -> a:uint_t n ->
+  Lemma (a = a % pow2 n)
+
val lemma_add_sub_cancel: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (add_mod (sub_mod a b) b = a)
+
val lemma_mod_sub_distr_l: a:int -> b:int -> p:pos ->
+  Lemma ((a - b) % p = ((a % p) - b) % p)
+
val lemma_sub_add_cancel: #n:pos -> a:uint_t n -> b:uint_t n ->
+  Lemma (sub_mod (add_mod a b) b = a)
+
let zero_extend_vec (#n:pos) (a:BitVector.bv_t n): Tot (BitVector.bv_t (n+1)) = Seq.append (Seq.create 1 false) a
+let one_extend_vec (#n:pos) (a:BitVector.bv_t n): Tot (BitVector.bv_t (n+1)) = Seq.append (Seq.create 1 true) a
+
let zero_extend (#n:pos) (a:uint_t n): Tot (uint_t (n+1)) = from_vec (zero_extend_vec (to_vec a))
+let one_extend (#n:pos) (a:uint_t n): Tot (uint_t (n+1)) = from_vec (one_extend_vec (to_vec a))
+
val lemma_zero_extend: #n:pos -> a:uint_t n ->
+  Lemma (zero_extend a = a)
+  [SMTPat (zero_extend a)]
+
val lemma_one_extend: #n:pos -> a:uint_t n ->
+  Lemma (one_extend a = pow2 n + a)
+  [SMTPat (one_extend a)]
+
val lemma_lognot_zero_ext: #n:pos -> a:uint_t n ->
+  Lemma (lognot #(n+1) (zero_extend a) = pow2 n + (lognot #n a))
+
val lemma_lognot_one_ext: #n:pos -> a:uint_t n ->
+  Lemma (lognot #(n+1) (one_extend a) = lognot #n a)
+
val lemma_lognot_value_mod: #n:pos -> a:uint_t n ->
+  Lemma
+  (requires True)
+  (ensures (lognot a = pow2 n - a - 1))
+  (decreases n)
+
val lemma_lognot_value_zero: #n:pos -> a:uint_t n{a = 0} ->
+  Lemma (lognot a = sub_mod (sub_mod 0 a) 1)
+
val lemma_one_mod_pow2: #n:pos ->
+  Lemma (1 = 1 % (pow2 n))
+
val lemma_lognot_value_nonzero: #n:pos -> a:uint_t n{a <> 0} ->
+  Lemma (lognot a = sub_mod (sub_mod 0 a) 1)
+
val lemma_lognot_value: #n:pos -> a:uint_t n ->
+  Lemma (lognot #n a = sub_mod (sub_mod 0 a) 1)
+
val lemma_minus_eq_zero_sub: #n:pos -> a:uint_t n ->
+  Lemma (minus #n a = sub_mod #n 0 a)
+ diff --git a/docs/FStar.UInt128.html b/docs/FStar.UInt128.html index 505e5e4..e4e7a2f 100644 --- a/docs/FStar.UInt128.html +++ b/docs/FStar.UInt128.html @@ -1,16 +1,141 @@ - - + + - - - - - + FStar.UInt128 + -

module FStar.UInt128

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.UInt128

+ +
noextract
+let n = 128
+
val t: (x:Type0{hasEq x})
+
[@@ noextract_to "Kremlin"]
+val v (x:t) : Tot (uint_t n)
+
[@@ noextract_to "Kremlin"]
+val uint_to_t: x:uint_t n -> Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+
val v_inj (x1 x2: t): Lemma (requires (v x1 == v x2)) (ensures (x1 == x2))
+
val add: a:t -> b:t -> Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+
val add_underspec: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a + v b) n ==> v a + v b = v c))
+
val add_mod: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun c -> (v a + v b) % pow2 n = v c))
+

Subtraction primitives

+
val sub: a:t -> b:t -> Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+
val sub_underspec: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a - v b) n ==> v a - v b = v c))
+
val sub_mod: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun c -> (v a - v b) % pow2 n = v c))
+

Bitwise operators

+
val logand: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun r -> v r == logand (v a) (v b)))
+
val logxor: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun r -> v r == logxor (v a) (v b)))
+
val logor: a:t -> b:t -> Pure t
+  (requires True)
+  (ensures (fun r -> v r == logor (v a) (v b)))
+
val lognot: a:t -> Pure t
+  (requires True)
+  (ensures (fun r -> v r == lognot (v a)))
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verifiation check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __uint_to_t (x:int) : Tot t =
+      assume (fits x 128);
+      uint_to_t x
+

Shift operators

+
val shift_left: a:t -> s:UInt32.t -> Pure t
+  (requires (U32.v s < n))
+  (ensures (fun c -> v c = ((v a * pow2 (UInt32.v s)) % pow2 n)))
+
val shift_right: a:t -> s:UInt32.t -> Pure t
+  (requires (U32.v s < n))
+  (ensures (fun c -> v c = (v a / (pow2 (UInt32.v s)))))
+

Comparison operators

+
val eq (a:t) (b:t) : Pure bool
+  (requires True)
+  (ensures (fun r -> r == eq #n (v a) (v b)))
+
val gt (a:t) (b:t) : Pure bool
+  (requires True)
+  (ensures (fun r -> r == gt #n (v a) (v b)))
+
val lt (a:t) (b:t) : Pure bool
+  (requires True)
+  (ensures (fun r -> r == lt #n (v a) (v b)))
+
val gte (a:t) (b:t) : Pure bool
+  (requires True)
+  (ensures (fun r -> r == gte #n (v a) (v b)))
+
val lte (a:t) (b:t) : Pure bool
+  (requires True)
+  (ensures (fun r -> r == lte #n (v a) (v b)))
+
val eq_mask: a:t -> b:t -> Tot (c:t{(v a = v b ==> v c = pow2 n - 1) /\ (v a <> v b ==> v c = 0)})
+val gte_mask: a:t -> b:t -> Tot (c:t{(v a >= v b ==> v c = pow2 n - 1) /\ (v a < v b ==> v c = 0)})
+

Casts

+
val uint64_to_uint128: a:U64.t -> b:t{v b == U64.v a}
+val uint128_to_uint64: a:t -> b:U64.t{U64.v b == v a % pow2 64}
+

To input / output constants

+

TODO: assume these without implementations

+

val to_string: t -> Tot string +val of_string: string -> Tot t

+

Infix notations

+
inline_for_extraction noextract let op_Plus_Hat = add
+inline_for_extraction noextract let op_Plus_Question_Hat = add_underspec
+inline_for_extraction noextract let op_Plus_Percent_Hat = add_mod
+inline_for_extraction noextract let op_Subtraction_Hat = sub
+inline_for_extraction noextract let op_Subtraction_Question_Hat = sub_underspec
+inline_for_extraction noextract let op_Subtraction_Percent_Hat = sub_mod
+inline_for_extraction noextract let op_Amp_Hat = logand
+inline_for_extraction noextract let op_Hat_Hat = logxor
+inline_for_extraction noextract let op_Bar_Hat = logor
+inline_for_extraction noextract let op_Less_Less_Hat = shift_left
+inline_for_extraction noextract let op_Greater_Greater_Hat = shift_right
+inline_for_extraction noextract let op_Equals_Hat = eq
+inline_for_extraction noextract let op_Greater_Hat = gt
+inline_for_extraction noextract let op_Less_Hat = lt
+inline_for_extraction noextract let op_Greater_Equals_Hat = gte
+inline_for_extraction noextract let op_Less_Equals_Hat = lte
+

Multiplication primitives

+

Note that unlike UIntN, we do not provide uint128 * uint128 primitives (mul, +mul_underspec, mul_mod, and mul_div)

+
val mul32: x:U64.t -> y:U32.t -> Pure t
+  (requires True)
+  (ensures (fun r -> v r == U64.v x * U32.v y))
+
val mul_wide: x:U64.t -> y:U64.t -> Pure t
+  (requires True)
+  (ensures (fun r -> v r == U64.v x * U64.v y))
+ diff --git a/docs/FStar.UInt16.html b/docs/FStar.UInt16.html index 40b5673..69e9dad 100644 --- a/docs/FStar.UInt16.html +++ b/docs/FStar.UInt16.html @@ -1,16 +1,376 @@ - - + + - - - - - + FStar.UInt16 + -

module FStar.UInt16

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.UInt16

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 16
+
+

For FStar.UIntN.fstp: anything that you fix/update here should be +reflected in FStar.IntN.fstp, which is mostly a copy-paste of +this module.

+

Except, as compared to FStar.IntN.fstp, here:

+ +
+
+

This module provides an abstract type for machine integers of a +given signedness and width. The interface is designed to be safe +with respect to arithmetic underflow and overflow.

+
+
+

Note, we have attempted several times to re-design this module to +make it more amenable to normalization and to impose less overhead +on the SMT solver when reasoning about machine integer +arithmetic. The following github issue reports on the current +status of that work.

+

https://github.com/FStarLang/FStar/issues/1757

+
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

+t

+

Abstract type of machine integers, with an underlying +representation using a bounded mathematical integer

+
new val t : eqtype
+

+v

+

A coercion that projects a bounded mathematical integer from a +machine integer

+
val v (x:t) : Tot (uint_t n)
+

+uint_to_t

+

A coercion that injects a bounded mathematical integers into a +machine integer

+
val uint_to_t (x:uint_t n) : Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+

+uv_inv

+

Injection/projection inverse

+
val uv_inv (x : t) : Lemma
+  (ensures (uint_to_t (v x) == x))
+  [SMTPat (v x)]
+

+vu_inv

+

Projection/injection inverse

+
val vu_inv (x : uint_t n) : Lemma
+  (ensures (v (uint_to_t x) == x))
+  [SMTPat (uint_to_t x)]
+

+v_inj

+

An alternate form of the injectivity of the v projection

+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+

+zero

+

Constants 0 and 1

+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+

+Addition primitives

+

+add

+

Bounds-respecting addition

+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

The precondition enforces that the sum does not overflow, +expressing the bound as an addition on mathematical integers

+

+add_underspec

+

Underspecified, possibly overflowing addition:

+
val add_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a + v b) n ==> v a + v b = v c))
+

The postcondition only enures that the result is the sum of the +arguments in case there is no overflow

+

+add_mod

+

Addition modulo 2^n

+
val add_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.add_mod (v a) (v b) = v c))
+

Machine integers can always be added, but the postcondition is now +in terms of addition modulo 2^n on mathematical integers

+

+Subtraction primitives

+

+sub

+

Bounds-respecting subtraction

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

The precondition enforces that the difference does not underflow, +expressing the bound as a difference on mathematical integers

+

+sub_underspec

+

Underspecified, possibly overflowing subtraction:

+
val sub_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a - v b) n ==> v a - v b = v c))
+

The postcondition only enures that the result is the difference of +the arguments in case there is no underflow

+

+sub_mod

+

Subtraction modulo 2^n

+
val sub_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.sub_mod (v a) (v b) = v c))
+

Machine integers can always be subtractd, but the postcondition is +now in terms of subtraction modulo 2^n on mathematical integers

+

+Multiplication primitives

+

+mul

+

Bounds-respecting multiplication

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

The precondition enforces that the product does not overflow, +expressing the bound as a product on mathematical integers

+

+mul_underspec

+

Underspecified, possibly overflowing product

+
val mul_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a * v b) n ==> v a * v b = v c))
+

The postcondition only enures that the result is the product of +the arguments in case there is no overflow

+

+mul_mod

+

Multiplication modulo 2^n

+
val mul_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mul_mod (v a) (v b) = v c))
+

Machine integers can always be multiplied, but the postcondition +is now in terms of product modulo 2^n on mathematical integers

+

+Division primitives

+

+div

+

Euclidean division of a and b, with b non-zero

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (True))
+  (ensures (fun c -> v a / v b = v c))
+

+Modulo primitives

+

+rem

+

Euclidean remainder

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mod (v a) (v b) = v c))
+

The result is the modulus of a with respect to a non-zero b

+

+Bitwise operators

+
+

Also see FStar.BV

+
+

+logand

+

Bitwise logical conjunction

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+

+logxor

+

Bitwise logical exclusive-or

+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+

+logor

+

Bitwise logical disjunction

+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+

+lognot

+

Bitwise logical negation

+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

+Shift operators

+

+shift_right

+

Shift right with zero fill, shifting at most the integer width

+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.UInt.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

+

Shift left with zero fill, shifting at most the integer width

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.UInt.shift_left (v a) (UInt32.v s) = v c))
+

+Comparison operators

+

+eq

+

Equality

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+

Note, it is safe to also use the polymorphic decidable equality +operator =

+

+gt

+

Greater than

+
let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+

+gte

+

Greater than or equal

+
let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+

+lt

+

Less than

+
let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+

+lte

+

Less than or equal

+
let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

+minus

+

Unary negation

+
inline_for_extraction
+let minus (a:t) = add_mod (lognot a) (uint_to_t 1)
+

+n_minus_one

+

The maximum value for this type

+
inline_for_extraction
+let n_minus_one = UInt32.uint_to_t (n - 1)
+
#set-options "--z3rlimit 80 --initial_fuel 1 --max_fuel 1"
+

+eq_mask

+

A constant-time way to compute the equality of +two machine integers.

+
let eq_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a = v b ==> v c = pow2 n - 1) /\
+                       (v a <> v b ==> v c = 0)))
+  = let x = logxor a b in
+    let minus_x = minus x in
+    let x_or_minus_x = logor x minus_x in
+    let xnx = shift_right x_or_minus_x n_minus_one in
+    let c = sub_mod xnx (uint_to_t 1) in
+    if a = b then
+    begin
+      logxor_self (v a);
+      lognot_lemma_1 #n;
+      logor_lemma_1 (v x);
+      assert (v x = 0 /\ v minus_x = 0 /\
+              v x_or_minus_x = 0 /\ v xnx = 0);
+      assert (v c = ones n)
+    end
+    else
+    begin
+      logxor_neq_nonzero (v a) (v b);
+      lemma_msb_pow2 #n (v (lognot x));
+      lemma_msb_pow2 #n (v minus_x);
+      lemma_minus_zero #n (v x);
+      assert (v c = FStar.UInt.zero n)
+    end;
+    c
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=2e60bb395c1f589a398ec606d611132ef9ef764b

+

Note, the branching on a=b is just for proof-purposes.

+
private
+val lemma_sub_msbs (a:t) (b:t)
+    : Lemma ((msb (v a) = msb (v b)) ==> (v a < v b <==> msb (v (sub_mod a b))))
+

+gte_mask

+

A constant-time way to compute the >= inequality of +two machine integers.

+
let gte_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a >= v b ==> v c = pow2 n - 1) /\
+                       (v a < v b ==> v c = 0)))
+  = let x = a in
+    let y = b in
+    let x_xor_y = logxor x y in
+    let x_sub_y = sub_mod x y in
+    let x_sub_y_xor_y = logxor x_sub_y y in
+    let q = logor x_xor_y x_sub_y_xor_y in
+    let x_xor_q = logxor x q in
+    let x_xor_q_ = shift_right x_xor_q n_minus_one in
+    let c = sub_mod x_xor_q_ (uint_to_t 1) in
+    lemma_sub_msbs x y;
+    lemma_msb_gte (v x) (v y);
+    lemma_msb_gte (v y) (v x);
+    c
+#reset-options
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=0a483a9b431d87eca1b275463c632f8d5551978a

+

+Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Plus_Question_Hat = add_underspec
+unfold let op_Plus_Percent_Hat = add_mod
+unfold let op_Subtraction_Hat = sub
+unfold let op_Subtraction_Question_Hat = sub_underspec
+unfold let op_Subtraction_Percent_Hat = sub_mod
+unfold let op_Star_Hat = mul
+unfold let op_Star_Question_Hat = mul_underspec
+unfold let op_Star_Percent_Hat = mul_mod
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+

+To input / output constants

+

+to_string

+

In decimal representation

+
val to_string: t -> Tot string
+

+to_string_hex

+

In hex representation (with leading 0x)

+
val to_string_hex: t -> Tot string
+

+to_string_hex_pad

+

In fixed-width hex representation (left-padded with zeroes, no leading 0x)

+
val to_string_hex_pad: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __uint_to_t (x:int) : Tot t
+    = uint_to_t x
+#reset-options
+ diff --git a/docs/FStar.UInt32.html b/docs/FStar.UInt32.html index 0f5e1eb..7adf2fb 100644 --- a/docs/FStar.UInt32.html +++ b/docs/FStar.UInt32.html @@ -1,16 +1,376 @@ - - + + - - - - - + FStar.UInt32 + -

module FStar.UInt32

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.UInt32

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 32
+
+

For FStar.UIntN.fstp: anything that you fix/update here should be +reflected in FStar.IntN.fstp, which is mostly a copy-paste of +this module.

+

Except, as compared to FStar.IntN.fstp, here:

+ +
+
+

This module provides an abstract type for machine integers of a +given signedness and width. The interface is designed to be safe +with respect to arithmetic underflow and overflow.

+
+
+

Note, we have attempted several times to re-design this module to +make it more amenable to normalization and to impose less overhead +on the SMT solver when reasoning about machine integer +arithmetic. The following github issue reports on the current +status of that work.

+

https://github.com/FStarLang/FStar/issues/1757

+
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

+t

+

Abstract type of machine integers, with an underlying +representation using a bounded mathematical integer

+
new val t : eqtype
+

+v

+

A coercion that projects a bounded mathematical integer from a +machine integer

+
val v (x:t) : Tot (uint_t n)
+

+uint_to_t

+

A coercion that injects a bounded mathematical integers into a +machine integer

+
val uint_to_t (x:uint_t n) : Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+

+uv_inv

+

Injection/projection inverse

+
val uv_inv (x : t) : Lemma
+  (ensures (uint_to_t (v x) == x))
+  [SMTPat (v x)]
+

+vu_inv

+

Projection/injection inverse

+
val vu_inv (x : uint_t n) : Lemma
+  (ensures (v (uint_to_t x) == x))
+  [SMTPat (uint_to_t x)]
+

+v_inj

+

An alternate form of the injectivity of the v projection

+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+

+zero

+

Constants 0 and 1

+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+

+Addition primitives

+

+add

+

Bounds-respecting addition

+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

The precondition enforces that the sum does not overflow, +expressing the bound as an addition on mathematical integers

+

+add_underspec

+

Underspecified, possibly overflowing addition:

+
val add_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a + v b) n ==> v a + v b = v c))
+

The postcondition only enures that the result is the sum of the +arguments in case there is no overflow

+

+add_mod

+

Addition modulo 2^n

+
val add_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.add_mod (v a) (v b) = v c))
+

Machine integers can always be added, but the postcondition is now +in terms of addition modulo 2^n on mathematical integers

+

+Subtraction primitives

+

+sub

+

Bounds-respecting subtraction

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

The precondition enforces that the difference does not underflow, +expressing the bound as a difference on mathematical integers

+

+sub_underspec

+

Underspecified, possibly overflowing subtraction:

+
val sub_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a - v b) n ==> v a - v b = v c))
+

The postcondition only enures that the result is the difference of +the arguments in case there is no underflow

+

+sub_mod

+

Subtraction modulo 2^n

+
val sub_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.sub_mod (v a) (v b) = v c))
+

Machine integers can always be subtractd, but the postcondition is +now in terms of subtraction modulo 2^n on mathematical integers

+

+Multiplication primitives

+

+mul

+

Bounds-respecting multiplication

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

The precondition enforces that the product does not overflow, +expressing the bound as a product on mathematical integers

+

+mul_underspec

+

Underspecified, possibly overflowing product

+
val mul_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a * v b) n ==> v a * v b = v c))
+

The postcondition only enures that the result is the product of +the arguments in case there is no overflow

+

+mul_mod

+

Multiplication modulo 2^n

+
val mul_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mul_mod (v a) (v b) = v c))
+

Machine integers can always be multiplied, but the postcondition +is now in terms of product modulo 2^n on mathematical integers

+

+Division primitives

+

+div

+

Euclidean division of a and b, with b non-zero

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (True))
+  (ensures (fun c -> v a / v b = v c))
+

+Modulo primitives

+

+rem

+

Euclidean remainder

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mod (v a) (v b) = v c))
+

The result is the modulus of a with respect to a non-zero b

+

+Bitwise operators

+
+

Also see FStar.BV

+
+

+logand

+

Bitwise logical conjunction

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+

+logxor

+

Bitwise logical exclusive-or

+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+

+logor

+

Bitwise logical disjunction

+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+

+lognot

+

Bitwise logical negation

+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

+Shift operators

+

+shift_right

+

Shift right with zero fill, shifting at most the integer width

+
val shift_right (a:t) (s:t) : Pure t
+  (requires (v s < n))
+  (ensures (fun c -> FStar.UInt.shift_right (v a) (v s) = v c))
+

+shift_left

+

Shift left with zero fill, shifting at most the integer width

+
val shift_left (a:t) (s:t) : Pure t
+  (requires (v s < n))
+  (ensures (fun c -> FStar.UInt.shift_left (v a) (v s) = v c))
+

+Comparison operators

+

+eq

+

Equality

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+

Note, it is safe to also use the polymorphic decidable equality +operator =

+

+gt

+

Greater than

+
let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+

+gte

+

Greater than or equal

+
let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+

+lt

+

Less than

+
let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+

+lte

+

Less than or equal

+
let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

+minus

+

Unary negation

+
inline_for_extraction
+let minus (a:t) = add_mod (lognot a) (uint_to_t 1)
+

+n_minus_one

+

The maximum value for this type

+
inline_for_extraction
+let n_minus_one = uint_to_t (n - 1)
+
#set-options "--z3rlimit 80 --initial_fuel 1 --max_fuel 1"
+

+eq_mask

+

A constant-time way to compute the equality of +two machine integers.

+
let eq_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a = v b ==> v c = pow2 n - 1) /\
+                       (v a <> v b ==> v c = 0)))
+  = let x = logxor a b in
+    let minus_x = minus x in
+    let x_or_minus_x = logor x minus_x in
+    let xnx = shift_right x_or_minus_x n_minus_one in
+    let c = sub_mod xnx (uint_to_t 1) in
+    if a = b then
+    begin
+      logxor_self (v a);
+      lognot_lemma_1 #n;
+      logor_lemma_1 (v x);
+      assert (v x = 0 /\ v minus_x = 0 /\
+              v x_or_minus_x = 0 /\ v xnx = 0);
+      assert (v c = ones n)
+    end
+    else
+    begin
+      logxor_neq_nonzero (v a) (v b);
+      lemma_msb_pow2 #n (v (lognot x));
+      lemma_msb_pow2 #n (v minus_x);
+      lemma_minus_zero #n (v x);
+      assert (v c = FStar.UInt.zero n)
+    end;
+    c
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=2e60bb395c1f589a398ec606d611132ef9ef764b

+

Note, the branching on a=b is just for proof-purposes.

+
private
+val lemma_sub_msbs (a:t) (b:t)
+    : Lemma ((msb (v a) = msb (v b)) ==> (v a < v b <==> msb (v (sub_mod a b))))
+

+gte_mask

+

A constant-time way to compute the >= inequality of +two machine integers.

+
let gte_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a >= v b ==> v c = pow2 n - 1) /\
+                       (v a < v b ==> v c = 0)))
+  = let x = a in
+    let y = b in
+    let x_xor_y = logxor x y in
+    let x_sub_y = sub_mod x y in
+    let x_sub_y_xor_y = logxor x_sub_y y in
+    let q = logor x_xor_y x_sub_y_xor_y in
+    let x_xor_q = logxor x q in
+    let x_xor_q_ = shift_right x_xor_q n_minus_one in
+    let c = sub_mod x_xor_q_ (uint_to_t 1) in
+    lemma_sub_msbs x y;
+    lemma_msb_gte (v x) (v y);
+    lemma_msb_gte (v y) (v x);
+    c
+#reset-options
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=0a483a9b431d87eca1b275463c632f8d5551978a

+

+Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Plus_Question_Hat = add_underspec
+unfold let op_Plus_Percent_Hat = add_mod
+unfold let op_Subtraction_Hat = sub
+unfold let op_Subtraction_Question_Hat = sub_underspec
+unfold let op_Subtraction_Percent_Hat = sub_mod
+unfold let op_Star_Hat = mul
+unfold let op_Star_Question_Hat = mul_underspec
+unfold let op_Star_Percent_Hat = mul_mod
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+

+To input / output constants

+

+to_string

+

In decimal representation

+
val to_string: t -> Tot string
+

+to_string_hex

+

In hex representation (with leading 0x)

+
val to_string_hex: t -> Tot string
+

+to_string_hex_pad

+

In fixed-width hex representation (left-padded with zeroes, no leading 0x)

+
val to_string_hex_pad: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __uint_to_t (x:int) : Tot t
+    = uint_to_t x
+#reset-options
+ diff --git a/docs/FStar.UInt64.html b/docs/FStar.UInt64.html index 125123a..2be0826 100644 --- a/docs/FStar.UInt64.html +++ b/docs/FStar.UInt64.html @@ -1,16 +1,376 @@ - - + + - - - - - + FStar.UInt64 + -

module FStar.UInt64

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.UInt64

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 64
+
+

For FStar.UIntN.fstp: anything that you fix/update here should be +reflected in FStar.IntN.fstp, which is mostly a copy-paste of +this module.

+

Except, as compared to FStar.IntN.fstp, here:

+ +
+
+

This module provides an abstract type for machine integers of a +given signedness and width. The interface is designed to be safe +with respect to arithmetic underflow and overflow.

+
+
+

Note, we have attempted several times to re-design this module to +make it more amenable to normalization and to impose less overhead +on the SMT solver when reasoning about machine integer +arithmetic. The following github issue reports on the current +status of that work.

+

https://github.com/FStarLang/FStar/issues/1757

+
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

+t

+

Abstract type of machine integers, with an underlying +representation using a bounded mathematical integer

+
new val t : eqtype
+

+v

+

A coercion that projects a bounded mathematical integer from a +machine integer

+
val v (x:t) : Tot (uint_t n)
+

+uint_to_t

+

A coercion that injects a bounded mathematical integers into a +machine integer

+
val uint_to_t (x:uint_t n) : Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+

+uv_inv

+

Injection/projection inverse

+
val uv_inv (x : t) : Lemma
+  (ensures (uint_to_t (v x) == x))
+  [SMTPat (v x)]
+

+vu_inv

+

Projection/injection inverse

+
val vu_inv (x : uint_t n) : Lemma
+  (ensures (v (uint_to_t x) == x))
+  [SMTPat (uint_to_t x)]
+

+v_inj

+

An alternate form of the injectivity of the v projection

+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+

+zero

+

Constants 0 and 1

+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+

+Addition primitives

+

+add

+

Bounds-respecting addition

+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

The precondition enforces that the sum does not overflow, +expressing the bound as an addition on mathematical integers

+

+add_underspec

+

Underspecified, possibly overflowing addition:

+
val add_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a + v b) n ==> v a + v b = v c))
+

The postcondition only enures that the result is the sum of the +arguments in case there is no overflow

+

+add_mod

+

Addition modulo 2^n

+
val add_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.add_mod (v a) (v b) = v c))
+

Machine integers can always be added, but the postcondition is now +in terms of addition modulo 2^n on mathematical integers

+

+Subtraction primitives

+

+sub

+

Bounds-respecting subtraction

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

The precondition enforces that the difference does not underflow, +expressing the bound as a difference on mathematical integers

+

+sub_underspec

+

Underspecified, possibly overflowing subtraction:

+
val sub_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a - v b) n ==> v a - v b = v c))
+

The postcondition only enures that the result is the difference of +the arguments in case there is no underflow

+

+sub_mod

+

Subtraction modulo 2^n

+
val sub_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.sub_mod (v a) (v b) = v c))
+

Machine integers can always be subtractd, but the postcondition is +now in terms of subtraction modulo 2^n on mathematical integers

+

+Multiplication primitives

+

+mul

+

Bounds-respecting multiplication

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

The precondition enforces that the product does not overflow, +expressing the bound as a product on mathematical integers

+

+mul_underspec

+

Underspecified, possibly overflowing product

+
val mul_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a * v b) n ==> v a * v b = v c))
+

The postcondition only enures that the result is the product of +the arguments in case there is no overflow

+

+mul_mod

+

Multiplication modulo 2^n

+
val mul_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mul_mod (v a) (v b) = v c))
+

Machine integers can always be multiplied, but the postcondition +is now in terms of product modulo 2^n on mathematical integers

+

+Division primitives

+

+div

+

Euclidean division of a and b, with b non-zero

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (True))
+  (ensures (fun c -> v a / v b = v c))
+

+Modulo primitives

+

+rem

+

Euclidean remainder

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mod (v a) (v b) = v c))
+

The result is the modulus of a with respect to a non-zero b

+

+Bitwise operators

+
+

Also see FStar.BV

+
+

+logand

+

Bitwise logical conjunction

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+

+logxor

+

Bitwise logical exclusive-or

+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+

+logor

+

Bitwise logical disjunction

+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+

+lognot

+

Bitwise logical negation

+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

+Shift operators

+

+shift_right

+

Shift right with zero fill, shifting at most the integer width

+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.UInt.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

+

Shift left with zero fill, shifting at most the integer width

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.UInt.shift_left (v a) (UInt32.v s) = v c))
+

+Comparison operators

+

+eq

+

Equality

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+

Note, it is safe to also use the polymorphic decidable equality +operator =

+

+gt

+

Greater than

+
let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+

+gte

+

Greater than or equal

+
let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+

+lt

+

Less than

+
let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+

+lte

+

Less than or equal

+
let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

+minus

+

Unary negation

+
inline_for_extraction
+let minus (a:t) = add_mod (lognot a) (uint_to_t 1)
+

+n_minus_one

+

The maximum value for this type

+
inline_for_extraction
+let n_minus_one = UInt32.uint_to_t (n - 1)
+
#set-options "--z3rlimit 80 --initial_fuel 1 --max_fuel 1"
+

+eq_mask

+

A constant-time way to compute the equality of +two machine integers.

+
let eq_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a = v b ==> v c = pow2 n - 1) /\
+                       (v a <> v b ==> v c = 0)))
+  = let x = logxor a b in
+    let minus_x = minus x in
+    let x_or_minus_x = logor x minus_x in
+    let xnx = shift_right x_or_minus_x n_minus_one in
+    let c = sub_mod xnx (uint_to_t 1) in
+    if a = b then
+    begin
+      logxor_self (v a);
+      lognot_lemma_1 #n;
+      logor_lemma_1 (v x);
+      assert (v x = 0 /\ v minus_x = 0 /\
+              v x_or_minus_x = 0 /\ v xnx = 0);
+      assert (v c = ones n)
+    end
+    else
+    begin
+      logxor_neq_nonzero (v a) (v b);
+      lemma_msb_pow2 #n (v (lognot x));
+      lemma_msb_pow2 #n (v minus_x);
+      lemma_minus_zero #n (v x);
+      assert (v c = FStar.UInt.zero n)
+    end;
+    c
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=2e60bb395c1f589a398ec606d611132ef9ef764b

+

Note, the branching on a=b is just for proof-purposes.

+
private
+val lemma_sub_msbs (a:t) (b:t)
+    : Lemma ((msb (v a) = msb (v b)) ==> (v a < v b <==> msb (v (sub_mod a b))))
+

+gte_mask

+

A constant-time way to compute the >= inequality of +two machine integers.

+
let gte_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a >= v b ==> v c = pow2 n - 1) /\
+                       (v a < v b ==> v c = 0)))
+  = let x = a in
+    let y = b in
+    let x_xor_y = logxor x y in
+    let x_sub_y = sub_mod x y in
+    let x_sub_y_xor_y = logxor x_sub_y y in
+    let q = logor x_xor_y x_sub_y_xor_y in
+    let x_xor_q = logxor x q in
+    let x_xor_q_ = shift_right x_xor_q n_minus_one in
+    let c = sub_mod x_xor_q_ (uint_to_t 1) in
+    lemma_sub_msbs x y;
+    lemma_msb_gte (v x) (v y);
+    lemma_msb_gte (v y) (v x);
+    c
+#reset-options
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=0a483a9b431d87eca1b275463c632f8d5551978a

+

+Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Plus_Question_Hat = add_underspec
+unfold let op_Plus_Percent_Hat = add_mod
+unfold let op_Subtraction_Hat = sub
+unfold let op_Subtraction_Question_Hat = sub_underspec
+unfold let op_Subtraction_Percent_Hat = sub_mod
+unfold let op_Star_Hat = mul
+unfold let op_Star_Question_Hat = mul_underspec
+unfold let op_Star_Percent_Hat = mul_mod
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+

+To input / output constants

+

+to_string

+

In decimal representation

+
val to_string: t -> Tot string
+

+to_string_hex

+

In hex representation (with leading 0x)

+
val to_string_hex: t -> Tot string
+

+to_string_hex_pad

+

In fixed-width hex representation (left-padded with zeroes, no leading 0x)

+
val to_string_hex_pad: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __uint_to_t (x:int) : Tot t
+    = uint_to_t x
+#reset-options
+ diff --git a/docs/FStar.UInt8.html b/docs/FStar.UInt8.html index 5cb7bd6..b0fd6b0 100644 --- a/docs/FStar.UInt8.html +++ b/docs/FStar.UInt8.html @@ -1,16 +1,377 @@ - - + + - - - - - + FStar.UInt8 + -

module FStar.UInt8

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.UInt8

+

+THIS MODULE IS GENETATED AUTOMATICALLY USING mk_int.sh, DO NOT EDIT DIRECTLY ***

+
unfold let n = 8
+
+

For FStar.UIntN.fstp: anything that you fix/update here should be +reflected in FStar.IntN.fstp, which is mostly a copy-paste of +this module.

+

Except, as compared to FStar.IntN.fstp, here:

+ +
+
+

This module provides an abstract type for machine integers of a +given signedness and width. The interface is designed to be safe +with respect to arithmetic underflow and overflow.

+
+
+

Note, we have attempted several times to re-design this module to +make it more amenable to normalization and to impose less overhead +on the SMT solver when reasoning about machine integer +arithmetic. The following github issue reports on the current +status of that work.

+

https://github.com/FStarLang/FStar/issues/1757

+
+ +
#set-options "--max_fuel 0 --max_ifuel 0"
+

+t

+

Abstract type of machine integers, with an underlying +representation using a bounded mathematical integer

+
new val t : eqtype
+

+v

+

A coercion that projects a bounded mathematical integer from a +machine integer

+
val v (x:t) : Tot (uint_t n)
+

+uint_to_t

+

A coercion that injects a bounded mathematical integers into a +machine integer

+
val uint_to_t (x:uint_t n) : Pure t
+  (requires True)
+  (ensures (fun y -> v y = x))
+

+uv_inv

+

Injection/projection inverse

+
val uv_inv (x : t) : Lemma
+  (ensures (uint_to_t (v x) == x))
+  [SMTPat (v x)]
+

+vu_inv

+

Projection/injection inverse

+
val vu_inv (x : uint_t n) : Lemma
+  (ensures (v (uint_to_t x) == x))
+  [SMTPat (uint_to_t x)]
+

+v_inj

+

An alternate form of the injectivity of the v projection

+
val v_inj (x1 x2: t): Lemma
+  (requires (v x1 == v x2))
+  (ensures (x1 == x2))
+

+zero

+

Constants 0 and 1

+
val zero : x:t{v x = 0}
+
val one : x:t{v x = 1}
+

+Addition primitives

+

+add

+

Bounds-respecting addition

+
val add (a:t) (b:t) : Pure t
+  (requires (size (v a + v b) n))
+  (ensures (fun c -> v a + v b = v c))
+

The precondition enforces that the sum does not overflow, +expressing the bound as an addition on mathematical integers

+

+add_underspec

+

Underspecified, possibly overflowing addition:

+
val add_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a + v b) n ==> v a + v b = v c))
+

The postcondition only enures that the result is the sum of the +arguments in case there is no overflow

+

+add_mod

+

Addition modulo 2^n

+
val add_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.add_mod (v a) (v b) = v c))
+

Machine integers can always be added, but the postcondition is now +in terms of addition modulo 2^n on mathematical integers

+

+Subtraction primitives

+

+sub

+

Bounds-respecting subtraction

+
val sub (a:t) (b:t) : Pure t
+  (requires (size (v a - v b) n))
+  (ensures (fun c -> v a - v b = v c))
+

The precondition enforces that the difference does not underflow, +expressing the bound as a difference on mathematical integers

+

+sub_underspec

+

Underspecified, possibly overflowing subtraction:

+
val sub_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a - v b) n ==> v a - v b = v c))
+

The postcondition only enures that the result is the difference of +the arguments in case there is no underflow

+

+sub_mod

+

Subtraction modulo 2^n

+
val sub_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.sub_mod (v a) (v b) = v c))
+

Machine integers can always be subtractd, but the postcondition is +now in terms of subtraction modulo 2^n on mathematical integers

+

+Multiplication primitives

+

+mul

+

Bounds-respecting multiplication

+
val mul (a:t) (b:t) : Pure t
+  (requires (size (v a * v b) n))
+  (ensures (fun c -> v a * v b = v c))
+

The precondition enforces that the product does not overflow, +expressing the bound as a product on mathematical integers

+

+mul_underspec

+

Underspecified, possibly overflowing product

+
val mul_underspec (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c ->
+    size (v a * v b) n ==> v a * v b = v c))
+

The postcondition only enures that the result is the product of +the arguments in case there is no overflow

+

+mul_mod

+

Multiplication modulo 2^n

+
val mul_mod (a:t) (b:t) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mul_mod (v a) (v b) = v c))
+

Machine integers can always be multiplied, but the postcondition +is now in terms of product modulo 2^n on mathematical integers

+

+Division primitives

+

+div

+

Euclidean division of a and b, with b non-zero

+
val div (a:t) (b:t{v b <> 0}) : Pure t
+  (requires (True))
+  (ensures (fun c -> v a / v b = v c))
+

+Modulo primitives

+

+rem

+

Euclidean remainder

+
val rem (a:t) (b:t{v b <> 0}) : Pure t
+  (requires True)
+  (ensures (fun c -> FStar.UInt.mod (v a) (v b) = v c))
+

The result is the modulus of a with respect to a non-zero b

+

+Bitwise operators

+
+

Also see FStar.BV

+
+

+logand

+

Bitwise logical conjunction

+
val logand (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logand` v y = v z))
+

+logxor

+

Bitwise logical exclusive-or

+
val logxor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logxor` v y == v z))
+

+logor

+

Bitwise logical disjunction

+
val logor (x:t) (y:t) : Pure t
+  (requires True)
+  (ensures (fun z -> v x `logor` v y == v z))
+

+lognot

+

Bitwise logical negation

+
val lognot (x:t) : Pure t
+  (requires True)
+  (ensures (fun z -> lognot (v x) == v z))
+

+Shift operators

+

+shift_right

+

Shift right with zero fill, shifting at most the integer width

+
val shift_right (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.UInt.shift_right (v a) (UInt32.v s) = v c))
+

+shift_left

+

Shift left with zero fill, shifting at most the integer width

+
val shift_left (a:t) (s:UInt32.t) : Pure t
+  (requires (UInt32.v s < n))
+  (ensures (fun c -> FStar.UInt.shift_left (v a) (UInt32.v s) = v c))
+

+Comparison operators

+

+eq

+

Equality

+
let eq (a:t) (b:t) : Tot bool = eq #n (v a) (v b)
+

Note, it is safe to also use the polymorphic decidable equality +operator =

+

+gt

+

Greater than

+
let gt (a:t) (b:t) : Tot bool = gt #n (v a) (v b)
+

+gte

+

Greater than or equal

+
let gte (a:t) (b:t) : Tot bool = gte #n (v a) (v b)
+

+lt

+

Less than

+
let lt (a:t) (b:t) : Tot bool = lt #n (v a) (v b)
+

+lte

+

Less than or equal

+
let lte (a:t) (b:t) : Tot bool = lte #n (v a) (v b)
+

+minus

+

Unary negation

+
inline_for_extraction
+let minus (a:t) = add_mod (lognot a) (uint_to_t 1)
+

+n_minus_one

+

The maximum value for this type

+
inline_for_extraction
+let n_minus_one = UInt32.uint_to_t (n - 1)
+
#set-options "--z3rlimit 80 --initial_fuel 1 --max_fuel 1"
+

+eq_mask

+

A constant-time way to compute the equality of +two machine integers.

+
let eq_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a = v b ==> v c = pow2 n - 1) /\
+                       (v a <> v b ==> v c = 0)))
+  = let x = logxor a b in
+    let minus_x = minus x in
+    let x_or_minus_x = logor x minus_x in
+    let xnx = shift_right x_or_minus_x n_minus_one in
+    let c = sub_mod xnx (uint_to_t 1) in
+    if a = b then
+    begin
+      logxor_self (v a);
+      lognot_lemma_1 #n;
+      logor_lemma_1 (v x);
+      assert (v x = 0 /\ v minus_x = 0 /\
+              v x_or_minus_x = 0 /\ v xnx = 0);
+      assert (v c = ones n)
+    end
+    else
+    begin
+      logxor_neq_nonzero (v a) (v b);
+      lemma_msb_pow2 #n (v (lognot x));
+      lemma_msb_pow2 #n (v minus_x);
+      lemma_minus_zero #n (v x);
+      assert (v c = FStar.UInt.zero n)
+    end;
+    c
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=2e60bb395c1f589a398ec606d611132ef9ef764b

+

Note, the branching on a=b is just for proof-purposes.

+
private
+val lemma_sub_msbs (a:t) (b:t)
+    : Lemma ((msb (v a) = msb (v b)) ==> (v a < v b <==> msb (v (sub_mod a b))))
+

+gte_mask

+

A constant-time way to compute the >= inequality of +two machine integers.

+
let gte_mask (a:t) (b:t)
+  : Pure t
+    (requires True)
+    (ensures (fun c -> (v a >= v b ==> v c = pow2 n - 1) /\
+                       (v a < v b ==> v c = 0)))
+  = let x = a in
+    let y = b in
+    let x_xor_y = logxor x y in
+    let x_sub_y = sub_mod x y in
+    let x_sub_y_xor_y = logxor x_sub_y y in
+    let q = logor x_xor_y x_sub_y_xor_y in
+    let x_xor_q = logxor x q in
+    let x_xor_q_ = shift_right x_xor_q n_minus_one in
+    let c = sub_mod x_xor_q_ (uint_to_t 1) in
+    lemma_sub_msbs x y;
+    lemma_msb_gte (v x) (v y);
+    lemma_msb_gte (v y) (v x);
+    c
+#reset-options
+

With inspiration from https://git.zx2c4.com/WireGuard/commit/src/crypto/curve25519-hacl64.h?id=0a483a9b431d87eca1b275463c632f8d5551978a

+

+Infix notations

+
unfold let op_Plus_Hat = add
+unfold let op_Plus_Question_Hat = add_underspec
+unfold let op_Plus_Percent_Hat = add_mod
+unfold let op_Subtraction_Hat = sub
+unfold let op_Subtraction_Question_Hat = sub_underspec
+unfold let op_Subtraction_Percent_Hat = sub_mod
+unfold let op_Star_Hat = mul
+unfold let op_Star_Question_Hat = mul_underspec
+unfold let op_Star_Percent_Hat = mul_mod
+unfold let op_Slash_Hat = div
+unfold let op_Percent_Hat = rem
+unfold let op_Hat_Hat = logxor
+unfold let op_Amp_Hat = logand
+unfold let op_Bar_Hat = logor
+unfold let op_Less_Less_Hat = shift_left
+unfold let op_Greater_Greater_Hat = shift_right
+unfold let op_Equals_Hat = eq
+unfold let op_Greater_Hat = gt
+unfold let op_Greater_Equals_Hat = gte
+unfold let op_Less_Hat = lt
+unfold let op_Less_Equals_Hat = lte
+

+To input / output constants

+

+to_string

+

In decimal representation

+
val to_string: t -> Tot string
+

+to_string_hex

+

In hex representation (with leading 0x)

+
val to_string_hex: t -> Tot string
+

+to_string_hex_pad

+

In fixed-width hex representation (left-padded with zeroes, no leading 0x)

+
val to_string_hex_pad: t -> Tot string
+
val of_string: string -> Tot t
+
#set-options "--lax"
+

This private primitive is used internally by the +compiler to translate bounded integer constants +with a desugaring-time check of the size of the number, +rather than an expensive verification check. +Since it is marked private, client programs cannot call it directly +Since it is marked unfold, it eagerly reduces, +eliminating the verification overhead of the wrapper

+
private
+unfold
+let __uint_to_t (x:int) : Tot t
+    = uint_to_t x
+#reset-options
+unfold inline_for_extraction type byte = t
+ diff --git a/docs/FStar.Udp.html b/docs/FStar.Udp.html index b1cc384..9748df5 100644 --- a/docs/FStar.Udp.html +++ b/docs/FStar.Udp.html @@ -1,16 +1,40 @@ - - + + - - - - - + FStar.Udp + -

module FStar.Udp

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Udp

+ +

Type declarations

+
new val socket: eqtype
+new val sock_in_channel: Type0
+new val sock_out_channel: Type0
+new val udpListener: Type0
+

Server side

+
val listen: string -> nat -> EXT udpListener
+val accept: udpListener -> EXT socket
+val stop: udpListener -> EXT unit
+

Client side

+
val connect: string -> nat -> EXT socket
+

Input/Output

+
val recv: socket -> nat -> EXT (optResult string bytes)
+val send: socket -> bytes -> EXT (optResult string unit)
+val close: socket -> EXT unit
+

Helper functions

+
val socket_split: socket -> EXT (sock_in_channel * sock_out_channel)
+val flush: sock_out_channel -> EXT unit
+

Unimplemented

+

assume val connectTimeout: nat -> string -> nat -> EXT socket +assume val acceptTimeout: nat -> tcpListener -> EXT socket

+ diff --git a/docs/FStar.Universe.html b/docs/FStar.Universe.html index 1f6a6e7..72a7385 100644 --- a/docs/FStar.Universe.html +++ b/docs/FStar.Universe.html @@ -1,63 +1,47 @@ - - + + - - - - - - + FStar.Universe + -

module FStar.Universe

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-
 This module implements some basic facilities to raise the universe of a type *
-  * The type [raise_t a] is supposed to be isomorphic to [a] but in a higher     *
-  * universe. The two functions [raise_val] and [dowgrade_val] allow to coerce   *
-  * from [a] to [raise_t a] and back.                                            *
-
val raise_t:Unidentified product: [(Type a)] (Type max a b)
-

[raise_t a] is an isomorphic copy of [a] (living in universe 'ua) in universe [max 'ua 'ub] *

-
val raise_val:Unidentified product: [#a:(Type a)] Unidentified product: [x:a] raise_t a b a
-

[raise_val x] injects a value [x] of type [a] to [raise_t a] *

-
val downgrade_val:Unidentified product: [#a:(Type a)] Unidentified product: [x:raise_t a b a] a
-

[downgrade_val x] projects a value [x] of type [raise_t a] to [a] *

+

+FStar.Universe

+

This module implements some basic facilities to raise the universe of a type *

+ +

+raise_t

+

raise_t a is an isomorphic copy of a (living in universe 'ua) in universe max 'ua 'ub *

+
val raise_t : Type u#a -> Type u#(max a b)
+

+raise_val

+

raise_val x injects a value x of type a to raise_t a *

+
val raise_val : #a:Type u#a -> x:a -> raise_t u#a u#b a
+

+downgrade_val

+

downgrade_val x projects a value x of type raise_t a to a *

+
val downgrade_val : #a:Type u#a -> x:raise_t u#a u#b a -> a
+
val downgrade_val_raise_val
+  (#a: Type u#a)
+  (x: a)
+: Lemma
+  (downgrade_val u#a u#b (raise_val x) == x)
+  [SMTPat (downgrade_val u#a u#b (raise_val x))]
+
val raise_val_downgrade_val
+  (#a: Type u#a)
+  (x: raise_t u#a u#b a)
+: Lemma
+  (raise_val (downgrade_val x) == x)
+  [SMTPat (raise_val u#a u#b (downgrade_val x))]
+
let lift_dom #a #b (q:a -> b) : raise_t a -> b =
+  fun v -> q (downgrade_val v)
+
let lift_codom #a #b (q:a -> b) : a -> raise_t b =
+  fun v -> raise_val (q v)
+ diff --git a/docs/FStar.Util.html b/docs/FStar.Util.html index afb5196..35c418c 100644 --- a/docs/FStar.Util.html +++ b/docs/FStar.Util.html @@ -1,16 +1,26 @@ - - + + - - - - - + FStar.Util + -

module FStar.Util

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Util

+ +

2016-11-22: the following MUST be defined here AFTER the above open', since they are used in op_At_Plus_At` below

+
let op_Plus_Plus x y = TSet.union x y
+let op_Plus_Plus_Hat x y = x ++ (TSet.singleton y)
+let op_Hat_Plus_Hat  x y = (TSet.singleton x) ++ (TSet.singleton y)
+
let op_At_Plus_At (#a:Type) (#b:Type) (x:reference a) (y:reference b) =
+   Set.union (Set.singleton (as_addr x)) (Set.singleton (as_addr y))
+let op_Plus_Plus_At (#a:Type) (x:Set.set nat) (y:reference a) = Set.union x (Set.singleton (as_addr y))
+ diff --git a/docs/FStar.VConfig.html b/docs/FStar.VConfig.html new file mode 100644 index 0000000..e9b7d30 --- /dev/null +++ b/docs/FStar.VConfig.html @@ -0,0 +1,48 @@ + + + + + FStar.VConfig + + + +

+FStar.VConfig

+

+vconfig

+

This type represents the set of verification-relevant options used +to check a particular definition. It can be read from tactics via +sigelt_opts and set via the check_with attribute.

+
type vconfig = {
+  initial_fuel                              : int;
+  max_fuel                                  : int;
+  initial_ifuel                             : int;
+  max_ifuel                                 : int;
+  detail_errors                             : bool;
+  detail_hint_replay                        : bool;
+  no_smt                                    : bool;
+  quake_lo                                  : int;
+  quake_hi                                  : int;
+  quake_keep                                : bool;
+  retry                                     : bool;
+  smtencoding_elim_box                      : bool;
+  smtencoding_nl_arith_repr                 : string;
+  smtencoding_l_arith_repr                  : string;
+  smtencoding_valid_intro                   : bool;
+  smtencoding_valid_elim                    : bool;
+  tcnorm                                    : bool;
+  no_plugins                                : bool;
+  no_tactics                                : bool;
+  vcgen_optimize_bind_as_seq                : option string;
+  z3cliopt                                  : list string;
+  z3refresh                                 : bool;
+  z3rlimit                                  : int;
+  z3rlimit_factor                           : int;
+  z3seed                                    : int;
+  trivial_pre_for_unannotated_effectful_fns : bool;
+  reuse_hint_for                            : option string;
+}
+

This type, and the whole module, mirror FStar.VConfig in F* sources.

+ + + diff --git a/docs/FStar.Vector.Base.html b/docs/FStar.Vector.Base.html index 126b5d4..98ca9bb 100644 --- a/docs/FStar.Vector.Base.html +++ b/docs/FStar.Vector.Base.html @@ -1,57 +1,368 @@ - - + + - - - - - - + FStar.Vector.Base + -

module FStar.Vector.Base

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

-

-    Abstractly, a `vec a l` is just a sequence whose length is `U32.v l`.
-    `reveal` and `hide` build an isomorphism establishing this
-*
+

A library for vectors, i.e., immutable arrays, whose length is +representable by a machine integer, FStar.UInt32.t.

+

This is closely related to FStar.Seq, with the following main +differences:

+

The type raw a l: A raw vector

+
    +
  1. +

    Raw vectors receive special treatment during extraction, +especially by KreMLin, which extracts a vector to a raw C +pointer. When extracing to OCaml, a raw a l is a +Batteries.Vect t a

    +
    2. +
  2. +

    The length of a vector is representable in a U32.t

    +
    3. +
  3. +

    The interface is designed around a length-indexed type: this +enables the compilation to raw pointers, since this ensures +that all functions that manipulate vectors always have a U32 +variable describing that vector's length in scope.

    +

    A length-indexed interface is also suitable for clients for whom +proving properties about the length is a primary concern: the +signatures in this interface carry intrinsic proofs about length +properties, simplifying proof obligations in client code.

    +
    4. +
  4. +

    Raw vectors lack decidable equality (since that cannot be +implemented given the representation choice in KreMLin)

    +
    5. +
+

The type t a: A dynamically sized vector

+
    +
  1. +

    Conceptually, a t a is a pair of a len:U32.t and a raw a len. They are implemented as such by KreMLin. When extracting +to OCaml, t a is identical to raw a _, i.e., it is still +extracted to a Batteries.Vect.t a

    +
    2. +
  2. +

    Unlike raw vectors, t a supports decidable equality when it +is supported by a. This is the main reason t a is provided +at an abstract type, rather than being exposed as a pair of a +U32 and a raw vector, since the latter does not support +decidable equality.

    +
    3. +
+

@summary Immutable vectors whose length is less than pow2 32

+

+FStar.Vector.Base

+ +

//////////////////////////////////////////////////////////////////////////////

+
+

The basic model of raw vectors as u32-length sequences

+
+

//////////////////////////////////////////////////////////////////////////////

+
+

The length of a vector fits in 32 bits

+
+
let len_t = U32.t
+
+

A raw vector.

+ +
+
val raw:
+    a:Type u#a
+  -> l:len_t
+  -> Type u#a
+
+

A convenience to use nat for the length of vector in specs and proofs

+
+
let raw_length (#a:Type) (#l:len_t) (v:raw a l) : GTot nat = U32.v l
+
Abstractly, a `vec a l` is just a sequence whose length is `U32.v l`.
+`reveal` and `hide` build an isomorphism establishing this
+
+ +
val reveal:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> GTot (s:S.seq a{S.length s = raw_length v})
+
val hide:
+    #a:Type
+  -> s:S.seq a{S.length s < pow2 32}
+  -> GTot (raw a (U32.uint_to_t (S.length s)))
+
val hide_reveal:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> Lemma (ensures (hide (reveal v) == v))
+          [SMTPat (reveal v)]
+
val reveal_hide:
+    #a:Type
+  -> s:S.seq a{S.length s < pow2 32}
+  -> Lemma (ensures (reveal (hide s) == s))
+          [SMTPat (hide s)]
+
+

Extensional equality for vectors

+
+
let equal (#a:Type) (#l:len_t) (v1:raw a l) (v2:raw a l) =
+    Seq.equal (reveal v1) (reveal v2)
+
+

Extensional equality can be used to prove syntactic equality

+
+
val extensionality:
+    #a:Type
+  -> #l:len_t
+  -> v1:raw a l
+  -> v2:raw a l
+  -> Lemma (requires (equal v1 v2))
+          (ensures (v1 == v2))
+

//////////////////////////////////////////////////////////////////////////////

+
+

end of the basic model

+
+

//////////////////////////////////////////////////////////////////////////////

+

//////////////////////////////////////////////////////////////////////////////

+
+

A small set of basic operations on raw vectors, corresponding to the operations +on sequences. Other operations can be derived from these, as we do for seq. +-- init, index, update, append, slice

+
+

//////////////////////////////////////////////////////////////////////////////

+
+

index_t v: is the type of a within-bounds index of v

+
+
let index_t (#a:Type) (#l:len_t) (v:raw a l) =
+    m:len_t{U32.v m < U32.v l}
+
+

init l contents: +initialize an l-sized vector using contents i for the ith element

+
+
val init:
+    #a:Type
+  -> l:len_t
+  -> contents: (i:nat { i < U32.v l } -> Tot a)
+  -> Tot (raw a l)
+
+

index v i: get the ith element of v

+
+
val index:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> i:index_t v
+  -> Tot a
+
+

v.i`` is shorthand for index v i

+
+
unfold let op_String_Access #a #l = index #a #l
+
+

update v i x: +- a new vector that differs from v only at index i, where it contains x. +- Incurs a full copy in KreMLin +- In OCaml, the new vector shares as much as possible with v

+
+
val update:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> i:index_t v
+  -> x:a
+  -> Tot (raw a l)
+
+

v.i <- x is shorthand for update v i x

+
+
unfold let op_String_Assignment #a #l = update #a #l
+
+

append v1 v2: +- requires proving that the sum of the lengths of v1 and v2 still fit in a u32 +- Incurs a full copy in KreMLin +- Amortized constant time in OCaml

+
+
val append:
+    #a:Type
+  -> #l1:len_t
+  -> #l2:len_t
+  -> v1:raw a l1
+  -> v2:raw a l2{UInt.size U32.(v l1 + v l2) U32.n}
+  -> Tot (raw a U32.(l1 +^ l2))
+
+

v1 @| v2: shorthand for append v1 v2

+
+
unfold let (@|) #a #l1 #l2 = append #a #l1 #l2
+
+

sub v i j: +- the sub-vector of v starting from index i up to, but not including, j +- Constant time in KreMLin (just an addition on a pointer) +- Worst-case (log l) time in OCaml

+
+
val sub:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> i:len_t
+  -> j:len_t{U32.(v i <= v j /\ v j <= v l)}
+  -> Tot (raw a U32.(j -^ i))
+

//////////////////////////////////////////////////////////////////////////////

+
+

Lemmas about the basic operations, all rather boring +-- Each is just a lifting specifying the corresponding operation on seq

+
+

//////////////////////////////////////////////////////////////////////////////

+
val reveal_init:
+    #a:Type
+  -> l:len_t
+  -> contents: (i:nat { i < U32.v l } -> Tot a)
+  -> Lemma
+    (ensures (reveal (init l contents) == Seq.init (U32.v l) contents))
+    [SMTPat (init l contents)]
+
val reveal_index:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> i:index_t v
+  -> Lemma
+    (ensures (v.[i] == Seq.index (reveal v) (U32.v i)))
+    [SMTPat (v.[i])]
+
val reveal_update:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> i:index_t v
+  -> x:a
+  -> Lemma
+    (ensures (reveal (v.[i] <- x) == Seq.upd (reveal v) (U32.v i) x))
+    [SMTPat (v.[i] <- x)]
+
val reveal_append:
+    #a:Type
+  -> #l1:len_t
+  -> #l2:len_t
+  -> v1:raw a l1
+  -> v2:raw a l2{UInt.size U32.(v l1 + v l2) U32.n}
+  -> Lemma
+    (ensures (reveal (v1 @| v2) == Seq.append (reveal v1) (reveal v2)))
+    [SMTPat (v1 @| v2)]
+
val reveal_sub:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> i:len_t
+  -> j:len_t{U32.(v i <= v j /\ v j <= v l)}
+  -> Lemma
+    (ensures (reveal (sub v i j) == S.slice (reveal v) (U32.v i) (U32.v j)))
+    [SMTPat (sub v i j)]
+

//////////////////////////////////////////////////////////////////////////////

+
+

Now, we have Vector.Base.t, abstractly, a raw vector paired with its u32 length

+
+

//////////////////////////////////////////////////////////////////////////////

+
val t:
+    a:Type u#a
+  -> Type u#a
+
+

Unlike raw vectors, t-vectors support decidable equality

+
+
val t_has_eq:
+    a:Type u#a
+  -> Lemma
+    (requires (hasEq a))
+    (ensures  (hasEq (t a)))
+    [SMTPat (hasEq (t a))]
+
+

The length of a t-vector is a dynamically computable u32

+
+
val len:
+    #a:Type
+  -> t a
+  -> len_t
+
+

A convenience to access the length of a t-vector as a nat

+
+
[@@"deprecated: this will be moved to the ghost effect"]
+let length (#a:Type) (x:t a) : nat = U32.v (len x)
+
+

Access the underlying raw vector

+
+
val as_raw:
+    #a:Type
+  -> x:t a
+  -> raw a (len x)
+
+

Promote a raw vector

+
+
val from_raw:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> x:t a{len x = l}
+
+

as_raw and from_raw are mutual inverses

+
+
val as_raw_from_raw:
+    #a:Type
+  -> #l:len_t
+  -> v:raw a l
+  -> Lemma (ensures (as_raw (from_raw v) == v))
+          [SMTPat (from_raw v)]
+
val from_raw_as_raw:
+    #a:Type
+  -> x:t a
+  -> Lemma (ensures (from_raw (as_raw x) == x))
+          [SMTPat (as_raw x)]
+
+

v.(i) accesses the ith element of v

+
+
unfold
+let op_Array_Access
+    (#a:Type)
+    (x:t a)
+    (i:index_t (as_raw x))
+  : Tot a
+  = (as_raw x).[i]
+
+

v.(i) <- x is a new t-vector that differs from v only at i

+
+
unfold
+let op_Array_Assignment
+    (#a:Type)
+    (x:t a)
+    (i:index_t (as_raw x))
+    (v:a)
+  : Tot (t a)
+  = from_raw ((as_raw x).[i] <- v)
+
+

v1 @@ v2: appending t-vectors

+
+
unfold
+let (@@)
+    (#a:Type)
+    (x1:t a)
+    (x2:t a{UInt.size (length x1 + length x2) U32.n})
+  : Tot (t a)
+  = from_raw (as_raw x1 @| as_raw x2)
+
+

slice v i j: +the sub-vector of v starting from index i up to, but not including, j

+
+
unfold
+let slice
+    (#a:Type)
+    (x:t a)
+    (i:len_t)
+    (j:len_t{U32.(v i <= v j /\ v j <= length x)})
+  : Tot (t a)
+  = from_raw (sub (as_raw x) i j)
+
val dummy : unit
+ diff --git a/docs/FStar.Vector.Properties.html b/docs/FStar.Vector.Properties.html index e7615ce..278dec8 100644 --- a/docs/FStar.Vector.Properties.html +++ b/docs/FStar.Vector.Properties.html @@ -1,16 +1,100 @@ - - + + - - - - - + FStar.Vector.Properties + -

module FStar.Vector.Properties

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Vector.Properties

+ +
+

This coercion seems to be necessary in some places

+

For example, when trying to treat a raw a (l1 +^ l2) +as a raw a (m1 +^ m2) +F* type inference tries matches on the head symbol of the index +and tries to prove l1 = m1 /\ l2 = m2 +which is often too strong. +This coercion is a workaround for in such cases

+
+
unfold
+let coerce
+    (#a:Type)
+    (#l:len_t)
+    (v:raw a l)
+    (m:len_t{l == m})
+  : Tot (raw a m)
+  = v
+
+

An abbreviation that states that some binary arithmetic +operation on len_t's respects bouns

+
+
unfold
+let ok
+    (op:int -> int -> int)
+    (l1:len_t)
+    (l2:len_t)
+  : Type
+  = UInt.size U32.(op (v l1) (v l2)) U32.n
+
+

Most lemmas from FStar.Seq.Properties can just be lifted +to vectors, although the lengths have to be bounds checked

+
+
let append_inj
+    (#a:Type)
+    (#l1:len_t)
+    (#l2:len_t)
+    (#m1:len_t)
+    (#m2:len_t)
+    (u1:raw a l1)
+    (u2:raw a l2{ok (+) l1 l2})
+    (v1:raw a m1)
+    (v2:raw a m2{ok (+) m1 m2})
+  : Lemma
+    (requires (let open U32 in
+               m1 +^ m2 = l1 +^ l2 /\
+               equal (u1@|u2) (coerce (v1@|v2) (l1 +^ l2)) /\
+               (l1 == m1 \/ l2 == m2)))
+    (ensures (l1 = m1 /\
+              l2 = m2 /\
+              equal u1 v1 /\
+              equal u2 v2))
+  = FStar.Seq.lemma_append_inj (reveal u1) (reveal u2) (reveal v1) (reveal v2)
+
let head (#a:Type) (#l:len_t{l <> 0ul}) (v:raw a l)
+  : Tot a
+  = v.[0ul]
+
let tail (#a:Type) (#l:len_t{l <> 0ul}) (v:raw a l)
+  : Tot (raw a U32.(l -^ 1ul))
+  = sub v 1ul l
+
let head_append
+    (#a:Type)
+    (#l1:len_t)
+    (#l2:len_t)
+    (v1:raw a l1{l1 <> 0ul})
+    (v2:raw a l2{ok (+) l1 l2})
+  : Lemma
+    (ensures (head (v1@|v2) == head v1))
+  = ()
+
let tail_append
+    (#a:Type)
+    (#l1:len_t)
+    (#l2:len_t)
+    (v1:raw a l1{l1 <> 0ul})
+    (v2:raw a l2{ok (+) l1 l2})
+  : Lemma
+    (ensures (tail (v1@|v2) == tail v1@|v2))
+  = Seq.lemma_tail_append (reveal v1) (reveal v2)
+
+

and so on ...

+
+ diff --git a/docs/FStar.Vector.html b/docs/FStar.Vector.html index 864a1c1..5d2a694 100644 --- a/docs/FStar.Vector.html +++ b/docs/FStar.Vector.html @@ -1,16 +1,19 @@ - - + + - - - - - + FStar.Vector + -

module FStar.Vector

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

+FStar.Vector

+ + diff --git a/docs/FStar.WellFounded.html b/docs/FStar.WellFounded.html index db95cc3..a8832fe 100644 --- a/docs/FStar.WellFounded.html +++ b/docs/FStar.WellFounded.html @@ -1,16 +1,144 @@ - - + + - - - - - + FStar.WellFounded + -

module FStar.WellFounded

-

fsdoc: no-summary-found

-

fsdoc: no-comment-found

+

Copyright 2015 Chantal Keller and Catalin Hritcu, Microsoft Research and Inria

+

Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at

+
http://www.apache.org/licenses/LICENSE-2.0
+
+

Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License.

+

Defining accessibility predicates and well-founded recursion like in Coq +https://coq.inria.fr/library/Coq.Init.Wf.html

+

+FStar.WellFounded

+ +
noeq
+type acc (#a:Type) (r:relation a) (x:a) : Type =
+  | AccIntro : (y:a -> r y x -> acc r y) -> acc r x
+ +
let well_founded (#a:Type) (r:relation a) = x:a -> acc r x
+ +
let acc_inv (#aa:Type) (#r:relation aa) (x:aa) (a:acc r x)
+  : (e:(y:aa -> r y x -> acc r y){e << a})
+  = match a with | AccIntro h1 -> h1
+
let rec fix_F (#aa:Type) (#r:relation aa) (#p:(aa -> Type))
+              (f: (x:aa -> (y:aa -> r y x -> p y) -> p x))
+              (x:aa) (a:acc r x)
+  : Tot (p x) (decreases a)
+  = f x (fun y h -> fix_F f y (acc_inv x a y h))
+
let fix (#aa:Type) (#r:relation aa) (rwf:well_founded r)
+        (p:aa -> Type) (f:(x:aa -> (y:aa -> r y x -> p y) -> p x))
+        (x:aa)
+  : p x
+  = fix_F f x (rwf x)
+ +
[@@ erasable]
+noeq
+type acc_g (#a:Type) (r:relation a) (x:a) : Type =
+  | AccIntro_g : (y:a -> r y x -> acc_g r y) -> acc_g r x
+
type is_well_founded (#a:Type) (rel:relation a) =
+  forall (x:a). squash (acc_g rel x)
+
type well_founded_relation (a:Type) = rel:relation a{is_well_founded rel}
+
#push-options "--warn_error -271"
+unfold
+let as_well_founded (#a:Type) (#rel:relation a) (f:(x:a -> acc_g rel x))
+  : well_founded_relation a
+  = let aux (x:a)
+      : Lemma (squash (acc_g rel x))
+              [SMTPat ()]
+      = FStar.Squash.return_squash (f x) in
+    rel
+#pop-options
+ +
let subrelation_wf (#a:Type) (#r #sub_r:relation a)
+  (sub_w:(x:a -> y:a -> sub_r x y -> r x y))
+  (r_wf:well_founded r)
+  : well_founded sub_r
+  = let rec aux (x:a) (acc_r:acc r x) : Tot (acc sub_r x) (decreases acc_r) =
+      AccIntro (fun y sub_r_y_x ->
+        aux y
+          (match acc_r with
+           | AccIntro f -> f y (sub_w y x sub_r_y_x))) in
+    fun x -> aux x (r_wf x)
+
#push-options "--warn_error -271"
+let subrelation_squash_wf (#a:Type) (#r #sub_r:relation a)
+  (sub_w:(x:a -> y:a -> sub_r x y -> squash (r x y)))
+  (r_wf:well_founded r)
+  : Lemma (is_well_founded sub_r)
+  = let aux (x:a)
+      : Lemma (squash (acc_g sub_r x))
+              [SMTPat ()]
+      = let rec acc_y (x:a) (acc_r:acc r x) (y:a) (p:sub_r y x)
+          : Tot (acc_g sub_r y)
+                (decreases acc_r)
+          = AccIntro_g (acc_y y
+              (match acc_r with
+               | AccIntro f -> f y (elim_squash (sub_w y x p)))) in
+        Squash.return_squash (AccIntro_g (acc_y x (r_wf x)))
+    in
+    ()
+#pop-options
+
unfold
+let subrelation_as_wf (#a:Type) (#r #sub_r:relation a)
+  (sub_w:(x:a -> y:a -> sub_r x y -> squash (r x y)))
+  (r_wf:well_founded r)
+  : well_founded_relation a
+  = subrelation_squash_wf sub_w r_wf;
+    sub_r
+
let inverse_image (#a #b:Type) (r_b:relation b) (f:a -> b) : relation a =
+  fun x y -> r_b (f x) (f y)
+
let inverse_image_wf (#a #b:Type) (#r_b:relation b)
+  (f:a -> b)
+  (r_b_wf:well_founded r_b)
+  : well_founded (inverse_image r_b f)
+  = let rec aux (x:a) (acc_r_b:acc r_b (f x))
+      : Tot (acc (inverse_image r_b f) x)
+            (decreases acc_r_b) =
+      let get_acc_r_b_y (y:a) (p:(inverse_image r_b f) y x)
+        : Tot (acc_r_b_y:acc r_b (f y){acc_r_b_y << acc_r_b})
+        = match acc_r_b with
+          | AccIntro g -> g (f y) p in
+      AccIntro (fun y p -> aux y (get_acc_r_b_y y p)) in
+    fun x -> aux x (r_b_wf (f x))
+ diff --git a/docs/index.html b/docs/index.html index a95eb18..ebc0d0c 100644 --- a/docs/index.html +++ b/docs/index.html @@ -1,54 +1,58 @@ - - + + - - - - - + index +

FStar.Algebra.CommMonoid

+

FStar.Algebra.CommMonoid.Equiv

FStar.Algebra.Monoid

FStar.All

FStar.BV

+

FStar.BaseTypes

FStar.BigOps

FStar.BitVector

+

FStar.Bytes

FStar.Calc

+

FStar.Char

FStar.Classical

+

FStar.Classical.Sugar

+

FStar.Date

FStar.DependentMap

+

FStar.Dyn

FStar.Endianness

FStar.Exn

FStar.Fin

+

FStar.Float

FStar.FunctionalExtensionality

FStar.GSet

FStar.Ghost

FStar.Heap

+

FStar.HyperStack

FStar.HyperStack.All

FStar.HyperStack.ST

-

FStar.HyperStack

FStar.IFC

FStar.IO

FStar.IndefiniteDescription

-

FStar.Int.Cast.Full

-

FStar.Int.Cast

FStar.Int

+

FStar.Int.Cast

+

FStar.Int.Cast.Full

FStar.Int128

FStar.Int16

-

FStar.Int31

FStar.Int32

-

FStar.Int63

FStar.Int64

FStar.Int8

FStar.Integers

+

FStar.LexicographicOrdering

+

FStar.List

+

FStar.List.Pure

FStar.List.Pure.Base

FStar.List.Pure.Properties

-

FStar.List.Pure

+

FStar.List.Tot

FStar.List.Tot.Base

FStar.List.Tot.Properties

-

FStar.List.Tot

-

FStar.List

FStar.MRef

FStar.Map

FStar.MarkovsPrinciple

@@ -63,111 +67,79 @@

FStar.Monotonic.HyperHeap

FStar.Monotonic.HyperStack

FStar.Monotonic.Map

+

FStar.Monotonic.Pure

FStar.Monotonic.Seq

FStar.Monotonic.Witnessed

FStar.Mul

FStar.Option

-

FStar.OrdMap

-

FStar.OrdMapProps

-

FStar.OrdSet

FStar.OrdSetProps

FStar.Order

-

FStar.Pervasives.Native

+

FStar.PCM

FStar.Pervasives

+

FStar.Pervasives.Native

FStar.PredicateExtensionality

FStar.Preorder

FStar.Printf

FStar.PropositionalExtensionality

-

FStar.Reader

+

FStar.Range

+

FStar.Real

FStar.Ref

+

FStar.Reflection

FStar.Reflection.Arith

-

FStar.Reflection.Basic

+

FStar.Reflection.Builtins

FStar.Reflection.Const

-

FStar.Reflection.Data

-

FStar.Reflection.Derived.Lemmas

FStar.Reflection.Derived

+

FStar.Reflection.Derived.Lemmas

FStar.Reflection.Formula

-

FStar.Reflection

+

FStar.Reflection.Types

FStar.ReflexiveTransitiveClosure

FStar.ST

+

FStar.Seq

FStar.Seq.Base

+

FStar.Seq.Permutation

FStar.Seq.Properties

FStar.Seq.Sorted

-

FStar.Seq

FStar.Set

FStar.Squash

FStar.SquashProperties

+

FStar.String

FStar.StrongExcludedMiddle

FStar.TSet

+

FStar.Tactics

FStar.Tactics.Arith

FStar.Tactics.BV

FStar.Tactics.Builtins

FStar.Tactics.Canon

-

FStar.Tactics.CanonCommMonoid

-

FStar.Tactics.CanonCommMonoidSimple

FStar.Tactics.CanonCommSemiring

FStar.Tactics.CanonCommSwaps

FStar.Tactics.CanonMonoid

+

FStar.Tactics.Common

FStar.Tactics.Derived

FStar.Tactics.Effect

FStar.Tactics.Logic

FStar.Tactics.PatternMatching

+

FStar.Tactics.Print

FStar.Tactics.Result

FStar.Tactics.Simplifier

FStar.Tactics.SyntaxHelpers

FStar.Tactics.Typeclasses

+

FStar.Tactics.Types

FStar.Tactics.Util

-

FStar.Tactics

+

FStar.Tcp

FStar.UInt

FStar.UInt128

FStar.UInt16

-

FStar.UInt31

FStar.UInt32

-

FStar.UInt63

FStar.UInt64

FStar.UInt8

+

FStar.Udp

FStar.Universe

FStar.Util

+

FStar.VConfig

+

FStar.Vector

FStar.Vector.Base

FStar.Vector.Properties

-

FStar.Vector

FStar.WellFounded

-

FStar.BV

-

FStar.BaseTypes

-

FStar.BigOps

-

FStar.Bytes

-

FStar.Char

-

FStar.Classical

-

FStar.Date

-

FStar.Dyn

-

FStar.Endianness

-

FStar.Float

-

FStar.FunctionalExtensionality

-

FStar.GSet

-

FStar.Ghost

-

FStar.HyperStack.ST

-

FStar.Map

-

FStar.Math.Euclid

-

FStar.Math.Fermat

-

FStar.Modifies

-

FStar.ModifiesGen

-

FStar.Monotonic.DependentMap

-

FStar.Monotonic.Heap

-

FStar.Monotonic.HyperHeap

-

FStar.Monotonic.HyperStack

-

FStar.Monotonic.Witnessed

-

FStar.Range

-

FStar.Real

-

FStar.Reflection.Types

-

FStar.ReflexiveTransitiveClosure

-

FStar.Set

-

FStar.Squash

-

FStar.String

-

FStar.Tactics.Types

-

FStar.Tcp

-

FStar.UInt128

-

FStar.Udp

-

FStar.Universe

-

FStar.Vector.Base

+ From aa586ca61db5f28e928381d07cf7a93f99b219a0 Mon Sep 17 00:00:00 2001 From: Mark Gritter Date: Sun, 7 Nov 2021 16:00:03 -0600 Subject: [PATCH 2/3] Add introductions to index file, extracted from individual MD files --- docs/index.html | 42 ++++++++++++++++++++++-------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/docs/index.html b/docs/index.html index ebc0d0c..628079f 100644 --- a/docs/index.html +++ b/docs/index.html @@ -6,36 +6,38 @@ +

+F* standard library modules

FStar.Algebra.CommMonoid

FStar.Algebra.CommMonoid.Equiv

FStar.Algebra.Monoid

FStar.All

-

FStar.BV

-

FStar.BaseTypes

-

FStar.BigOps

-

FStar.BitVector

+

FStar.BV -- This module defines an abstract type of length-indexed bit vectors.

+

FStar.BaseTypes -- This module aggregates commonly used primitive type constants into a single module, providing abbreviations for them.

+

FStar.BigOps -- This library provides propositional connectives over finite sets expressed as lists, aka "big operators", in analogy with LaTeX usage for \bigand, \bigor, etc.

+

FStar.BitVector -- This module defines a bit vector as a sequence of booleans of a given length, and provides various utilities.

FStar.Bytes

FStar.Calc

-

FStar.Char

-

FStar.Classical

-

FStar.Classical.Sugar

-

FStar.Date

-

FStar.DependentMap

+

FStar.Char -- This module provides the char type, an abstract type representing UTF-8 characters.

+

FStar.Classical -- This module provides various utilities to manipulate the squashed logical connectives ==>, /\, \/, forall, exists and ==, defined in Prims in terms of the squash type.

+

FStar.Classical.Sugar -- This module provides a few combinators that are targeted by the desugaring phase of the F* front end

+

FStar.Date -- A module providing primitives for dates and times

+

FStar.DependentMap -- This module provides an abstract type of maps whose co-domain depends on the value of each key.

FStar.Dyn

-

FStar.Endianness

+

FStar.Endianness -- A library of lemmas for reasoning about sequences of machine integers and their (little|big)-endian representation as a sequence of bytes.

FStar.Exn

-

FStar.Fin

-

FStar.Float

-

FStar.FunctionalExtensionality

+

FStar.Fin -- This module is supposed to contain various lemmas about finiteness.

+

FStar.Float -- Support for floating point numbers in F* is nearly non-existent.

+

FStar.FunctionalExtensionality -- Functional extensionality asserts the equality of pointwise-equal functions.

FStar.GSet

-

FStar.Ghost

+

FStar.Ghost -- This module provides an erased type to abstract computationally irrelevant values.

FStar.Heap

FStar.HyperStack

FStar.HyperStack.All

FStar.HyperStack.ST

-

FStar.IFC

+

FStar.IFC -- FStar.IFC provides a simple, generic abstraction for monadic information-flow control based on a user-defined (semi-)lattice of information flow labels.

FStar.IO

-

FStar.IndefiniteDescription

+

FStar.IndefiniteDescription -- Indefinite description is an axiom that allows picking a witness for existentially quantified predicate.

FStar.Int

FStar.Int.Cast

FStar.Int.Cast.Full

@@ -45,7 +47,7 @@

FStar.Int64

FStar.Int8

FStar.Integers

-

FStar.LexicographicOrdering

+

FStar.LexicographicOrdering -- This module proves that lexicographic ordering is well-founded (i.e. every element is accessible)

FStar.List

FStar.List.Pure

FStar.List.Pure.Base

@@ -92,7 +94,7 @@

FStar.Reflection.Derived.Lemmas

FStar.Reflection.Formula

FStar.Reflection.Types

-

FStar.ReflexiveTransitiveClosure

+

FStar.ReflexiveTransitiveClosure -- This module defines the reflexive transitive closure of a relation.

FStar.ST

FStar.Seq

FStar.Seq.Base

@@ -100,7 +102,7 @@

FStar.Seq.Properties

FStar.Seq.Sorted

FStar.Set

-

FStar.Squash

+

FStar.Squash -- The module provides an interface to work with squash types, F*'s representation for proof-irrelevant propositions.

FStar.SquashProperties

FStar.String

FStar.StrongExcludedMiddle

@@ -110,7 +112,7 @@

FStar.Tactics.BV

FStar.Tactics.Builtins

FStar.Tactics.Canon

-

FStar.Tactics.CanonCommSemiring

+

FStar.Tactics.CanonCommSemiring -- A tactic to solve equalities on a commutative semiring (a, +, *, 0, 1)

FStar.Tactics.CanonCommSwaps

FStar.Tactics.CanonMonoid

FStar.Tactics.Common

From 06840b4f5c655b25ced2189a552251c6d3945c6c Mon Sep 17 00:00:00 2001 From: Mark Gritter Date: Sun, 7 Nov 2021 18:09:16 -0600 Subject: [PATCH 3/3] Add github CSS instead of embedding it in every file. --- docs/gh-style.css | 1 + 1 file changed, 1 insertion(+) create mode 100644 docs/gh-style.css diff --git a/docs/gh-style.css b/docs/gh-style.css new file mode 100644 index 0000000..27b8023 --- /dev/null +++ b/docs/gh-style.css @@ -0,0 +1 @@ +@charset "utf-8"; .gist{font-size:16px;color:#333;text-align:left;/*!* GitHub Light v0.4.1 * Copyright(c) 2012 - 2017 GitHub,Inc. * Licensed under MIT(https://github.com/primer/github-syntax-theme-generator/blob/master/LICENSE) */ direction:ltr}.gist .markdown-body{font-family:-apple-system,BlinkMacSystemFont,Segoe UI,Helvetica,Arial,sans-serif,Apple Color Emoji,Segoe UI Emoji;font-size:16px;line-height:1.5;word-wrap:break-word}.gist .markdown-body kbd{display:inline-block;padding:3px 5px;font:11px SFMono-Regular,Consolas,Liberation Mono,Menlo,monospace;line-height:10px;color:#444d56;vertical-align:middle;background-color:#fafbfc;border:1px solid #d1d5da;border-radius:3px;box-shadow:inset 0 -1px 0 #d1d5da}.gist .markdown-body:before{display:table;content:""}.gist .markdown-body:after{display:table;clear:both;content:""}.gist .markdown-body>:first-child{margin-top:0 !important}.gist .markdown-body>:last-child{margin-bottom:0 !important}.gist .markdown-body a:not([href]){color:inherit;text-decoration:none}.gist .markdown-body .absent{color:#cb2431}.gist .markdown-body .anchor{float:left;padding-right:4px;margin-left:-20px;line-height:1}.gist .markdown-body .anchor:focus{outline:none}.gist .markdown-body blockquote,.gist .markdown-body details,.gist .markdown-body dl,.gist .markdown-body ol,.gist .markdown-body p,.gist .markdown-body pre,.gist .markdown-body table,.gist .markdown-body ul{margin-top:0;margin-bottom:16px}.gist .markdown-body hr{height:.25em;padding:0;margin:24px 0;background-color:#e1e4e8;border:0}.gist .markdown-body blockquote{padding:0 1em;color:#6a737d;border-left:.25em solid #dfe2e5}.gist .markdown-body blockquote>:first-child{margin-top:0}.gist .markdown-body blockquote>:last-child{margin-bottom:0}.gist .markdown-body h1,.gist .markdown-body h2,.gist .markdown-body h3,.gist .markdown-body h4,.gist .markdown-body h5,.gist .markdown-body h6{margin-top:24px;margin-bottom:16px;font-weight:600;line-height:1.25}.gist .markdown-body h1 .octicon-link,.gist .markdown-body h2 .octicon-link,.gist .markdown-body h3 .octicon-link,.gist .markdown-body h4 .octicon-link,.gist .markdown-body h5 .octicon-link,.gist .markdown-body h6 .octicon-link{color:#1b1f23;vertical-align:middle;visibility:hidden}.gist .markdown-body h1:hover .anchor,.gist .markdown-body h2:hover .anchor,.gist .markdown-body h3:hover .anchor,.gist .markdown-body h4:hover .anchor,.gist .markdown-body h5:hover .anchor,.gist .markdown-body h6:hover .anchor{text-decoration:none}.gist .markdown-body h1:hover .anchor .octicon-link,.gist .markdown-body h2:hover .anchor .octicon-link,.gist .markdown-body h3:hover .anchor .octicon-link,.gist .markdown-body h4:hover .anchor .octicon-link,.gist .markdown-body h5:hover .anchor .octicon-link,.gist .markdown-body h6:hover .anchor .octicon-link{visibility:visible}.gist .markdown-body h1 code,.gist .markdown-body h1 tt,.gist .markdown-body h2 code,.gist .markdown-body h2 tt,.gist .markdown-body h3 code,.gist .markdown-body h3 tt,.gist .markdown-body h4 code,.gist .markdown-body h4 tt,.gist .markdown-body h5 code,.gist .markdown-body h5 tt,.gist .markdown-body h6 code,.gist .markdown-body h6 tt{font-size:inherit}.gist .markdown-body h1{font-size:2em}.gist .markdown-body h1,.gist .markdown-body h2{padding-bottom:.3em;border-bottom:1px solid #eaecef}.gist .markdown-body h2{font-size:1.5em}.gist .markdown-body h3{font-size:1.25em}.gist .markdown-body h4{font-size:1em}.gist .markdown-body h5{font-size:.875em}.gist .markdown-body h6{font-size:.85em;color:#6a737d}.gist .markdown-body ol,.gist .markdown-body ul{padding-left:2em}.gist .markdown-body ol.no-list,.gist .markdown-body ul.no-list{padding:0;list-style-type:none}.gist .markdown-body ol ol,.gist .markdown-body ol ul,.gist .markdown-body ul ol,.gist .markdown-body ul ul{margin-top:0;margin-bottom:0}.gist .markdown-body li{word-wrap:break-all}.gist .markdown-body li>p{margin-top:16px}.gist .markdown-body li+li{margin-top:.25em}.gist .markdown-body dl{padding:0}.gist .markdown-body dl dt{padding:0;margin-top:16px;font-size:1em;font-style:italic;font-weight:600}.gist .markdown-body dl dd{padding:0 16px;margin-bottom:16px}.gist .markdown-body table{display:block;width:100%;overflow:auto}.gist .markdown-body table th{font-weight:600}.gist .markdown-body table td,.gist .markdown-body table th{padding:6px 13px;border:1px solid #dfe2e5}.gist .markdown-body table tr{background-color:#fff;border-top:1px solid #c6cbd1}.gist .markdown-body table tr:nth-child(2n){background-color:#f6f8fa}.gist .markdown-body table img{background-color:initial}.gist .markdown-body img{max-width:100%;box-sizing:initial;background-color:#fff}.gist .markdown-body img[align=right]{padding-left:20px}.gist .markdown-body img[align=left]{padding-right:20px}.gist .markdown-body .emoji{max-width:none;vertical-align:text-top;background-color:initial}.gist .markdown-body span.frame{display:block;overflow:hidden}.gist .markdown-body span.frame>span{display:block;float:left;width:auto;padding:7px;margin:13px 0 0;overflow:hidden;border:1px solid #dfe2e5}.gist .markdown-body span.frame span img{display:block;float:left}.gist .markdown-body span.frame span span{display:block;padding:5px 0 0;clear:both;color:#24292e}.gist .markdown-body span.align-center{display:block;overflow:hidden;clear:both}.gist .markdown-body span.align-center>span{display:block;margin:13px auto 0;overflow:hidden;text-align:center}.gist .markdown-body span.align-center span img{margin:0 auto;text-align:center}.gist .markdown-body span.align-right{display:block;overflow:hidden;clear:both}.gist .markdown-body span.align-right>span{display:block;margin:13px 0 0;overflow:hidden;text-align:right}.gist .markdown-body span.align-right span img{margin:0;text-align:right}.gist .markdown-body span.float-left{display:block;float:left;margin-right:13px;overflow:hidden}.gist .markdown-body span.float-left span{margin:13px 0 0}.gist .markdown-body span.float-right{display:block;float:right;margin-left:13px;overflow:hidden}.gist .markdown-body span.float-right>span{display:block;margin:13px auto 0;overflow:hidden;text-align:right}.gist .markdown-body code,.gist .markdown-body tt{padding:.2em .4em;margin:0;font-size:85%;background-color:#f6f8fa;border-radius:3px}.gist .markdown-body code br,.gist .markdown-body tt br{display:none}.gist .markdown-body del code{text-decoration:inherit}.gist .markdown-body pre{word-wrap:normal}.gist .markdown-body pre>code{padding:0;margin:0;font-size:100%;word-break:normal;white-space:pre;background:transparent;border:0}.gist .markdown-body .highlight{margin-bottom:16px}.gist .markdown-body .highlight pre{margin-bottom:0;word-break:normal}.gist .markdown-body .highlight pre,.gist .markdown-body pre{padding:16px;overflow:auto;font-size:85%;line-height:1.45;background-color:#f6f8fa;border-radius:3px}.gist .markdown-body pre code,.gist .markdown-body pre tt{display:inline;max-width:auto;padding:0;margin:0;overflow:visible;line-height:inherit;word-wrap:normal;background-color:#f6f8fa;border:0}.gist .markdown-body .csv-data td,.gist .markdown-body .csv-data th{padding:5px;overflow:hidden;font-size:12px;line-height:1;text-align:left;white-space:nowrap}.gist .markdown-body .csv-data .blob-num{padding:10px 8px 9px;text-align:right;background:#fff;border:0}.gist .markdown-body .csv-data tr{border-top:0}.gist .markdown-body .csv-data th{font-weight:600;background:#f6f8fa;border-top:0}.gist .pl-c{color:#6a737d}.gist .pl-c1,.gist .pl-s .pl-v{color:#005cc5}.gist .pl-e,.gist .pl-en{color:#6f42c1}.gist .pl-s .pl-s1,.gist .pl-smi{color:#24292e}.gist .pl-ent{color:#22863a}.gist .pl-k{color:#d73a49}.gist .pl-pds,.gist .pl-s,.gist .pl-s .pl-pse .pl-s1,.gist .pl-sr,.gist .pl-sr .pl-cce,.gist .pl-sr .pl-sra,.gist .pl-sr .pl-sre{color:#032f62}.gist .pl-smw,.gist .pl-v{color:#e36209}.gist .pl-bu{color:#b31d28}.gist .pl-ii{color:#fafbfc;background-color:#b31d28}.gist .pl-c2{color:#fafbfc;background-color:#d73a49}.gist .pl-c2:before{content:"^M"}.gist .pl-sr .pl-cce{font-weight:700;color:#22863a}.gist .pl-ml{color:#735c0f}.gist .pl-mh,.gist .pl-mh .pl-en,.gist .pl-ms{font-weight:700;color:#005cc5}.gist .pl-mi{font-style:italic;color:#24292e}.gist .pl-mb{font-weight:700;color:#24292e}.gist .pl-md{color:#b31d28;background-color:#ffeef0}.gist .pl-mi1{color:#22863a;background-color:#f0fff4}.gist .pl-mc{color:#e36209;background-color:#ffebda}.gist .pl-mi2{color:#f6f8fa;background-color:#005cc5}.gist .pl-mdr{font-weight:700;color:#6f42c1}.gist .pl-ba{color:#586069}.gist .pl-sg{color:#959da5}.gist .pl-corl{text-decoration:underline;color:#032f62}.gist .breadcrumb{font-size:16px;color:#586069}.gist .breadcrumb .separator{white-space:pre-wrap}.gist .breadcrumb .separator:after,.gist .breadcrumb .separator:before{content:" "}.gist .breadcrumb strong.final-path{color:#24292e}.gist strong{font-weight:bolder}.gist .editor-abort{display:inline;font-size:14px}.gist .blob-interaction-bar{position:relative;background-color:#f2f2f2;border-bottom:1px solid #e5e5e5}.gist .blob-interaction-bar:before{display:table;content:""}.gist .blob-interaction-bar:after{display:table;clear:both;content:""}.gist .blob-interaction-bar .octicon-search{position:absolute;top:10px;left:10px;font-size:12px;color:#586069}.gist .blob-filter{width:100%;padding:4px 20px 5px 30px;font-size:12px;border:0;border-radius:0;outline:none}.gist .blob-filter:focus{outline:none}.gist .html-blob{margin-bottom:15px}.gist .TagsearchPopover{width:inherit;max-width:600px}.gist .TagsearchPopover-content{max-height:300px}.gist .TagsearchPopover-list .TagsearchPopover-list-item:hover{background-color:#f6f8fa}.gist .TagsearchPopover-list .TagsearchPopover-list-item .TagsearchPopover-item:hover{text-decoration:none}.gist .TagsearchPopover-list .blob-code-inner{white-space:pre-wrap}.gist .linejump .linejump-input{width:340px;background-color:#fafbfc}.gist .linejump .btn,.gist .linejump .linejump-input{padding:10px 15px;font-size:16px}.gist .CopyBlock{line-height:20px;cursor:pointer}.gist .CopyBlock .octicon-clippy{display:none}.gist .CopyBlock:active,.gist .CopyBlock:focus,.gist .CopyBlock:hover{background-color:#fff;outline:none}.gist .CopyBlock:active .octicon-clippy,.gist .CopyBlock:focus .octicon-clippy,.gist .CopyBlock:hover .octicon-clippy{display:inline-block}.gist .blob-wrapper{overflow-x:auto;overflow-y:hidden}.gist .page-blob.height-full .blob-wrapper{overflow-y:auto}.gist .page-edit-blob.height-full .CodeMirror{height:300px}.gist .page-edit-blob.height-full .CodeMirror,.gist .page-edit-blob.height-full .CodeMirror-scroll{display:flex;flex-direction:column;flex:1 1 auto}.gist .blob-wrapper-embedded{max-height:240px;overflow-y:auto}.gist .diff-table{width:100%;border-collapse:initial}.gist .diff-table .line-comments{padding:10px;vertical-align:top;border-top:1px solid #e1e4e8}.gist .diff-table .line-comments:first-child+.empty-cell{border-left-width:1px}.gist .diff-table tr:not(:last-child) .line-comments{border-top:1px solid #e1e4e8;border-bottom:1px solid #e1e4e8}.gist .blob-num{width:1%;min-width:50px;padding-right:10px;padding-left:10px;font-family:SFMono-Regular,Consolas,Liberation Mono,Menlo,monospace;font-size:12px;line-height:20px;color:rgba(27,31,35,.3);text-align:right;white-space:nowrap;vertical-align:top;cursor:pointer;-webkit-user-select:none;-moz-user-select:none;-ms-user-select:none;user-select:none}.gist .blob-num:hover{color:rgba(27,31,35,.6)}.gist .blob-num:before{content:attr(data-line-number)}.gist .blob-num.non-expandable{cursor:default}.gist .blob-num.non-expandable:hover{color:rgba(27,31,35,.3)}.gist .blob-code{position:relative;padding-right:10px;padding-left:10px;line-height:20px;vertical-align:top}.gist .blob-code-inner{overflow:visible;font-family:SFMono-Regular,Consolas,Liberation Mono,Menlo,monospace;font-size:12px;color:#24292e;word-wrap:normal;white-space:pre}.gist .blob-code-inner .x-first{border-top-left-radius:.2em;border-bottom-left-radius:.2em}.gist .blob-code-inner .x-last{border-top-right-radius:.2em;border-bottom-right-radius:.2em}.gist .blob-code-inner.highlighted,.gist .blob-code-inner .highlighted{background-color:#fffbdd}.gist .blob-code-marker:before{padding-right:8px;content:attr(data-code-marker)}.gist .blob-code-marker-addition:before{content:"+ "}.gist .blob-code-marker-deletion:before{content:"- "}.gist .blob-code-marker-context:before{content:" "}.gist .soft-wrap .diff-table{table-layout:fixed}.gist .soft-wrap .blob-code{padding-left:18px;text-indent:-7px}.gist .soft-wrap .blob-code-inner{word-wrap:break-word;white-space:pre-wrap}.gist .soft-wrap .no-nl-marker{display:none}.gist .soft-wrap .add-line-comment{margin-left:-28px}.gist .blob-code-hunk,.gist .blob-num-expandable,.gist .blob-num-hunk{color:rgba(27,31,35,.7);vertical-align:middle}.gist .blob-num-expandable,.gist .blob-num-hunk{background-color:#dbedff}.gist .blob-code-hunk{padding-top:4px;padding-bottom:4px;background-color:#f1f8ff;border-width:1px 0}.gist .blob-expanded .blob-code,.gist .blob-expanded .blob-num{background-color:#fafbfc}.gist .blob-expanded+tr:not(.blob-expanded) .blob-code,.gist .blob-expanded+tr:not(.blob-expanded) .blob-num,.gist .blob-expanded .blob-num-hunk,.gist tr:not(.blob-expanded)+.blob-expanded .blob-code,.gist tr:not(.blob-expanded)+.blob-expanded .blob-num{border-top:1px solid #eaecef}.gist .blob-num-expandable{padding:0;font-size:12px;text-align:center}.gist .blob-num-expandable .diff-expander{display:block;width:auto;height:auto;padding:4px 11px 4px 10px;margin-right:-1px;color:#586069;cursor:pointer}.gist .blob-num-expandable .diff-expander .octicon{vertical-align:top}.gist .blob-num-expandable .directional-expander{display:block;width:auto;height:auto;margin-right:-1px;color:#586069;cursor:pointer}.gist .blob-num-expandable .single-expander{padding-top:4px;padding-bottom:4px}.gist .blob-num-expandable .diff-expander:hover,.gist .blob-num-expandable .directional-expander:hover{color:#fff;text-shadow:none;background-color:#0366d6;border-color:#0366d6}.gist .blob-code-addition{background-color:#e6ffed}.gist .blob-code-addition .x{color:#24292e;background-color:#acf2bd}.gist .blob-num-addition{background-color:#cdffd8;border-color:#bef5cb}.gist .blob-code-deletion{background-color:#ffeef0}.gist .blob-code-deletion .x{color:#24292e;background-color:#fdb8c0}.gist .blob-num-deletion{background-color:#ffdce0;border-color:#fdaeb7}.gist .is-selecting,.gist .is-selecting .blob-num{cursor:ns-resize !important}.gist .is-selecting .add-line-comment,.gist .is-selecting a{pointer-events:none;cursor:ns-resize !important}.gist .is-selecting .is-hovered .add-line-comment{opacity:0}.gist .is-selecting.file-diff-split,.gist .is-selecting.file-diff-split .blob-num{cursor:nwse-resize !important}.gist .is-selecting.file-diff-split .add-line-comment,.gist .is-selecting.file-diff-split .empty-cell,.gist .is-selecting.file-diff-split a{pointer-events:none;cursor:nwse-resize !important}.gist .selected-line{position:relative}.gist .selected-line:after{position:absolute;top:0;left:0;display:block;width:100%;height:100%;box-sizing:border-box;pointer-events:none;content:"";background:rgba(255,223,93,.2);mix-blend-mode:multiply}.gist .selected-line.selected-line-top:after{border-top:1px solid #ffd33d}.gist .selected-line.selected-line-bottom:after{border-bottom:1px solid #ffd33d}.gist .selected-line.selected-line-left:after,.gist .selected-line:first-child:after{border-left:1px solid #ffd33d}.gist .selected-line.selected-line-right:after,.gist .selected-line:last-child:after{border-right:1px solid #ffd33d}.gist .is-commenting .selected-line.blob-code:before{position:absolute;top:0;left:-1px;display:block;width:4px;height:100%;content:"";background:#0366d6}.gist .add-line-comment{position:relative;z-index:5;float:left;width:22px;height:22px;margin:-2px -10px -2px -20px;line-height:21px;color:#fff;text-align:center;text-indent:0;cursor:pointer;background-color:#0366d6;background-image:linear-gradient(#0372ef,#0366d6);border-radius:3px;box-shadow:0 1px 4px rgba(27,31,35,.15);opacity:0;transition:transform .1s ease-in-out;transform:scale(.8)}.gist .add-line-comment:hover{transform:scale(1)}.gist .add-line-comment:focus,.is-hovered .gist .add-line-comment{opacity:1}.gist .add-line-comment .octicon{vertical-align:text-top;pointer-events:none}.gist .add-line-comment.octicon-check{background:#333;opacity:1}.gist .inline-comment-form{border:1px solid #dfe2e5;border-radius:3px}.gist .inline-review-comment{margin-top:0 !important;margin-bottom:10px !important}.gist .inline-review-comment .gc:first-child+tr .blob-code,.gist .inline-review-comment .gc:first-child+tr .blob-num{padding-top:5px}.gist .inline-review-comment tr:last-child{border-bottom-right-radius:3px;border-bottom-left-radius:3px}.gist .inline-review-comment tr:last-child .blob-code,.gist .inline-review-comment tr:last-child .blob-num{padding-bottom:8px}.gist .inline-review-comment tr:last-child .blob-code:first-child,.gist .inline-review-comment tr:last-child .blob-num:first-child{border-bottom-left-radius:3px}.gist .inline-review-comment tr:last-child .blob-code:last-child,.gist .inline-review-comment tr:last-child .blob-num:last-child{border-bottom-right-radius:3px}.gist .timeline-inline-comments{width:100%;table-layout:fixed}.gist .show-inline-notes .inline-comments,.gist .timeline-inline-comments .inline-comments{display:table-row}.gist .inline-comments,.gist .inline-comments.is-collapsed{display:none}.gist .inline-comments .line-comments.is-collapsed{visibility:hidden}.gist .inline-comments .line-comments+.blob-num{border-left-width:1px}.gist .inline-comments .timeline-comment{margin-bottom:10px}.gist .comment-holder,.gist .inline-comments .inline-comment-form,.gist .inline-comments .inline-comment-form-container{max-width:780px}.gist .empty-cell+.line-comments,.gist .line-comments+.line-comments{border-left:1px solid #eaecef}.gist .inline-comment-form-container .inline-comment-form,.gist .inline-comment-form-container.open .inline-comment-form-actions{display:none}.gist .inline-comment-form-container .inline-comment-form-actions,.gist .inline-comment-form-container.open .inline-comment-form{display:block}.gist body.full-width .container,.gist body.full-width .container-lg,.gist body.full-width .container-xl,.gist body.split-diff .container,.gist body.split-diff .container-lg,.gist body.split-diff .container-xl{width:100%;max-width:none;padding-right:20px;padding-left:20px}.gist body.full-width .repository-content,.gist body.split-diff .repository-content{width:100%}.gist body.full-width .new-pr-form,.gist body.split-diff .new-pr-form{max-width:980px}.gist .file-diff-split{table-layout:fixed}.gist .file-diff-split .blob-code+.blob-num{border-left:1px solid #f6f8fa}.gist .file-diff-split .blob-code-inner{word-wrap:break-word;white-space:pre-wrap}.gist .file-diff-split .empty-cell{cursor:default;background-color:#fafbfc;border-right-color:#eaecef}@media (max-width:1280px){.gist .file-diff-split .write-selected .comment-form-head{margin-bottom:48px !important}.gist .file-diff-split markdown-toolbar{position:absolute;right:8px;bottom:-40px}}.gist .submodule-diff-stats .octicon-diff-removed{color:#cb2431}.gist .submodule-diff-stats .octicon-diff-renamed{color:#677a85}.gist .submodule-diff-stats .octicon-diff-modified{color:#d0b44c}.gist .submodule-diff-stats .octicon-diff-added{color:#28a745}.gist .BlobToolbar{left:-17px}.gist .BlobToolbar-dropdown{margin-left:-2px}.gist .code-navigation-banner{background:linear-gradient(180deg,rgba(242,248,254,0),rgba(242,248,254,.47))}.gist .code-navigation-banner .code-navigation-banner-illo{background-image:url(code-navigation-banner-illo.svg);background-repeat:no-repeat;background-position:50%}.gist .pl-token.active,.gist .pl-token:hover{cursor:pointer;background:#ffea7f}.gist .task-list-item{list-style-type:none}.gist .task-list-item label{font-weight:400}.gist .task-list-item.enabled label{cursor:pointer}.gist .task-list-item+.task-list-item{margin-top:3px}.gist .task-list-item .handle{display:none}.gist .task-list-item-checkbox{margin:0 .2em .25em -1.6em;vertical-align:middle}.gist .reorderable-task-lists .markdown-body .contains-task-list{padding:0}.gist .reorderable-task-lists .markdown-body li:not(.task-list-item){margin-left:26px}.gist .reorderable-task-lists .markdown-body ol:not(.contains-task-list) li,.gist .reorderable-task-lists .markdown-body ul:not(.contains-task-list) li{margin-left:0}.gist .reorderable-task-lists .markdown-body li p{margin-top:0}.gist .reorderable-task-lists .markdown-body .task-list-item{padding-right:15px;padding-left:42px;margin-right:-15px;margin-left:-15px;border:1px solid transparent}.gist .reorderable-task-lists .markdown-body .task-list-item+.task-list-item{margin-top:0}.gist .reorderable-task-lists .markdown-body .task-list-item .contains-task-list{padding-top:4px}.gist .reorderable-task-lists .markdown-body .task-list-item .handle{display:block;float:left;width:20px;padding:2px 0 0 2px;margin-left:-43px;opacity:0}.gist .reorderable-task-lists .markdown-body .task-list-item .drag-handle{fill:#333}.gist .reorderable-task-lists .markdown-body .task-list-item.hovered>.handle{opacity:1}.gist .reorderable-task-lists .markdown-body .task-list-item.is-dragging{opacity:0}.gist .review-comment-contents .markdown-body .task-list-item{padding-left:42px;margin-right:-12px;margin-left:-12px;border-top-left-radius:3px;border-bottom-left-radius:3px}.gist .review-comment-contents .markdown-body .task-list-item.hovered{border-left-color:#ededed}.gist .highlight{padding:0;margin:0;font-family:SFMono-Regular,Consolas,Liberation Mono,Menlo,monospace;font-size:12px;font-weight:400;line-height:1.4;color:#333;background:#fff;border:0}.gist .octospinner,.gist .render-viewer-error,.gist .render-viewer-fatal,.gist .render-viewer-invalid{display:none}.gist iframe.render-viewer{width:100%;height:480px;overflow:hidden;border:0}.gist code,.gist pre{font-family:SFMono-Regular,Consolas,Liberation Mono,Menlo,monospace !important}.gist .gist-meta{padding:10px;overflow:hidden;font:12px -apple-system,BlinkMacSystemFont,Segoe UI,Helvetica,Arial,sans-serif,Apple Color Emoji,Segoe UI Emoji;color:#586069;background-color:#f7f7f7;border-radius:0 0 3px 3px}.gist .gist-meta a{font-weight:600;color:#666;text-decoration:none;border:0}.gist .gist-data{overflow:auto;word-wrap:normal;background-color:#fff;border-bottom:1px solid #ddd;border-radius:3px 3px 0 0}.gist .gist-file{margin-bottom:1em;font-family:SFMono-Regular,Consolas,Liberation Mono,Menlo,monospace;border:1px solid;border-color:#ddd #ddd #ccc;border-radius:3px}.gist .gist-file article{padding:6px}.gist .gist-file .scroll .gist-data{position:absolute;top:0;right:0;bottom:30px;left:0;overflow:scroll}.gist .gist-file .scroll .gist-meta{position:absolute;right:0;bottom:0;left:0}.gist .blob-num{min-width:inherit}.gist .blob-code,.gist .blob-num{padding:1px 10px !important;background:transparent}.gist .blob-code{text-align:left;border:0}.gist .blob-wrapper table{border-collapse:collapse}.gist table,.gist table tr,.gist table tr td,.gist table tr th{border-collapse:collapse}.gist .blob-wrapper tr:first-child td{padding-top:4px}.gist .markdown-body .anchor{display:none}