diff options
Diffstat (limited to '')
| -rw-r--r-- | tests/hashmap/Hashmap.Properties.fst | 235 |
1 files changed, 235 insertions, 0 deletions
diff --git a/tests/hashmap/Hashmap.Properties.fst b/tests/hashmap/Hashmap.Properties.fst new file mode 100644 index 00000000..bd066dd0 --- /dev/null +++ b/tests/hashmap/Hashmap.Properties.fst @@ -0,0 +1,235 @@ +(** Properties about the hashmap *) +module Hashmap.Properties +open Primitives +open FStar.List.Tot +open FStar.Mul +open Hashmap.Types +open Hashmap.Clauses +open Hashmap.Funs + +#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" + +(*** Utilities *) + +val pairwise_distinct : #a:eqtype -> ls:list a -> Tot bool +let rec pairwise_distinct (#a : eqtype) (ls : list a) : Tot bool = + match ls with + | [] -> true + | x :: ls' -> List.Tot.for_all (fun y -> x <> y) ls' && pairwise_distinct ls' + +val for_allP: #a:Type -> f:(a -> Tot Type0) -> list a -> Tot Type0 +let rec for_allP (f : 'a -> Tot Type0) (l : list 'a) : Tot Type0 = + match l with + | [] -> True + | hd::tl -> f hd /\ for_allP f tl + +val pairwise_relP : #a:Type -> pred:(a -> a -> Tot Type0) -> ls:list a -> Tot Type0 +let rec pairwise_relP #a pred ls = + match ls with + | [] -> True + | x :: ls' -> + for_allP (pred x) ls' /\ pairwise_relP pred ls' + +val pairwise_rel : #a:Type -> pred:(a -> a -> Tot bool) -> ls:list a -> Tot bool +let rec pairwise_rel #a pred ls = + match ls with + | [] -> true + | x :: ls' -> + List.Tot.for_all (pred x) ls' && pairwise_rel pred ls' + +/// The lack of lemmas about list manipulation is really annoying... + +#push-options "--fuel 1" +let rec flatten_append (#a : Type) (l1 l2: list (list a)) : + Lemma (flatten (l1 @ l2) == flatten l1 @ flatten l2) = + match l1 with + | [] -> () + | x :: l1' -> + flatten_append l1' l2; + append_assoc x (flatten l1') (flatten l2) +#pop-options + +/// We don't use anonymous functions as parameters to other functions, but rather +/// introduce auxiliary functions instead: otherwise we can't reason (because +/// F*'s encoding to the SMT is imprecise for functions) +let fst_is_disctinct (#a : eqtype) (#b : Type0) (p0 : a & b) (p1 : a & b) : Type0 = + fst p0 <> fst p1 + +(*** Invariants, representants *) + +/// "Natural" length function for [list_t] +let rec list_t_len (#t : Type0) (ls : list_t t) : nat = + match ls with + | ListNil -> 0 + | ListCons _ _ tl -> 1 + list_t_len tl + +/// The "key" type +type key = usize + +type binding (t : Type0) = key & t + +type slots_t (t : Type0) = vec (list_t t) + +/// We represent hash maps as associative lists +type assoc_list (t : Type0) = list (binding t) + +/// Representation function for [list_t] +let rec list_t_v (#t : Type0) (ls : list_t t) : assoc_list t = + match ls with + | ListNil -> [] + | ListCons k v tl -> (k,v) :: list_t_v tl + +/// Representation function for the slots. +/// Rk.: I hesitated to use [concatMap] +let slots_t_v (#t : Type0) (slots : slots_t t) : assoc_list t = + flatten (map list_t_v slots) + +/// Representation function for [hash_map_t] +let hash_map_t_v (#t : Type0) (hm : hash_map_t t) : assoc_list t = + slots_t_v hm.hash_map_slots + +let same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b = k +let binding_neq (#t : Type0) (b0 b1 : binding t) : bool = fst b0 <> fst b1 + +let has_same_binding (#t : Type0) (al : assoc_list t) ((k,v) : binding t) : Type0 = + match find (same_key k) al with + | None -> False + | Some (k',v') -> v' == v + +/// Auxiliary function stating that two associative lists are "equivalent" +let assoc_list_equiv (#t : Type0) (al0 al1 : assoc_list t) : Type0 = + // All the bindings in al0 can be found in al1 + for_allP (has_same_binding al1) al0 /\ + // And the reverse is true + for_allP (has_same_binding al0) al1 + +/// Base invariant for the hashmap (might temporarily be broken at some point) +let hash_map_t_base_inv (#t : Type0) (hm : hash_map_t t) : Type0 = + let al = hash_map_t_v hm in + // [num_entries] correctly tracks the number of entries in the table + hm.hash_map_num_entries = length al /\ + // All the keys are pairwise distinct + pairwise_rel binding_neq al /\ + // The capacity must be > 0 (otherwise we can't resize, because we multiply + // the capacity by two!) + length hm.hash_map_slots > 0 /\ + // Load computation + begin + let capacity = length hm.hash_map_slots in + let (dividend, divisor) = hm.hash_map_max_load_factor in + 0 < dividend /\ dividend < divisor /\ + hm.hash_map_max_load = (capacity * dividend) / divisor + end + +/// Invariant for the hashmap +let hash_map_t_inv_simpl (#t : Type0) (hm : hash_map_t t) : Type0 = + // Base invariant + hash_map_t_base_inv hm /\ + // The hash map is either: not overloaded, or we can't resize it + (hm.hash_map_num_entries <= hm.hash_map_max_load + || length hm.hash_map_slots * 2 > usize_max) + +/// The following predicate links the hashmap to an associative list. +/// Note that it does not compute the representant: different (permuted) +/// lists can be used to represent the same hashmap! +let hash_map_t_is_al (#t : Type0) (hm : hash_map_t t) (al : assoc_list t) : Type0 = + let hm_al = hash_map_t_v hm in + assoc_list_equiv hm_al al + +/// The invariant we reveal to the user +let hash_map_t_inv (#t : Type0) (hm : hash_map_t t) (al : assoc_list t) : Type0 = + // The hash map invariant is satisfied + hash_map_t_inv_simpl hm /\ + // And it can be seen as the given associative list + hash_map_t_is_al hm al + +(*** Proofs *) +(**** allocate_slots *) +val hash_map_allocate_slots_fwd_lem + (t : Type0) (slots : vec (list_t t)) (n : usize) : + Lemma + (requires (slots_t_v slots == [] /\ length slots + n <= usize_max)) + (ensures ( + match hash_map_allocate_slots_fwd t slots n with + | Fail -> False + | Return slots' -> + slots_t_v slots' == [] /\ + length slots' = length slots + n)) + (decreases (hash_map_allocate_slots_decreases t slots n)) + +#push-options "--fuel 1" +let rec hash_map_allocate_slots_fwd_lem t slots n = + if n = 0 then () + else + begin match vec_push_back (list_t t) slots ListNil with + | Fail -> assert(False) + | Return v -> + (* Prove that the new slots [v] represent an empty mapping *) + assert(v == slots @ [ListNil]); + map_append list_t_v slots [ListNil]; + assert(map list_t_v v == map list_t_v slots @ map list_t_v [ListNil]); + assert_norm(map (list_t_v #t) [ListNil] == [[]]); + flatten_append (map list_t_v slots) [[]]; + assert(slots_t_v v == slots_t_v slots @ slots_t_v [ListNil]); + assert_norm(slots_t_v #t [ListNil] == []); + assert(slots_t_v v == slots_t_v slots @ []); + assert(slots_t_v v == slots_t_v slots); + assert(slots_t_v v == []); + begin match usize_sub n 1 with + | Fail -> assert(False) + | Return i -> + hash_map_allocate_slots_fwd_lem t v i; + begin match hash_map_allocate_slots_fwd t v i with + | Fail -> assert(False) + | Return v0 -> () + end + end + end +#pop-options + +(**** new *) +/// Under proper conditions, [new] doesn't fail and returns an empty hash map. +val hash_map_new_with_capacity_fwd_lem + (t : Type0) (capacity : usize) + (max_load_dividend : usize) (max_load_divisor : usize) : + Lemma + (requires ( + 0 < max_load_dividend /\ + max_load_dividend < max_load_divisor /\ + 0 < capacity /\ + capacity * max_load_dividend < usize_max)) + (ensures ( + match hash_map_new_with_capacity_fwd t capacity max_load_dividend max_load_divisor with + | Fail -> False + | Return hm -> hash_map_t_inv hm [])) + +#push-options "--fuel 1" +let hash_map_new_with_capacity_fwd_lem (t : Type0) (capacity : usize) + (max_load_dividend : usize) (max_load_divisor : usize) = + let v = vec_new (list_t t) in + assert(length v = 0); + hash_map_allocate_slots_fwd_lem t v capacity; + begin match hash_map_allocate_slots_fwd t v capacity with + | Fail -> assert(False) + | Return v0 -> + begin match usize_mul capacity max_load_dividend with + | Fail -> assert(False) + | Return i -> + begin match usize_div i max_load_divisor with + | Fail -> assert(False) + | Return i0 -> + let hm = Mkhash_map_t 0 (max_load_dividend, max_load_divisor) i0 v0 in + // The base invariant + let al = hash_map_t_v hm in + assert(hash_map_t_base_inv hm); + assert(hash_map_t_inv_simpl hm); + assert(hash_map_t_is_al hm []) + end + end + end +#pop-options + + +(**** clear_slots *) + +(**** clear *) |