From a9c256fe95523842a1ff025e73f6e9ce7c2db38a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 18 Aug 2023 10:44:01 +0200 Subject: Add tests which use const generics as values --- tests/lean/Array/Funs.lean | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'tests/lean') diff --git a/tests/lean/Array/Funs.lean b/tests/lean/Array/Funs.lean index ad737dca..8d10c660 100644 --- a/tests/lean/Array/Funs.lean +++ b/tests/lean/Array/Funs.lean @@ -166,6 +166,10 @@ def index_index_array Array.index_shared (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32) s i Array.index_shared U32 (Usize.ofInt 32) a j +/- [array::const_gen_ret]: forward function -/ +def const_gen_ret (N : Usize) : Result Usize := + Result.ret N + /- [array::update_update_array]: forward function -/ def update_update_array (s : Array (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32)) (i : Usize) -- cgit v1.3.1 From 8543092569616ef6a75949a72532f7b73dc696f2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 18 Aug 2023 12:23:03 +0200 Subject: Regenerate the array tests --- tests/coq/array/Array_Funs.v | 9 +++++++++ tests/fstar/array/Array.Funs.fst | 8 ++++++++ tests/lean/Array/Funs.lean | 8 ++++++++ 3 files changed, 25 insertions(+) (limited to 'tests/lean') diff --git a/tests/coq/array/Array_Funs.v b/tests/coq/array/Array_Funs.v index d47e4633..6ff3066a 100644 --- a/tests/coq/array/Array_Funs.v +++ b/tests/coq/array/Array_Funs.v @@ -451,6 +451,15 @@ Definition f3_fwd (n : nat) : result u32 := sum2_fwd n s s0 . +(** [array::SZ] *) +Definition sz_body : result usize := Return 32%usize. +Definition sz_c : usize := sz_body%global. + +(** [array::f5]: forward function *) +Definition f5_fwd (x : array u32 32%usize) : result u32 := + array_index_shared u32 32%usize x 0%usize +. + (** [array::ite]: forward function *) Definition ite_fwd : result unit := s <- diff --git a/tests/fstar/array/Array.Funs.fst b/tests/fstar/array/Array.Funs.fst index 72163585..83256398 100644 --- a/tests/fstar/array/Array.Funs.fst +++ b/tests/fstar/array/Array.Funs.fst @@ -347,6 +347,14 @@ let f3_fwd : result u32 = ]) 16 18 in sum2_fwd s s0 +(** [array::SZ] *) +let sz_body : result usize = Return 32 +let sz_c : usize = eval_global sz_body + +(** [array::f5]: forward function *) +let f5_fwd (x : array u32 32) : result u32 = + array_index_shared u32 32 x 0 + (** [array::ite]: forward function *) let ite_fwd : result unit = let* s = array_to_slice_mut_fwd u32 2 (mk_array u32 2 [ 0; 0 ]) in diff --git a/tests/lean/Array/Funs.lean b/tests/lean/Array/Funs.lean index 8d10c660..a42072d1 100644 --- a/tests/lean/Array/Funs.lean +++ b/tests/lean/Array/Funs.lean @@ -447,6 +447,14 @@ def f3 : Result U32 := ]) (Usize.ofInt 16) (Usize.ofInt 18) sum2 s s0 +/- [array::SZ] -/ +def sz_body : Result Usize := Result.ret (Usize.ofInt 32) +def sz_c : Usize := eval_global sz_body (by simp) + +/- [array::f5]: forward function -/ +def f5 (x : Array U32 (Usize.ofInt 32)) : Result U32 := + Array.index_shared U32 (Usize.ofInt 32) x (Usize.ofInt 0) + /- [array::ite]: forward function -/ def ite : Result Unit := do -- cgit v1.3.1 From ce8f5c8f67e41a74bfdf8f6d664ff4e45e9de850 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 7 Sep 2023 16:06:14 +0200 Subject: Regenerate the test files and fix a proof --- tests/coq/array/Primitives.v | 14 +++++++ tests/coq/betree/BetreeMain_Funs.v | 10 +---- tests/coq/betree/Primitives.v | 14 +++++++ tests/coq/hashmap/Hashmap_Funs.v | 6 +-- tests/coq/hashmap/Primitives.v | 14 +++++++ tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 6 +-- tests/coq/hashmap_on_disk/Primitives.v | 14 +++++++ tests/coq/misc/Constants.v | 6 +-- tests/coq/misc/Primitives.v | 14 +++++++ tests/fstar/array/Primitives.fst | 47 +++++++++++++++++----- tests/fstar/betree/BetreeMain.Funs.fst | 8 +--- tests/fstar/betree/Primitives.fst | 47 +++++++++++++++++----- .../fstar/betree_back_stateful/BetreeMain.Funs.fst | 8 +--- tests/fstar/betree_back_stateful/Primitives.fst | 47 +++++++++++++++++----- tests/fstar/hashmap/Hashmap.Funs.fst | 6 +-- tests/fstar/hashmap/Primitives.fst | 47 +++++++++++++++++----- tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst | 6 +-- tests/fstar/hashmap_on_disk/Primitives.fst | 47 +++++++++++++++++----- tests/fstar/misc/Constants.fst | 6 +-- tests/fstar/misc/Primitives.fst | 47 +++++++++++++++++----- tests/hol4/betree/betreeMain_FunsScript.sml | 12 +----- tests/hol4/betree/betreeMain_FunsTheory.sig | 14 +------ tests/hol4/hashmap/hashmap_FunsScript.sml | 10 +---- tests/hol4/hashmap/hashmap_FunsTheory.sig | 12 +----- tests/hol4/hashmap/hashmap_PropertiesScript.sml | 2 +- .../hashmap_on_disk/hashmapMain_FunsScript.sml | 10 +---- .../hashmap_on_disk/hashmapMain_FunsTheory.sig | 12 +----- tests/hol4/misc-constants/constantsScript.sml | 10 +---- tests/hol4/misc-constants/constantsTheory.sig | 12 +----- tests/lean/BetreeMain/Funs.lean | 9 +---- tests/lean/Constants.lean | 6 +-- tests/lean/Hashmap/Funs.lean | 6 +-- tests/lean/HashmapMain/Funs.lean | 6 +-- 33 files changed, 320 insertions(+), 215 deletions(-) (limited to 'tests/lean') diff --git a/tests/coq/array/Primitives.v b/tests/coq/array/Primitives.v index 71a2d9c3..8d6c9c8d 100644 --- a/tests/coq/array/Primitives.v +++ b/tests/coq/array/Primitives.v @@ -394,6 +394,20 @@ Notation "x s< y" := (scalar_ltb x y) (at level 80) : Primitives_scope. Notation "x s>= y" := (scalar_geb x y) (at level 80) : Primitives_scope. Notation "x s> y" := (scalar_gtb x y) (at level 80) : Primitives_scope. +(** Constants *) +Definition core_u8_max := u8_max %u32. +Definition core_u16_max := u16_max %u32. +Definition core_u32_max := u32_max %u32. +Definition core_u64_max := u64_max %u64. +Definition core_u128_max := u64_max %u128. +Axiom core_usize_max : usize. (** TODO *) +Definition core_i8_max := i8_max %i32. +Definition core_i16_max := i16_max %i32. +Definition core_i32_max := i32_max %i32. +Definition core_i64_max := i64_max %i64. +Definition core_i128_max := i64_max %i128. +Axiom core_isize_max : isize. (** TODO *) + (*** Range *) Record range (T : Type) := mk_range { start: T; diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v index 1e457433..cfa1f8fb 100644 --- a/tests/coq/betree/BetreeMain_Funs.v +++ b/tests/coq/betree/BetreeMain_Funs.v @@ -75,12 +75,6 @@ Definition betree_node_id_counter_fresh_id_back Return {| Betree_node_id_counter_next_node_id := i |} . -(** [core::num::u64::{9}::MAX] *) -Definition core_num_u64_max_body : result u64 := - Return 18446744073709551615%u64 -. -Definition core_num_u64_max_c : u64 := core_num_u64_max_body%global. - (** [betree_main::betree::upsert_update]: forward function *) Definition betree_upsert_update_fwd (prev : option u64) (st : Betree_upsert_fun_state_t) : result u64 := @@ -93,8 +87,8 @@ Definition betree_upsert_update_fwd | Some prev0 => match st with | BetreeUpsertFunStateAdd v => - margin <- u64_sub core_num_u64_max_c prev0; - if margin s>= v then u64_add prev0 v else Return core_num_u64_max_c + margin <- u64_sub core_u64_max prev0; + if margin s>= v then u64_add prev0 v else Return core_u64_max | BetreeUpsertFunStateSub v => if prev0 s>= v then u64_sub prev0 v else Return 0%u64 end diff --git a/tests/coq/betree/Primitives.v b/tests/coq/betree/Primitives.v index 71a2d9c3..8d6c9c8d 100644 --- a/tests/coq/betree/Primitives.v +++ b/tests/coq/betree/Primitives.v @@ -394,6 +394,20 @@ Notation "x s< y" := (scalar_ltb x y) (at level 80) : Primitives_scope. Notation "x s>= y" := (scalar_geb x y) (at level 80) : Primitives_scope. Notation "x s> y" := (scalar_gtb x y) (at level 80) : Primitives_scope. +(** Constants *) +Definition core_u8_max := u8_max %u32. +Definition core_u16_max := u16_max %u32. +Definition core_u32_max := u32_max %u32. +Definition core_u64_max := u64_max %u64. +Definition core_u128_max := u64_max %u128. +Axiom core_usize_max : usize. (** TODO *) +Definition core_i8_max := i8_max %i32. +Definition core_i16_max := i16_max %i32. +Definition core_i32_max := i32_max %i32. +Definition core_i64_max := i64_max %i64. +Definition core_i128_max := i64_max %i128. +Axiom core_isize_max : isize. (** TODO *) + (*** Range *) Record range (T : Type) := mk_range { start: T; diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index e950ba0b..054880d4 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -190,10 +190,6 @@ Definition hash_map_insert_no_resize_fwd_back |}) . -(** [core::num::u32::{8}::MAX] *) -Definition core_num_u32_max_body : result u32 := Return 4294967295%u32. -Definition core_num_u32_max_c : u32 := core_num_u32_max_body%global. - (** [hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) Fixpoint hash_map_move_elements_from_list_loop_fwd_back @@ -259,7 +255,7 @@ Definition hash_map_move_elements_fwd_back (there is a single backward function, and the forward function returns ()) *) Definition hash_map_try_resize_fwd_back (T : Type) (n : nat) (self : Hash_map_t T) : result (Hash_map_t T) := - max_usize <- scalar_cast U32 Usize core_num_u32_max_c; + max_usize <- scalar_cast U32 Usize core_u32_max; let capacity := vec_len (List_t T) self.(Hash_map_slots) in n1 <- usize_div max_usize 2%usize; let (i, i0) := self.(Hash_map_max_load_factor) in diff --git a/tests/coq/hashmap/Primitives.v b/tests/coq/hashmap/Primitives.v index 71a2d9c3..8d6c9c8d 100644 --- a/tests/coq/hashmap/Primitives.v +++ b/tests/coq/hashmap/Primitives.v @@ -394,6 +394,20 @@ Notation "x s< y" := (scalar_ltb x y) (at level 80) : Primitives_scope. Notation "x s>= y" := (scalar_geb x y) (at level 80) : Primitives_scope. Notation "x s> y" := (scalar_gtb x y) (at level 80) : Primitives_scope. +(** Constants *) +Definition core_u8_max := u8_max %u32. +Definition core_u16_max := u16_max %u32. +Definition core_u32_max := u32_max %u32. +Definition core_u64_max := u64_max %u64. +Definition core_u128_max := u64_max %u128. +Axiom core_usize_max : usize. (** TODO *) +Definition core_i8_max := i8_max %i32. +Definition core_i16_max := i16_max %i32. +Definition core_i32_max := i32_max %i32. +Definition core_i64_max := i64_max %i64. +Definition core_i128_max := i64_max %i128. +Axiom core_isize_max : isize. (** TODO *) + (*** Range *) Record range (T : Type) := mk_range { start: T; diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index 657d5590..a85adbf2 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -208,10 +208,6 @@ Definition hashmap_hash_map_insert_no_resize_fwd_back |}) . -(** [core::num::u32::{8}::MAX] *) -Definition core_num_u32_max_body : result u32 := Return 4294967295%u32. -Definition core_num_u32_max_c : u32 := core_num_u32_max_body%global. - (** [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) Fixpoint hashmap_hash_map_move_elements_from_list_loop_fwd_back @@ -282,7 +278,7 @@ Definition hashmap_hash_map_try_resize_fwd_back (T : Type) (n : nat) (self : Hashmap_hash_map_t T) : result (Hashmap_hash_map_t T) := - max_usize <- scalar_cast U32 Usize core_num_u32_max_c; + max_usize <- scalar_cast U32 Usize core_u32_max; let capacity := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in n1 <- usize_div max_usize 2%usize; let (i, i0) := self.(Hashmap_hash_map_max_load_factor) in diff --git a/tests/coq/hashmap_on_disk/Primitives.v b/tests/coq/hashmap_on_disk/Primitives.v index 71a2d9c3..8d6c9c8d 100644 --- a/tests/coq/hashmap_on_disk/Primitives.v +++ b/tests/coq/hashmap_on_disk/Primitives.v @@ -394,6 +394,20 @@ Notation "x s< y" := (scalar_ltb x y) (at level 80) : Primitives_scope. Notation "x s>= y" := (scalar_geb x y) (at level 80) : Primitives_scope. Notation "x s> y" := (scalar_gtb x y) (at level 80) : Primitives_scope. +(** Constants *) +Definition core_u8_max := u8_max %u32. +Definition core_u16_max := u16_max %u32. +Definition core_u32_max := u32_max %u32. +Definition core_u64_max := u64_max %u64. +Definition core_u128_max := u64_max %u128. +Axiom core_usize_max : usize. (** TODO *) +Definition core_i8_max := i8_max %i32. +Definition core_i16_max := i16_max %i32. +Definition core_i32_max := i32_max %i32. +Definition core_i64_max := i64_max %i64. +Definition core_i128_max := i64_max %i128. +Axiom core_isize_max : isize. (** TODO *) + (*** Range *) Record range (T : Type) := mk_range { start: T; diff --git a/tests/coq/misc/Constants.v b/tests/coq/misc/Constants.v index f1c32730..5dd78a09 100644 --- a/tests/coq/misc/Constants.v +++ b/tests/coq/misc/Constants.v @@ -12,12 +12,8 @@ Module Constants. Definition x0_body : result u32 := Return 0%u32. Definition x0_c : u32 := x0_body%global. -(** [core::num::u32::{8}::MAX] *) -Definition core_num_u32_max_body : result u32 := Return 4294967295%u32. -Definition core_num_u32_max_c : u32 := core_num_u32_max_body%global. - (** [constants::X1] *) -Definition x1_body : result u32 := Return core_num_u32_max_c. +Definition x1_body : result u32 := Return core_u32_max. Definition x1_c : u32 := x1_body%global. (** [constants::X2] *) diff --git a/tests/coq/misc/Primitives.v b/tests/coq/misc/Primitives.v index 71a2d9c3..8d6c9c8d 100644 --- a/tests/coq/misc/Primitives.v +++ b/tests/coq/misc/Primitives.v @@ -394,6 +394,20 @@ Notation "x s< y" := (scalar_ltb x y) (at level 80) : Primitives_scope. Notation "x s>= y" := (scalar_geb x y) (at level 80) : Primitives_scope. Notation "x s> y" := (scalar_gtb x y) (at level 80) : Primitives_scope. +(** Constants *) +Definition core_u8_max := u8_max %u32. +Definition core_u16_max := u16_max %u32. +Definition core_u32_max := u32_max %u32. +Definition core_u64_max := u64_max %u64. +Definition core_u128_max := u64_max %u128. +Axiom core_usize_max : usize. (** TODO *) +Definition core_i8_max := i8_max %i32. +Definition core_i16_max := i16_max %i32. +Definition core_i32_max := i32_max %i32. +Definition core_i64_max := i64_max %i64. +Definition core_i128_max := i64_max %i128. +Axiom core_isize_max : isize. (** TODO *) + (*** Range *) Record range (T : Type) := mk_range { start: T; diff --git a/tests/fstar/array/Primitives.fst b/tests/fstar/array/Primitives.fst index 9db82069..cd18cf29 100644 --- a/tests/fstar/array/Primitives.fst +++ b/tests/fstar/array/Primitives.fst @@ -169,17 +169,44 @@ let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : /// The scalar types type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max /// Negation let isize_neg = scalar_neg #Isize diff --git a/tests/fstar/betree/BetreeMain.Funs.fst b/tests/fstar/betree/BetreeMain.Funs.fst index 847dc865..2bb2352b 100644 --- a/tests/fstar/betree/BetreeMain.Funs.fst +++ b/tests/fstar/betree/BetreeMain.Funs.fst @@ -60,10 +60,6 @@ let betree_node_id_counter_fresh_id_back let* i = u64_add self.betree_node_id_counter_next_node_id 1 in Return { betree_node_id_counter_next_node_id = i } -(** [core::num::u64::{9}::MAX] *) -let core_num_u64_max_body : result u64 = Return 18446744073709551615 -let core_num_u64_max_c : u64 = eval_global core_num_u64_max_body - (** [betree_main::betree::upsert_update]: forward function *) let betree_upsert_update_fwd (prev : option u64) (st : betree_upsert_fun_state_t) : result u64 = @@ -76,8 +72,8 @@ let betree_upsert_update_fwd | Some prev0 -> begin match st with | BetreeUpsertFunStateAdd v -> - let* margin = u64_sub core_num_u64_max_c prev0 in - if margin >= v then u64_add prev0 v else Return core_num_u64_max_c + let* margin = u64_sub core_u64_max prev0 in + if margin >= v then u64_add prev0 v else Return core_u64_max | BetreeUpsertFunStateSub v -> if prev0 >= v then u64_sub prev0 v else Return 0 end diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index 9db82069..cd18cf29 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -169,17 +169,44 @@ let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : /// The scalar types type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max /// Negation let isize_neg = scalar_neg #Isize diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst index 3d08cd3c..8083ee8f 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst +++ b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst @@ -60,10 +60,6 @@ let betree_node_id_counter_fresh_id_back let* i = u64_add self.betree_node_id_counter_next_node_id 1 in Return { betree_node_id_counter_next_node_id = i } -(** [core::num::u64::{9}::MAX] *) -let core_num_u64_max_body : result u64 = Return 18446744073709551615 -let core_num_u64_max_c : u64 = eval_global core_num_u64_max_body - (** [betree_main::betree::upsert_update]: forward function *) let betree_upsert_update_fwd (prev : option u64) (st : betree_upsert_fun_state_t) : result u64 = @@ -76,8 +72,8 @@ let betree_upsert_update_fwd | Some prev0 -> begin match st with | BetreeUpsertFunStateAdd v -> - let* margin = u64_sub core_num_u64_max_c prev0 in - if margin >= v then u64_add prev0 v else Return core_num_u64_max_c + let* margin = u64_sub core_u64_max prev0 in + if margin >= v then u64_add prev0 v else Return core_u64_max | BetreeUpsertFunStateSub v -> if prev0 >= v then u64_sub prev0 v else Return 0 end diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst index 9db82069..cd18cf29 100644 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ b/tests/fstar/betree_back_stateful/Primitives.fst @@ -169,17 +169,44 @@ let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : /// The scalar types type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max /// Negation let isize_neg = scalar_neg #Isize diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index f4c13a7b..40cd0477 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -139,10 +139,6 @@ let hash_map_insert_no_resize_fwd_back let* v = vec_index_mut_back (list_t t) self.hash_map_slots hash_mod l0 in Return { self with hash_map_slots = v } -(** [core::num::u32::{8}::MAX] *) -let core_num_u32_max_body : result u32 = Return 4294967295 -let core_num_u32_max_c : u32 = eval_global core_num_u32_max_body - (** [hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) let rec hash_map_move_elements_from_list_loop_fwd_back @@ -194,7 +190,7 @@ let hash_map_move_elements_fwd_back (there is a single backward function, and the forward function returns ()) *) let hash_map_try_resize_fwd_back (t : Type0) (self : hash_map_t t) : result (hash_map_t t) = - let* max_usize = scalar_cast U32 Usize core_num_u32_max_c in + let* max_usize = scalar_cast U32 Usize core_u32_max in let capacity = vec_len (list_t t) self.hash_map_slots in let* n1 = usize_div max_usize 2 in let (i, i0) = self.hash_map_max_load_factor in diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index 9db82069..cd18cf29 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -169,17 +169,44 @@ let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : /// The scalar types type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max /// Negation let isize_neg = scalar_neg #Isize diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index 1c94209c..5af90bd8 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -157,10 +157,6 @@ let hashmap_hash_map_insert_no_resize_fwd_back hash_mod l0 in Return { self with hashmap_hash_map_slots = v } -(** [core::num::u32::{8}::MAX] *) -let core_num_u32_max_body : result u32 = Return 4294967295 -let core_num_u32_max_c : u32 = eval_global core_num_u32_max_body - (** [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) let rec hashmap_hash_map_move_elements_from_list_loop_fwd_back @@ -218,7 +214,7 @@ let hashmap_hash_map_move_elements_fwd_back (there is a single backward function, and the forward function returns ()) *) let hashmap_hash_map_try_resize_fwd_back (t : Type0) (self : hashmap_hash_map_t t) : result (hashmap_hash_map_t t) = - let* max_usize = scalar_cast U32 Usize core_num_u32_max_c in + let* max_usize = scalar_cast U32 Usize core_u32_max in let capacity = vec_len (hashmap_list_t t) self.hashmap_hash_map_slots in let* n1 = usize_div max_usize 2 in let (i, i0) = self.hashmap_hash_map_max_load_factor in diff --git a/tests/fstar/hashmap_on_disk/Primitives.fst b/tests/fstar/hashmap_on_disk/Primitives.fst index 9db82069..cd18cf29 100644 --- a/tests/fstar/hashmap_on_disk/Primitives.fst +++ b/tests/fstar/hashmap_on_disk/Primitives.fst @@ -169,17 +169,44 @@ let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : /// The scalar types type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max /// Negation let isize_neg = scalar_neg #Isize diff --git a/tests/fstar/misc/Constants.fst b/tests/fstar/misc/Constants.fst index d2b0415e..7dfb6f36 100644 --- a/tests/fstar/misc/Constants.fst +++ b/tests/fstar/misc/Constants.fst @@ -9,12 +9,8 @@ open Primitives let x0_body : result u32 = Return 0 let x0_c : u32 = eval_global x0_body -(** [core::num::u32::{8}::MAX] *) -let core_num_u32_max_body : result u32 = Return 4294967295 -let core_num_u32_max_c : u32 = eval_global core_num_u32_max_body - (** [constants::X1] *) -let x1_body : result u32 = Return core_num_u32_max_c +let x1_body : result u32 = Return core_u32_max let x1_c : u32 = eval_global x1_body (** [constants::X2] *) diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index 9db82069..cd18cf29 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -169,17 +169,44 @@ let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : /// The scalar types type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max /// Negation let isize_neg = scalar_neg #Isize diff --git a/tests/hol4/betree/betreeMain_FunsScript.sml b/tests/hol4/betree/betreeMain_FunsScript.sml index 5e604f8c..bd16c16c 100644 --- a/tests/hol4/betree/betreeMain_FunsScript.sml +++ b/tests/hol4/betree/betreeMain_FunsScript.sml @@ -88,14 +88,6 @@ val betree_node_id_counter_fresh_id_back_def = Define ‘ od ’ -(** [core::num::u64::{9}::MAX] *) -Definition core_num_u64_max_body_def: - core_num_u64_max_body : u64 result = Return (int_to_u64 18446744073709551615) -End -Definition core_num_u64_max_c_def: - core_num_u64_max_c : u64 = get_return_value core_num_u64_max_body -End - val betree_upsert_update_fwd_def = Define ‘ (** [betree_main::betree::upsert_update]: forward function *) betree_upsert_update_fwd @@ -109,8 +101,8 @@ val betree_upsert_update_fwd_def = Define ‘ (case st of | BetreeUpsertFunStateAdd v => do - margin <- u64_sub core_num_u64_max_c prev0; - if u64_ge margin v then u64_add prev0 v else Return core_num_u64_max_c + margin <- u64_sub core_u64_max prev0; + if u64_ge margin v then u64_add prev0 v else Return core_u64_max od | BetreeUpsertFunStateSub v => if u64_ge prev0 v then u64_sub prev0 v else Return (int_to_u64 0))) diff --git a/tests/hol4/betree/betreeMain_FunsTheory.sig b/tests/hol4/betree/betreeMain_FunsTheory.sig index 6c249f70..c922ca9f 100644 --- a/tests/hol4/betree/betreeMain_FunsTheory.sig +++ b/tests/hol4/betree/betreeMain_FunsTheory.sig @@ -58,8 +58,6 @@ sig val betree_store_internal_node_fwd_def : thm val betree_store_leaf_node_fwd_def : thm val betree_upsert_update_fwd_def : thm - val core_num_u64_max_body_def : thm - val core_num_u64_max_c_def : thm val main_fwd_def : thm val betreeMain_Funs_grammars : type_grammar.grammar * term_grammar.grammar @@ -1215,22 +1213,14 @@ sig case st of BetreeUpsertFunStateAdd v => do - margin <- u64_sub core_num_u64_max_c prev0; + margin <- u64_sub core_u64_max prev0; if u64_ge margin v then u64_add prev0 v - else Return core_num_u64_max_c + else Return core_u64_max od | BetreeUpsertFunStateSub v' => if u64_ge prev0 v' then u64_sub prev0 v' else Return (int_to_u64 0) - [core_num_u64_max_body_def] Definition - - ⊢ core_num_u64_max_body = Return (int_to_u64 18446744073709551615) - - [core_num_u64_max_c_def] Definition - - ⊢ core_num_u64_max_c = get_return_value core_num_u64_max_body - [main_fwd_def] Definition ⊢ main_fwd = Return () diff --git a/tests/hol4/hashmap/hashmap_FunsScript.sml b/tests/hol4/hashmap/hashmap_FunsScript.sml index e3c3d2a5..682c5760 100644 --- a/tests/hol4/hashmap/hashmap_FunsScript.sml +++ b/tests/hol4/hashmap/hashmap_FunsScript.sml @@ -170,14 +170,6 @@ val hash_map_insert_no_resize_fwd_back_def = Define ‘ od ’ -(** [core::num::u32::{8}::MAX] *) -Definition core_num_u32_max_body_def: - core_num_u32_max_body : u32 result = Return (int_to_u32 4294967295) -End -Definition core_num_u32_max_c_def: - core_num_u32_max_c : u32 = get_return_value core_num_u32_max_body -End - val [hash_map_move_elements_from_list_loop_fwd_back_def] = DefineDiv ‘ (** [hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) @@ -241,7 +233,7 @@ val hash_map_try_resize_fwd_back_def = Define ‘ (there is a single backward function, and the forward function returns ()) *) hash_map_try_resize_fwd_back (self : 't hash_map_t) : 't hash_map_t result = do - max_usize <- mk_usize (u32_to_int core_num_u32_max_c); + max_usize <- mk_usize (u32_to_int core_u32_max); let capacity = vec_len self.hash_map_slots in do n1 <- usize_div max_usize (int_to_usize 2); diff --git a/tests/hol4/hashmap/hashmap_FunsTheory.sig b/tests/hol4/hashmap/hashmap_FunsTheory.sig index 50482547..bb3e192b 100644 --- a/tests/hol4/hashmap/hashmap_FunsTheory.sig +++ b/tests/hol4/hashmap/hashmap_FunsTheory.sig @@ -3,8 +3,6 @@ sig type thm = Thm.thm (* Definitions *) - val core_num_u32_max_body_def : thm - val core_num_u32_max_c_def : thm val hash_key_fwd_def : thm val hash_map_allocate_slots_fwd_def : thm val hash_map_allocate_slots_loop_fwd_def : thm @@ -48,14 +46,6 @@ sig (* [hashmap_Types] Parent theory of "hashmap_Funs" - [core_num_u32_max_body_def] Definition - - ⊢ core_num_u32_max_body = Return (int_to_u32 4294967295) - - [core_num_u32_max_c_def] Definition - - ⊢ core_num_u32_max_c = get_return_value core_num_u32_max_body - [hash_key_fwd_def] Definition ⊢ ∀k. hash_key_fwd k = Return k @@ -472,7 +462,7 @@ sig ⊢ ∀self. hash_map_try_resize_fwd_back self = do - max_usize <- mk_usize (u32_to_int core_num_u32_max_c); + max_usize <- mk_usize (u32_to_int core_u32_max); capacity <<- vec_len self.hash_map_slots; n1 <- usize_div max_usize (int_to_usize 2); (i,i0) <<- self.hash_map_max_load_factor; diff --git a/tests/hol4/hashmap/hashmap_PropertiesScript.sml b/tests/hol4/hashmap/hashmap_PropertiesScript.sml index 7259f2f5..8bc12fa5 100644 --- a/tests/hol4/hashmap/hashmap_PropertiesScript.sml +++ b/tests/hol4/hashmap/hashmap_PropertiesScript.sml @@ -1296,7 +1296,7 @@ Proof rw [hash_map_try_resize_fwd_back_def] >> (* “_ <-- mk_usize (u32_to_int core_num_u32_max_c)” *) assume_tac usize_u32_bounds >> - fs [core_num_u32_max_c_def, core_num_u32_max_body_def, get_return_value_def, u32_max_def] >> + fs [core_u32_max_def, u32_max_def] >> massage >> fs [mk_usize_def, u32_max_def] >> (* / 2 *) progress >> diff --git a/tests/hol4/hashmap_on_disk/hashmapMain_FunsScript.sml b/tests/hol4/hashmap_on_disk/hashmapMain_FunsScript.sml index b21c4f58..c1e30aa6 100644 --- a/tests/hol4/hashmap_on_disk/hashmapMain_FunsScript.sml +++ b/tests/hol4/hashmap_on_disk/hashmapMain_FunsScript.sml @@ -193,14 +193,6 @@ val hashmap_hash_map_insert_no_resize_fwd_back_def = Define ‘ od ’ -(** [core::num::u32::{8}::MAX] *) -Definition core_num_u32_max_body_def: - core_num_u32_max_body : u32 result = Return (int_to_u32 4294967295) -End -Definition core_num_u32_max_c_def: - core_num_u32_max_c : u32 = get_return_value core_num_u32_max_body -End - val [hashmap_hash_map_move_elements_from_list_loop_fwd_back_def] = DefineDiv ‘ (** [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) @@ -271,7 +263,7 @@ val hashmap_hash_map_try_resize_fwd_back_def = Define ‘ hashmap_hash_map_try_resize_fwd_back (self : 't hashmap_hash_map_t) : 't hashmap_hash_map_t result = do - max_usize <- mk_usize (u32_to_int core_num_u32_max_c); + max_usize <- mk_usize (u32_to_int core_u32_max); let capacity = vec_len self.hashmap_hash_map_slots in do n1 <- usize_div max_usize (int_to_usize 2); diff --git a/tests/hol4/hashmap_on_disk/hashmapMain_FunsTheory.sig b/tests/hol4/hashmap_on_disk/hashmapMain_FunsTheory.sig index 1d24cb26..d4e43d9a 100644 --- a/tests/hol4/hashmap_on_disk/hashmapMain_FunsTheory.sig +++ b/tests/hol4/hashmap_on_disk/hashmapMain_FunsTheory.sig @@ -3,8 +3,6 @@ sig type thm = Thm.thm (* Definitions *) - val core_num_u32_max_body_def : thm - val core_num_u32_max_c_def : thm val hashmap_hash_key_fwd_def : thm val hashmap_hash_map_allocate_slots_fwd_def : thm val hashmap_hash_map_allocate_slots_loop_fwd_def : thm @@ -50,14 +48,6 @@ sig (* [hashmapMain_Opaque] Parent theory of "hashmapMain_Funs" - [core_num_u32_max_body_def] Definition - - ⊢ core_num_u32_max_body = Return (int_to_u32 4294967295) - - [core_num_u32_max_c_def] Definition - - ⊢ core_num_u32_max_c = get_return_value core_num_u32_max_body - [hashmap_hash_key_fwd_def] Definition ⊢ ∀k. hashmap_hash_key_fwd k = Return k @@ -506,7 +496,7 @@ sig ⊢ ∀self. hashmap_hash_map_try_resize_fwd_back self = do - max_usize <- mk_usize (u32_to_int core_num_u32_max_c); + max_usize <- mk_usize (u32_to_int core_u32_max); capacity <<- vec_len self.hashmap_hash_map_slots; n1 <- usize_div max_usize (int_to_usize 2); (i,i0) <<- self.hashmap_hash_map_max_load_factor; diff --git a/tests/hol4/misc-constants/constantsScript.sml b/tests/hol4/misc-constants/constantsScript.sml index d589d348..40a319c6 100644 --- a/tests/hol4/misc-constants/constantsScript.sml +++ b/tests/hol4/misc-constants/constantsScript.sml @@ -13,17 +13,9 @@ Definition x0_c_def: x0_c : u32 = get_return_value x0_body End -(** [core::num::u32::{8}::MAX] *) -Definition core_num_u32_max_body_def: - core_num_u32_max_body : u32 result = Return (int_to_u32 4294967295) -End -Definition core_num_u32_max_c_def: - core_num_u32_max_c : u32 = get_return_value core_num_u32_max_body -End - (** [constants::X1] *) Definition x1_body_def: - x1_body : u32 result = Return core_num_u32_max_c + x1_body : u32 result = Return core_u32_max End Definition x1_c_def: x1_c : u32 = get_return_value x1_body diff --git a/tests/hol4/misc-constants/constantsTheory.sig b/tests/hol4/misc-constants/constantsTheory.sig index 149d7e22..287ad5f5 100644 --- a/tests/hol4/misc-constants/constantsTheory.sig +++ b/tests/hol4/misc-constants/constantsTheory.sig @@ -4,8 +4,6 @@ sig (* Definitions *) val add_fwd_def : thm - val core_num_u32_max_body_def : thm - val core_num_u32_max_c_def : thm val get_z1_fwd_def : thm val get_z1_z1_body_def : thm val get_z1_z1_c_def : thm @@ -110,14 +108,6 @@ sig ⊢ ∀a b. add_fwd a b = i32_add a b - [core_num_u32_max_body_def] Definition - - ⊢ core_num_u32_max_body = Return (int_to_u32 4294967295) - - [core_num_u32_max_c_def] Definition - - ⊢ core_num_u32_max_c = get_return_value core_num_u32_max_body - [get_z1_fwd_def] Definition ⊢ get_z1_fwd = Return get_z1_z1_c @@ -321,7 +311,7 @@ sig [x1_body_def] Definition - ⊢ x1_body = Return core_num_u32_max_c + ⊢ x1_body = Return core_u32_max [x1_c_def] Definition diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean index 07ef08dc..6681731f 100644 --- a/tests/lean/BetreeMain/Funs.lean +++ b/tests/lean/BetreeMain/Funs.lean @@ -64,11 +64,6 @@ def betree.NodeIdCounter.fresh_id_back let i ← self.next_node_id + (U64.ofInt 1) Result.ret { next_node_id := i } -/- [core::num::u64::{9}::MAX] -/ -def core_num_u64_max_body : Result U64 := - Result.ret (U64.ofInt 18446744073709551615) -def core_num_u64_max_c : U64 := eval_global core_num_u64_max_body (by simp) - /- [betree_main::betree::upsert_update]: forward function -/ def betree.upsert_update (prev : Option U64) (st : betree.UpsertFunState) : Result U64 := @@ -81,10 +76,10 @@ def betree.upsert_update match st with | betree.UpsertFunState.Add v => do - let margin ← core_num_u64_max_c - prev0 + let margin ← core_u64_max - prev0 if margin >= v then prev0 + v - else Result.ret core_num_u64_max_c + else Result.ret core_u64_max | betree.UpsertFunState.Sub v => if prev0 >= v then prev0 - v diff --git a/tests/lean/Constants.lean b/tests/lean/Constants.lean index 51b415d6..b0cdaa90 100644 --- a/tests/lean/Constants.lean +++ b/tests/lean/Constants.lean @@ -9,12 +9,8 @@ namespace constants def x0_body : Result U32 := Result.ret (U32.ofInt 0) def x0_c : U32 := eval_global x0_body (by simp) -/- [core::num::u32::{8}::MAX] -/ -def core_num_u32_max_body : Result U32 := Result.ret (U32.ofInt 4294967295) -def core_num_u32_max_c : U32 := eval_global core_num_u32_max_body (by simp) - /- [constants::X1] -/ -def x1_body : Result U32 := Result.ret core_num_u32_max_c +def x1_body : Result U32 := Result.ret core_u32_max def x1_c : U32 := eval_global x1_body (by simp) /- [constants::X2] -/ diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 30b30e0b..01c61de4 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -132,10 +132,6 @@ def HashMap.insert_no_resize let v ← Vec.index_mut_back (List T) self.slots hash_mod l0 Result.ret { self with slots := v } -/- [core::num::u32::{8}::MAX] -/ -def core_num_u32_max_body : Result U32 := Result.ret (U32.ofInt 4294967295) -def core_num_u32_max_c : U32 := eval_global core_num_u32_max_body (by simp) - /- [hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ divergent def HashMap.move_elements_from_list_loop @@ -184,7 +180,7 @@ def HashMap.move_elements (there is a single backward function, and the forward function returns ()) -/ def HashMap.try_resize (T : Type) (self : HashMap T) : Result (HashMap T) := do - let max_usize ← Scalar.cast .Usize core_num_u32_max_c + let max_usize ← Scalar.cast .Usize core_u32_max let capacity := Vec.len (List T) self.slots let n1 ← max_usize / (Usize.ofInt 2) let (i, i0) := self.max_load_factor diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index aec957ec..848b1a35 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -147,10 +147,6 @@ def hashmap.HashMap.insert_no_resize let v ← Vec.index_mut_back (hashmap.List T) self.slots hash_mod l0 Result.ret { self with slots := v } -/- [core::num::u32::{8}::MAX] -/ -def core_num_u32_max_body : Result U32 := Result.ret (U32.ofInt 4294967295) -def core_num_u32_max_c : U32 := eval_global core_num_u32_max_body (by simp) - /- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ divergent def hashmap.HashMap.move_elements_from_list_loop @@ -206,7 +202,7 @@ def hashmap.HashMap.move_elements def hashmap.HashMap.try_resize (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do - let max_usize ← Scalar.cast .Usize core_num_u32_max_c + let max_usize ← Scalar.cast .Usize core_u32_max let capacity := Vec.len (hashmap.List T) self.slots let n1 ← max_usize / (Usize.ofInt 2) let (i, i0) := self.max_load_factor -- cgit v1.3.1 From 78a2731924aa13989998c6be4a5a6865ce5098aa Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 13 Sep 2023 07:33:30 +0200 Subject: Make minor modifications --- compiler/Contexts.ml | 12 ++++++++++++ compiler/InterpreterStatements.ml | 8 ++++++-- compiler/InterpreterUtils.ml | 6 +++++- compiler/Print.ml | 22 +++++++++++++++------- compiler/SymbolicToPure.ml | 37 ------------------------------------- tests/lean/Hashmap/Properties.lean | 8 +++----- 6 files changed, 41 insertions(+), 52 deletions(-) (limited to 'tests/lean') diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml index 9d22a643..df77959e 100644 --- a/compiler/Contexts.ml +++ b/compiler/Contexts.ml @@ -333,9 +333,21 @@ type eval_ctx = { } [@@deriving show] +let lookup_type_var_opt (ctx : eval_ctx) (vid : TypeVarId.id) : type_var option + = + if TypeVarId.to_int vid < List.length ctx.type_vars then + Some (TypeVarId.nth ctx.type_vars vid) + else None + let lookup_type_var (ctx : eval_ctx) (vid : TypeVarId.id) : type_var = TypeVarId.nth ctx.type_vars vid +let lookup_const_generic_var_opt (ctx : eval_ctx) (vid : ConstGenericVarId.id) : + const_generic_var option = + if ConstGenericVarId.to_int vid < List.length ctx.const_generic_vars then + Some (ConstGenericVarId.nth ctx.const_generic_vars vid) + else None + let lookup_const_generic_var (ctx : eval_ctx) (vid : ConstGenericVarId.id) : const_generic_var = ConstGenericVarId.nth ctx.const_generic_vars vid diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index 1ea16e58..97fb80f4 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -1198,7 +1198,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call) log#ldebug (lazy ("trait method call:\n- call: " ^ call_to_string ctx call - ^ "\n- method name: " ^ method_name ^ "\n- generics:\n" + ^ "\n- method name: " ^ method_name ^ "\n- call.generics:\n" ^ egeneric_args_to_string ctx call.generics ^ "\n- trait and method generics:\n" ^ egeneric_args_to_string ctx @@ -1273,7 +1273,10 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call) (lazy ("provided method call:" ^ "\n- method name: " ^ method_name ^ "\n- generics:\n" - ^ egeneric_args_to_string ctx generics)); + ^ egeneric_args_to_string ctx generics + ^ "\n- parent params info: " + ^ Print.option_to_string A.show_params_info + method_def.signature.parent_params_info)); let tr_self = T.TraitRef (etrait_ref_no_regions_to_gr_trait_ref trait_ref) in @@ -1303,6 +1306,7 @@ and eval_transparent_function_call_symbolic (config : C.config) (call : A.call) (List.append trait_decl.required_methods provided) in let method_def = C.ctx_lookup_fun_decl ctx method_id in + log#ldebug (lazy ("method:\n" ^ fun_decl_to_string ctx method_def)); (* Instantiate *) let tr_self = T.TraitRef trait_ref in let tr_self = diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml index 8a7e8c52..8525be29 100644 --- a/compiler/InterpreterUtils.ml +++ b/compiler/InterpreterUtils.ml @@ -39,8 +39,12 @@ let typed_avalue_to_string = PA.typed_avalue_to_string let place_to_string = PA.place_to_string let operand_to_string = PA.operand_to_string let egeneric_args_to_string = PA.egeneric_args_to_string +let fun_decl_to_string = PA.fun_decl_to_string let call_to_string = PA.call_to_string -let trait_impl_to_string = PA.trait_impl_to_string + +let trait_impl_to_string ctx = + PA.trait_impl_to_string { ctx with type_vars = []; const_generic_vars = [] } + let statement_to_string ctx = PA.statement_to_string ctx "" " " let statement_to_string_with_tab ctx = PA.statement_to_string ctx " " " " let env_elem_to_string ctx = PA.env_elem_to_string ctx "" " " diff --git a/compiler/Print.ml b/compiler/Print.ml index 55aa0c53..92743bc1 100644 --- a/compiler/Print.ml +++ b/compiler/Print.ml @@ -479,19 +479,23 @@ module Contexts = struct PV.value_to_rtype_formatter fmt let eval_ctx_to_ctx_formatter (ctx : C.eval_ctx) : ctx_formatter = - (* We shouldn't use rvar_to_string *) - let rvar_to_string _r = - raise (Failure "Unexpected use of rvar_to_string") + let rvar_to_string r = + (* In theory we shouldn't use rvar_to_string, but it can happen + when printing definitions for instance... *) + T.RegionVarId.to_string r in let r_to_string r = PT.region_id_to_string r in let type_var_id_to_string vid = - let v = C.lookup_type_var ctx vid in - v.name + (* The context may be invalid *) + match C.lookup_type_var_opt ctx vid with + | None -> T.TypeVarId.to_string vid + | Some v -> v.name in let const_generic_var_id_to_string vid = - let v = C.lookup_const_generic_var ctx vid in - v.name + match C.lookup_const_generic_var_opt ctx vid with + | None -> T.ConstGenericVarId.to_string vid + | Some v -> v.name in let type_decl_id_to_string def_id = let def = C.ctx_lookup_type_decl ctx def_id in @@ -702,6 +706,10 @@ module EvalCtxLlbcAst = struct let fmt = PC.eval_ctx_to_ast_formatter ctx in PA.call_to_string fmt "" call + let fun_decl_to_string (ctx : C.eval_ctx) (f : A.fun_decl) : string = + let fmt = PC.eval_ctx_to_ast_formatter ctx in + PA.fun_decl_to_string fmt "" " " f + let statement_to_string (ctx : C.eval_ctx) (indent : string) (indent_incr : string) (e : A.statement) : string = let fmt = PC.eval_ctx_to_ast_formatter ctx in diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 1da0521d..4c5b99c3 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -346,43 +346,6 @@ let bs_ctx_lookup_local_function_sig (def_id : A.FunDeclId.id) let id = (A.Regular def_id, back_id) in (RegularFunIdNotLoopMap.find id ctx.fun_context.fun_sigs).sg -let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) - (args : texpression list) (ctx : bs_ctx) : bs_ctx = - let calls = ctx.calls in - assert (not (V.FunCallId.Map.mem call_id calls)); - let info = - { forward; forward_inputs = args; backwards = T.RegionGroupId.Map.empty } - in - let calls = V.FunCallId.Map.add call_id info calls in - { ctx with calls } - -(** [back_args]: the *additional* list of inputs received by the backward function *) -let bs_ctx_register_backward_call (abs : V.abs) (call_id : V.FunCallId.id) - (back_id : T.RegionGroupId.id) (back_args : texpression list) (ctx : bs_ctx) - : bs_ctx * fun_or_op_id = - (* Insert the abstraction in the call informations *) - let info = V.FunCallId.Map.find call_id ctx.calls in - assert (not (T.RegionGroupId.Map.mem back_id info.backwards)); - let backwards = - T.RegionGroupId.Map.add back_id (abs, back_args) info.backwards - in - let info = { info with backwards } in - let calls = V.FunCallId.Map.add call_id info ctx.calls in - (* Insert the abstraction in the abstractions map *) - let abstractions = ctx.abstractions in - assert (not (V.AbstractionId.Map.mem abs.abs_id abstractions)); - let abstractions = - V.AbstractionId.Map.add abs.abs_id (abs, back_args) abstractions - in - (* Retrieve the fun_id *) - let fun_id = - match info.forward.call_id with - | S.Fun (fid, _) -> Fun (FromLlbc (fid, None, Some back_id)) - | S.Unop _ | S.Binop _ -> raise (Failure "Unreachable") - in - (* Update the context and return *) - ({ ctx with calls; abstractions }, fun_id) - (* Some generic translation functions (we need to translate different "flavours" of types: sty, forward types, backward types, etc.) *) let rec translate_generic_args (translate_ty : 'r T.ty -> ty) diff --git a/tests/lean/Hashmap/Properties.lean b/tests/lean/Hashmap/Properties.lean index ab95b854..6bc821d3 100644 --- a/tests/lean/Hashmap/Properties.lean +++ b/tests/lean/Hashmap/Properties.lean @@ -303,19 +303,17 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value | some _ => nhm.len_s = hm.len_s) := by rw [insert_no_resize] simp only [hash_key, bind_tc_ret] -- TODO: annoying - have _ : (Vec.len (List α) hm.slots).val ≠ 0 := by checkpoint + have _ : (Vec.len (List α) hm.slots).val ≠ 0 := by intro simp_all [inv] - progress keep _ as ⟨ hash_mod, hhm ⟩ - have _ : 0 ≤ hash_mod.val := by checkpoint scalar_tac + progress as ⟨ hash_mod, hhm ⟩ + have _ : 0 ≤ hash_mod.val := by scalar_tac have _ : hash_mod.val < Vec.length hm.slots := by have : 0 < hm.slots.val.len := by simp [inv] at hinv simp [hinv] -- TODO: we want to automate that simp [*, Int.emod_lt_of_pos] - -- TODO: change the spec of Vec.index_mut to introduce a let-binding. - -- or: make progress introduce the let-binding by itself (this is clearer) progress as ⟨ l, h_leq ⟩ -- TODO: make progress use the names written in the goal progress as ⟨ inserted ⟩ -- cgit v1.3.1 From e684179ff9c582495b720c3b1310e0648ca24a58 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 6 Oct 2023 12:13:38 +0200 Subject: Generate the Traits test files for Lean --- tests/lean/Traits.lean | 1 + tests/lean/Traits/Funs.lean | 232 +++++++++++++++++++++++++++++++++++++++++++ tests/lean/Traits/Types.lean | 86 ++++++++++++++++ tests/lean/lakefile.lean | 1 + 4 files changed, 320 insertions(+) create mode 100644 tests/lean/Traits.lean create mode 100644 tests/lean/Traits/Funs.lean create mode 100644 tests/lean/Traits/Types.lean (limited to 'tests/lean') diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean new file mode 100644 index 00000000..5e812e95 --- /dev/null +++ b/tests/lean/Traits.lean @@ -0,0 +1 @@ +import Traits.Funs diff --git a/tests/lean/Traits/Funs.lean b/tests/lean/Traits/Funs.lean new file mode 100644 index 00000000..52ff0c0a --- /dev/null +++ b/tests/lean/Traits/Funs.lean @@ -0,0 +1,232 @@ +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [traits]: function definitions +import Base +import Traits.Types +open Primitives + +namespace traits + +/- [traits::Bool::{0}::get_bool]: forward function -/ +def Bool.get_bool (self : Bool) : Result Bool := + Result.ret self + +/- Trait implementation: [traits::Bool::{0}] -/ +def Bool.BoolTraitInst : BoolTrait Bool := { + get_bool := Bool.get_bool +} + +/- [traits::BoolTrait::ret_true]: forward function -/ +def BoolTrait.ret_true + {Self : Type} (self_clause : BoolTrait Self) (self : Self) : Result Bool := + Result.ret true + +/- [traits::test_bool_trait_bool]: forward function -/ +def test_bool_trait_bool (x : Bool) : Result Bool := + do + let b ← Bool.get_bool x + if b + then BoolTrait.ret_true Bool.BoolTraitInst x + else Result.ret false + +/- [traits::Option::{1}::get_bool]: forward function -/ +def Option.get_bool (T : Type) (self : Option T) : Result Bool := + match self with + | Option.none => Result.ret false + | Option.some t => Result.ret true + +/- Trait implementation: [traits::Option::{1}] -/ +def Option.BoolTraitInst (T : Type) : BoolTrait (Option T) := { + get_bool := Option.get_bool T +} + +/- [traits::test_bool_trait_option]: forward function -/ +def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := + do + let b ← Option.get_bool T x + if b + then BoolTrait.ret_true (Option.BoolTraitInst T) x + else Result.ret false + +/- [traits::test_bool_trait]: forward function -/ +def test_bool_trait (T : Type) (inst : BoolTrait T) (x : T) : Result Bool := + inst.get_bool x + +/- [traits::u64::{2}::to_u64]: forward function -/ +def u64.to_u64 (self : U64) : Result U64 := + Result.ret self + +/- Trait implementation: [traits::u64::{2}] -/ +def u64.ToU64Inst : ToU64 U64 := { + to_u64 := u64.to_u64 +} + +/- [traits::Tuple2::{3}::to_u64]: forward function -/ +def Tuple2.to_u64 (A : Type) (inst : ToU64 A) (self : (A × A)) : Result U64 := + do + let (t, t0) := self + let i ← inst.to_u64 t + let i0 ← inst.to_u64 t0 + i + i0 + +/- Trait implementation: [traits::Tuple2::{3}] -/ +def Tuple2.ToU64Inst (A : Type) (inst : ToU64 A) : ToU64 (A × A) := { + to_u64 := Tuple2.to_u64 A inst +} + +/- [traits::f]: forward function -/ +def f (T : Type) (inst : ToU64 T) (x : (T × T)) : Result U64 := + Tuple2.to_u64 T inst x + +/- [traits::g]: forward function -/ +def g (T : Type) (inst : ToU64 (T × T)) (x : (T × T)) : Result U64 := + inst.to_u64 x + +/- [traits::h0]: forward function -/ +def h0 (x : U64) : Result U64 := + u64.to_u64 x + +/- [traits::Wrapper::{4}::to_u64]: forward function -/ +def Wrapper.to_u64 + (T : Type) (inst : ToU64 T) (self : Wrapper T) : Result U64 := + inst.to_u64 self.x + +/- Trait implementation: [traits::Wrapper::{4}] -/ +def Wrapper.ToU64Inst (T : Type) (inst : ToU64 T) : ToU64 (Wrapper T) := { + to_u64 := Wrapper.to_u64 T inst +} + +/- [traits::h1]: forward function -/ +def h1 (x : Wrapper U64) : Result U64 := + Wrapper.to_u64 U64 u64.ToU64Inst x + +/- [traits::h2]: forward function -/ +def h2 (T : Type) (inst : ToU64 T) (x : Wrapper T) : Result U64 := + Wrapper.to_u64 T inst x + +/- [traits::u64::{5}::to_type]: forward function -/ +def u64.to_type (self : U64) : Result Bool := + Result.ret (self > (U64.ofInt 0)) + +/- Trait implementation: [traits::u64::{5}] -/ +def u64.ToTypeInst : ToType U64 Bool := { + to_type := u64.to_type +} + +/- [traits::h3]: forward function -/ +def h3 + (T1 T2 : Type) (inst : OfType T1) (inst0 : ToType T2 T1) (y : T2) : + Result T1 + := + inst.of_type T2 inst0 y + +/- [traits::h4]: forward function -/ +def h4 + (T1 T2 : Type) (inst : OfTypeBis T1 T2) (inst0 : ToType T2 T1) (y : T2) : + Result T1 + := + inst.of_type y + +/- [traits::TestType::{6}::test::TestType1::{0}::test]: forward function -/ +def TestType.test.TestType1.test + (self : TestType.test.TestType1) : Result Bool := + Result.ret (self._0 > (U64.ofInt 1)) + +/- Trait implementation: [traits::TestType::{6}::test::TestType1::{0}] -/ +def TestType.test.TestType1.TestTypetestTestTraitInst : TestType.test.TestTrait + TestType.test.TestType1 := { + test := TestType.test.TestType1.test +} + +/- [traits::TestType::{6}::test]: forward function -/ +def TestType.test + (T : Type) (inst : ToU64 T) (self : TestType T) (x : T) : Result Bool := + do + let x0 ← inst.to_u64 x + if x0 > (U64.ofInt 0) + then TestType.test.TestType1.test { _0 := (U64.ofInt 0) } + else Result.ret false + +/- [traits::BoolWrapper::{7}::to_type]: forward function -/ +def BoolWrapper.to_type + (T : Type) (inst : ToType Bool T) (self : BoolWrapper) : Result T := + inst.to_type self._0 + +/- Trait implementation: [traits::BoolWrapper::{7}] -/ +def BoolWrapper.ToTypeInst (T : Type) (inst : ToType Bool T) : ToType + BoolWrapper T := { + to_type := BoolWrapper.to_type T inst +} + +/- [traits::WithConstTy::LEN2] -/ +def with_const_ty_len2_body : Result Usize := Result.ret (Usize.ofInt 32) +def with_const_ty_len2_c : Usize := + eval_global with_const_ty_len2_body (by simp) + +/- [traits::Bool::{8}::LEN1] -/ +def bool_len1_body : Result Usize := Result.ret (Usize.ofInt 12) +def bool_len1_c : Usize := eval_global bool_len1_body (by simp) + +/- [traits::Bool::{8}::f]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def Bool.f (i : U64) (a : Array U8 (Usize.ofInt 32)) : Result U64 := + Result.ret i + +/- Trait implementation: [traits::Bool::{8}] -/ +def Bool.WithConstTyInst : WithConstTy Bool (Usize.ofInt 32) := { + LEN1 := bool_len1_c + LEN2 := with_const_ty_len2_c + V := U8 + W := U64 + W_clause_0 := u64.ToU64Inst + f := Bool.f +} + +/- [traits::use_with_const_ty1]: forward function -/ +def use_with_const_ty1 + (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) : Result Usize := + let i := inst.LEN1 + Result.ret i + +/- [traits::use_with_const_ty2]: forward function -/ +def use_with_const_ty2 + (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) (w : inst.W) : + Result Unit + := + Result.ret () + +/- [traits::use_with_const_ty3]: forward function -/ +def use_with_const_ty3 + (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) (x : inst.W) : + Result U64 + := + inst.W_clause_0.to_u64 x + +/- [traits::test_where1]: forward function -/ +def test_where1 (T : Type) (_x : T) : Result Unit := + Result.ret () + +/- [traits::test_where2]: forward function -/ +def test_where2 + (T : Type) (inst : WithConstTy T (Usize.ofInt 32)) (_x : U32) : + Result Unit + := + Result.ret () + +/- [traits::test_child_trait1]: forward function -/ +def test_child_trait1 + (T : Type) (inst : ChildTrait T) (x : T) : Result alloc.string.String := + inst.parent_clause_0.get_name x + +/- [traits::test_child_trait2]: forward function -/ +def test_child_trait2 + (T : Type) (inst : ChildTrait T) (x : T) : Result inst.parent_clause_0.W := + inst.parent_clause_0.get_w x + +/- [traits::order1]: forward function -/ +def order1 + (T U : Type) (inst : ParentTrait0 T) (inst0 : ParentTrait0 U) : + Result Unit + := + Result.ret () + +end traits diff --git a/tests/lean/Traits/Types.lean b/tests/lean/Traits/Types.lean new file mode 100644 index 00000000..b3a52346 --- /dev/null +++ b/tests/lean/Traits/Types.lean @@ -0,0 +1,86 @@ +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [traits]: type definitions +import Base +open Primitives + +namespace traits + +/- Trait declaration: [traits::BoolTrait] -/ +structure BoolTrait (Self : Type) where + get_bool : Self → Result Bool + +/- Trait declaration: [traits::ToU64] -/ +structure ToU64 (Self : Type) where + to_u64 : Self → Result U64 + +/- [traits::Wrapper] -/ +structure Wrapper (T : Type) where + x : T + +/- Trait declaration: [traits::ToType] -/ +structure ToType (Self T : Type) where + to_type : Self → Result T + +/- Trait declaration: [traits::OfType] -/ +structure OfType (Self : Type) where + of_type : forall (T : Type) (inst : ToType T Self), T → Result Self + +/- Trait declaration: [traits::OfTypeBis] -/ +structure OfTypeBis (Self T : Type) where + parent_clause_0 :ToType T Self + of_type : T → Result Self + +/- [traits::TestType] -/ +structure TestType (T : Type) where + _0 : T + +/- [traits::TestType::{6}::test::TestType1] -/ +structure TestType.test.TestType1 where + _0 : U64 + +/- Trait declaration: [traits::TestType::{6}::test::TestTrait] -/ +structure TestType.test.TestTrait (Self : Type) where + test : Self → Result Bool + +/- [traits::BoolWrapper] -/ +structure BoolWrapper where + _0 : Bool + +/- Trait declaration: [traits::WithConstTy] -/ +structure WithConstTy (Self : Type) (LEN : Usize) where + LEN1 :Usize + LEN2 :Usize + V :Type + W :Type + W_clause_0 :ToU64 W + f : W → Array U8 LEN → Result W + +/- [alloc::string::String] -/ +axiom alloc.string.String : Type + +/- Trait declaration: [traits::ParentTrait0] -/ +structure ParentTrait0 (Self : Type) where + W :Type + get_name : Self → Result alloc.string.String + get_w : Self → Result W + +/- Trait declaration: [traits::ParentTrait1] -/ +structure ParentTrait1 (Self : Type) where + +/- Trait declaration: [traits::ChildTrait] -/ +structure ChildTrait (Self : Type) where + parent_clause_0 :ParentTrait0 Self + parent_clause_1 :ParentTrait1 Self + +/- Trait declaration: [traits::Iterator] -/ +structure Iterator (Self : Type) where + Item :Type + +/- Trait declaration: [traits::IntoIterator] -/ +structure IntoIterator (Self : Type) where + Item :Type + IntoIter :Type + IntoIter_clause_0 :Iterator IntoIter + into_iter : Self → Result IntoIter + +end traits diff --git a/tests/lean/lakefile.lean b/tests/lean/lakefile.lean index cc63c48f..1747c581 100644 --- a/tests/lean/lakefile.lean +++ b/tests/lean/lakefile.lean @@ -18,3 +18,4 @@ package «tests» {} @[default_target] lean_lib paper @[default_target] lean_lib poloniusList @[default_target] lean_lib array +@[default_target] lean_lib traits -- cgit v1.3.1 From af78286d801b26bf7a70b8815619591d48245cb8 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 6 Oct 2023 12:23:26 +0200 Subject: Slightly improve formatting of the generated code --- compiler/Extract.ml | 7 ++++++- tests/lean/Traits/Types.lean | 20 ++++++++++---------- 2 files changed, 16 insertions(+), 11 deletions(-) (limited to 'tests/lean') diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 19c3803b..ce423acf 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -4272,6 +4272,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) let item_name = ctx_get_trait_const decl.def_id name ctx in let ty () = let inside = false in + F.pp_print_space fmt (); extract_ty ctx fmt TypeDeclId.Set.empty inside ty in extract_trait_decl_item ctx fmt item_name ty) @@ -4282,7 +4283,10 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (fun (name, (clauses, _)) -> (* Extract the type *) let item_name = ctx_get_trait_type decl.def_id name ctx in - let ty () = F.pp_print_string fmt (type_keyword ()) in + let ty () = + F.pp_print_space fmt (); + F.pp_print_string fmt (type_keyword ()) + in extract_trait_decl_item ctx fmt item_name ty; (* Extract the clauses *) List.iter @@ -4291,6 +4295,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) ctx_get_trait_item_clause decl.def_id name clause.clause_id ctx in let ty () = + F.pp_print_space fmt (); extract_trait_clause_type ctx fmt TypeDeclId.Set.empty clause in extract_trait_decl_item ctx fmt item_name ty) diff --git a/tests/lean/Traits/Types.lean b/tests/lean/Traits/Types.lean index b3a52346..a8c12fe5 100644 --- a/tests/lean/Traits/Types.lean +++ b/tests/lean/Traits/Types.lean @@ -48,11 +48,11 @@ structure BoolWrapper where /- Trait declaration: [traits::WithConstTy] -/ structure WithConstTy (Self : Type) (LEN : Usize) where - LEN1 :Usize - LEN2 :Usize - V :Type - W :Type - W_clause_0 :ToU64 W + LEN1 : Usize + LEN2 : Usize + V : Type + W : Type + W_clause_0 : ToU64 W f : W → Array U8 LEN → Result W /- [alloc::string::String] -/ @@ -60,7 +60,7 @@ axiom alloc.string.String : Type /- Trait declaration: [traits::ParentTrait0] -/ structure ParentTrait0 (Self : Type) where - W :Type + W : Type get_name : Self → Result alloc.string.String get_w : Self → Result W @@ -74,13 +74,13 @@ structure ChildTrait (Self : Type) where /- Trait declaration: [traits::Iterator] -/ structure Iterator (Self : Type) where - Item :Type + Item : Type /- Trait declaration: [traits::IntoIterator] -/ structure IntoIterator (Self : Type) where - Item :Type - IntoIter :Type - IntoIter_clause_0 :Iterator IntoIter + Item : Type + IntoIter : Type + IntoIter_clause_0 : Iterator IntoIter into_iter : Self → Result IntoIter end traits -- cgit v1.3.1 From bb37801b3922f617302f5ffe25e8c8e7c0734b08 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Oct 2023 00:40:46 +0200 Subject: Add support for array repeat --- tests/lean/Array/Funs.lean | 33 +++++++-------------------------- 1 file changed, 7 insertions(+), 26 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/Array/Funs.lean b/tests/lean/Array/Funs.lean index a42072d1..d3cb29d2 100644 --- a/tests/lean/Array/Funs.lean +++ b/tests/lean/Array/Funs.lean @@ -53,16 +53,6 @@ def index_array_u32 (s : Array U32 (Usize.ofInt 32)) (i : Usize) : Result U32 := Array.index_shared U32 (Usize.ofInt 32) s i -/- [array::index_array_generic]: forward function -/ -def index_array_generic - (N : Usize) (s : Array U32 N) (i : Usize) : Result U32 := - Array.index_shared U32 N s i - -/- [array::index_array_generic_call]: forward function -/ -def index_array_generic_call - (N : Usize) (s : Array U32 N) (i : Usize) : Result U32 := - index_array_generic N s i - /- [array::index_array_copy]: forward function -/ def index_array_copy (x : Array U32 (Usize.ofInt 32)) : Result U32 := Array.index_shared U32 (Usize.ofInt 32) x (Usize.ofInt 0) @@ -166,10 +156,6 @@ def index_index_array Array.index_shared (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32) s i Array.index_shared U32 (Usize.ofInt 32) a j -/- [array::const_gen_ret]: forward function -/ -def const_gen_ret (N : Usize) : Result Usize := - Result.ret N - /- [array::update_update_array]: forward function -/ def update_update_array (s : Array (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32)) (i : Usize) @@ -430,21 +416,11 @@ def f3 : Result U32 := (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) (Usize.ofInt 0) let _ ← f2 i + let b := Array.repeat U32 (Usize.ofInt 32) (U32.ofInt 0) let s ← Array.to_slice_shared U32 (Usize.ofInt 2) (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) - let s0 ← - f4 - (Array.make U32 (Usize.ofInt 32) [ - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0) - ]) (Usize.ofInt 16) (Usize.ofInt 18) + let s0 ← f4 b (Usize.ofInt 16) (Usize.ofInt 18) sum2 s s0 /- [array::SZ] -/ @@ -474,4 +450,9 @@ def ite : Result Unit := (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) s2 Result.ret () +/- [array::array]: forward function -/ +def array (LEN : Usize) : Result (Array U8 LEN) := + let a := Array.repeat U8 LEN (U8.ofInt 0) + Result.ret a + end array -- cgit v1.3.1 From 6eebc66e34561bc6985b5866d49c8314a6fbaee9 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 24 Oct 2023 17:47:39 +0200 Subject: Start taking into account non-fallible functions like core::mem::replace --- compiler/ExtractBuiltin.ml | 8 +++ compiler/PureMicroPasses.ml | 12 ++-- tests/lean/NoNestedBorrows.lean | 134 +++++++++++++++++++--------------------- 3 files changed, 79 insertions(+), 75 deletions(-) (limited to 'tests/lean') diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 2e46b120..9cc7c226 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -29,6 +29,7 @@ module SimpleNameOrd = struct end module SimpleNameMap = Collections.MakeMap (SimpleNameOrd) +module SimpleNameSet = Collections.MakeSet (SimpleNameOrd) (** Small utility to memoize some computations *) let mk_memoized (f : unit -> 'a) : unit -> 'a = @@ -374,6 +375,13 @@ let mk_builtin_funs_map () = let builtin_funs_map = mk_memoized mk_builtin_funs_map +let builtin_non_fallible_funs = + [ "alloc::boxed::Box::deref"; "alloc::boxed::Box::deref_mut" ] + +let builtin_non_fallible_funs_set = + SimpleNameSet.of_list + (List.map string_to_simple_name builtin_non_fallible_funs) + type builtin_trait_decl_info = { rust_name : string; extract_name : string; diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index a326d19e..f3e6cbe2 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1544,20 +1544,22 @@ let eliminate_box_functions (ctx : trans_ctx) (def : fun_decl) : fun_decl = | Fun (FromLlbc (FunId (Regular fid), _lp_id, rg_id)) -> ( (* Lookup the function name *) let def = FunDeclId.Map.find fid ctx.fun_ctx.fun_decls in - match (Names.name_to_string def.name, rg_id) with - | "alloc::box::Boxed::deref", None -> + match + (Names.name_no_disambiguators_to_string def.name, rg_id) + with + | "alloc::boxed::Box::deref", None -> (* [Box::deref] forward is the identity *) let arg, args = Collections.List.pop args in mk_apps arg args - | "alloc::box::Boxed::deref", Some _ -> + | "alloc::boxed::Box::deref", Some _ -> (* [Box::deref] backward is [()] (doesn't give back anything) *) assert (args = []); mk_unit_rvalue - | "alloc::box::Boxed::deref_mut", None -> + | "alloc::boxed::Box::deref_mut", None -> (* [Box::deref_mut] forward is the identity *) let arg, args = Collections.List.pop args in mk_apps arg args - | "alloc::box::Boxed::deref_mut", Some _ -> + | "alloc::boxed::Box::deref_mut", Some _ -> (* [Box::deref_mut] back is almost the identity: * let box_deref_mut (x_init : t) (x_back : t) : t = x_back * *) diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index 884e62c4..a90d6ea2 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -54,7 +54,7 @@ def div_test (x : U32) (y : U32) : Result U32 := /- [no_nested_borrows::div_test1]: forward function -/ def div_test1 (x : U32) : Result U32 := - x / (U32.ofInt 2) + x / 2#u32 /- [no_nested_borrows::rem_test]: forward function -/ def rem_test (x : U32) (y : U32) : Result U32 := @@ -67,7 +67,7 @@ def cast_test (x : U32) : Result I32 := /- [no_nested_borrows::test2]: forward function -/ def test2 : Result Unit := do - let _ ← (U32.ofInt 23) + (U32.ofInt 44) + let _ ← 23#u32 + 44#u32 Result.ret () /- Unit test for [no_nested_borrows::test2] -/ @@ -82,10 +82,10 @@ def get_max (x : U32) (y : U32) : Result U32 := /- [no_nested_borrows::test3]: forward function -/ def test3 : Result Unit := do - let x ← get_max (U32.ofInt 4) (U32.ofInt 3) - let y ← get_max (U32.ofInt 10) (U32.ofInt 11) + let x ← get_max 4#u32 3#u32 + let y ← get_max 10#u32 11#u32 let z ← x + y - if not (z = (U32.ofInt 15)) + if not (z = 15#u32) then Result.fail Error.panic else Result.ret () @@ -95,8 +95,8 @@ def test3 : Result Unit := /- [no_nested_borrows::test_neg1]: forward function -/ def test_neg1 : Result Unit := do - let y ← - (I32.ofInt 3) - if not (y = (I32.ofInt (-(3:Int)))) + let y ← - 3#i32 + if not (y = (-(3:Int))#i32) then Result.fail Error.panic else Result.ret () @@ -105,7 +105,7 @@ def test_neg1 : Result Unit := /- [no_nested_borrows::refs_test1]: forward function -/ def refs_test1 : Result Unit := - if not ((I32.ofInt 1) = (I32.ofInt 1)) + if not (1#i32 = 1#i32) then Result.fail Error.panic else Result.ret () @@ -114,16 +114,16 @@ def refs_test1 : Result Unit := /- [no_nested_borrows::refs_test2]: forward function -/ def refs_test2 : Result Unit := - if not ((I32.ofInt 2) = (I32.ofInt 2)) + if not (2#i32 = 2#i32) then Result.fail Error.panic else - if not ((I32.ofInt 0) = (I32.ofInt 0)) + if not (0#i32 = 0#i32) then Result.fail Error.panic else - if not ((I32.ofInt 2) = (I32.ofInt 2)) + if not (2#i32 = 2#i32) then Result.fail Error.panic else - if not ((I32.ofInt 2) = (I32.ofInt 2)) + if not (2#i32 = 2#i32) then Result.fail Error.panic else Result.ret () @@ -167,8 +167,8 @@ def test_panic (b : Bool) : Result Unit := /- [no_nested_borrows::test_copy_int]: forward function -/ def test_copy_int : Result Unit := do - let y ← copy_int (I32.ofInt 0) - if not ((I32.ofInt 0) = y) + let y ← copy_int 0#i32 + if not (0#i32 = y) then Result.fail Error.panic else Result.ret () @@ -185,7 +185,7 @@ def is_cons (T : Type) (l : List T) : Result Bool := def test_is_cons : Result Unit := do let l := List.Nil - let b ← is_cons I32 (List.Cons (I32.ofInt 0) l) + let b ← is_cons I32 (List.Cons 0#i32 l) if not b then Result.fail Error.panic else Result.ret () @@ -203,9 +203,9 @@ def split_list (T : Type) (l : List T) : Result (T × (List T)) := def test_split_list : Result Unit := do let l := List.Nil - let p ← split_list I32 (List.Cons (I32.ofInt 0) l) + let p ← split_list I32 (List.Cons 0#i32 l) let (hd, _) := p - if not (hd = (I32.ofInt 0)) + if not (hd = 0#i32) then Result.fail Error.panic else Result.ret () @@ -228,19 +228,18 @@ def choose_back /- [no_nested_borrows::choose_test]: forward function -/ def choose_test : Result Unit := do - let z ← choose I32 true (I32.ofInt 0) (I32.ofInt 0) - let z0 ← z + (I32.ofInt 1) - if not (z0 = (I32.ofInt 1)) + let z ← choose I32 true 0#i32 0#i32 + let z0 ← z + 1#i32 + if not (z0 = 1#i32) then Result.fail Error.panic else do - let (x, y) ← choose_back I32 true (I32.ofInt 0) (I32.ofInt 0) z0 - if not (x = (I32.ofInt 1)) + let (x, y) ← choose_back I32 true 0#i32 0#i32 z0 + if not (x = 1#i32) then Result.fail Error.panic - else - if not (y = (I32.ofInt 0)) - then Result.fail Error.panic - else Result.ret () + else if not (y = 0#i32) + then Result.fail Error.panic + else Result.ret () /- Unit test for [no_nested_borrows::choose_test] -/ #assert (choose_test == .ret ()) @@ -268,17 +267,17 @@ divergent def list_length (T : Type) (l : List T) : Result U32 := match l with | List.Cons t l1 => do let i ← list_length T l1 - (U32.ofInt 1) + i - | List.Nil => Result.ret (U32.ofInt 0) + 1#u32 + i + | List.Nil => Result.ret 0#u32 /- [no_nested_borrows::list_nth_shared]: forward function -/ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := match l with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_shared T tl i0 | List.Nil => Result.fail Error.panic @@ -286,10 +285,10 @@ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := divergent def list_nth_mut (T : Type) (l : List T) (i : U32) : Result T := match l with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut T tl i0 | List.Nil => Result.fail Error.panic @@ -298,11 +297,11 @@ divergent def list_nth_mut_back (T : Type) (l : List T) (i : U32) (ret0 : T) : Result (List T) := match l with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl0 ← list_nth_mut_back T tl i0 ret0 Result.ret (List.Cons x tl0) | List.Nil => Result.fail Error.panic @@ -324,47 +323,42 @@ def list_rev (T : Type) (l : List T) : Result (List T) := def test_list_functions : Result Unit := do let l := List.Nil - let l0 := List.Cons (I32.ofInt 2) l - let l1 := List.Cons (I32.ofInt 1) l0 - let i ← list_length I32 (List.Cons (I32.ofInt 0) l1) - if not (i = (U32.ofInt 3)) + let l0 := List.Cons 2#i32 l + let l1 := List.Cons 1#i32 l0 + let i ← list_length I32 (List.Cons 0#i32 l1) + if not (i = 3#u32) then Result.fail Error.panic else do - let i0 ← - list_nth_shared I32 (List.Cons (I32.ofInt 0) l1) (U32.ofInt 0) - if not (i0 = (I32.ofInt 0)) + let i0 ← list_nth_shared I32 (List.Cons 0#i32 l1) 0#u32 + if not (i0 = 0#i32) then Result.fail Error.panic else do - let i1 ← - list_nth_shared I32 (List.Cons (I32.ofInt 0) l1) (U32.ofInt 1) - if not (i1 = (I32.ofInt 1)) + let i1 ← list_nth_shared I32 (List.Cons 0#i32 l1) 1#u32 + if not (i1 = 1#i32) then Result.fail Error.panic else do - let i2 ← - list_nth_shared I32 (List.Cons (I32.ofInt 0) l1) - (U32.ofInt 2) - if not (i2 = (I32.ofInt 2)) + let i2 ← list_nth_shared I32 (List.Cons 0#i32 l1) 2#u32 + if not (i2 = 2#i32) then Result.fail Error.panic else do let ls ← - list_nth_mut_back I32 (List.Cons (I32.ofInt 0) l1) - (U32.ofInt 1) (I32.ofInt 3) - let i3 ← list_nth_shared I32 ls (U32.ofInt 0) - if not (i3 = (I32.ofInt 0)) + list_nth_mut_back I32 (List.Cons 0#i32 l1) 1#u32 3#i32 + let i3 ← list_nth_shared I32 ls 0#u32 + if not (i3 = 0#i32) then Result.fail Error.panic else do - let i4 ← list_nth_shared I32 ls (U32.ofInt 1) - if not (i4 = (I32.ofInt 3)) + let i4 ← list_nth_shared I32 ls 1#u32 + if not (i4 = 3#i32) then Result.fail Error.panic else do - let i5 ← list_nth_shared I32 ls (U32.ofInt 2) - if not (i5 = (I32.ofInt 2)) + let i5 ← list_nth_shared I32 ls 2#u32 + if not (i5 = 2#i32) then Result.fail Error.panic else Result.ret () @@ -427,15 +421,15 @@ structure StructWithTuple (T1 T2 : Type) where /- [no_nested_borrows::new_tuple1]: forward function -/ def new_tuple1 : Result (StructWithTuple U32 U32) := - Result.ret { p := ((U32.ofInt 1), (U32.ofInt 2)) } + Result.ret { p := (1#u32, 2#u32) } /- [no_nested_borrows::new_tuple2]: forward function -/ def new_tuple2 : Result (StructWithTuple I16 I16) := - Result.ret { p := ((I16.ofInt 1), (I16.ofInt 2)) } + Result.ret { p := (1#i16, 2#i16) } /- [no_nested_borrows::new_tuple3]: forward function -/ def new_tuple3 : Result (StructWithTuple U64 I64) := - Result.ret { p := ((U64.ofInt 1), (I64.ofInt 2)) } + Result.ret { p := (1#u64, 2#i64) } /- [no_nested_borrows::StructWithPair] -/ structure StructWithPair (T1 T2 : Type) where @@ -443,31 +437,31 @@ structure StructWithPair (T1 T2 : Type) where /- [no_nested_borrows::new_pair1]: forward function -/ def new_pair1 : Result (StructWithPair U32 U32) := - Result.ret { p := { x := (U32.ofInt 1), y := (U32.ofInt 2) } } + Result.ret { p := { x := 1#u32, y := 2#u32 } } /- [no_nested_borrows::test_constants]: forward function -/ def test_constants : Result Unit := do let swt ← new_tuple1 let (i, _) := swt.p - if not (i = (U32.ofInt 1)) + if not (i = 1#u32) then Result.fail Error.panic else do let swt0 ← new_tuple2 let (i0, _) := swt0.p - if not (i0 = (I16.ofInt 1)) + if not (i0 = 1#i16) then Result.fail Error.panic else do let swt1 ← new_tuple3 let (i1, _) := swt1.p - if not (i1 = (U64.ofInt 1)) + if not (i1 = 1#u64) then Result.fail Error.panic else do let swp ← new_pair1 - if not (swp.p.x = (U32.ofInt 1)) + if not (swp.p.x = 1#u32) then Result.fail Error.panic else Result.ret () @@ -492,21 +486,21 @@ def test_mem_replace (px : U32) : Result U32 := /- [no_nested_borrows::test_shared_borrow_bool1]: forward function -/ def test_shared_borrow_bool1 (b : Bool) : Result U32 := if b - then Result.ret (U32.ofInt 0) - else Result.ret (U32.ofInt 1) + then Result.ret 0#u32 + else Result.ret 1#u32 /- [no_nested_borrows::test_shared_borrow_bool2]: forward function -/ def test_shared_borrow_bool2 : Result U32 := - Result.ret (U32.ofInt 0) + Result.ret 0#u32 /- [no_nested_borrows::test_shared_borrow_enum1]: forward function -/ def test_shared_borrow_enum1 (l : List U32) : Result U32 := match l with - | List.Cons i l0 => Result.ret (U32.ofInt 1) - | List.Nil => Result.ret (U32.ofInt 0) + | List.Cons i l0 => Result.ret 1#u32 + | List.Nil => Result.ret 0#u32 /- [no_nested_borrows::test_shared_borrow_enum2]: forward function -/ def test_shared_borrow_enum2 : Result U32 := - Result.ret (U32.ofInt 0) + Result.ret 0#u32 end no_nested_borrows -- cgit v1.3.1 From 9c230dddebb171ee1b3e0176838441163836b875 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 24 Oct 2023 18:16:53 +0200 Subject: Handle properly the builtin, non fallible functions --- backends/lean/Base/Primitives/Base.lean | 4 ++-- compiler/ExtractBase.ml | 4 ++-- compiler/ExtractBuiltin.ml | 34 ++++++++++++++++++++++++++++++++- compiler/FunsAnalysis.ml | 34 ++++++++++++++++++--------------- tests/lean/NoNestedBorrows.lean | 12 ++++++------ 5 files changed, 62 insertions(+), 26 deletions(-) (limited to 'tests/lean') diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean index 2bd081c0..10af8f67 100644 --- a/backends/lean/Base/Primitives/Base.lean +++ b/backends/lean/Base/Primitives/Base.lean @@ -120,8 +120,8 @@ def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := -- MISC -- ---------- -@[simp] def core.mem.replace (a : Type) (x : a) (_ : a) : Result a := ret x -@[simp] def core.mem.replace_back (a : Type) (_ : a) (y : a) : Result a := ret y +@[simp] def core.mem.replace (a : Type) (x : a) (_ : a) : a := x +@[simp] def core.mem.replace_back (a : Type) (_ : a) (y : a) : a := y /-- Aeneas-translated function -- useful to reduce non-recursive definitions. Use with `simp [ aeneas ]` -/ diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index e004aba8..8f32ba44 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -22,8 +22,8 @@ type region_group_info = { *) } -module StringSet = Collections.MakeSet (Collections.OrderedString) -module StringMap = Collections.MakeMap (Collections.OrderedString) +module StringSet = Collections.StringSet +module StringMap = Collections.StringMap type name = Names.name type type_name = Names.type_name diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 9cc7c226..4c6fe014 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -376,7 +376,39 @@ let mk_builtin_funs_map () = let builtin_funs_map = mk_memoized mk_builtin_funs_map let builtin_non_fallible_funs = - [ "alloc::boxed::Box::deref"; "alloc::boxed::Box::deref_mut" ] + let int_names = + [ + "usize"; + "u8"; + "u16"; + "u32"; + "u64"; + "u128"; + "isize"; + "i8"; + "i16"; + "i32"; + "i64"; + "i128"; + ] + in + let int_ops = + [ "wrapping_add"; "wrapping_sub"; "rotate_left"; "rotate_right" ] + in + let int_funs = + List.map + (fun int_name -> + List.map (fun op -> "core::num::" ^ int_name ^ "::" ^ op) int_ops) + int_names + in + let int_funs = List.concat int_funs in + [ + "alloc::boxed::Box::deref"; + "alloc::boxed::Box::deref_mut"; + "core::mem::replace"; + "core::mem::take"; + ] + @ int_funs let builtin_non_fallible_funs_set = SimpleNameSet.of_list diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml index 1273f57d..3ba5d35d 100644 --- a/compiler/FunsAnalysis.ml +++ b/compiler/FunsAnalysis.ml @@ -57,21 +57,16 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) let stateful = ref false in let can_diverge = ref false in let is_rec = ref false in + let is_builtin_non_fallible_group = ref false in (* We have some specialized knowledge of some library functions; we don't have any more custom treatment than this, and these functions can be modeled suitably in Primitives.fst, rather than special-casing for them all the way. *) - let module M = struct type opaque_info = { fallible: bool; stateful: bool } end in - let open M in - let opaque_info (f: fun_decl) = - match f.name with - | [ Ident "core"; Ident "num"; Ident "u32"; _; Ident "wrapping_add" ] - | [ Ident "core"; Ident "num"; Ident "u32"; _; Ident "rotate_left" ] -> - { fallible = false; stateful = false } - | _ -> - (* Opaque function: we consider they fail by default *) - { fallible = true; stateful = true } + let is_builtin_non_fallible (f : fun_decl) : bool = + let open ExtractBuiltin in + let name = name_to_simple_name f.name in + SimpleNameSet.mem name builtin_non_fallible_funs_set in (* JP: Why not use a reduce visitor here with a tuple of the values to be @@ -124,11 +119,16 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) in (* Sanity check: global bodies don't contain stateful calls *) assert ((not f.is_global_decl_body) || not !stateful); + let is_builtin_non_fallible = is_builtin_non_fallible f in + is_builtin_non_fallible_group := + !is_builtin_non_fallible_group || is_builtin_non_fallible; match f.body with | None -> - let info = opaque_info f in - obj#may_fail info.fallible; - stateful := (not f.is_global_decl_body) && use_state && info.stateful + obj#may_fail (not is_builtin_non_fallible); + stateful := + (not f.is_global_decl_body) + && use_state + && not is_builtin_non_fallible | Some body -> obj#visit_statement () body.body in List.iter visit_fun d; @@ -136,12 +136,16 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) * groups containing globals contain exactly one declaration *) let is_global_decl_body = List.exists (fun f -> f.is_global_decl_body) d in assert ((not is_global_decl_body) || List.length d = 1); + assert ((not !is_builtin_non_fallible_group) || List.length d = 1); (* We ignore on purpose functions that cannot fail and consider they *can* * fail: the result of the analysis is not used yet to adjust the translation * so that the functions which syntactically can't fail don't use an error monad. - * However, we do keep the result of the analysis for global bodies. + * However, we do keep the result of the analysis for global bodies and for + * builtin functions which are marked as non-fallible. * *) - can_fail := (not is_global_decl_body) || !can_fail; + can_fail := + ((not is_global_decl_body) && not !is_builtin_non_fallible_group) + || !can_fail; { can_fail = !can_fail; stateful = !stateful; diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index a90d6ea2..d6d603ce 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -139,9 +139,9 @@ def test_list1 : Result Unit := /- [no_nested_borrows::test_box1]: forward function -/ def test_box1 : Result Unit := - let b := (I32.ofInt 1) + let b := 1#i32 let x := b - if not (x = (I32.ofInt 1)) + if not (x = 1#i32) then Result.fail Error.panic else Result.ret () @@ -316,7 +316,7 @@ divergent def list_rev_aux /- [no_nested_borrows::list_rev]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def list_rev (T : Type) (l : List T) : Result (List T) := - let li := mem.replace (List T) l List.Nil + let li := core.mem.replace (List T) l List.Nil list_rev_aux T li List.Nil /- [no_nested_borrows::test_list_functions]: forward function -/ @@ -478,10 +478,10 @@ def test_weird_borrows1 : Result Unit := /- [no_nested_borrows::test_mem_replace]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def test_mem_replace (px : U32) : Result U32 := - let y := mem.replace U32 px (U32.ofInt 1) - if not (y = (U32.ofInt 0)) + let y := core.mem.replace U32 px 1#u32 + if not (y = 0#u32) then Result.fail Error.panic - else Result.ret (U32.ofInt 2) + else Result.ret 2#u32 /- [no_nested_borrows::test_shared_borrow_bool1]: forward function -/ def test_shared_borrow_bool1 (b : Bool) : Result U32 := -- cgit v1.3.1 From 862c6f939b001e4fe0556cc73af71210e7b96ea2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 25 Oct 2023 15:38:23 +0200 Subject: Regenerate the Lean array test --- tests/lean/Array/Funs.lean | 319 +++++++++++++++++++++------------------------ 1 file changed, 150 insertions(+), 169 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/Array/Funs.lean b/tests/lean/Array/Funs.lean index d3cb29d2..899bf856 100644 --- a/tests/lean/Array/Funs.lean +++ b/tests/lean/Array/Funs.lean @@ -6,35 +6,39 @@ open Primitives namespace array +/- [array::incr]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def incr (x : U32) : Result U32 := + x + 1#u32 + /- [array::array_to_shared_slice_]: forward function -/ def array_to_shared_slice_ - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) : Result (Slice T0) := - Array.to_slice_shared T0 (Usize.ofInt 32) s + (T0 : Type) (s : Array T0 32#usize) : Result (Slice T0) := + Array.to_slice_shared T0 32#usize s /- [array::array_to_mut_slice_]: forward function -/ def array_to_mut_slice_ - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) : Result (Slice T0) := - Array.to_slice_mut T0 (Usize.ofInt 32) s + (T0 : Type) (s : Array T0 32#usize) : Result (Slice T0) := + Array.to_slice_mut T0 32#usize s /- [array::array_to_mut_slice_]: backward function 0 -/ def array_to_mut_slice__back - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) (ret0 : Slice T0) : - Result (Array T0 (Usize.ofInt 32)) + (T0 : Type) (s : Array T0 32#usize) (ret0 : Slice T0) : + Result (Array T0 32#usize) := - Array.to_slice_mut_back T0 (Usize.ofInt 32) s ret0 + Array.to_slice_mut_back T0 32#usize s ret0 /- [array::array_len]: forward function -/ -def array_len (T0 : Type) (s : Array T0 (Usize.ofInt 32)) : Result Usize := +def array_len (T0 : Type) (s : Array T0 32#usize) : Result Usize := do - let s0 ← Array.to_slice_shared T0 (Usize.ofInt 32) s + let s0 ← Array.to_slice_shared T0 32#usize s let i := Slice.len T0 s0 Result.ret i /- [array::shared_array_len]: forward function -/ -def shared_array_len - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) : Result Usize := +def shared_array_len (T0 : Type) (s : Array T0 32#usize) : Result Usize := do - let s0 ← Array.to_slice_shared T0 (Usize.ofInt 32) s + let s0 ← Array.to_slice_shared T0 32#usize s let i := Slice.len T0 s0 Result.ret i @@ -45,29 +49,28 @@ def shared_slice_len (T0 : Type) (s : Slice T0) : Result Usize := /- [array::index_array_shared]: forward function -/ def index_array_shared - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) (i : Usize) : Result T0 := - Array.index_shared T0 (Usize.ofInt 32) s i + (T0 : Type) (s : Array T0 32#usize) (i : Usize) : Result T0 := + Array.index_shared T0 32#usize s i /- [array::index_array_u32]: forward function -/ -def index_array_u32 - (s : Array U32 (Usize.ofInt 32)) (i : Usize) : Result U32 := - Array.index_shared U32 (Usize.ofInt 32) s i +def index_array_u32 (s : Array U32 32#usize) (i : Usize) : Result U32 := + Array.index_shared U32 32#usize s i /- [array::index_array_copy]: forward function -/ -def index_array_copy (x : Array U32 (Usize.ofInt 32)) : Result U32 := - Array.index_shared U32 (Usize.ofInt 32) x (Usize.ofInt 0) +def index_array_copy (x : Array U32 32#usize) : Result U32 := + Array.index_shared U32 32#usize x 0#usize /- [array::index_mut_array]: forward function -/ def index_mut_array - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) (i : Usize) : Result T0 := - Array.index_mut T0 (Usize.ofInt 32) s i + (T0 : Type) (s : Array T0 32#usize) (i : Usize) : Result T0 := + Array.index_mut T0 32#usize s i /- [array::index_mut_array]: backward function 0 -/ def index_mut_array_back - (T0 : Type) (s : Array T0 (Usize.ofInt 32)) (i : Usize) (ret0 : T0) : - Result (Array T0 (Usize.ofInt 32)) + (T0 : Type) (s : Array T0 32#usize) (i : Usize) (ret0 : T0) : + Result (Array T0 32#usize) := - Array.index_mut_back T0 (Usize.ofInt 32) s i ret0 + Array.index_mut_back T0 32#usize s i ret0 /- [array::index_slice]: forward function -/ def index_slice (T0 : Type) (s : Slice T0) (i : Usize) : Result T0 := @@ -85,100 +88,103 @@ def index_mut_slice_back /- [array::slice_subslice_shared_]: forward function -/ def slice_subslice_shared_ (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := - Slice.subslice_shared U32 x (Range.mk y z) + core.slice.index.Slice.index U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32) x + { start := y, end_ := z } /- [array::slice_subslice_mut_]: forward function -/ def slice_subslice_mut_ (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := - Slice.subslice_mut U32 x (Range.mk y z) + core.slice.index.Slice.index_mut U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32) x + { start := y, end_ := z } /- [array::slice_subslice_mut_]: backward function 0 -/ def slice_subslice_mut__back (x : Slice U32) (y : Usize) (z : Usize) (ret0 : Slice U32) : Result (Slice U32) := - Slice.subslice_mut_back U32 x (Range.mk y z) ret0 + core.slice.index.Slice.index_mut_back U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32) x + { start := y, end_ := z } ret0 /- [array::array_to_slice_shared_]: forward function -/ -def array_to_slice_shared_ - (x : Array U32 (Usize.ofInt 32)) : Result (Slice U32) := - Array.to_slice_shared U32 (Usize.ofInt 32) x +def array_to_slice_shared_ (x : Array U32 32#usize) : Result (Slice U32) := + Array.to_slice_shared U32 32#usize x /- [array::array_to_slice_mut_]: forward function -/ -def array_to_slice_mut_ - (x : Array U32 (Usize.ofInt 32)) : Result (Slice U32) := - Array.to_slice_mut U32 (Usize.ofInt 32) x +def array_to_slice_mut_ (x : Array U32 32#usize) : Result (Slice U32) := + Array.to_slice_mut U32 32#usize x /- [array::array_to_slice_mut_]: backward function 0 -/ def array_to_slice_mut__back - (x : Array U32 (Usize.ofInt 32)) (ret0 : Slice U32) : - Result (Array U32 (Usize.ofInt 32)) - := - Array.to_slice_mut_back U32 (Usize.ofInt 32) x ret0 + (x : Array U32 32#usize) (ret0 : Slice U32) : Result (Array U32 32#usize) := + Array.to_slice_mut_back U32 32#usize x ret0 /- [array::array_subslice_shared_]: forward function -/ def array_subslice_shared_ - (x : Array U32 (Usize.ofInt 32)) (y : Usize) (z : Usize) : - Result (Slice U32) - := - Array.subslice_shared U32 (Usize.ofInt 32) x (Range.mk y z) + (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := + core.array.Array.index U32 (Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexInst U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } /- [array::array_subslice_mut_]: forward function -/ def array_subslice_mut_ - (x : Array U32 (Usize.ofInt 32)) (y : Usize) (z : Usize) : - Result (Slice U32) - := - Array.subslice_mut U32 (Usize.ofInt 32) x (Range.mk y z) + (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := + core.array.Array.index_mut U32 (Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } /- [array::array_subslice_mut_]: backward function 0 -/ def array_subslice_mut__back - (x : Array U32 (Usize.ofInt 32)) (y : Usize) (z : Usize) (ret0 : Slice U32) : - Result (Array U32 (Usize.ofInt 32)) + (x : Array U32 32#usize) (y : Usize) (z : Usize) (ret0 : Slice U32) : + Result (Array U32 32#usize) := - Array.subslice_mut_back U32 (Usize.ofInt 32) x (Range.mk y z) ret0 + core.array.Array.index_mut_back U32 (Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } ret0 /- [array::index_slice_0]: forward function -/ def index_slice_0 (T0 : Type) (s : Slice T0) : Result T0 := - Slice.index_shared T0 s (Usize.ofInt 0) + Slice.index_shared T0 s 0#usize /- [array::index_array_0]: forward function -/ -def index_array_0 (T0 : Type) (s : Array T0 (Usize.ofInt 32)) : Result T0 := - Array.index_shared T0 (Usize.ofInt 32) s (Usize.ofInt 0) +def index_array_0 (T0 : Type) (s : Array T0 32#usize) : Result T0 := + Array.index_shared T0 32#usize s 0#usize /- [array::index_index_array]: forward function -/ def index_index_array - (s : Array (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32)) (i : Usize) - (j : Usize) : + (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : Result U32 := do - let a ← - Array.index_shared (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32) s i - Array.index_shared U32 (Usize.ofInt 32) a j + let a ← Array.index_shared (Array U32 32#usize) 32#usize s i + Array.index_shared U32 32#usize a j /- [array::update_update_array]: forward function -/ def update_update_array - (s : Array (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32)) (i : Usize) - (j : Usize) : + (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : Result Unit := do - let a ← Array.index_mut (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32) s i - let a0 ← Array.index_mut_back U32 (Usize.ofInt 32) a j (U32.ofInt 0) - let _ ← - Array.index_mut_back (Array U32 (Usize.ofInt 32)) (Usize.ofInt 32) s i a0 + let a ← Array.index_mut (Array U32 32#usize) 32#usize s i + let a0 ← Array.index_mut_back U32 32#usize a j 0#u32 + let _ ← Array.index_mut_back (Array U32 32#usize) 32#usize s i a0 Result.ret () /- [array::array_local_deep_copy]: forward function -/ -def array_local_deep_copy (x : Array U32 (Usize.ofInt 32)) : Result Unit := +def array_local_deep_copy (x : Array U32 32#usize) : Result Unit := Result.ret () /- [array::take_array]: forward function -/ -def take_array (a : Array U32 (Usize.ofInt 2)) : Result Unit := +def take_array (a : Array U32 2#usize) : Result Unit := Result.ret () /- [array::take_array_borrow]: forward function -/ -def take_array_borrow (a : Array U32 (Usize.ofInt 2)) : Result Unit := +def take_array_borrow (a : Array U32 2#usize) : Result Unit := Result.ret () /- [array::take_slice]: forward function -/ @@ -193,148 +199,133 @@ def take_mut_slice (s : Slice U32) : Result (Slice U32) := /- [array::take_all]: forward function -/ def take_all : Result Unit := do - let _ ← - take_array - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) - let _ ← - take_array_borrow - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← take_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s ← - Array.to_slice_shared U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + Array.to_slice_shared U32 2#usize + (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let _ ← take_slice s let s0 ← - Array.to_slice_mut U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s1 ← take_mut_slice s0 let _ ← - Array.to_slice_mut_back U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) s1 + Array.to_slice_mut_back U32 2#usize + (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 Result.ret () /- [array::index_array]: forward function -/ -def index_array (x : Array U32 (Usize.ofInt 2)) : Result U32 := - Array.index_shared U32 (Usize.ofInt 2) x (Usize.ofInt 0) +def index_array (x : Array U32 2#usize) : Result U32 := + Array.index_shared U32 2#usize x 0#usize /- [array::index_array_borrow]: forward function -/ -def index_array_borrow (x : Array U32 (Usize.ofInt 2)) : Result U32 := - Array.index_shared U32 (Usize.ofInt 2) x (Usize.ofInt 0) +def index_array_borrow (x : Array U32 2#usize) : Result U32 := + Array.index_shared U32 2#usize x 0#usize /- [array::index_slice_u32_0]: forward function -/ def index_slice_u32_0 (x : Slice U32) : Result U32 := - Slice.index_shared U32 x (Usize.ofInt 0) + Slice.index_shared U32 x 0#usize /- [array::index_mut_slice_u32_0]: forward function -/ def index_mut_slice_u32_0 (x : Slice U32) : Result U32 := - Slice.index_shared U32 x (Usize.ofInt 0) + Slice.index_shared U32 x 0#usize /- [array::index_mut_slice_u32_0]: backward function 0 -/ def index_mut_slice_u32_0_back (x : Slice U32) : Result (Slice U32) := do - let _ ← Slice.index_shared U32 x (Usize.ofInt 0) + let _ ← Slice.index_shared U32 x 0#usize Result.ret x /- [array::index_all]: forward function -/ def index_all : Result U32 := do - let i ← - index_array - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) - let i0 ← - index_array - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + let i ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i0 ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i1 ← i + i0 - let i2 ← - index_array_borrow - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + let i2 ← index_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i3 ← i1 + i2 let s ← - Array.to_slice_shared U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + Array.to_slice_shared U32 2#usize + (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i4 ← index_slice_u32_0 s let i5 ← i3 + i4 let s0 ← - Array.to_slice_mut U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i6 ← index_mut_slice_u32_0 s0 let i7 ← i5 + i6 let s1 ← index_mut_slice_u32_0_back s0 let _ ← - Array.to_slice_mut_back U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) s1 + Array.to_slice_mut_back U32 2#usize + (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 Result.ret i7 /- [array::update_array]: forward function -/ -def update_array (x : Array U32 (Usize.ofInt 2)) : Result Unit := +def update_array (x : Array U32 2#usize) : Result Unit := do - let _ ← - Array.index_mut_back U32 (Usize.ofInt 2) x (Usize.ofInt 0) (U32.ofInt 1) + let _ ← Array.index_mut_back U32 2#usize x 0#usize 1#u32 Result.ret () /- [array::update_array_mut_borrow]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def update_array_mut_borrow - (x : Array U32 (Usize.ofInt 2)) : Result (Array U32 (Usize.ofInt 2)) := - Array.index_mut_back U32 (Usize.ofInt 2) x (Usize.ofInt 0) (U32.ofInt 1) + (x : Array U32 2#usize) : Result (Array U32 2#usize) := + Array.index_mut_back U32 2#usize x 0#usize 1#u32 /- [array::update_mut_slice]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def update_mut_slice (x : Slice U32) : Result (Slice U32) := - Slice.index_mut_back U32 x (Usize.ofInt 0) (U32.ofInt 1) + Slice.index_mut_back U32 x 0#usize 1#u32 /- [array::update_all]: forward function -/ def update_all : Result Unit := do - let _ ← - update_array - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) - let x ← - update_array_mut_borrow - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) - let s ← Array.to_slice_mut U32 (Usize.ofInt 2) x + let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let x ← update_array_mut_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s ← Array.to_slice_mut U32 2#usize x let s0 ← update_mut_slice s - let _ ← Array.to_slice_mut_back U32 (Usize.ofInt 2) x s0 + let _ ← Array.to_slice_mut_back U32 2#usize x s0 Result.ret () /- [array::range_all]: forward function -/ def range_all : Result Unit := do let s ← - Array.subslice_mut U32 (Usize.ofInt 4) - (Array.make U32 (Usize.ofInt 4) [ - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0) - ]) (Range.mk (Usize.ofInt 1) (Usize.ofInt 3)) + core.array.Array.index_mut U32 (Range Usize) 4#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) + (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) + { start := 1#usize, end_ := 3#usize } let s0 ← update_mut_slice s let _ ← - Array.subslice_mut_back U32 (Usize.ofInt 4) - (Array.make U32 (Usize.ofInt 4) [ - (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0), (U32.ofInt 0) - ]) (Range.mk (Usize.ofInt 1) (Usize.ofInt 3)) s0 + core.array.Array.index_mut_back U32 (Range Usize) 4#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) + (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) + { start := 1#usize, end_ := 3#usize } s0 Result.ret () /- [array::deref_array_borrow]: forward function -/ -def deref_array_borrow (x : Array U32 (Usize.ofInt 2)) : Result U32 := - Array.index_shared U32 (Usize.ofInt 2) x (Usize.ofInt 0) +def deref_array_borrow (x : Array U32 2#usize) : Result U32 := + Array.index_shared U32 2#usize x 0#usize /- [array::deref_array_mut_borrow]: forward function -/ -def deref_array_mut_borrow (x : Array U32 (Usize.ofInt 2)) : Result U32 := - Array.index_shared U32 (Usize.ofInt 2) x (Usize.ofInt 0) +def deref_array_mut_borrow (x : Array U32 2#usize) : Result U32 := + Array.index_shared U32 2#usize x 0#usize /- [array::deref_array_mut_borrow]: backward function 0 -/ def deref_array_mut_borrow_back - (x : Array U32 (Usize.ofInt 2)) : Result (Array U32 (Usize.ofInt 2)) := + (x : Array U32 2#usize) : Result (Array U32 2#usize) := do - let _ ← Array.index_shared U32 (Usize.ofInt 2) x (Usize.ofInt 0) + let _ ← Array.index_shared U32 2#usize x 0#usize Result.ret x /- [array::take_array_t]: forward function -/ -def take_array_t (a : Array T (Usize.ofInt 2)) : Result Unit := +def take_array_t (a : Array T 2#usize) : Result Unit := Result.ret () /- [array::non_copyable_array]: forward function -/ def non_copyable_array : Result Unit := do - let _ ← take_array_t (Array.make T (Usize.ofInt 2) [ T.A, T.B ]) + let _ ← take_array_t (Array.make T 2#usize [ T.A, T.B ]) Result.ret () /- [array::sum]: loop 0: forward function -/ @@ -345,13 +336,13 @@ divergent def sum_loop (s : Slice U32) (sum0 : U32) (i : Usize) : Result U32 := do let i1 ← Slice.index_shared U32 s i let sum1 ← sum0 + i1 - let i2 ← i + (Usize.ofInt 1) + let i2 ← i + 1#usize sum_loop s sum1 i2 else Result.ret sum0 /- [array::sum]: forward function -/ def sum (s : Slice U32) : Result U32 := - sum_loop s (U32.ofInt 0) (Usize.ofInt 0) + sum_loop s 0#u32 0#usize /- [array::sum2]: loop 0: forward function -/ divergent def sum2_loop @@ -364,7 +355,7 @@ divergent def sum2_loop let i2 ← Slice.index_shared U32 s2 i let i3 ← i1 + i2 let sum1 ← sum0 + i3 - let i4 ← i + (Usize.ofInt 1) + let i4 ← i + 1#usize sum2_loop s s2 sum1 i4 else Result.ret sum0 @@ -374,27 +365,25 @@ def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 := let i0 := Slice.len U32 s2 if not (i = i0) then Result.fail Error.panic - else sum2_loop s s2 (U32.ofInt 0) (Usize.ofInt 0) + else sum2_loop s s2 0#u32 0#usize /- [array::f0]: forward function -/ def f0 : Result Unit := do let s ← - Array.to_slice_mut U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) - let s0 ← Slice.index_mut_back U32 s (Usize.ofInt 0) (U32.ofInt 1) + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let s0 ← Slice.index_mut_back U32 s 0#usize 1#u32 let _ ← - Array.to_slice_mut_back U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) s0 + Array.to_slice_mut_back U32 2#usize + (Array.make U32 2#usize [ 1#u32, 2#u32 ]) s0 Result.ret () /- [array::f1]: forward function -/ def f1 : Result Unit := do let _ ← - Array.index_mut_back U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) - (Usize.ofInt 0) (U32.ofInt 1) + Array.index_mut_back U32 2#usize + (Array.make U32 2#usize [ 1#u32, 2#u32 ]) 0#usize 1#u32 Result.ret () /- [array::f2]: forward function -/ @@ -402,57 +391,49 @@ def f2 (i : U32) : Result Unit := Result.ret () /- [array::f4]: forward function -/ -def f4 - (x : Array U32 (Usize.ofInt 32)) (y : Usize) (z : Usize) : - Result (Slice U32) - := - Array.subslice_shared U32 (Usize.ofInt 32) x (Range.mk y z) +def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := + core.array.Array.index U32 (Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexInst U32 (Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } /- [array::f3]: forward function -/ def f3 : Result U32 := do let i ← - Array.index_shared U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) - (Usize.ofInt 0) + Array.index_shared U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + 0#usize let _ ← f2 i - let b := Array.repeat U32 (Usize.ofInt 32) (U32.ofInt 0) + let b := Array.repeat U32 32#usize 0#u32 let s ← - Array.to_slice_shared U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 1), (U32.ofInt 2) ]) - let s0 ← f4 b (Usize.ofInt 16) (Usize.ofInt 18) + Array.to_slice_shared U32 2#usize + (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let s0 ← f4 b 16#usize 18#usize sum2 s s0 /- [array::SZ] -/ -def sz_body : Result Usize := Result.ret (Usize.ofInt 32) +def sz_body : Result Usize := Result.ret 32#usize def sz_c : Usize := eval_global sz_body (by simp) /- [array::f5]: forward function -/ -def f5 (x : Array U32 (Usize.ofInt 32)) : Result U32 := - Array.index_shared U32 (Usize.ofInt 32) x (Usize.ofInt 0) +def f5 (x : Array U32 32#usize) : Result U32 := + Array.index_shared U32 32#usize x 0#usize /- [array::ite]: forward function -/ def ite : Result Unit := do let s ← - Array.to_slice_mut U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s0 ← - Array.to_slice_mut U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) + Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s1 ← index_mut_slice_u32_0_back s0 let _ ← - Array.to_slice_mut_back U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) s1 + Array.to_slice_mut_back U32 2#usize + (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 let s2 ← index_mut_slice_u32_0_back s let _ ← - Array.to_slice_mut_back U32 (Usize.ofInt 2) - (Array.make U32 (Usize.ofInt 2) [ (U32.ofInt 0), (U32.ofInt 0) ]) s2 + Array.to_slice_mut_back U32 2#usize + (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s2 Result.ret () -/- [array::array]: forward function -/ -def array (LEN : Usize) : Result (Array U8 LEN) := - let a := Array.repeat U8 LEN (U8.ofInt 0) - Result.ret a - end array -- cgit v1.3.1 From 4e70d285b35d25c172e7bedd204ec885ef91d146 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 25 Oct 2023 18:46:44 +0200 Subject: Regenerate the hashmap files --- tests/lean/Hashmap/Funs.lean | 217 +++++++++++++++++++++++++----------------- tests/lean/Hashmap/Types.lean | 2 +- 2 files changed, 133 insertions(+), 86 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 01c61de4..8464c432 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -12,18 +12,22 @@ def hash_key (k : Usize) : Result Usize := /- [hashmap::HashMap::{0}::allocate_slots]: loop 0: forward function -/ divergent def HashMap.allocate_slots_loop - (T : Type) (slots : Vec (List T)) (n : Usize) : Result (Vec (List T)) := - if n > (Usize.ofInt 0) + (T : Type) (slots : alloc.vec.Vec (List T)) (n : Usize) : + Result (alloc.vec.Vec (List T)) + := + if n > 0#usize then do - let slots0 ← Vec.push (List T) slots List.Nil - let n0 ← n - (Usize.ofInt 1) + let slots0 ← alloc.vec.Vec.push (List T) slots List.Nil + let n0 ← n - 1#usize HashMap.allocate_slots_loop T slots0 n0 else Result.ret slots /- [hashmap::HashMap::{0}::allocate_slots]: forward function -/ def HashMap.allocate_slots - (T : Type) (slots : Vec (List T)) (n : Usize) : Result (Vec (List T)) := + (T : Type) (slots : alloc.vec.Vec (List T)) (n : Usize) : + Result (alloc.vec.Vec (List T)) + := HashMap.allocate_slots_loop T slots n /- [hashmap::HashMap::{0}::new_with_capacity]: forward function -/ @@ -33,13 +37,13 @@ def HashMap.new_with_capacity Result (HashMap T) := do - let v := Vec.new (List T) + let v := alloc.vec.Vec.new (List T) let slots ← HashMap.allocate_slots T v capacity let i ← capacity * max_load_dividend let i0 ← i / max_load_divisor Result.ret { - num_entries := (Usize.ofInt 0), + num_entries := 0#usize, max_load_factor := (max_load_dividend, max_load_divisor), max_load := i0, slots := slots @@ -47,18 +51,23 @@ def HashMap.new_with_capacity /- [hashmap::HashMap::{0}::new]: forward function -/ def HashMap.new (T : Type) : Result (HashMap T) := - HashMap.new_with_capacity T (Usize.ofInt 32) (Usize.ofInt 4) (Usize.ofInt 5) + HashMap.new_with_capacity T 32#usize 4#usize 5#usize /- [hashmap::HashMap::{0}::clear]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ divergent def HashMap.clear_loop - (T : Type) (slots : Vec (List T)) (i : Usize) : Result (Vec (List T)) := - let i0 := Vec.len (List T) slots + (T : Type) (slots : alloc.vec.Vec (List T)) (i : Usize) : + Result (alloc.vec.Vec (List T)) + := + let i0 := alloc.vec.Vec.len (List T) slots if i < i0 then do - let i1 ← i + (Usize.ofInt 1) - let slots0 ← Vec.index_mut_back (List T) slots i List.Nil + let i1 ← i + 1#usize + let slots0 ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) slots + i List.Nil HashMap.clear_loop T slots0 i1 else Result.ret slots @@ -66,8 +75,8 @@ divergent def HashMap.clear_loop (there is a single backward function, and the forward function returns ()) -/ def HashMap.clear (T : Type) (self : HashMap T) : Result (HashMap T) := do - let v ← HashMap.clear_loop T self.slots (Usize.ofInt 0) - Result.ret { self with num_entries := (Usize.ofInt 0), slots := v } + let v ← HashMap.clear_loop T self.slots 0#usize + Result.ret { self with num_entries := 0#usize, slots := v } /- [hashmap::HashMap::{0}::len]: forward function -/ def HashMap.len (T : Type) (self : HashMap T) : Result Usize := @@ -115,21 +124,30 @@ def HashMap.insert_no_resize := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod let inserted ← HashMap.insert_in_list T key value l if inserted then do - let i0 ← self.num_entries + (Usize.ofInt 1) + let i0 ← self.num_entries + 1#usize let l0 ← HashMap.insert_in_list_back T key value l - let v ← Vec.index_mut_back (List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod l0 Result.ret { self with num_entries := i0, slots := v } else do let l0 ← HashMap.insert_in_list_back T key value l - let v ← Vec.index_mut_back (List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod l0 Result.ret { self with slots := v } /- [hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function @@ -152,27 +170,35 @@ def HashMap.move_elements_from_list /- [hashmap::HashMap::{0}::move_elements]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ divergent def HashMap.move_elements_loop - (T : Type) (ntable : HashMap T) (slots : Vec (List T)) (i : Usize) : - Result ((HashMap T) × (Vec (List T))) + (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize) + : + Result ((HashMap T) × (alloc.vec.Vec (List T))) := - let i0 := Vec.len (List T) slots + let i0 := alloc.vec.Vec.len (List T) slots if i < i0 then do - let l ← Vec.index_mut (List T) slots i - let ls := mem.replace (List T) l List.Nil + let l ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) slots + i + let ls := core.mem.replace (List T) l List.Nil let ntable0 ← HashMap.move_elements_from_list T ntable ls - let i1 ← i + (Usize.ofInt 1) - let l0 := mem.replace_back (List T) l List.Nil - let slots0 ← Vec.index_mut_back (List T) slots i l0 + let i1 ← i + 1#usize + let l0 := core.mem.replace_back (List T) l List.Nil + let slots0 ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) slots + i l0 HashMap.move_elements_loop T ntable0 slots0 i1 else Result.ret (ntable, slots) /- [hashmap::HashMap::{0}::move_elements]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def HashMap.move_elements - (T : Type) (ntable : HashMap T) (slots : Vec (List T)) (i : Usize) : - Result ((HashMap T) × (Vec (List T))) + (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize) + : + Result ((HashMap T) × (alloc.vec.Vec (List T))) := HashMap.move_elements_loop T ntable slots i @@ -181,17 +207,16 @@ def HashMap.move_elements def HashMap.try_resize (T : Type) (self : HashMap T) : Result (HashMap T) := do let max_usize ← Scalar.cast .Usize core_u32_max - let capacity := Vec.len (List T) self.slots - let n1 ← max_usize / (Usize.ofInt 2) + let capacity := alloc.vec.Vec.len (List T) self.slots + let n1 ← max_usize / 2#usize let (i, i0) := self.max_load_factor let i1 ← n1 / i if capacity <= i1 then do - let i2 ← capacity * (Usize.ofInt 2) + let i2 ← capacity * 2#usize let ntable ← HashMap.new_with_capacity T i2 i i0 - let (ntable0, _) ← - HashMap.move_elements T ntable self.slots (Usize.ofInt 0) + let (ntable0, _) ← HashMap.move_elements T ntable self.slots 0#usize Result.ret { ntable0 @@ -233,9 +258,12 @@ def HashMap.contains_key (T : Type) (self : HashMap T) (key : Usize) : Result Bool := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_shared (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod HashMap.contains_key_in_list T key l /- [hashmap::HashMap::{0}::get_in_list]: loop 0: forward function -/ @@ -256,9 +284,12 @@ def HashMap.get_in_list (T : Type) (key : Usize) (ls : List T) : Result T := def HashMap.get (T : Type) (self : HashMap T) (key : Usize) : Result T := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_shared (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod HashMap.get_in_list T key l /- [hashmap::HashMap::{0}::get_mut_in_list]: loop 0: forward function -/ @@ -298,9 +329,12 @@ def HashMap.get_mut_in_list_back def HashMap.get_mut (T : Type) (self : HashMap T) (key : Usize) : Result T := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod HashMap.get_mut_in_list T l key /- [hashmap::HashMap::{0}::get_mut]: backward function 0 -/ @@ -310,11 +344,17 @@ def HashMap.get_mut_back := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod let l0 ← HashMap.get_mut_in_list_back T l key ret0 - let v ← Vec.index_mut_back (List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod l0 Result.ret { self with slots := v } /- [hashmap::HashMap::{0}::remove_from_list]: loop 0: forward function -/ @@ -324,12 +364,12 @@ divergent def HashMap.remove_from_list_loop | List.Cons ckey t tl => if ckey = key then - let mv_ls := mem.replace (List T) (List.Cons ckey t tl) List.Nil + let mv_ls := core.mem.replace (List T) (List.Cons ckey t tl) List.Nil match mv_ls with - | List.Cons i cvalue tl0 => Result.ret (Option.some cvalue) + | List.Cons i cvalue tl0 => Result.ret (some cvalue) | List.Nil => Result.fail Error.panic else HashMap.remove_from_list_loop T key tl - | List.Nil => Result.ret Option.none + | List.Nil => Result.ret none /- [hashmap::HashMap::{0}::remove_from_list]: forward function -/ def HashMap.remove_from_list @@ -343,7 +383,7 @@ divergent def HashMap.remove_from_list_loop_back | List.Cons ckey t tl => if ckey = key then - let mv_ls := mem.replace (List T) (List.Cons ckey t tl) List.Nil + let mv_ls := core.mem.replace (List T) (List.Cons ckey t tl) List.Nil match mv_ls with | List.Cons i cvalue tl0 => Result.ret tl0 | List.Nil => Result.fail Error.panic @@ -363,84 +403,91 @@ def HashMap.remove (T : Type) (self : HashMap T) (key : Usize) : Result (Option T) := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod let x ← HashMap.remove_from_list T key l match x with - | Option.none => Result.ret Option.none - | Option.some x0 => - do - let _ ← self.num_entries - (Usize.ofInt 1) - Result.ret (Option.some x0) + | none => Result.ret none + | some x0 => do + let _ ← self.num_entries - 1#usize + Result.ret (some x0) /- [hashmap::HashMap::{0}::remove]: backward function 0 -/ def HashMap.remove_back (T : Type) (self : HashMap T) (key : Usize) : Result (HashMap T) := do let hash ← hash_key key - let i := Vec.len (List T) self.slots + let i := alloc.vec.Vec.len (List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod let x ← HashMap.remove_from_list T key l match x with - | Option.none => + | none => do let l0 ← HashMap.remove_from_list_back T key l - let v ← Vec.index_mut_back (List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod l0 Result.ret { self with slots := v } - | Option.some x0 => + | some x0 => do - let i0 ← self.num_entries - (Usize.ofInt 1) + let i0 ← self.num_entries - 1#usize let l0 ← HashMap.remove_from_list_back T key l - let v ← Vec.index_mut_back (List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List T)) + self.slots hash_mod l0 Result.ret { self with num_entries := i0, slots := v } /- [hashmap::test1]: forward function -/ def test1 : Result Unit := do let hm ← HashMap.new U64 - let hm0 ← HashMap.insert U64 hm (Usize.ofInt 0) (U64.ofInt 42) - let hm1 ← HashMap.insert U64 hm0 (Usize.ofInt 128) (U64.ofInt 18) - let hm2 ← HashMap.insert U64 hm1 (Usize.ofInt 1024) (U64.ofInt 138) - let hm3 ← HashMap.insert U64 hm2 (Usize.ofInt 1056) (U64.ofInt 256) - let i ← HashMap.get U64 hm3 (Usize.ofInt 128) - if not (i = (U64.ofInt 18)) + let hm0 ← HashMap.insert U64 hm 0#usize 42#u64 + let hm1 ← HashMap.insert U64 hm0 128#usize 18#u64 + let hm2 ← HashMap.insert U64 hm1 1024#usize 138#u64 + let hm3 ← HashMap.insert U64 hm2 1056#usize 256#u64 + let i ← HashMap.get U64 hm3 128#usize + if not (i = 18#u64) then Result.fail Error.panic else do - let hm4 ← - HashMap.get_mut_back U64 hm3 (Usize.ofInt 1024) (U64.ofInt 56) - let i0 ← HashMap.get U64 hm4 (Usize.ofInt 1024) - if not (i0 = (U64.ofInt 56)) + let hm4 ← HashMap.get_mut_back U64 hm3 1024#usize 56#u64 + let i0 ← HashMap.get U64 hm4 1024#usize + if not (i0 = 56#u64) then Result.fail Error.panic else do - let x ← HashMap.remove U64 hm4 (Usize.ofInt 1024) + let x ← HashMap.remove U64 hm4 1024#usize match x with - | Option.none => Result.fail Error.panic - | Option.some x0 => - if not (x0 = (U64.ofInt 56)) + | none => Result.fail Error.panic + | some x0 => + if not (x0 = 56#u64) then Result.fail Error.panic else do - let hm5 ← HashMap.remove_back U64 hm4 (Usize.ofInt 1024) - let i1 ← HashMap.get U64 hm5 (Usize.ofInt 0) - if not (i1 = (U64.ofInt 42)) + let hm5 ← HashMap.remove_back U64 hm4 1024#usize + let i1 ← HashMap.get U64 hm5 0#usize + if not (i1 = 42#u64) then Result.fail Error.panic else do - let i2 ← HashMap.get U64 hm5 (Usize.ofInt 128) - if not (i2 = (U64.ofInt 18)) + let i2 ← HashMap.get U64 hm5 128#usize + if not (i2 = 18#u64) then Result.fail Error.panic else do - let i3 ← HashMap.get U64 hm5 (Usize.ofInt 1056) - if not (i3 = (U64.ofInt 256)) + let i3 ← HashMap.get U64 hm5 1056#usize + if not (i3 = 256#u64) then Result.fail Error.panic else Result.ret () -/- Unit test for [hashmap::test1] -/ -#assert (test1 == .ret ()) - end hashmap diff --git a/tests/lean/Hashmap/Types.lean b/tests/lean/Hashmap/Types.lean index 6455798d..e007bce0 100644 --- a/tests/lean/Hashmap/Types.lean +++ b/tests/lean/Hashmap/Types.lean @@ -15,6 +15,6 @@ structure HashMap (T : Type) where num_entries : Usize max_load_factor : (Usize × Usize) max_load : Usize - slots : Vec (List T) + slots : alloc.vec.Vec (List T) end hashmap -- cgit v1.3.1 From c380ab1699a115edf88e9d83234a4423333e52bf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 14:12:09 +0200 Subject: Regenerate the array files for Lean --- tests/lean/Array/Funs.lean | 206 +++++++++++++++++++++----------------------- tests/lean/Array/Types.lean | 8 +- 2 files changed, 103 insertions(+), 111 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/Array/Funs.lean b/tests/lean/Array/Funs.lean index 899bf856..32ae6248 100644 --- a/tests/lean/Array/Funs.lean +++ b/tests/lean/Array/Funs.lean @@ -13,89 +13,87 @@ def incr (x : U32) : Result U32 := /- [array::array_to_shared_slice_]: forward function -/ def array_to_shared_slice_ - (T0 : Type) (s : Array T0 32#usize) : Result (Slice T0) := - Array.to_slice_shared T0 32#usize s + (T : Type) (s : Array T 32#usize) : Result (Slice T) := + Array.to_slice T 32#usize s /- [array::array_to_mut_slice_]: forward function -/ -def array_to_mut_slice_ - (T0 : Type) (s : Array T0 32#usize) : Result (Slice T0) := - Array.to_slice_mut T0 32#usize s +def array_to_mut_slice_ (T : Type) (s : Array T 32#usize) : Result (Slice T) := + Array.to_slice T 32#usize s /- [array::array_to_mut_slice_]: backward function 0 -/ def array_to_mut_slice__back - (T0 : Type) (s : Array T0 32#usize) (ret0 : Slice T0) : - Result (Array T0 32#usize) + (T : Type) (s : Array T 32#usize) (ret0 : Slice T) : + Result (Array T 32#usize) := - Array.to_slice_mut_back T0 32#usize s ret0 + Array.from_slice T 32#usize s ret0 /- [array::array_len]: forward function -/ -def array_len (T0 : Type) (s : Array T0 32#usize) : Result Usize := +def array_len (T : Type) (s : Array T 32#usize) : Result Usize := do - let s0 ← Array.to_slice_shared T0 32#usize s - let i := Slice.len T0 s0 + let s0 ← Array.to_slice T 32#usize s + let i := Slice.len T s0 Result.ret i /- [array::shared_array_len]: forward function -/ -def shared_array_len (T0 : Type) (s : Array T0 32#usize) : Result Usize := +def shared_array_len (T : Type) (s : Array T 32#usize) : Result Usize := do - let s0 ← Array.to_slice_shared T0 32#usize s - let i := Slice.len T0 s0 + let s0 ← Array.to_slice T 32#usize s + let i := Slice.len T s0 Result.ret i /- [array::shared_slice_len]: forward function -/ -def shared_slice_len (T0 : Type) (s : Slice T0) : Result Usize := - let i := Slice.len T0 s +def shared_slice_len (T : Type) (s : Slice T) : Result Usize := + let i := Slice.len T s Result.ret i /- [array::index_array_shared]: forward function -/ def index_array_shared - (T0 : Type) (s : Array T0 32#usize) (i : Usize) : Result T0 := - Array.index_shared T0 32#usize s i + (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := + Array.index_usize T 32#usize s i /- [array::index_array_u32]: forward function -/ def index_array_u32 (s : Array U32 32#usize) (i : Usize) : Result U32 := - Array.index_shared U32 32#usize s i + Array.index_usize U32 32#usize s i /- [array::index_array_copy]: forward function -/ def index_array_copy (x : Array U32 32#usize) : Result U32 := - Array.index_shared U32 32#usize x 0#usize + Array.index_usize U32 32#usize x 0#usize /- [array::index_mut_array]: forward function -/ -def index_mut_array - (T0 : Type) (s : Array T0 32#usize) (i : Usize) : Result T0 := - Array.index_mut T0 32#usize s i +def index_mut_array (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := + Array.index_usize T 32#usize s i /- [array::index_mut_array]: backward function 0 -/ def index_mut_array_back - (T0 : Type) (s : Array T0 32#usize) (i : Usize) (ret0 : T0) : - Result (Array T0 32#usize) + (T : Type) (s : Array T 32#usize) (i : Usize) (ret0 : T) : + Result (Array T 32#usize) := - Array.index_mut_back T0 32#usize s i ret0 + Array.update_usize T 32#usize s i ret0 /- [array::index_slice]: forward function -/ -def index_slice (T0 : Type) (s : Slice T0) (i : Usize) : Result T0 := - Slice.index_shared T0 s i +def index_slice (T : Type) (s : Slice T) (i : Usize) : Result T := + Slice.index_usize T s i /- [array::index_mut_slice]: forward function -/ -def index_mut_slice (T0 : Type) (s : Slice T0) (i : Usize) : Result T0 := - Slice.index_mut T0 s i +def index_mut_slice (T : Type) (s : Slice T) (i : Usize) : Result T := + Slice.index_usize T s i /- [array::index_mut_slice]: backward function 0 -/ def index_mut_slice_back - (T0 : Type) (s : Slice T0) (i : Usize) (ret0 : T0) : Result (Slice T0) := - Slice.index_mut_back T0 s i ret0 + (T : Type) (s : Slice T) (i : Usize) (ret0 : T) : Result (Slice T) := + Slice.update_usize T s i ret0 /- [array::slice_subslice_shared_]: forward function -/ def slice_subslice_shared_ (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := - core.slice.index.Slice.index U32 (Range Usize) + core.slice.index.Slice.index U32 (core.ops.range.Range Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32) x { start := y, end_ := z } /- [array::slice_subslice_mut_]: forward function -/ def slice_subslice_mut_ (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := - core.slice.index.Slice.index_mut U32 (Range Usize) + core.slice.index.Slice.index_mut U32 (core.ops.range.Range Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32) x { start := y, end_ := z } @@ -104,37 +102,37 @@ def slice_subslice_mut__back (x : Slice U32) (y : Usize) (z : Usize) (ret0 : Slice U32) : Result (Slice U32) := - core.slice.index.Slice.index_mut_back U32 (Range Usize) + core.slice.index.Slice.index_mut_back U32 (core.ops.range.Range Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32) x { start := y, end_ := z } ret0 /- [array::array_to_slice_shared_]: forward function -/ def array_to_slice_shared_ (x : Array U32 32#usize) : Result (Slice U32) := - Array.to_slice_shared U32 32#usize x + Array.to_slice U32 32#usize x /- [array::array_to_slice_mut_]: forward function -/ def array_to_slice_mut_ (x : Array U32 32#usize) : Result (Slice U32) := - Array.to_slice_mut U32 32#usize x + Array.to_slice U32 32#usize x /- [array::array_to_slice_mut_]: backward function 0 -/ def array_to_slice_mut__back (x : Array U32 32#usize) (ret0 : Slice U32) : Result (Array U32 32#usize) := - Array.to_slice_mut_back U32 32#usize x ret0 + Array.from_slice U32 32#usize x ret0 /- [array::array_subslice_shared_]: forward function -/ def array_subslice_shared_ (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := - core.array.Array.index U32 (Range Usize) 32#usize - (core.slice.index.Slice.coreopsindexIndexInst U32 (Range Usize) - (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x { start := y, end_ := z } /- [array::array_subslice_mut_]: forward function -/ def array_subslice_mut_ (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := - core.array.Array.index_mut U32 (Range Usize) 32#usize - (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) - (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + core.array.Array.index_mut U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x { start := y, end_ := z } /- [array::array_subslice_mut_]: backward function 0 -/ @@ -142,18 +140,18 @@ def array_subslice_mut__back (x : Array U32 32#usize) (y : Usize) (z : Usize) (ret0 : Slice U32) : Result (Array U32 32#usize) := - core.array.Array.index_mut_back U32 (Range Usize) 32#usize - (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) - (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + core.array.Array.index_mut_back U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x { start := y, end_ := z } ret0 /- [array::index_slice_0]: forward function -/ -def index_slice_0 (T0 : Type) (s : Slice T0) : Result T0 := - Slice.index_shared T0 s 0#usize +def index_slice_0 (T : Type) (s : Slice T) : Result T := + Slice.index_usize T s 0#usize /- [array::index_array_0]: forward function -/ -def index_array_0 (T0 : Type) (s : Array T0 32#usize) : Result T0 := - Array.index_shared T0 32#usize s 0#usize +def index_array_0 (T : Type) (s : Array T 32#usize) : Result T := + Array.index_usize T 32#usize s 0#usize /- [array::index_index_array]: forward function -/ def index_index_array @@ -161,8 +159,8 @@ def index_index_array Result U32 := do - let a ← Array.index_shared (Array U32 32#usize) 32#usize s i - Array.index_shared U32 32#usize a j + let a ← Array.index_usize (Array U32 32#usize) 32#usize s i + Array.index_usize U32 32#usize a j /- [array::update_update_array]: forward function -/ def update_update_array @@ -170,9 +168,9 @@ def update_update_array Result Unit := do - let a ← Array.index_mut (Array U32 32#usize) 32#usize s i - let a0 ← Array.index_mut_back U32 32#usize a j 0#u32 - let _ ← Array.index_mut_back (Array U32 32#usize) 32#usize s i a0 + let a ← Array.index_usize (Array U32 32#usize) 32#usize s i + let a0 ← Array.update_usize U32 32#usize a j 0#u32 + let _ ← Array.update_usize (Array U32 32#usize) 32#usize s i a0 Result.ret () /- [array::array_local_deep_copy]: forward function -/ @@ -202,37 +200,35 @@ def take_all : Result Unit := let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let _ ← take_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s ← - Array.to_slice_shared U32 2#usize - (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let _ ← take_slice s let s0 ← - Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s1 ← take_mut_slice s0 let _ ← - Array.to_slice_mut_back U32 2#usize - (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 Result.ret () /- [array::index_array]: forward function -/ def index_array (x : Array U32 2#usize) : Result U32 := - Array.index_shared U32 2#usize x 0#usize + Array.index_usize U32 2#usize x 0#usize /- [array::index_array_borrow]: forward function -/ def index_array_borrow (x : Array U32 2#usize) : Result U32 := - Array.index_shared U32 2#usize x 0#usize + Array.index_usize U32 2#usize x 0#usize /- [array::index_slice_u32_0]: forward function -/ def index_slice_u32_0 (x : Slice U32) : Result U32 := - Slice.index_shared U32 x 0#usize + Slice.index_usize U32 x 0#usize /- [array::index_mut_slice_u32_0]: forward function -/ def index_mut_slice_u32_0 (x : Slice U32) : Result U32 := - Slice.index_shared U32 x 0#usize + Slice.index_usize U32 x 0#usize /- [array::index_mut_slice_u32_0]: backward function 0 -/ def index_mut_slice_u32_0_back (x : Slice U32) : Result (Slice U32) := do - let _ ← Slice.index_shared U32 x 0#usize + let _ ← Slice.index_usize U32 x 0#usize Result.ret x /- [array::index_all]: forward function -/ @@ -244,60 +240,60 @@ def index_all : Result U32 := let i2 ← index_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i3 ← i1 + i2 let s ← - Array.to_slice_shared U32 2#usize - (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i4 ← index_slice_u32_0 s let i5 ← i3 + i4 let s0 ← - Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let i6 ← index_mut_slice_u32_0 s0 let i7 ← i5 + i6 let s1 ← index_mut_slice_u32_0_back s0 let _ ← - Array.to_slice_mut_back U32 2#usize - (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 Result.ret i7 /- [array::update_array]: forward function -/ def update_array (x : Array U32 2#usize) : Result Unit := do - let _ ← Array.index_mut_back U32 2#usize x 0#usize 1#u32 + let _ ← Array.update_usize U32 2#usize x 0#usize 1#u32 Result.ret () /- [array::update_array_mut_borrow]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def update_array_mut_borrow (x : Array U32 2#usize) : Result (Array U32 2#usize) := - Array.index_mut_back U32 2#usize x 0#usize 1#u32 + Array.update_usize U32 2#usize x 0#usize 1#u32 /- [array::update_mut_slice]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def update_mut_slice (x : Slice U32) : Result (Slice U32) := - Slice.index_mut_back U32 x 0#usize 1#u32 + Slice.update_usize U32 x 0#usize 1#u32 /- [array::update_all]: forward function -/ def update_all : Result Unit := do let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let x ← update_array_mut_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - let s ← Array.to_slice_mut U32 2#usize x + let s ← Array.to_slice U32 2#usize x let s0 ← update_mut_slice s - let _ ← Array.to_slice_mut_back U32 2#usize x s0 + let _ ← Array.from_slice U32 2#usize x s0 Result.ret () /- [array::range_all]: forward function -/ def range_all : Result Unit := do let s ← - core.array.Array.index_mut U32 (Range Usize) 4#usize - (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) + core.array.Array.index_mut U32 (core.ops.range.Range Usize) 4#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 + (core.ops.range.Range Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) { start := 1#usize, end_ := 3#usize } let s0 ← update_mut_slice s let _ ← - core.array.Array.index_mut_back U32 (Range Usize) 4#usize - (core.slice.index.Slice.coreopsindexIndexMutInst U32 (Range Usize) + core.array.Array.index_mut_back U32 (core.ops.range.Range Usize) 4#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 + (core.ops.range.Range Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) { start := 1#usize, end_ := 3#usize } s0 @@ -305,27 +301,27 @@ def range_all : Result Unit := /- [array::deref_array_borrow]: forward function -/ def deref_array_borrow (x : Array U32 2#usize) : Result U32 := - Array.index_shared U32 2#usize x 0#usize + Array.index_usize U32 2#usize x 0#usize /- [array::deref_array_mut_borrow]: forward function -/ def deref_array_mut_borrow (x : Array U32 2#usize) : Result U32 := - Array.index_shared U32 2#usize x 0#usize + Array.index_usize U32 2#usize x 0#usize /- [array::deref_array_mut_borrow]: backward function 0 -/ def deref_array_mut_borrow_back (x : Array U32 2#usize) : Result (Array U32 2#usize) := do - let _ ← Array.index_shared U32 2#usize x 0#usize + let _ ← Array.index_usize U32 2#usize x 0#usize Result.ret x /- [array::take_array_t]: forward function -/ -def take_array_t (a : Array T 2#usize) : Result Unit := +def take_array_t (a : Array AB 2#usize) : Result Unit := Result.ret () /- [array::non_copyable_array]: forward function -/ def non_copyable_array : Result Unit := do - let _ ← take_array_t (Array.make T 2#usize [ T.A, T.B ]) + let _ ← take_array_t (Array.make AB 2#usize [ AB.A, AB.B ]) Result.ret () /- [array::sum]: loop 0: forward function -/ @@ -334,7 +330,7 @@ divergent def sum_loop (s : Slice U32) (sum0 : U32) (i : Usize) : Result U32 := if i < i0 then do - let i1 ← Slice.index_shared U32 s i + let i1 ← Slice.index_usize U32 s i let sum1 ← sum0 + i1 let i2 ← i + 1#usize sum_loop s sum1 i2 @@ -351,8 +347,8 @@ divergent def sum2_loop if i < i0 then do - let i1 ← Slice.index_shared U32 s i - let i2 ← Slice.index_shared U32 s2 i + let i1 ← Slice.index_usize U32 s i + let i2 ← Slice.index_usize U32 s2 i let i3 ← i1 + i2 let sum1 ← sum0 + i3 let i4 ← i + 1#usize @@ -371,19 +367,18 @@ def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 := def f0 : Result Unit := do let s ← - Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) - let s0 ← Slice.index_mut_back U32 s 0#usize 1#u32 + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let s0 ← Slice.update_usize U32 s 0#usize 1#u32 let _ ← - Array.to_slice_mut_back U32 2#usize - (Array.make U32 2#usize [ 1#u32, 2#u32 ]) s0 + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) s0 Result.ret () /- [array::f1]: forward function -/ def f1 : Result Unit := do let _ ← - Array.index_mut_back U32 2#usize - (Array.make U32 2#usize [ 1#u32, 2#u32 ]) 0#usize 1#u32 + Array.update_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + 0#usize 1#u32 Result.ret () /- [array::f2]: forward function -/ @@ -392,22 +387,21 @@ def f2 (i : U32) : Result Unit := /- [array::f4]: forward function -/ def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := - core.array.Array.index U32 (Range Usize) 32#usize - (core.slice.index.Slice.coreopsindexIndexInst U32 (Range Usize) - (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x { start := y, end_ := z } /- [array::f3]: forward function -/ def f3 : Result U32 := do let i ← - Array.index_shared U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + Array.index_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) 0#usize let _ ← f2 i let b := Array.repeat U32 32#usize 0#u32 let s ← - Array.to_slice_shared U32 2#usize - (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) let s0 ← f4 b 16#usize 18#usize sum2 s s0 @@ -417,23 +411,21 @@ def sz_c : Usize := eval_global sz_body (by simp) /- [array::f5]: forward function -/ def f5 (x : Array U32 32#usize) : Result U32 := - Array.index_shared U32 32#usize x 0#usize + Array.index_usize U32 32#usize x 0#usize /- [array::ite]: forward function -/ def ite : Result Unit := do let s ← - Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s0 ← - Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s1 ← index_mut_slice_u32_0_back s0 let _ ← - Array.to_slice_mut_back U32 2#usize - (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 let s2 ← index_mut_slice_u32_0_back s let _ ← - Array.to_slice_mut_back U32 2#usize - (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s2 + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s2 Result.ret () end array diff --git a/tests/lean/Array/Types.lean b/tests/lean/Array/Types.lean index 72241276..60fa81ab 100644 --- a/tests/lean/Array/Types.lean +++ b/tests/lean/Array/Types.lean @@ -5,9 +5,9 @@ open Primitives namespace array -/- [array::T] -/ -inductive T := -| A : T -| B : T +/- [array::AB] -/ +inductive AB := +| A : AB +| B : AB end array -- cgit v1.3.1 From bfafe1f4d1cb69c9b921a77c7193c92b45cc21df Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 14:45:19 +0200 Subject: Regenerate several test files for Lean --- tests/lean/Constants.lean | 29 ++++---- tests/lean/External/Funs.lean | 16 ++--- tests/lean/Loops/Funs.lean | 161 +++++++++++++++++++++++------------------- tests/lean/Paper.lean | 48 ++++++------- 4 files changed, 132 insertions(+), 122 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/Constants.lean b/tests/lean/Constants.lean index b0cdaa90..2603cbbf 100644 --- a/tests/lean/Constants.lean +++ b/tests/lean/Constants.lean @@ -6,7 +6,7 @@ open Primitives namespace constants /- [constants::X0] -/ -def x0_body : Result U32 := Result.ret (U32.ofInt 0) +def x0_body : Result U32 := Result.ret 0#u32 def x0_c : U32 := eval_global x0_body (by simp) /- [constants::X1] -/ @@ -14,15 +14,15 @@ def x1_body : Result U32 := Result.ret core_u32_max def x1_c : U32 := eval_global x1_body (by simp) /- [constants::X2] -/ -def x2_body : Result U32 := Result.ret (U32.ofInt 3) +def x2_body : Result U32 := Result.ret 3#u32 def x2_c : U32 := eval_global x2_body (by simp) /- [constants::incr]: forward function -/ def incr (n : U32) : Result U32 := - n + (U32.ofInt 1) + n + 1#u32 /- [constants::X3] -/ -def x3_body : Result U32 := incr (U32.ofInt 32) +def x3_body : Result U32 := incr 32#u32 def x3_c : U32 := eval_global x3_body (by simp) /- [constants::mk_pair0]: forward function -/ @@ -39,20 +39,19 @@ def mk_pair1 (x : U32) (y : U32) : Result (Pair U32 U32) := Result.ret { x := x, y := y } /- [constants::P0] -/ -def p0_body : Result (U32 × U32) := mk_pair0 (U32.ofInt 0) (U32.ofInt 1) +def p0_body : Result (U32 × U32) := mk_pair0 0#u32 1#u32 def p0_c : (U32 × U32) := eval_global p0_body (by simp) /- [constants::P1] -/ -def p1_body : Result (Pair U32 U32) := mk_pair1 (U32.ofInt 0) (U32.ofInt 1) +def p1_body : Result (Pair U32 U32) := mk_pair1 0#u32 1#u32 def p1_c : Pair U32 U32 := eval_global p1_body (by simp) /- [constants::P2] -/ -def p2_body : Result (U32 × U32) := Result.ret ((U32.ofInt 0), (U32.ofInt 1)) +def p2_body : Result (U32 × U32) := Result.ret (0#u32, 1#u32) def p2_c : (U32 × U32) := eval_global p2_body (by simp) /- [constants::P3] -/ -def p3_body : Result (Pair U32 U32) := - Result.ret { x := (U32.ofInt 0), y := (U32.ofInt 1) } +def p3_body : Result (Pair U32 U32) := Result.ret { x := 0#u32, y := 1#u32 } def p3_c : Pair U32 U32 := eval_global p3_body (by simp) /- [constants::Wrap] -/ @@ -64,7 +63,7 @@ def Wrap.new (T : Type) (val : T) : Result (Wrap T) := Result.ret { val := val } /- [constants::Y] -/ -def y_body : Result (Wrap I32) := Wrap.new I32 (I32.ofInt 2) +def y_body : Result (Wrap I32) := Wrap.new I32 2#i32 def y_c : Wrap I32 := eval_global y_body (by simp) /- [constants::unwrap_y]: forward function -/ @@ -76,7 +75,7 @@ def yval_body : Result I32 := unwrap_y def yval_c : I32 := eval_global yval_body (by simp) /- [constants::get_z1::Z1] -/ -def get_z1_z1_body : Result I32 := Result.ret (I32.ofInt 3) +def get_z1_z1_body : Result I32 := Result.ret 3#i32 def get_z1_z1_c : I32 := eval_global get_z1_z1_body (by simp) /- [constants::get_z1]: forward function -/ @@ -88,7 +87,7 @@ def add (a : I32) (b : I32) : Result I32 := a + b /- [constants::Q1] -/ -def q1_body : Result I32 := Result.ret (I32.ofInt 5) +def q1_body : Result I32 := Result.ret 5#i32 def q1_c : I32 := eval_global q1_body (by simp) /- [constants::Q2] -/ @@ -96,7 +95,7 @@ def q2_body : Result I32 := Result.ret q1_c def q2_c : I32 := eval_global q2_body (by simp) /- [constants::Q3] -/ -def q3_body : Result I32 := add q2_c (I32.ofInt 3) +def q3_body : Result I32 := add q2_c 3#i32 def q3_c : I32 := eval_global q3_body (by simp) /- [constants::get_z2]: forward function -/ @@ -107,7 +106,7 @@ def get_z2 : Result I32 := add q1_c i0 /- [constants::S1] -/ -def s1_body : Result U32 := Result.ret (U32.ofInt 6) +def s1_body : Result U32 := Result.ret 6#u32 def s1_c : U32 := eval_global s1_body (by simp) /- [constants::S2] -/ @@ -119,7 +118,7 @@ def s3_body : Result (Pair U32 U32) := Result.ret p3_c def s3_c : Pair U32 U32 := eval_global s3_body (by simp) /- [constants::S4] -/ -def s4_body : Result (Pair U32 U32) := mk_pair1 (U32.ofInt 7) (U32.ofInt 8) +def s4_body : Result (Pair U32 U32) := mk_pair1 7#u32 8#u32 def s4_c : Pair U32 U32 := eval_global s4_body (by simp) end constants diff --git a/tests/lean/External/Funs.lean b/tests/lean/External/Funs.lean index 055d7860..55fb07be 100644 --- a/tests/lean/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -30,14 +30,14 @@ def swap_back def test_new_non_zero_u32 (x : U32) (st : State) : Result (State × core.num.nonzero.NonZeroU32) := do - let (st0, opt) ← core.num.nonzero.NonZeroU32.new x st - core.option.Option.unwrap core.num.nonzero.NonZeroU32 opt st0 + let (st0, o) ← core.num.nonzero.NonZeroU32.new x st + core.option.Option.unwrap core.num.nonzero.NonZeroU32 o st0 /- [external::test_vec]: forward function -/ def test_vec : Result Unit := do - let v := Vec.new U32 - let _ ← Vec.push U32 v (U32.ofInt 0) + let v := alloc.vec.Vec.new U32 + let _ ← alloc.vec.Vec.push U32 v 0#u32 Result.ret () /- Unit test for [external::test_vec] -/ @@ -75,14 +75,14 @@ def test_custom_swap_back (x : U32) (y : U32) (st : State) (st0 : State) : Result (State × (U32 × U32)) := - custom_swap_back U32 x y st (U32.ofInt 1) st0 + custom_swap_back U32 x y st 1#u32 st0 /- [external::test_swap_non_zero]: forward function -/ def test_swap_non_zero (x : U32) (st : State) : Result (State × U32) := do - let (st0, _) ← swap U32 x (U32.ofInt 0) st - let (st1, (x0, _)) ← swap_back U32 x (U32.ofInt 0) st st0 - if x0 = (U32.ofInt 0) + let (st0, _) ← swap U32 x 0#u32 st + let (st1, (x0, _)) ← swap_back U32 x 0#u32 st st0 + if x0 = 0#u32 then Result.fail Error.panic else Result.ret (st1, x0) diff --git a/tests/lean/Loops/Funs.lean b/tests/lean/Loops/Funs.lean index 5fbe200f..f9c7569e 100644 --- a/tests/lean/Loops/Funs.lean +++ b/tests/lean/Loops/Funs.lean @@ -11,13 +11,13 @@ divergent def sum_loop (max : U32) (i : U32) (s : U32) : Result U32 := if i < max then do let s0 ← s + i - let i0 ← i + (U32.ofInt 1) + let i0 ← i + 1#u32 sum_loop max i0 s0 - else s * (U32.ofInt 2) + else s * 2#u32 /- [loops::sum]: forward function -/ def sum (max : U32) : Result U32 := - sum_loop max (U32.ofInt 0) (U32.ofInt 0) + sum_loop max 0#u32 0#u32 /- [loops::sum_with_mut_borrows]: loop 0: forward function -/ divergent def sum_with_mut_borrows_loop @@ -26,13 +26,13 @@ divergent def sum_with_mut_borrows_loop then do let ms0 ← ms + mi - let mi0 ← mi + (U32.ofInt 1) + let mi0 ← mi + 1#u32 sum_with_mut_borrows_loop max mi0 ms0 - else ms * (U32.ofInt 2) + else ms * 2#u32 /- [loops::sum_with_mut_borrows]: forward function -/ def sum_with_mut_borrows (max : U32) : Result U32 := - sum_with_mut_borrows_loop max (U32.ofInt 0) (U32.ofInt 0) + sum_with_mut_borrows_loop max 0#u32 0#u32 /- [loops::sum_with_shared_borrows]: loop 0: forward function -/ divergent def sum_with_shared_borrows_loop @@ -40,31 +40,34 @@ divergent def sum_with_shared_borrows_loop if i < max then do - let i0 ← i + (U32.ofInt 1) + let i0 ← i + 1#u32 let s0 ← s + i0 sum_with_shared_borrows_loop max i0 s0 - else s * (U32.ofInt 2) + else s * 2#u32 /- [loops::sum_with_shared_borrows]: forward function -/ def sum_with_shared_borrows (max : U32) : Result U32 := - sum_with_shared_borrows_loop max (U32.ofInt 0) (U32.ofInt 0) + sum_with_shared_borrows_loop max 0#u32 0#u32 /- [loops::clear]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ -divergent def clear_loop (v : Vec U32) (i : Usize) : Result (Vec U32) := - let i0 := Vec.len U32 v +divergent def clear_loop + (v : alloc.vec.Vec U32) (i : Usize) : Result (alloc.vec.Vec U32) := + let i0 := alloc.vec.Vec.len U32 v if i < i0 then do - let i1 ← i + (Usize.ofInt 1) - let v0 ← Vec.index_mut_back U32 v i (U32.ofInt 0) + let i1 ← i + 1#usize + let v0 ← + alloc.vec.Vec.index_mut_back U32 Usize + (core.slice.index.usize.coresliceindexSliceIndexInst U32) v i 0#u32 clear_loop v0 i1 else Result.ret v /- [loops::clear]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ -def clear (v : Vec U32) : Result (Vec U32) := - clear_loop v (Usize.ofInt 0) +def clear (v : alloc.vec.Vec U32) : Result (alloc.vec.Vec U32) := + clear_loop v 0#usize /- [loops::list_mem]: loop 0: forward function -/ divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := @@ -83,10 +86,10 @@ divergent def list_nth_mut_loop_loop (T : Type) (ls : List T) (i : U32) : Result T := match ls with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut_loop_loop T tl i0 | List.Nil => Result.fail Error.panic @@ -99,11 +102,11 @@ divergent def list_nth_mut_loop_loop_back (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := match ls with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl0 ← list_nth_mut_loop_loop_back T tl i0 ret0 Result.ret (List.Cons x tl0) | List.Nil => Result.fail Error.panic @@ -118,10 +121,10 @@ divergent def list_nth_shared_loop_loop (T : Type) (ls : List T) (i : U32) : Result T := match ls with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_shared_loop_loop T tl i0 | List.Nil => Result.fail Error.panic @@ -138,9 +141,13 @@ divergent def get_elem_mut_loop (x : Usize) (ls : List Usize) : Result Usize := | List.Nil => Result.fail Error.panic /- [loops::get_elem_mut]: forward function -/ -def get_elem_mut (slots : Vec (List Usize)) (x : Usize) : Result Usize := +def get_elem_mut + (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := do - let l ← Vec.index_mut (List Usize) slots (Usize.ofInt 0) + let l ← + alloc.vec.Vec.index_mut (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) + slots 0#usize get_elem_mut_loop x l /- [loops::get_elem_mut]: loop 0: backward function 0 -/ @@ -158,13 +165,18 @@ divergent def get_elem_mut_loop_back /- [loops::get_elem_mut]: backward function 0 -/ def get_elem_mut_back - (slots : Vec (List Usize)) (x : Usize) (ret0 : Usize) : - Result (Vec (List Usize)) + (slots : alloc.vec.Vec (List Usize)) (x : Usize) (ret0 : Usize) : + Result (alloc.vec.Vec (List Usize)) := do - let l ← Vec.index_mut (List Usize) slots (Usize.ofInt 0) + let l ← + alloc.vec.Vec.index_mut (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) + slots 0#usize let l0 ← get_elem_mut_loop_back x l ret0 - Vec.index_mut_back (List Usize) slots (Usize.ofInt 0) l0 + alloc.vec.Vec.index_mut_back (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) slots + 0#usize l0 /- [loops::get_elem_shared]: loop 0: forward function -/ divergent def get_elem_shared_loop @@ -176,9 +188,13 @@ divergent def get_elem_shared_loop | List.Nil => Result.fail Error.panic /- [loops::get_elem_shared]: forward function -/ -def get_elem_shared (slots : Vec (List Usize)) (x : Usize) : Result Usize := +def get_elem_shared + (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := do - let l ← Vec.index_shared (List Usize) slots (Usize.ofInt 0) + let l ← + alloc.vec.Vec.index (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) + slots 0#usize get_elem_shared_loop x l /- [loops::id_mut]: forward function -/ @@ -198,10 +214,10 @@ divergent def list_nth_mut_loop_with_id_loop (T : Type) (i : U32) (ls : List T) : Result T := match ls with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut_loop_with_id_loop T i0 tl | List.Nil => Result.fail Error.panic @@ -216,11 +232,11 @@ divergent def list_nth_mut_loop_with_id_loop_back (T : Type) (i : U32) (ls : List T) (ret0 : T) : Result (List T) := match ls with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl0 ← list_nth_mut_loop_with_id_loop_back T i0 tl ret0 Result.ret (List.Cons x tl0) | List.Nil => Result.fail Error.panic @@ -238,12 +254,11 @@ divergent def list_nth_shared_loop_with_id_loop (T : Type) (i : U32) (ls : List T) : Result T := match ls with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x - else - do - let i0 ← i - (U32.ofInt 1) - list_nth_shared_loop_with_id_loop T i0 tl + else do + let i0 ← i - 1#u32 + list_nth_shared_loop_with_id_loop T i0 tl | List.Nil => Result.fail Error.panic /- [loops::list_nth_shared_loop_with_id]: forward function -/ @@ -260,12 +275,11 @@ divergent def list_nth_mut_loop_pair_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) - else - do - let i0 ← i - (U32.ofInt 1) - list_nth_mut_loop_pair_loop T tl0 tl1 i0 + else do + let i0 ← i - 1#u32 + list_nth_mut_loop_pair_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -283,11 +297,11 @@ divergent def list_nth_mut_loop_pair_loop_back'a | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl0) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl00 ← list_nth_mut_loop_pair_loop_back'a T tl0 tl1 i0 ret0 Result.ret (List.Cons x0 tl00) | List.Nil => Result.fail Error.panic @@ -309,11 +323,11 @@ divergent def list_nth_mut_loop_pair_loop_back'b | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl10 ← list_nth_mut_loop_pair_loop_back'b T tl0 tl1 i0 ret0 Result.ret (List.Cons x1 tl10) | List.Nil => Result.fail Error.panic @@ -333,12 +347,11 @@ divergent def list_nth_shared_loop_pair_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) - else - do - let i0 ← i - (U32.ofInt 1) - list_nth_shared_loop_pair_loop T tl0 tl1 i0 + else do + let i0 ← i - 1#u32 + list_nth_shared_loop_pair_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -354,11 +367,11 @@ divergent def list_nth_mut_loop_pair_merge_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut_loop_pair_merge_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -377,12 +390,12 @@ divergent def list_nth_mut_loop_pair_merge_loop_back | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then let (t, t0) := ret0 Result.ret (List.Cons t tl0, List.Cons t0 tl1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let (tl00, tl10) ← list_nth_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 Result.ret (List.Cons x0 tl00, List.Cons x1 tl10) @@ -403,11 +416,11 @@ divergent def list_nth_shared_loop_pair_merge_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_shared_loop_pair_merge_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -424,11 +437,11 @@ divergent def list_nth_mut_shared_loop_pair_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut_shared_loop_pair_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -447,11 +460,11 @@ divergent def list_nth_mut_shared_loop_pair_loop_back | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl0) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl00 ← list_nth_mut_shared_loop_pair_loop_back T tl0 tl1 i0 ret0 Result.ret (List.Cons x0 tl00) @@ -472,11 +485,11 @@ divergent def list_nth_mut_shared_loop_pair_merge_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -495,11 +508,11 @@ divergent def list_nth_mut_shared_loop_pair_merge_loop_back | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl0) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl00 ← list_nth_mut_shared_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 Result.ret (List.Cons x0 tl00) @@ -520,11 +533,11 @@ divergent def list_nth_shared_mut_loop_pair_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_shared_mut_loop_pair_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -543,11 +556,11 @@ divergent def list_nth_shared_mut_loop_pair_loop_back | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl10 ← list_nth_shared_mut_loop_pair_loop_back T tl0 tl1 i0 ret0 Result.ret (List.Cons x1 tl10) @@ -568,11 +581,11 @@ divergent def list_nth_shared_mut_loop_pair_merge_loop | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (x0, x1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i0 | List.Nil => Result.fail Error.panic | List.Nil => Result.fail Error.panic @@ -591,11 +604,11 @@ divergent def list_nth_shared_mut_loop_pair_merge_loop_back | List.Cons x0 tl0 => match ls1 with | List.Cons x1 tl1 => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl1) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl10 ← list_nth_shared_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 Result.ret (List.Cons x1 tl10) diff --git a/tests/lean/Paper.lean b/tests/lean/Paper.lean index c15c5e4b..ae4dd243 100644 --- a/tests/lean/Paper.lean +++ b/tests/lean/Paper.lean @@ -8,13 +8,13 @@ namespace paper /- [paper::ref_incr]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def ref_incr (x : I32) : Result I32 := - x + (I32.ofInt 1) + x + 1#i32 /- [paper::test_incr]: forward function -/ def test_incr : Result Unit := do - let x ← ref_incr (I32.ofInt 0) - if not (x = (I32.ofInt 1)) + let x ← ref_incr 0#i32 + if not (x = 1#i32) then Result.fail Error.panic else Result.ret () @@ -37,19 +37,18 @@ def choose_back /- [paper::test_choose]: forward function -/ def test_choose : Result Unit := do - let z ← choose I32 true (I32.ofInt 0) (I32.ofInt 0) - let z0 ← z + (I32.ofInt 1) - if not (z0 = (I32.ofInt 1)) + let z ← choose I32 true 0#i32 0#i32 + let z0 ← z + 1#i32 + if not (z0 = 1#i32) then Result.fail Error.panic else do - let (x, y) ← choose_back I32 true (I32.ofInt 0) (I32.ofInt 0) z0 - if not (x = (I32.ofInt 1)) + let (x, y) ← choose_back I32 true 0#i32 0#i32 z0 + if not (x = 1#i32) then Result.fail Error.panic - else - if not (y = (I32.ofInt 0)) - then Result.fail Error.panic - else Result.ret () + else if not (y = 0#i32) + then Result.fail Error.panic + else Result.ret () /- Unit test for [paper::test_choose] -/ #assert (test_choose == .ret ()) @@ -63,10 +62,10 @@ inductive List (T : Type) := divergent def list_nth_mut (T : Type) (l : List T) (i : U32) : Result T := match l with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret x else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 list_nth_mut T tl i0 | List.Nil => Result.fail Error.panic @@ -75,11 +74,11 @@ divergent def list_nth_mut_back (T : Type) (l : List T) (i : U32) (ret0 : T) : Result (List T) := match l with | List.Cons x tl => - if i = (U32.ofInt 0) + if i = 0#u32 then Result.ret (List.Cons ret0 tl) else do - let i0 ← i - (U32.ofInt 1) + let i0 ← i - 1#u32 let tl0 ← list_nth_mut_back T tl i0 ret0 Result.ret (List.Cons x tl0) | List.Nil => Result.fail Error.panic @@ -90,20 +89,19 @@ divergent def sum (l : List I32) : Result I32 := | List.Cons x tl => do let i ← sum tl x + i - | List.Nil => Result.ret (I32.ofInt 0) + | List.Nil => Result.ret 0#i32 /- [paper::test_nth]: forward function -/ def test_nth : Result Unit := do let l := List.Nil - let l0 := List.Cons (I32.ofInt 3) l - let l1 := List.Cons (I32.ofInt 2) l0 - let x ← list_nth_mut I32 (List.Cons (I32.ofInt 1) l1) (U32.ofInt 2) - let x0 ← x + (I32.ofInt 1) - let l2 ← - list_nth_mut_back I32 (List.Cons (I32.ofInt 1) l1) (U32.ofInt 2) x0 + let l0 := List.Cons 3#i32 l + let l1 := List.Cons 2#i32 l0 + let x ← list_nth_mut I32 (List.Cons 1#i32 l1) 2#u32 + let x0 ← x + 1#i32 + let l2 ← list_nth_mut_back I32 (List.Cons 1#i32 l1) 2#u32 x0 let i ← sum l2 - if not (i = (I32.ofInt 7)) + if not (i = 7#i32) then Result.fail Error.panic else Result.ret () @@ -115,7 +113,7 @@ def call_choose (p : (U32 × U32)) : Result U32 := do let (px, py) := p let pz ← choose U32 true px py - let pz0 ← pz + (U32.ofInt 1) + let pz0 ← pz + 1#u32 let (px0, _) ← choose_back U32 true px py pz0 Result.ret px0 -- cgit v1.3.1 From 76e7a6e4c4ead2e48bc56118b38347b59f4f30db Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 14:50:57 +0200 Subject: Regenerate the betree example for Lean --- tests/lean/BetreeMain/Funs.lean | 79 ++++++++++++++++++++--------------------- 1 file changed, 39 insertions(+), 40 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean index 6681731f..0901d449 100644 --- a/tests/lean/BetreeMain/Funs.lean +++ b/tests/lean/BetreeMain/Funs.lean @@ -40,39 +40,39 @@ def betree.store_leaf_node /- [betree_main::betree::fresh_node_id]: forward function -/ def betree.fresh_node_id (counter : U64) : Result U64 := do - let _ ← counter + (U64.ofInt 1) + let _ ← counter + 1#u64 Result.ret counter /- [betree_main::betree::fresh_node_id]: backward function 0 -/ def betree.fresh_node_id_back (counter : U64) : Result U64 := - counter + (U64.ofInt 1) + counter + 1#u64 /- [betree_main::betree::NodeIdCounter::{0}::new]: forward function -/ def betree.NodeIdCounter.new : Result betree.NodeIdCounter := - Result.ret { next_node_id := (U64.ofInt 0) } + Result.ret { next_node_id := 0#u64 } /- [betree_main::betree::NodeIdCounter::{0}::fresh_id]: forward function -/ def betree.NodeIdCounter.fresh_id (self : betree.NodeIdCounter) : Result U64 := do - let _ ← self.next_node_id + (U64.ofInt 1) + let _ ← self.next_node_id + 1#u64 Result.ret self.next_node_id /- [betree_main::betree::NodeIdCounter::{0}::fresh_id]: backward function 0 -/ def betree.NodeIdCounter.fresh_id_back (self : betree.NodeIdCounter) : Result betree.NodeIdCounter := do - let i ← self.next_node_id + (U64.ofInt 1) + let i ← self.next_node_id + 1#u64 Result.ret { next_node_id := i } /- [betree_main::betree::upsert_update]: forward function -/ def betree.upsert_update (prev : Option U64) (st : betree.UpsertFunState) : Result U64 := match prev with - | Option.none => + | none => match st with | betree.UpsertFunState.Add v => Result.ret v - | betree.UpsertFunState.Sub i => Result.ret (U64.ofInt 0) - | Option.some prev0 => + | betree.UpsertFunState.Sub i => Result.ret 0#u64 + | some prev0 => match st with | betree.UpsertFunState.Add v => do @@ -83,29 +83,28 @@ def betree.upsert_update | betree.UpsertFunState.Sub v => if prev0 >= v then prev0 - v - else Result.ret (U64.ofInt 0) + else Result.ret 0#u64 /- [betree_main::betree::List::{1}::len]: forward function -/ divergent def betree.List.len (T : Type) (self : betree.List T) : Result U64 := match self with - | betree.List.Cons t tl => - do - let i ← betree.List.len T tl - (U64.ofInt 1) + i - | betree.List.Nil => Result.ret (U64.ofInt 0) + | betree.List.Cons t tl => do + let i ← betree.List.len T tl + 1#u64 + i + | betree.List.Nil => Result.ret 0#u64 /- [betree_main::betree::List::{1}::split_at]: forward function -/ divergent def betree.List.split_at (T : Type) (self : betree.List T) (n : U64) : Result ((betree.List T) × (betree.List T)) := - if n = (U64.ofInt 0) + if n = 0#u64 then Result.ret (betree.List.Nil, self) else match self with | betree.List.Cons hd tl => do - let i ← n - (U64.ofInt 1) + let i ← n - 1#u64 let p ← betree.List.split_at T tl i let (ls0, ls1) := p let l := ls0 @@ -116,13 +115,13 @@ divergent def betree.List.split_at (there is a single backward function, and the forward function returns ()) -/ def betree.List.push_front (T : Type) (self : betree.List T) (x : T) : Result (betree.List T) := - let tl := mem.replace (betree.List T) self betree.List.Nil + let tl := core.mem.replace (betree.List T) self betree.List.Nil let l := tl Result.ret (betree.List.Cons x l) /- [betree_main::betree::List::{1}::pop_front]: forward function -/ def betree.List.pop_front (T : Type) (self : betree.List T) : Result T := - let ls := mem.replace (betree.List T) self betree.List.Nil + let ls := core.mem.replace (betree.List T) self betree.List.Nil match ls with | betree.List.Cons x tl => Result.ret x | betree.List.Nil => Result.fail Error.panic @@ -130,7 +129,7 @@ def betree.List.pop_front (T : Type) (self : betree.List T) : Result T := /- [betree_main::betree::List::{1}::pop_front]: backward function 0 -/ def betree.List.pop_front_back (T : Type) (self : betree.List T) : Result (betree.List T) := - let ls := mem.replace (betree.List T) self betree.List.Nil + let ls := core.mem.replace (betree.List T) self betree.List.Nil match ls with | betree.List.Cons x tl => Result.ret tl | betree.List.Nil => Result.fail Error.panic @@ -256,7 +255,7 @@ divergent def betree.Node.apply_upserts let v ← betree.upsert_update prev s let msgs0 ← betree.List.pop_front_back (U64 × betree.Message) msgs - betree.Node.apply_upserts msgs0 (Option.some v) key st + betree.Node.apply_upserts msgs0 (some v) key st else do let (st0, v) ← core.option.Option.unwrap U64 prev st @@ -286,7 +285,7 @@ divergent def betree.Node.apply_upserts_back let v ← betree.upsert_update prev s let msgs0 ← betree.List.pop_front_back (U64 × betree.Message) msgs - betree.Node.apply_upserts_back msgs0 (Option.some v) key st + betree.Node.apply_upserts_back msgs0 (some v) key st else do let (_, v) ← core.option.Option.unwrap U64 prev st @@ -300,12 +299,12 @@ divergent def betree.Node.lookup_in_bindings | betree.List.Cons hd tl => let (i, i0) := hd if i = key - then Result.ret (Option.some i0) + then Result.ret (some i0) else if i > key - then Result.ret Option.none + then Result.ret none else betree.Node.lookup_in_bindings key tl - | betree.List.Nil => Result.ret Option.none + | betree.List.Nil => Result.ret none /- [betree_main::betree::Internal::{4}::lookup_in_children]: forward function -/ mutual divergent def betree.Internal.lookup_in_children @@ -348,13 +347,13 @@ divergent def betree.Node.lookup if k != key then do - let (st1, opt) ← + let (st1, o) ← betree.Internal.lookup_in_children (betree.Internal.mk i i0 n n0) key st0 let _ ← betree.Node.lookup_first_message_for_key_back key msgs (betree.List.Cons (k, msg) l) - Result.ret (st1, opt) + Result.ret (st1, o) else match msg with | betree.Message.Insert v => @@ -362,13 +361,13 @@ divergent def betree.Node.lookup let _ ← betree.Node.lookup_first_message_for_key_back key msgs (betree.List.Cons (k, betree.Message.Insert v) l) - Result.ret (st0, Option.some v) + Result.ret (st0, some v) | betree.Message.Delete => do let _ ← betree.Node.lookup_first_message_for_key_back key msgs (betree.List.Cons (k, betree.Message.Delete) l) - Result.ret (st0, Option.none) + Result.ret (st0, none) | betree.Message.Upsert ufs => do let (st1, v) ← @@ -387,21 +386,21 @@ divergent def betree.Node.lookup let msgs0 ← betree.Node.lookup_first_message_for_key_back key msgs pending0 let (st3, _) ← betree.store_internal_node i1 msgs0 st2 - Result.ret (st3, Option.some v0) + Result.ret (st3, some v0) | betree.List.Nil => do - let (st1, opt) ← + let (st1, o) ← betree.Internal.lookup_in_children (betree.Internal.mk i i0 n n0) key st0 let _ ← betree.Node.lookup_first_message_for_key_back key msgs betree.List.Nil - Result.ret (st1, opt) + Result.ret (st1, o) | betree.Node.Leaf node => do let (st0, bindings) ← betree.load_leaf_node node.id st - let opt ← betree.Node.lookup_in_bindings key bindings - Result.ret (st0, opt) + let o ← betree.Node.lookup_in_bindings key bindings + Result.ret (st0, o) /- [betree_main::betree::Node::{5}::lookup]: backward function 0 -/ divergent def betree.Node.lookup_back @@ -560,7 +559,7 @@ def betree.Node.apply_to_internal match m with | betree.Message.Insert prev => do - let v ← betree.upsert_update (Option.some prev) s + let v ← betree.upsert_update (some prev) s let msgs1 ← betree.List.pop_front_back (U64 × betree.Message) msgs0 let msgs2 ← @@ -569,7 +568,7 @@ def betree.Node.apply_to_internal betree.Node.lookup_first_message_for_key_back key msgs msgs2 | betree.Message.Delete => do - let v ← betree.upsert_update Option.none s + let v ← betree.upsert_update none s let msgs1 ← betree.List.pop_front_back (U64 × betree.Message) msgs0 let msgs2 ← @@ -665,7 +664,7 @@ def betree.Node.apply_to_leaf | betree.Message.Upsert s => do let (_, i) := hd - let v ← betree.upsert_update (Option.some i) s + let v ← betree.upsert_update (some i) s let bindings1 ← betree.List.pop_front_back (U64 × U64) bindings0 let bindings2 ← betree.List.push_front (U64 × U64) bindings1 (key, v) @@ -681,7 +680,7 @@ def betree.Node.apply_to_leaf betree.Node.lookup_mut_in_bindings_back key bindings bindings0 | betree.Message.Upsert s => do - let v ← betree.upsert_update Option.none s + let v ← betree.upsert_update none s let bindings1 ← betree.List.push_front (U64 × U64) bindings0 (key, v) betree.Node.lookup_mut_in_bindings_back key bindings bindings1 @@ -808,7 +807,7 @@ divergent def betree.Node.apply_messages let (st0, content) ← betree.load_leaf_node node.id st let content0 ← betree.Node.apply_messages_to_leaf content msgs let len ← betree.List.len (U64 × U64) content0 - let i ← (U64.ofInt 2) * params.split_size + let i ← 2#u64 * params.split_size if len >= i then do @@ -858,7 +857,7 @@ divergent def betree.Node.apply_messages_back let (st0, content) ← betree.load_leaf_node node.id st let content0 ← betree.Node.apply_messages_to_leaf content msgs let len ← betree.List.len (U64 × U64) content0 - let i ← (U64.ofInt 2) * params.split_size + let i ← 2#u64 * params.split_size if len >= i then do @@ -918,7 +917,7 @@ def betree.BeTree.new params := { min_flush_size := min_flush_size, split_size := split_size }, node_id_cnt := node_id_cnt0, - root := (betree.Node.Leaf { id := id, size := (U64.ofInt 0) }) + root := (betree.Node.Leaf { id := id, size := 0#u64 }) }) /- [betree_main::betree::BeTree::{6}::apply]: forward function -/ -- cgit v1.3.1 From 7ffcb8e9c5c03f198362fd27bd42f30064541509 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 15:06:36 +0200 Subject: Fix some issues and regenerate the HashmapMain example for Lean --- compiler/ExtractBuiltin.ml | 11 +- compiler/FunsAnalysis.ml | 11 +- compiler/InterpreterExpressions.ml | 3 +- tests/lean/HashmapMain/Funs.lean | 226 +++++++++++++++++++++---------------- tests/lean/HashmapMain/Types.lean | 2 +- 5 files changed, 147 insertions(+), 106 deletions(-) (limited to 'tests/lean') diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 363955bf..2dbacce3 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -381,6 +381,7 @@ let builtin_fun_effects = let int_funs = List.concat int_funs in let no_fail_no_state_funs = [ + (* TODO: redundancy with the funs information below *) "alloc::vec::Vec::new"; "alloc::vec::Vec::len"; "alloc::boxed::Box::deref"; @@ -395,7 +396,15 @@ let builtin_fun_effects = (fun n -> (n, { can_fail = false; stateful = false })) no_fail_no_state_funs in - let no_state_funs = [ "alloc::vec::Vec::push" ] in + let no_state_funs = + [ + (* TODO: redundancy with the funs information below *) + "alloc::vec::Vec::push"; + "alloc::vec::Vec::index"; + "alloc::vec::Vec::index_mut"; + "alloc::vec::Vec::index_mut_back"; + ] + in let no_state_funs = List.map (fun n -> (n, { can_fail = true; stateful = false })) no_state_funs in diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml index 9eac3e6f..69c0df71 100644 --- a/compiler/FunsAnalysis.ml +++ b/compiler/FunsAnalysis.ml @@ -76,6 +76,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) object (self) inherit [_] iter_statement as super method may_fail b = can_fail := !can_fail || b + method maybe_stateful b = stateful := !stateful || b method! visit_Assert env a = self#may_fail true; @@ -126,14 +127,14 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) | None -> let info_can_fail, info_stateful = match builtin_info with - | None -> (true, false) + | None -> (true, use_state) | Some { can_fail; stateful } -> (can_fail, stateful) in obj#may_fail info_can_fail; - stateful := - (not f.is_global_decl_body) - && use_state - && not (has_builtin_info && not info_stateful) + obj#maybe_stateful + (if f.is_global_decl_body then false + else if not use_state then false + else info_stateful) | Some body -> obj#visit_statement () body.body in List.iter visit_fun d; diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml index 341e97eb..245f3b77 100644 --- a/compiler/InterpreterExpressions.ml +++ b/compiler/InterpreterExpressions.ml @@ -144,7 +144,8 @@ let rec copy_value (allow_adt_copy : bool) (config : C.config) (match v.V.ty with | T.Adt (T.Assumed T.Box, _) -> raise (Failure "Can't copy an assumed value other than Option") - | T.Adt (T.AdtId _, _) -> assert allow_adt_copy + | T.Adt (T.AdtId _, _) as ty -> + assert (allow_adt_copy || ty_is_primitively_copyable ty) | T.Adt (T.Tuple, _) -> () (* Ok *) | T.Adt ( T.Assumed (Slice | T.Array), diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index 848b1a35..74fa8653 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -13,21 +13,21 @@ def hashmap.hash_key (k : Usize) : Result Usize := /- [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: loop 0: forward function -/ divergent def hashmap.HashMap.allocate_slots_loop - (T : Type) (slots : Vec (hashmap.List T)) (n : Usize) : - Result (Vec (hashmap.List T)) + (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (n : Usize) : + Result (alloc.vec.Vec (hashmap.List T)) := - if n > (Usize.ofInt 0) + if n > 0#usize then do - let slots0 ← Vec.push (hashmap.List T) slots hashmap.List.Nil - let n0 ← n - (Usize.ofInt 1) + let slots0 ← alloc.vec.Vec.push (hashmap.List T) slots hashmap.List.Nil + let n0 ← n - 1#usize hashmap.HashMap.allocate_slots_loop T slots0 n0 else Result.ret slots /- [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: forward function -/ def hashmap.HashMap.allocate_slots - (T : Type) (slots : Vec (hashmap.List T)) (n : Usize) : - Result (Vec (hashmap.List T)) + (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (n : Usize) : + Result (alloc.vec.Vec (hashmap.List T)) := hashmap.HashMap.allocate_slots_loop T slots n @@ -38,13 +38,13 @@ def hashmap.HashMap.new_with_capacity Result (hashmap.HashMap T) := do - let v := Vec.new (hashmap.List T) + let v := alloc.vec.Vec.new (hashmap.List T) let slots ← hashmap.HashMap.allocate_slots T v capacity let i ← capacity * max_load_dividend let i0 ← i / max_load_divisor Result.ret { - num_entries := (Usize.ofInt 0), + num_entries := 0#usize, max_load_factor := (max_load_dividend, max_load_divisor), max_load := i0, slots := slots @@ -52,22 +52,23 @@ def hashmap.HashMap.new_with_capacity /- [hashmap_main::hashmap::HashMap::{0}::new]: forward function -/ def hashmap.HashMap.new (T : Type) : Result (hashmap.HashMap T) := - hashmap.HashMap.new_with_capacity T (Usize.ofInt 32) (Usize.ofInt 4) - (Usize.ofInt 5) + hashmap.HashMap.new_with_capacity T 32#usize 4#usize 5#usize /- [hashmap_main::hashmap::HashMap::{0}::clear]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ divergent def hashmap.HashMap.clear_loop - (T : Type) (slots : Vec (hashmap.List T)) (i : Usize) : - Result (Vec (hashmap.List T)) + (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : + Result (alloc.vec.Vec (hashmap.List T)) := - let i0 := Vec.len (hashmap.List T) slots + let i0 := alloc.vec.Vec.len (hashmap.List T) slots if i < i0 then do - let i1 ← i + (Usize.ofInt 1) + let i1 ← i + 1#usize let slots0 ← - Vec.index_mut_back (hashmap.List T) slots i hashmap.List.Nil + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) slots i hashmap.List.Nil hashmap.HashMap.clear_loop T slots0 i1 else Result.ret slots @@ -76,8 +77,8 @@ divergent def hashmap.HashMap.clear_loop def hashmap.HashMap.clear (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do - let v ← hashmap.HashMap.clear_loop T self.slots (Usize.ofInt 0) - Result.ret { self with num_entries := (Usize.ofInt 0), slots := v } + let v ← hashmap.HashMap.clear_loop T self.slots 0#usize + Result.ret { self with num_entries := 0#usize, slots := v } /- [hashmap_main::hashmap::HashMap::{0}::len]: forward function -/ def hashmap.HashMap.len (T : Type) (self : hashmap.HashMap T) : Result Usize := @@ -130,21 +131,30 @@ def hashmap.HashMap.insert_no_resize := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod let inserted ← hashmap.HashMap.insert_in_list T key value l if inserted then do - let i0 ← self.num_entries + (Usize.ofInt 1) + let i0 ← self.num_entries + 1#usize let l0 ← hashmap.HashMap.insert_in_list_back T key value l - let v ← Vec.index_mut_back (hashmap.List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) self.slots hash_mod l0 Result.ret { self with num_entries := i0, slots := v } else do let l0 ← hashmap.HashMap.insert_in_list_back T key value l - let v ← Vec.index_mut_back (hashmap.List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) self.slots hash_mod l0 Result.ret { self with slots := v } /- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: loop 0: merged forward/backward function @@ -171,29 +181,35 @@ def hashmap.HashMap.move_elements_from_list /- [hashmap_main::hashmap::HashMap::{0}::move_elements]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ divergent def hashmap.HashMap.move_elements_loop - (T : Type) (ntable : hashmap.HashMap T) (slots : Vec (hashmap.List T)) - (i : Usize) : - Result ((hashmap.HashMap T) × (Vec (hashmap.List T))) + (T : Type) (ntable : hashmap.HashMap T) + (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : + Result ((hashmap.HashMap T) × (alloc.vec.Vec (hashmap.List T))) := - let i0 := Vec.len (hashmap.List T) slots + let i0 := alloc.vec.Vec.len (hashmap.List T) slots if i < i0 then do - let l ← Vec.index_mut (hashmap.List T) slots i - let ls := mem.replace (hashmap.List T) l hashmap.List.Nil + let l ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) slots i + let ls := core.mem.replace (hashmap.List T) l hashmap.List.Nil let ntable0 ← hashmap.HashMap.move_elements_from_list T ntable ls - let i1 ← i + (Usize.ofInt 1) - let l0 := mem.replace_back (hashmap.List T) l hashmap.List.Nil - let slots0 ← Vec.index_mut_back (hashmap.List T) slots i l0 + let i1 ← i + 1#usize + let l0 := core.mem.replace_back (hashmap.List T) l hashmap.List.Nil + let slots0 ← + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) slots i l0 hashmap.HashMap.move_elements_loop T ntable0 slots0 i1 else Result.ret (ntable, slots) /- [hashmap_main::hashmap::HashMap::{0}::move_elements]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ def hashmap.HashMap.move_elements - (T : Type) (ntable : hashmap.HashMap T) (slots : Vec (hashmap.List T)) - (i : Usize) : - Result ((hashmap.HashMap T) × (Vec (hashmap.List T))) + (T : Type) (ntable : hashmap.HashMap T) + (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : + Result ((hashmap.HashMap T) × (alloc.vec.Vec (hashmap.List T))) := hashmap.HashMap.move_elements_loop T ntable slots i @@ -203,17 +219,17 @@ def hashmap.HashMap.try_resize (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do let max_usize ← Scalar.cast .Usize core_u32_max - let capacity := Vec.len (hashmap.List T) self.slots - let n1 ← max_usize / (Usize.ofInt 2) + let capacity := alloc.vec.Vec.len (hashmap.List T) self.slots + let n1 ← max_usize / 2#usize let (i, i0) := self.max_load_factor let i1 ← n1 / i if capacity <= i1 then do - let i2 ← capacity * (Usize.ofInt 2) + let i2 ← capacity * 2#usize let ntable ← hashmap.HashMap.new_with_capacity T i2 i i0 let (ntable0, _) ← - hashmap.HashMap.move_elements T ntable self.slots (Usize.ofInt 0) + hashmap.HashMap.move_elements T ntable self.slots 0#usize Result.ret { ntable0 @@ -255,9 +271,12 @@ def hashmap.HashMap.contains_key (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result Bool := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_shared (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod hashmap.HashMap.contains_key_in_list T key l /- [hashmap_main::hashmap::HashMap::{0}::get_in_list]: loop 0: forward function -/ @@ -280,9 +299,12 @@ def hashmap.HashMap.get (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result T := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_shared (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod hashmap.HashMap.get_in_list T key l /- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: loop 0: forward function -/ @@ -327,9 +349,12 @@ def hashmap.HashMap.get_mut (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result T := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod hashmap.HashMap.get_mut_in_list T l key /- [hashmap_main::hashmap::HashMap::{0}::get_mut]: backward function 0 -/ @@ -339,11 +364,17 @@ def hashmap.HashMap.get_mut_back := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod let l0 ← hashmap.HashMap.get_mut_in_list_back T l key ret0 - let v ← Vec.index_mut_back (hashmap.List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod l0 Result.ret { self with slots := v } /- [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: loop 0: forward function -/ @@ -354,13 +385,13 @@ divergent def hashmap.HashMap.remove_from_list_loop if ckey = key then let mv_ls := - mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) + core.mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) hashmap.List.Nil match mv_ls with - | hashmap.List.Cons i cvalue tl0 => Result.ret (Option.some cvalue) + | hashmap.List.Cons i cvalue tl0 => Result.ret (some cvalue) | hashmap.List.Nil => Result.fail Error.panic else hashmap.HashMap.remove_from_list_loop T key tl - | hashmap.List.Nil => Result.ret Option.none + | hashmap.List.Nil => Result.ret none /- [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: forward function -/ def hashmap.HashMap.remove_from_list @@ -375,7 +406,7 @@ divergent def hashmap.HashMap.remove_from_list_loop_back if ckey = key then let mv_ls := - mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) + core.mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) hashmap.List.Nil match mv_ls with | hashmap.List.Cons i cvalue tl0 => Result.ret tl0 @@ -396,16 +427,18 @@ def hashmap.HashMap.remove (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result (Option T) := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod let x ← hashmap.HashMap.remove_from_list T key l match x with - | Option.none => Result.ret Option.none - | Option.some x0 => - do - let _ ← self.num_entries - (Usize.ofInt 1) - Result.ret (Option.some x0) + | none => Result.ret none + | some x0 => do + let _ ← self.num_entries - 1#usize + Result.ret (some x0) /- [hashmap_main::hashmap::HashMap::{0}::remove]: backward function 0 -/ def hashmap.HashMap.remove_back @@ -414,75 +447,75 @@ def hashmap.HashMap.remove_back := do let hash ← hashmap.hash_key key - let i := Vec.len (hashmap.List T) self.slots + let i := alloc.vec.Vec.len (hashmap.List T) self.slots let hash_mod ← hash % i - let l ← Vec.index_mut (hashmap.List T) self.slots hash_mod + let l ← + alloc.vec.Vec.index_mut (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List T)) + self.slots hash_mod let x ← hashmap.HashMap.remove_from_list T key l match x with - | Option.none => + | none => do let l0 ← hashmap.HashMap.remove_from_list_back T key l - let v ← Vec.index_mut_back (hashmap.List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) self.slots hash_mod l0 Result.ret { self with slots := v } - | Option.some x0 => + | some x0 => do - let i0 ← self.num_entries - (Usize.ofInt 1) + let i0 ← self.num_entries - 1#usize let l0 ← hashmap.HashMap.remove_from_list_back T key l - let v ← Vec.index_mut_back (hashmap.List T) self.slots hash_mod l0 + let v ← + alloc.vec.Vec.index_mut_back (hashmap.List T) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (hashmap.List + T)) self.slots hash_mod l0 Result.ret { self with num_entries := i0, slots := v } /- [hashmap_main::hashmap::test1]: forward function -/ def hashmap.test1 : Result Unit := do let hm ← hashmap.HashMap.new U64 - let hm0 ← hashmap.HashMap.insert U64 hm (Usize.ofInt 0) (U64.ofInt 42) - let hm1 ← hashmap.HashMap.insert U64 hm0 (Usize.ofInt 128) (U64.ofInt 18) - let hm2 ← - hashmap.HashMap.insert U64 hm1 (Usize.ofInt 1024) (U64.ofInt 138) - let hm3 ← - hashmap.HashMap.insert U64 hm2 (Usize.ofInt 1056) (U64.ofInt 256) - let i ← hashmap.HashMap.get U64 hm3 (Usize.ofInt 128) - if not (i = (U64.ofInt 18)) + let hm0 ← hashmap.HashMap.insert U64 hm 0#usize 42#u64 + let hm1 ← hashmap.HashMap.insert U64 hm0 128#usize 18#u64 + let hm2 ← hashmap.HashMap.insert U64 hm1 1024#usize 138#u64 + let hm3 ← hashmap.HashMap.insert U64 hm2 1056#usize 256#u64 + let i ← hashmap.HashMap.get U64 hm3 128#usize + if not (i = 18#u64) then Result.fail Error.panic else do - let hm4 ← - hashmap.HashMap.get_mut_back U64 hm3 (Usize.ofInt 1024) - (U64.ofInt 56) - let i0 ← hashmap.HashMap.get U64 hm4 (Usize.ofInt 1024) - if not (i0 = (U64.ofInt 56)) + let hm4 ← hashmap.HashMap.get_mut_back U64 hm3 1024#usize 56#u64 + let i0 ← hashmap.HashMap.get U64 hm4 1024#usize + if not (i0 = 56#u64) then Result.fail Error.panic else do - let x ← hashmap.HashMap.remove U64 hm4 (Usize.ofInt 1024) + let x ← hashmap.HashMap.remove U64 hm4 1024#usize match x with - | Option.none => Result.fail Error.panic - | Option.some x0 => - if not (x0 = (U64.ofInt 56)) + | none => Result.fail Error.panic + | some x0 => + if not (x0 = 56#u64) then Result.fail Error.panic else do - let hm5 ← - hashmap.HashMap.remove_back U64 hm4 (Usize.ofInt 1024) - let i1 ← hashmap.HashMap.get U64 hm5 (Usize.ofInt 0) - if not (i1 = (U64.ofInt 42)) + let hm5 ← hashmap.HashMap.remove_back U64 hm4 1024#usize + let i1 ← hashmap.HashMap.get U64 hm5 0#usize + if not (i1 = 42#u64) then Result.fail Error.panic else do - let i2 ← hashmap.HashMap.get U64 hm5 (Usize.ofInt 128) - if not (i2 = (U64.ofInt 18)) + let i2 ← hashmap.HashMap.get U64 hm5 128#usize + if not (i2 = 18#u64) then Result.fail Error.panic else do - let i3 ← - hashmap.HashMap.get U64 hm5 (Usize.ofInt 1056) - if not (i3 = (U64.ofInt 256)) + let i3 ← hashmap.HashMap.get U64 hm5 1056#usize + if not (i3 = 256#u64) then Result.fail Error.panic else Result.ret () -/- Unit test for [hashmap_main::hashmap::test1] -/ -#assert (hashmap.test1 == .ret ()) - /- [hashmap_main::insert_on_disk]: forward function -/ def insert_on_disk (key : Usize) (value : U64) (st : State) : Result (State × Unit) := @@ -496,7 +529,4 @@ def insert_on_disk def main : Result Unit := Result.ret () -/- Unit test for [hashmap_main::main] -/ -#assert (main == .ret ()) - end hashmap_main diff --git a/tests/lean/HashmapMain/Types.lean b/tests/lean/HashmapMain/Types.lean index 2b5cbd6c..065c109b 100644 --- a/tests/lean/HashmapMain/Types.lean +++ b/tests/lean/HashmapMain/Types.lean @@ -15,7 +15,7 @@ structure hashmap.HashMap (T : Type) where num_entries : Usize max_load_factor : (Usize × Usize) max_load : Usize - slots : Vec (hashmap.List T) + slots : alloc.vec.Vec (hashmap.List T) /- The state type used in the state-error monad -/ axiom State : Type -- cgit v1.3.1 From 4f824528f5e0c0f898b20917c6c06821efb934da Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 27 Oct 2023 12:12:18 +0200 Subject: Regenerate some of the F* test files --- backends/fstar/Primitives.fst | 21 +- tests/fstar/array/Primitives.fst | 19 +- tests/fstar/betree/Primitives.fst | 19 +- tests/fstar/betree_back_stateful/Primitives.fst | 19 +- tests/fstar/hashmap/Primitives.fst | 19 +- tests/fstar/hashmap_on_disk/Primitives.fst | 19 +- tests/fstar/misc/Constants.fst | 46 +-- tests/fstar/misc/External.Funs.fst | 38 +-- tests/fstar/misc/External.Opaque.fsti | 8 +- tests/fstar/misc/External.Types.fsti | 2 +- tests/fstar/misc/Loops.Clauses.Template.fst | 3 +- tests/fstar/misc/Loops.Clauses.fst | 2 +- tests/fstar/misc/Loops.Funs.fst | 392 ++++++++++++------------ tests/fstar/misc/Loops.Types.fst | 4 +- tests/fstar/misc/NoNestedBorrows.fst | 266 ++++++++-------- tests/fstar/misc/Paper.fst | 65 ++-- tests/fstar/misc/PoloniusList.fst | 18 +- tests/fstar/misc/Primitives.fst | 21 +- tests/lean/Constants.lean | 8 +- 19 files changed, 549 insertions(+), 440 deletions(-) (limited to 'tests/lean') diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 5e154122..71d75c11 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,13 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x)] + = + admit() diff --git a/tests/fstar/array/Primitives.fst b/tests/fstar/array/Primitives.fst index 5e154122..3110b247 100644 --- a/tests/fstar/array/Primitives.fst +++ b/tests/fstar/array/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,11 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) = + admit() diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index 5e154122..3110b247 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,11 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) = + admit() diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst index 5e154122..3110b247 100644 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ b/tests/fstar/betree_back_stateful/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,11 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) = + admit() diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index 5e154122..3110b247 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,11 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) = + admit() diff --git a/tests/fstar/hashmap_on_disk/Primitives.fst b/tests/fstar/hashmap_on_disk/Primitives.fst index 5e154122..3110b247 100644 --- a/tests/fstar/hashmap_on_disk/Primitives.fst +++ b/tests/fstar/hashmap_on_disk/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,11 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) = + admit() diff --git a/tests/fstar/misc/Constants.fst b/tests/fstar/misc/Constants.fst index 7dfb6f36..c21d6a5f 100644 --- a/tests/fstar/misc/Constants.fst +++ b/tests/fstar/misc/Constants.fst @@ -18,30 +18,30 @@ let x2_body : result u32 = Return 3 let x2_c : u32 = eval_global x2_body (** [constants::incr]: forward function *) -let incr_fwd (n : u32) : result u32 = +let incr (n : u32) : result u32 = u32_add n 1 (** [constants::X3] *) -let x3_body : result u32 = incr_fwd 32 +let x3_body : result u32 = incr 32 let x3_c : u32 = eval_global x3_body (** [constants::mk_pair0]: forward function *) -let mk_pair0_fwd (x : u32) (y : u32) : result (u32 & u32) = +let mk_pair0 (x : u32) (y : u32) : result (u32 & u32) = Return (x, y) (** [constants::Pair] *) -type pair_t (t1 t2 : Type0) = { pair_x : t1; pair_y : t2; } +type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } (** [constants::mk_pair1]: forward function *) -let mk_pair1_fwd (x : u32) (y : u32) : result (pair_t u32 u32) = - Return { pair_x = x; pair_y = y } +let mk_pair1 (x : u32) (y : u32) : result (pair_t u32 u32) = + Return { x = x; y = y } (** [constants::P0] *) -let p0_body : result (u32 & u32) = mk_pair0_fwd 0 1 +let p0_body : result (u32 & u32) = mk_pair0 0 1 let p0_c : (u32 & u32) = eval_global p0_body (** [constants::P1] *) -let p1_body : result (pair_t u32 u32) = mk_pair1_fwd 0 1 +let p1_body : result (pair_t u32 u32) = mk_pair1 0 1 let p1_c : pair_t u32 u32 = eval_global p1_body (** [constants::P2] *) @@ -49,26 +49,26 @@ let p2_body : result (u32 & u32) = Return (0, 1) let p2_c : (u32 & u32) = eval_global p2_body (** [constants::P3] *) -let p3_body : result (pair_t u32 u32) = Return { pair_x = 0; pair_y = 1 } +let p3_body : result (pair_t u32 u32) = Return { x = 0; y = 1 } let p3_c : pair_t u32 u32 = eval_global p3_body (** [constants::Wrap] *) -type wrap_t (t : Type0) = { wrap_val : t; } +type wrap_t (t : Type0) = { value : t; } (** [constants::Wrap::{0}::new]: forward function *) -let wrap_new_fwd (t : Type0) (val0 : t) : result (wrap_t t) = - Return { wrap_val = val0 } +let wrap_new (t : Type0) (value : t) : result (wrap_t t) = + Return { value = value } (** [constants::Y] *) -let y_body : result (wrap_t i32) = wrap_new_fwd i32 2 +let y_body : result (wrap_t i32) = wrap_new i32 2 let y_c : wrap_t i32 = eval_global y_body (** [constants::unwrap_y]: forward function *) -let unwrap_y_fwd : result i32 = - Return y_c.wrap_val +let unwrap_y : result i32 = + Return y_c.value (** [constants::YVAL] *) -let yval_body : result i32 = unwrap_y_fwd +let yval_body : result i32 = unwrap_y let yval_c : i32 = eval_global yval_body (** [constants::get_z1::Z1] *) @@ -76,11 +76,11 @@ let get_z1_z1_body : result i32 = Return 3 let get_z1_z1_c : i32 = eval_global get_z1_z1_body (** [constants::get_z1]: forward function *) -let get_z1_fwd : result i32 = +let get_z1 : result i32 = Return get_z1_z1_c (** [constants::add]: forward function *) -let add_fwd (a : i32) (b : i32) : result i32 = +let add (a : i32) (b : i32) : result i32 = i32_add a b (** [constants::Q1] *) @@ -92,19 +92,19 @@ let q2_body : result i32 = Return q1_c let q2_c : i32 = eval_global q2_body (** [constants::Q3] *) -let q3_body : result i32 = add_fwd q2_c 3 +let q3_body : result i32 = add q2_c 3 let q3_c : i32 = eval_global q3_body (** [constants::get_z2]: forward function *) -let get_z2_fwd : result i32 = - let* i = get_z1_fwd in let* i0 = add_fwd i q3_c in add_fwd q1_c i0 +let get_z2 : result i32 = + let* i = get_z1 in let* i0 = add i q3_c in add q1_c i0 (** [constants::S1] *) let s1_body : result u32 = Return 6 let s1_c : u32 = eval_global s1_body (** [constants::S2] *) -let s2_body : result u32 = incr_fwd s1_c +let s2_body : result u32 = incr s1_c let s2_c : u32 = eval_global s2_body (** [constants::S3] *) @@ -112,6 +112,6 @@ let s3_body : result (pair_t u32 u32) = Return p3_c let s3_c : pair_t u32 u32 = eval_global s3_body (** [constants::S4] *) -let s4_body : result (pair_t u32 u32) = mk_pair1_fwd 7 8 +let s4_body : result (pair_t u32 u32) = mk_pair1 7 8 let s4_c : pair_t u32 u32 = eval_global s4_body diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst index f118a2cf..e26014ac 100644 --- a/tests/fstar/misc/External.Funs.fst +++ b/tests/fstar/misc/External.Funs.fst @@ -8,8 +8,8 @@ include External.Opaque #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [external::swap]: forward function *) -let swap_fwd (t : Type0) (x : t) (y : t) (st : state) : result (state & unit) = - let* (st0, _) = core_mem_swap_fwd t x y st in +let swap (t : Type0) (x : t) (y : t) (st : state) : result (state & unit) = + let* (st0, _) = core_mem_swap t x y st in let* (st1, _) = core_mem_swap_back0 t x y st st0 in let* (st2, _) = core_mem_swap_back1 t x y st st1 in Return (st2, ()) @@ -19,28 +19,29 @@ let swap_back (t : Type0) (x : t) (y : t) (st : state) (st0 : state) : result (state & (t & t)) = - let* (st1, _) = core_mem_swap_fwd t x y st in + let* (st1, _) = core_mem_swap t x y st in let* (st2, x0) = core_mem_swap_back0 t x y st st1 in let* (_, y0) = core_mem_swap_back1 t x y st st2 in Return (st0, (x0, y0)) (** [external::test_new_non_zero_u32]: forward function *) -let test_new_non_zero_u32_fwd - (x : u32) (st : state) : result (state & core_num_nonzero_non_zero_u32_t) = - let* (st0, opt) = core_num_nonzero_non_zero_u32_new_fwd x st in - core_option_option_unwrap_fwd core_num_nonzero_non_zero_u32_t opt st0 +let test_new_non_zero_u32 + (x : u32) (st : state) : result (state & core_num_nonzero_NonZeroU32_t) = + let* (st0, o) = core_num_nonzero_NonZeroU32_new x st in + core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st0 (** [external::test_vec]: forward function *) -let test_vec_fwd : result unit = - let v = vec_new u32 in let* _ = vec_push_back u32 v 0 in Return () +let test_vec : result unit = + let v = alloc_vec_Vec_new u32 in + let* _ = alloc_vec_Vec_push u32 v 0 in + Return () (** Unit test for [external::test_vec] *) -let _ = assert_norm (test_vec_fwd = Return ()) +let _ = assert_norm (test_vec = Return ()) (** [external::custom_swap]: forward function *) -let custom_swap_fwd - (t : Type0) (x : t) (y : t) (st : state) : result (state & t) = - let* (st0, _) = core_mem_swap_fwd t x y st in +let custom_swap (t : Type0) (x : t) (y : t) (st : state) : result (state & t) = + let* (st0, _) = core_mem_swap t x y st in let* (st1, x0) = core_mem_swap_back0 t x y st st0 in let* (st2, _) = core_mem_swap_back1 t x y st st1 in Return (st2, x0) @@ -50,15 +51,14 @@ let custom_swap_back (t : Type0) (x : t) (y : t) (st : state) (ret : t) (st0 : state) : result (state & (t & t)) = - let* (st1, _) = core_mem_swap_fwd t x y st in + let* (st1, _) = core_mem_swap t x y st in let* (st2, _) = core_mem_swap_back0 t x y st st1 in let* (_, y0) = core_mem_swap_back1 t x y st st2 in Return (st0, (ret, y0)) (** [external::test_custom_swap]: forward function *) -let test_custom_swap_fwd - (x : u32) (y : u32) (st : state) : result (state & unit) = - let* (st0, _) = custom_swap_fwd u32 x y st in Return (st0, ()) +let test_custom_swap (x : u32) (y : u32) (st : state) : result (state & unit) = + let* (st0, _) = custom_swap u32 x y st in Return (st0, ()) (** [external::test_custom_swap]: backward function 0 *) let test_custom_swap_back @@ -68,8 +68,8 @@ let test_custom_swap_back custom_swap_back u32 x y st 1 st0 (** [external::test_swap_non_zero]: forward function *) -let test_swap_non_zero_fwd (x : u32) (st : state) : result (state & u32) = - let* (st0, _) = swap_fwd u32 x 0 st in +let test_swap_non_zero (x : u32) (st : state) : result (state & u32) = + let* (st0, _) = swap u32 x 0 st in let* (st1, (x0, _)) = swap_back u32 x 0 st st0 in if x0 = 0 then Fail Failure else Return (st1, x0) diff --git a/tests/fstar/misc/External.Opaque.fsti b/tests/fstar/misc/External.Opaque.fsti index 2e19f767..85cf285c 100644 --- a/tests/fstar/misc/External.Opaque.fsti +++ b/tests/fstar/misc/External.Opaque.fsti @@ -7,7 +7,7 @@ include External.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [core::mem::swap]: forward function *) -val core_mem_swap_fwd (t : Type0) : t -> t -> state -> result (state & unit) +val core_mem_swap (t : Type0) : t -> t -> state -> result (state & unit) (** [core::mem::swap]: backward function 0 *) val core_mem_swap_back0 @@ -18,10 +18,10 @@ val core_mem_swap_back1 (t : Type0) : t -> t -> state -> state -> result (state & t) (** [core::num::nonzero::NonZeroU32::{14}::new]: forward function *) -val core_num_nonzero_non_zero_u32_new_fwd - : u32 -> state -> result (state & (option core_num_nonzero_non_zero_u32_t)) +val core_num_nonzero_NonZeroU32_new + : u32 -> state -> result (state & (option core_num_nonzero_NonZeroU32_t)) (** [core::option::Option::{0}::unwrap]: forward function *) -val core_option_option_unwrap_fwd +val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/misc/External.Types.fsti b/tests/fstar/misc/External.Types.fsti index 4a13a744..78b5228d 100644 --- a/tests/fstar/misc/External.Types.fsti +++ b/tests/fstar/misc/External.Types.fsti @@ -6,7 +6,7 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [core::num::nonzero::NonZeroU32] *) -val core_num_nonzero_non_zero_u32_t : Type0 +val core_num_nonzero_NonZeroU32_t : Type0 (** The state type used in the state-error monad *) val state : Type0 diff --git a/tests/fstar/misc/Loops.Clauses.Template.fst b/tests/fstar/misc/Loops.Clauses.Template.fst index 053b7663..9920bdc1 100644 --- a/tests/fstar/misc/Loops.Clauses.Template.fst +++ b/tests/fstar/misc/Loops.Clauses.Template.fst @@ -22,7 +22,8 @@ let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : admit () (** [loops::clear]: decreases clause *) -unfold let clear_loop_decreases (v : vec u32) (i : usize) : nat = admit () +unfold +let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = admit () (** [loops::list_mem]: decreases clause *) unfold let list_mem_loop_decreases (x : u32) (ls : list_t u32) : nat = admit () diff --git a/tests/fstar/misc/Loops.Clauses.fst b/tests/fstar/misc/Loops.Clauses.fst index 82f34de1..75194437 100644 --- a/tests/fstar/misc/Loops.Clauses.fst +++ b/tests/fstar/misc/Loops.Clauses.fst @@ -20,7 +20,7 @@ let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : nat if max >= i then max - i else 0 (** [loops::clear]: decreases clause *) -unfold let clear_loop_decreases (v : vec u32) (i : usize) : nat = +unfold let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = if i <= List.Tot.length v then List.Tot.length v - i else 0 (** [loops::list_mem]: decreases clause *) diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index 9a80f415..0f755351 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -8,20 +8,20 @@ include Loops.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [loops::sum]: loop 0: forward function *) -let rec sum_loop_fwd +let rec sum_loop (max : u32) (i : u32) (s : u32) : Tot (result u32) (decreases (sum_loop_decreases max i s)) = if i < max - then let* s0 = u32_add s i in let* i0 = u32_add i 1 in sum_loop_fwd max i0 s0 + then let* s0 = u32_add s i in let* i0 = u32_add i 1 in sum_loop max i0 s0 else u32_mul s 2 (** [loops::sum]: forward function *) -let sum_fwd (max : u32) : result u32 = - sum_loop_fwd max 0 0 +let sum (max : u32) : result u32 = + sum_loop max 0 0 (** [loops::sum_with_mut_borrows]: loop 0: forward function *) -let rec sum_with_mut_borrows_loop_fwd +let rec sum_with_mut_borrows_loop (max : u32) (mi : u32) (ms : u32) : Tot (result u32) (decreases (sum_with_mut_borrows_loop_decreases max mi ms)) = @@ -29,15 +29,15 @@ let rec sum_with_mut_borrows_loop_fwd then let* ms0 = u32_add ms mi in let* mi0 = u32_add mi 1 in - sum_with_mut_borrows_loop_fwd max mi0 ms0 + sum_with_mut_borrows_loop max mi0 ms0 else u32_mul ms 2 (** [loops::sum_with_mut_borrows]: forward function *) -let sum_with_mut_borrows_fwd (max : u32) : result u32 = - sum_with_mut_borrows_loop_fwd max 0 0 +let sum_with_mut_borrows (max : u32) : result u32 = + sum_with_mut_borrows_loop max 0 0 (** [loops::sum_with_shared_borrows]: loop 0: forward function *) -let rec sum_with_shared_borrows_loop_fwd +let rec sum_with_shared_borrows_loop (max : u32) (i : u32) (s : u32) : Tot (result u32) (decreases (sum_with_shared_borrows_loop_decreases max i s)) = @@ -45,62 +45,64 @@ let rec sum_with_shared_borrows_loop_fwd then let* i0 = u32_add i 1 in let* s0 = u32_add s i0 in - sum_with_shared_borrows_loop_fwd max i0 s0 + sum_with_shared_borrows_loop max i0 s0 else u32_mul s 2 (** [loops::sum_with_shared_borrows]: forward function *) -let sum_with_shared_borrows_fwd (max : u32) : result u32 = - sum_with_shared_borrows_loop_fwd max 0 0 +let sum_with_shared_borrows (max : u32) : result u32 = + sum_with_shared_borrows_loop max 0 0 (** [loops::clear]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -let rec clear_loop_fwd_back - (v : vec u32) (i : usize) : - Tot (result (vec u32)) (decreases (clear_loop_decreases v i)) +let rec clear_loop + (v : alloc_vec_Vec u32) (i : usize) : + Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i)) = - let i0 = vec_len u32 v in + let i0 = alloc_vec_Vec_len u32 v in if i < i0 then let* i1 = usize_add i 1 in - let* v0 = vec_index_mut_back u32 v i 0 in - clear_loop_fwd_back v0 i1 + let* v0 = + alloc_vec_Vec_index_mut_back u32 usize + (core_slice_index_usize_coresliceindexSliceIndexInst u32) v i 0 in + clear_loop v0 i1 else Return v (** [loops::clear]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -let clear_fwd_back (v : vec u32) : result (vec u32) = - clear_loop_fwd_back v 0 +let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) = + clear_loop v 0 (** [loops::list_mem]: loop 0: forward function *) -let rec list_mem_loop_fwd +let rec list_mem_loop (x : u32) (ls : list_t u32) : Tot (result bool) (decreases (list_mem_loop_decreases x ls)) = begin match ls with - | ListCons y tl -> if y = x then Return true else list_mem_loop_fwd x tl - | ListNil -> Return false + | List_Cons y tl -> if y = x then Return true else list_mem_loop x tl + | List_Nil -> Return false end (** [loops::list_mem]: forward function *) -let list_mem_fwd (x : u32) (ls : list_t u32) : result bool = - list_mem_loop_fwd x ls +let list_mem (x : u32) (ls : list_t u32) : result bool = + list_mem_loop x ls (** [loops::list_nth_mut_loop]: loop 0: forward function *) -let rec list_nth_mut_loop_loop_fwd +let rec list_nth_mut_loop_loop (t : Type0) (ls : list_t t) (i : u32) : Tot (result t) (decreases (list_nth_mut_loop_loop_decreases t ls i)) = begin match ls with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_loop_loop_fwd t tl i0 - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_mut_loop_loop t tl i0 + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop]: forward function *) -let list_nth_mut_loop_fwd (t : Type0) (ls : list_t t) (i : u32) : result t = - list_nth_mut_loop_loop_fwd t ls i +let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result t = + list_nth_mut_loop_loop t ls i (** [loops::list_nth_mut_loop]: loop 0: backward function 0 *) let rec list_nth_mut_loop_loop_back @@ -108,14 +110,14 @@ let rec list_nth_mut_loop_loop_back Tot (result (list_t t)) (decreases (list_nth_mut_loop_loop_decreases t ls i)) = begin match ls with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else let* i0 = u32_sub i 1 in let* tl0 = list_nth_mut_loop_loop_back t tl i0 ret in - Return (ListCons x tl0) - | ListNil -> Fail Failure + Return (List_Cons x tl0) + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop]: backward function 0 *) @@ -124,36 +126,40 @@ let list_nth_mut_loop_back list_nth_mut_loop_loop_back t ls i ret (** [loops::list_nth_shared_loop]: loop 0: forward function *) -let rec list_nth_shared_loop_loop_fwd +let rec list_nth_shared_loop_loop (t : Type0) (ls : list_t t) (i : u32) : Tot (result t) (decreases (list_nth_shared_loop_loop_decreases t ls i)) = begin match ls with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_loop_loop_fwd t tl i0 - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_shared_loop_loop t tl i0 + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_loop]: forward function *) -let list_nth_shared_loop_fwd (t : Type0) (ls : list_t t) (i : u32) : result t = - list_nth_shared_loop_loop_fwd t ls i +let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t = + list_nth_shared_loop_loop t ls i (** [loops::get_elem_mut]: loop 0: forward function *) -let rec get_elem_mut_loop_fwd +let rec get_elem_mut_loop (x : usize) (ls : list_t usize) : Tot (result usize) (decreases (get_elem_mut_loop_decreases x ls)) = begin match ls with - | ListCons y tl -> if y = x then Return y else get_elem_mut_loop_fwd x tl - | ListNil -> Fail Failure + | List_Cons y tl -> if y = x then Return y else get_elem_mut_loop x tl + | List_Nil -> Fail Failure end (** [loops::get_elem_mut]: forward function *) -let get_elem_mut_fwd (slots : vec (list_t usize)) (x : usize) : result usize = - let* l = vec_index_mut_fwd (list_t usize) slots 0 in - get_elem_mut_loop_fwd x l +let get_elem_mut + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = + let* l = + alloc_vec_Vec_index_mut (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) + slots 0 in + get_elem_mut_loop x l (** [loops::get_elem_mut]: loop 0: backward function 0 *) let rec get_elem_mut_loop_back @@ -161,39 +167,48 @@ let rec get_elem_mut_loop_back Tot (result (list_t usize)) (decreases (get_elem_mut_loop_decreases x ls)) = begin match ls with - | ListCons y tl -> + | List_Cons y tl -> if y = x - then Return (ListCons ret tl) - else let* tl0 = get_elem_mut_loop_back x tl ret in Return (ListCons y tl0) - | ListNil -> Fail Failure + then Return (List_Cons ret tl) + else let* tl0 = get_elem_mut_loop_back x tl ret in Return (List_Cons y tl0) + | List_Nil -> Fail Failure end (** [loops::get_elem_mut]: backward function 0 *) let get_elem_mut_back - (slots : vec (list_t usize)) (x : usize) (ret : usize) : - result (vec (list_t usize)) + (slots : alloc_vec_Vec (list_t usize)) (x : usize) (ret : usize) : + result (alloc_vec_Vec (list_t usize)) = - let* l = vec_index_mut_fwd (list_t usize) slots 0 in + let* l = + alloc_vec_Vec_index_mut (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) + slots 0 in let* l0 = get_elem_mut_loop_back x l ret in - vec_index_mut_back (list_t usize) slots 0 l0 + alloc_vec_Vec_index_mut_back (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) slots + 0 l0 (** [loops::get_elem_shared]: loop 0: forward function *) -let rec get_elem_shared_loop_fwd +let rec get_elem_shared_loop (x : usize) (ls : list_t usize) : Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls)) = begin match ls with - | ListCons y tl -> if y = x then Return y else get_elem_shared_loop_fwd x tl - | ListNil -> Fail Failure + | List_Cons y tl -> if y = x then Return y else get_elem_shared_loop x tl + | List_Nil -> Fail Failure end (** [loops::get_elem_shared]: forward function *) -let get_elem_shared_fwd - (slots : vec (list_t usize)) (x : usize) : result usize = - let* l = vec_index_fwd (list_t usize) slots 0 in get_elem_shared_loop_fwd x l +let get_elem_shared + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = + let* l = + alloc_vec_Vec_index (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) + slots 0 in + get_elem_shared_loop x l (** [loops::id_mut]: forward function *) -let id_mut_fwd (t : Type0) (ls : list_t t) : result (list_t t) = +let id_mut (t : Type0) (ls : list_t t) : result (list_t t) = Return ls (** [loops::id_mut]: backward function 0 *) @@ -202,26 +217,26 @@ let id_mut_back Return ret (** [loops::id_shared]: forward function *) -let id_shared_fwd (t : Type0) (ls : list_t t) : result (list_t t) = +let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = Return ls (** [loops::list_nth_mut_loop_with_id]: loop 0: forward function *) -let rec list_nth_mut_loop_with_id_loop_fwd +let rec list_nth_mut_loop_with_id_loop (t : Type0) (i : u32) (ls : list_t t) : Tot (result t) (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) = begin match ls with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_loop_with_id_loop_fwd t i0 tl - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_mut_loop_with_id_loop t i0 tl + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_with_id]: forward function *) -let list_nth_mut_loop_with_id_fwd +let list_nth_mut_loop_with_id (t : Type0) (ls : list_t t) (i : u32) : result t = - let* ls0 = id_mut_fwd t ls in list_nth_mut_loop_with_id_loop_fwd t i ls0 + let* ls0 = id_mut t ls in list_nth_mut_loop_with_id_loop t i ls0 (** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 *) let rec list_nth_mut_loop_with_id_loop_back @@ -230,66 +245,64 @@ let rec list_nth_mut_loop_with_id_loop_back (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) = begin match ls with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else let* i0 = u32_sub i 1 in let* tl0 = list_nth_mut_loop_with_id_loop_back t i0 tl ret in - Return (ListCons x tl0) - | ListNil -> Fail Failure + Return (List_Cons x tl0) + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_with_id]: backward function 0 *) let list_nth_mut_loop_with_id_back (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = - let* ls0 = id_mut_fwd t ls in + let* ls0 = id_mut t ls in let* l = list_nth_mut_loop_with_id_loop_back t i ls0 ret in id_mut_back t ls l (** [loops::list_nth_shared_loop_with_id]: loop 0: forward function *) -let rec list_nth_shared_loop_with_id_loop_fwd +let rec list_nth_shared_loop_with_id_loop (t : Type0) (i : u32) (ls : list_t t) : Tot (result t) (decreases (list_nth_shared_loop_with_id_loop_decreases t i ls)) = begin match ls with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_loop_with_id_loop_fwd t i0 tl - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i0 tl + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_loop_with_id]: forward function *) -let list_nth_shared_loop_with_id_fwd +let list_nth_shared_loop_with_id (t : Type0) (ls : list_t t) (i : u32) : result t = - let* ls0 = id_shared_fwd t ls in - list_nth_shared_loop_with_id_loop_fwd t i ls0 + let* ls0 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls0 (** [loops::list_nth_mut_loop_pair]: loop 0: forward function *) -let rec list_nth_mut_loop_pair_loop_fwd +let rec list_nth_mut_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) - else - let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_pair]: forward function *) -let list_nth_mut_loop_pair_fwd +let list_nth_mut_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_loop_pair_loop_fwd t ls0 ls1 i + list_nth_mut_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 *) let rec list_nth_mut_loop_pair_loop_back'a @@ -298,18 +311,18 @@ let rec list_nth_mut_loop_pair_loop_back'a (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then Return (ListCons ret tl0) + then Return (List_Cons ret tl0) else let* i0 = u32_sub i 1 in let* tl00 = list_nth_mut_loop_pair_loop_back'a t tl0 tl1 i0 ret in - Return (ListCons x0 tl00) - | ListNil -> Fail Failure + Return (List_Cons x0 tl00) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_pair]: backward function 0 *) @@ -326,18 +339,18 @@ let rec list_nth_mut_loop_pair_loop_back'b (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then Return (ListCons ret tl1) + then Return (List_Cons ret tl1) else let* i0 = u32_sub i 1 in let* tl10 = list_nth_mut_loop_pair_loop_back'b t tl0 tl1 i0 ret in - Return (ListCons x1 tl10) - | ListNil -> Fail Failure + Return (List_Cons x1 tl10) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_pair]: backward function 1 *) @@ -348,54 +361,51 @@ let list_nth_mut_loop_pair_back'b list_nth_mut_loop_pair_loop_back'b t ls0 ls1 i ret (** [loops::list_nth_shared_loop_pair]: loop 0: forward function *) -let rec list_nth_shared_loop_pair_loop_fwd +let rec list_nth_shared_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_shared_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) - else - let* i0 = u32_sub i 1 in - list_nth_shared_loop_pair_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_loop_pair]: forward function *) -let list_nth_shared_loop_pair_fwd +let list_nth_shared_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_loop_pair_loop_fwd t ls0 ls1 i + list_nth_shared_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_mut_loop_pair_merge_loop_fwd +let rec list_nth_mut_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) else - let* i0 = u32_sub i 1 in - list_nth_mut_loop_pair_merge_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_pair_merge]: forward function *) -let list_nth_mut_loop_pair_merge_fwd +let list_nth_mut_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_loop_pair_merge_loop_fwd t ls0 ls1 i + list_nth_mut_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 *) let rec list_nth_mut_loop_pair_merge_loop_back @@ -404,19 +414,19 @@ let rec list_nth_mut_loop_pair_merge_loop_back (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then let (x, x2) = ret in Return (ListCons x tl0, ListCons x2 tl1) + then let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) else let* i0 = u32_sub i 1 in let* (tl00, tl10) = list_nth_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (ListCons x0 tl00, ListCons x1 tl10) - | ListNil -> Fail Failure + Return (List_Cons x0 tl00, List_Cons x1 tl10) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_loop_pair_merge]: backward function 0 *) @@ -427,54 +437,54 @@ let list_nth_mut_loop_pair_merge_back list_nth_mut_loop_pair_merge_loop_back t ls0 ls1 i ret (** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_shared_loop_pair_merge_loop_fwd +let rec list_nth_shared_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) else let* i0 = u32_sub i 1 in - list_nth_shared_loop_pair_merge_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + list_nth_shared_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_loop_pair_merge]: forward function *) -let list_nth_shared_loop_pair_merge_fwd +let list_nth_shared_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_loop_pair_merge_loop_fwd t ls0 ls1 i + list_nth_shared_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function *) -let rec list_nth_mut_shared_loop_pair_loop_fwd +let rec list_nth_mut_shared_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) else let* i0 = u32_sub i 1 in - list_nth_mut_shared_loop_pair_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + list_nth_mut_shared_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_shared_loop_pair]: forward function *) -let list_nth_mut_shared_loop_pair_fwd +let list_nth_mut_shared_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_shared_loop_pair_loop_fwd t ls0 ls1 i + list_nth_mut_shared_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 *) let rec list_nth_mut_shared_loop_pair_loop_back @@ -483,18 +493,18 @@ let rec list_nth_mut_shared_loop_pair_loop_back (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then Return (ListCons ret tl0) + then Return (List_Cons ret tl0) else let* i0 = u32_sub i 1 in let* tl00 = list_nth_mut_shared_loop_pair_loop_back t tl0 tl1 i0 ret in - Return (ListCons x0 tl00) - | ListNil -> Fail Failure + Return (List_Cons x0 tl00) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_shared_loop_pair]: backward function 0 *) @@ -505,29 +515,29 @@ let list_nth_mut_shared_loop_pair_back list_nth_mut_shared_loop_pair_loop_back t ls0 ls1 i ret (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_mut_shared_loop_pair_merge_loop_fwd +let rec list_nth_mut_shared_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) else let* i0 = u32_sub i 1 in - list_nth_mut_shared_loop_pair_merge_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_shared_loop_pair_merge]: forward function *) -let list_nth_mut_shared_loop_pair_merge_fwd +let list_nth_mut_shared_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_shared_loop_pair_merge_loop_fwd t ls0 ls1 i + list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 *) let rec list_nth_mut_shared_loop_pair_merge_loop_back @@ -536,19 +546,19 @@ let rec list_nth_mut_shared_loop_pair_merge_loop_back (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then Return (ListCons ret tl0) + then Return (List_Cons ret tl0) else let* i0 = u32_sub i 1 in let* tl00 = list_nth_mut_shared_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (ListCons x0 tl00) - | ListNil -> Fail Failure + Return (List_Cons x0 tl00) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 *) @@ -559,29 +569,29 @@ let list_nth_mut_shared_loop_pair_merge_back list_nth_mut_shared_loop_pair_merge_loop_back t ls0 ls1 i ret (** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function *) -let rec list_nth_shared_mut_loop_pair_loop_fwd +let rec list_nth_shared_mut_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) else let* i0 = u32_sub i 1 in - list_nth_shared_mut_loop_pair_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + list_nth_shared_mut_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_mut_loop_pair]: forward function *) -let list_nth_shared_mut_loop_pair_fwd +let list_nth_shared_mut_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_mut_loop_pair_loop_fwd t ls0 ls1 i + list_nth_shared_mut_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 *) let rec list_nth_shared_mut_loop_pair_loop_back @@ -590,18 +600,18 @@ let rec list_nth_shared_mut_loop_pair_loop_back (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then Return (ListCons ret tl1) + then Return (List_Cons ret tl1) else let* i0 = u32_sub i 1 in let* tl10 = list_nth_shared_mut_loop_pair_loop_back t tl0 tl1 i0 ret in - Return (ListCons x1 tl10) - | ListNil -> Fail Failure + Return (List_Cons x1 tl10) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_mut_loop_pair]: backward function 1 *) @@ -612,29 +622,29 @@ let list_nth_shared_mut_loop_pair_back list_nth_shared_mut_loop_pair_loop_back t ls0 ls1 i ret (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_shared_mut_loop_pair_merge_loop_fwd +let rec list_nth_shared_mut_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 then Return (x0, x1) else let* i0 = u32_sub i 1 in - list_nth_shared_mut_loop_pair_merge_loop_fwd t tl0 tl1 i0 - | ListNil -> Fail Failure + list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_mut_loop_pair_merge]: forward function *) -let list_nth_shared_mut_loop_pair_merge_fwd +let list_nth_shared_mut_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_mut_loop_pair_merge_loop_fwd t ls0 ls1 i + list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 *) let rec list_nth_shared_mut_loop_pair_merge_loop_back @@ -643,19 +653,19 @@ let rec list_nth_shared_mut_loop_pair_merge_loop_back (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) = begin match ls0 with - | ListCons x0 tl0 -> + | List_Cons x0 tl0 -> begin match ls1 with - | ListCons x1 tl1 -> + | List_Cons x1 tl1 -> if i = 0 - then Return (ListCons ret tl1) + then Return (List_Cons ret tl1) else let* i0 = u32_sub i 1 in let* tl10 = list_nth_shared_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (ListCons x1 tl10) - | ListNil -> Fail Failure + Return (List_Cons x1 tl10) + | List_Nil -> Fail Failure end - | ListNil -> Fail Failure + | List_Nil -> Fail Failure end (** [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 *) diff --git a/tests/fstar/misc/Loops.Types.fst b/tests/fstar/misc/Loops.Types.fst index 2e032fe7..c622c548 100644 --- a/tests/fstar/misc/Loops.Types.fst +++ b/tests/fstar/misc/Loops.Types.fst @@ -7,6 +7,6 @@ open Primitives (** [loops::List] *) type list_t (t : Type0) = -| ListCons : t -> list_t t -> list_t t -| ListNil : list_t t +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 2cdd6e21..33142250 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -6,95 +6,95 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [no_nested_borrows::Pair] *) -type pair_t (t1 t2 : Type0) = { pair_x : t1; pair_y : t2; } +type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } (** [no_nested_borrows::List] *) type list_t (t : Type0) = -| ListCons : t -> list_t t -> list_t t -| ListNil : list_t t +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t (** [no_nested_borrows::One] *) -type one_t (t1 : Type0) = | OneOne : t1 -> one_t t1 +type one_t (t1 : Type0) = | One_One : t1 -> one_t t1 (** [no_nested_borrows::EmptyEnum] *) -type empty_enum_t = | EmptyEnumEmpty : empty_enum_t +type emptyEnum_t = | EmptyEnum_Empty : emptyEnum_t (** [no_nested_borrows::Enum] *) -type enum_t = | EnumVariant1 : enum_t | EnumVariant2 : enum_t +type enum_t = | Enum_Variant1 : enum_t | Enum_Variant2 : enum_t (** [no_nested_borrows::EmptyStruct] *) -type empty_struct_t = unit +type emptyStruct_t = unit (** [no_nested_borrows::Sum] *) type sum_t (t1 t2 : Type0) = -| SumLeft : t1 -> sum_t t1 t2 -| SumRight : t2 -> sum_t t1 t2 +| Sum_Left : t1 -> sum_t t1 t2 +| Sum_Right : t2 -> sum_t t1 t2 (** [no_nested_borrows::neg_test]: forward function *) -let neg_test_fwd (x : i32) : result i32 = +let neg_test (x : i32) : result i32 = i32_neg x (** [no_nested_borrows::add_test]: forward function *) -let add_test_fwd (x : u32) (y : u32) : result u32 = +let add_test (x : u32) (y : u32) : result u32 = u32_add x y (** [no_nested_borrows::subs_test]: forward function *) -let subs_test_fwd (x : u32) (y : u32) : result u32 = +let subs_test (x : u32) (y : u32) : result u32 = u32_sub x y (** [no_nested_borrows::div_test]: forward function *) -let div_test_fwd (x : u32) (y : u32) : result u32 = +let div_test (x : u32) (y : u32) : result u32 = u32_div x y (** [no_nested_borrows::div_test1]: forward function *) -let div_test1_fwd (x : u32) : result u32 = +let div_test1 (x : u32) : result u32 = u32_div x 2 (** [no_nested_borrows::rem_test]: forward function *) -let rem_test_fwd (x : u32) (y : u32) : result u32 = +let rem_test (x : u32) (y : u32) : result u32 = u32_rem x y (** [no_nested_borrows::cast_test]: forward function *) -let cast_test_fwd (x : u32) : result i32 = +let cast_test (x : u32) : result i32 = scalar_cast U32 I32 x (** [no_nested_borrows::test2]: forward function *) -let test2_fwd : result unit = +let test2 : result unit = let* _ = u32_add 23 44 in Return () (** Unit test for [no_nested_borrows::test2] *) -let _ = assert_norm (test2_fwd = Return ()) +let _ = assert_norm (test2 = Return ()) (** [no_nested_borrows::get_max]: forward function *) -let get_max_fwd (x : u32) (y : u32) : result u32 = +let get_max (x : u32) (y : u32) : result u32 = if x >= y then Return x else Return y (** [no_nested_borrows::test3]: forward function *) -let test3_fwd : result unit = - let* x = get_max_fwd 4 3 in - let* y = get_max_fwd 10 11 in +let test3 : result unit = + let* x = get_max 4 3 in + let* y = get_max 10 11 in let* z = u32_add x y in if not (z = 15) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test3] *) -let _ = assert_norm (test3_fwd = Return ()) +let _ = assert_norm (test3 = Return ()) (** [no_nested_borrows::test_neg1]: forward function *) -let test_neg1_fwd : result unit = +let test_neg1 : result unit = let* y = i32_neg 3 in if not (y = -3) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_neg1] *) -let _ = assert_norm (test_neg1_fwd = Return ()) +let _ = assert_norm (test_neg1 = Return ()) (** [no_nested_borrows::refs_test1]: forward function *) -let refs_test1_fwd : result unit = +let refs_test1 : result unit = if not (1 = 1) then Fail Failure else Return () (** Unit test for [no_nested_borrows::refs_test1] *) -let _ = assert_norm (refs_test1_fwd = Return ()) +let _ = assert_norm (refs_test1 = Return ()) (** [no_nested_borrows::refs_test2]: forward function *) -let refs_test2_fwd : result unit = +let refs_test2 : result unit = if not (2 = 2) then Fail Failure else @@ -106,76 +106,76 @@ let refs_test2_fwd : result unit = else if not (2 = 2) then Fail Failure else Return () (** Unit test for [no_nested_borrows::refs_test2] *) -let _ = assert_norm (refs_test2_fwd = Return ()) +let _ = assert_norm (refs_test2 = Return ()) (** [no_nested_borrows::test_list1]: forward function *) -let test_list1_fwd : result unit = +let test_list1 : result unit = Return () (** Unit test for [no_nested_borrows::test_list1] *) -let _ = assert_norm (test_list1_fwd = Return ()) +let _ = assert_norm (test_list1 = Return ()) (** [no_nested_borrows::test_box1]: forward function *) -let test_box1_fwd : result unit = +let test_box1 : result unit = let b = 1 in let x = b in if not (x = 1) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_box1] *) -let _ = assert_norm (test_box1_fwd = Return ()) +let _ = assert_norm (test_box1 = Return ()) (** [no_nested_borrows::copy_int]: forward function *) -let copy_int_fwd (x : i32) : result i32 = +let copy_int (x : i32) : result i32 = Return x (** [no_nested_borrows::test_unreachable]: forward function *) -let test_unreachable_fwd (b : bool) : result unit = +let test_unreachable (b : bool) : result unit = if b then Fail Failure else Return () (** [no_nested_borrows::test_panic]: forward function *) -let test_panic_fwd (b : bool) : result unit = +let test_panic (b : bool) : result unit = if b then Fail Failure else Return () (** [no_nested_borrows::test_copy_int]: forward function *) -let test_copy_int_fwd : result unit = - let* y = copy_int_fwd 0 in if not (0 = y) then Fail Failure else Return () +let test_copy_int : result unit = + let* y = copy_int 0 in if not (0 = y) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_copy_int] *) -let _ = assert_norm (test_copy_int_fwd = Return ()) +let _ = assert_norm (test_copy_int = Return ()) (** [no_nested_borrows::is_cons]: forward function *) -let is_cons_fwd (t : Type0) (l : list_t t) : result bool = +let is_cons (t : Type0) (l : list_t t) : result bool = begin match l with - | ListCons x l0 -> Return true - | ListNil -> Return false + | List_Cons x l0 -> Return true + | List_Nil -> Return false end (** [no_nested_borrows::test_is_cons]: forward function *) -let test_is_cons_fwd : result unit = - let l = ListNil in - let* b = is_cons_fwd i32 (ListCons 0 l) in +let test_is_cons : result unit = + let l = List_Nil in + let* b = is_cons i32 (List_Cons 0 l) in if not b then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_is_cons] *) -let _ = assert_norm (test_is_cons_fwd = Return ()) +let _ = assert_norm (test_is_cons = Return ()) (** [no_nested_borrows::split_list]: forward function *) -let split_list_fwd (t : Type0) (l : list_t t) : result (t & (list_t t)) = +let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = begin match l with - | ListCons hd tl -> Return (hd, tl) - | ListNil -> Fail Failure + | List_Cons hd tl -> Return (hd, tl) + | List_Nil -> Fail Failure end (** [no_nested_borrows::test_split_list]: forward function *) -let test_split_list_fwd : result unit = - let l = ListNil in - let* p = split_list_fwd i32 (ListCons 0 l) in +let test_split_list : result unit = + let l = List_Nil in + let* p = split_list i32 (List_Cons 0 l) in let (hd, _) = p in if not (hd = 0) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_split_list] *) -let _ = assert_norm (test_split_list_fwd = Return ()) +let _ = assert_norm (test_split_list = Return ()) (** [no_nested_borrows::choose]: forward function *) -let choose_fwd (t : Type0) (b : bool) (x : t) (y : t) : result t = +let choose (t : Type0) (b : bool) (x : t) (y : t) : result t = if b then Return x else Return y (** [no_nested_borrows::choose]: backward function 0 *) @@ -184,8 +184,8 @@ let choose_back if b then Return (ret, y) else Return (x, ret) (** [no_nested_borrows::choose_test]: forward function *) -let choose_test_fwd : result unit = - let* z = choose_fwd i32 true 0 0 in +let choose_test : result unit = + let* z = choose i32 true 0 0 in let* z0 = i32_add z 1 in if not (z0 = 1) then Fail Failure @@ -196,115 +196,112 @@ let choose_test_fwd : result unit = else if not (y = 0) then Fail Failure else Return () (** Unit test for [no_nested_borrows::choose_test] *) -let _ = assert_norm (choose_test_fwd = Return ()) +let _ = assert_norm (choose_test = Return ()) (** [no_nested_borrows::test_char]: forward function *) -let test_char_fwd : result char = +let test_char : result char = Return 'a' (** [no_nested_borrows::Tree] *) type tree_t (t : Type0) = -| TreeLeaf : t -> tree_t t -| TreeNode : t -> node_elem_t t -> tree_t t -> tree_t t +| Tree_Leaf : t -> tree_t t +| Tree_Node : t -> nodeElem_t t -> tree_t t -> tree_t t (** [no_nested_borrows::NodeElem] *) -and node_elem_t (t : Type0) = -| NodeElemCons : tree_t t -> node_elem_t t -> node_elem_t t -| NodeElemNil : node_elem_t t +and nodeElem_t (t : Type0) = +| NodeElem_Cons : tree_t t -> nodeElem_t t -> nodeElem_t t +| NodeElem_Nil : nodeElem_t t (** [no_nested_borrows::list_length]: forward function *) -let rec list_length_fwd (t : Type0) (l : list_t t) : result u32 = +let rec list_length (t : Type0) (l : list_t t) : result u32 = begin match l with - | ListCons x l1 -> let* i = list_length_fwd t l1 in u32_add 1 i - | ListNil -> Return 0 + | List_Cons x l1 -> let* i = list_length t l1 in u32_add 1 i + | List_Nil -> Return 0 end (** [no_nested_borrows::list_nth_shared]: forward function *) -let rec list_nth_shared_fwd (t : Type0) (l : list_t t) (i : u32) : result t = +let rec list_nth_shared (t : Type0) (l : list_t t) (i : u32) : result t = begin match l with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_fwd t tl i0 - | ListNil -> Fail Failure + else let* i0 = u32_sub i 1 in list_nth_shared t tl i0 + | List_Nil -> Fail Failure end (** [no_nested_borrows::list_nth_mut]: forward function *) -let rec list_nth_mut_fwd (t : Type0) (l : list_t t) (i : u32) : result t = +let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result t = begin match l with - | ListCons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_fwd t tl i0 - | ListNil -> Fail Failure + | List_Cons x tl -> + if i = 0 then Return x else let* i0 = u32_sub i 1 in list_nth_mut t tl i0 + | List_Nil -> Fail Failure end (** [no_nested_borrows::list_nth_mut]: backward function 0 *) let rec list_nth_mut_back (t : Type0) (l : list_t t) (i : u32) (ret : t) : result (list_t t) = begin match l with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else let* i0 = u32_sub i 1 in let* tl0 = list_nth_mut_back t tl i0 ret in - Return (ListCons x tl0) - | ListNil -> Fail Failure + Return (List_Cons x tl0) + | List_Nil -> Fail Failure end (** [no_nested_borrows::list_rev_aux]: forward function *) -let rec list_rev_aux_fwd +let rec list_rev_aux (t : Type0) (li : list_t t) (lo : list_t t) : result (list_t t) = begin match li with - | ListCons hd tl -> list_rev_aux_fwd t tl (ListCons hd lo) - | ListNil -> Return lo + | List_Cons hd tl -> list_rev_aux t tl (List_Cons hd lo) + | List_Nil -> Return lo end (** [no_nested_borrows::list_rev]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -let list_rev_fwd_back (t : Type0) (l : list_t t) : result (list_t t) = - let li = mem_replace_fwd (list_t t) l ListNil in - list_rev_aux_fwd t li ListNil +let list_rev (t : Type0) (l : list_t t) : result (list_t t) = + let li = core_mem_replace (list_t t) l List_Nil in list_rev_aux t li List_Nil (** [no_nested_borrows::test_list_functions]: forward function *) -let test_list_functions_fwd : result unit = - let l = ListNil in - let l0 = ListCons 2 l in - let l1 = ListCons 1 l0 in - let* i = list_length_fwd i32 (ListCons 0 l1) in +let test_list_functions : result unit = + let l = List_Nil in + let l0 = List_Cons 2 l in + let l1 = List_Cons 1 l0 in + let* i = list_length i32 (List_Cons 0 l1) in if not (i = 3) then Fail Failure else - let* i0 = list_nth_shared_fwd i32 (ListCons 0 l1) 0 in + let* i0 = list_nth_shared i32 (List_Cons 0 l1) 0 in if not (i0 = 0) then Fail Failure else - let* i1 = list_nth_shared_fwd i32 (ListCons 0 l1) 1 in + let* i1 = list_nth_shared i32 (List_Cons 0 l1) 1 in if not (i1 = 1) then Fail Failure else - let* i2 = list_nth_shared_fwd i32 (ListCons 0 l1) 2 in + let* i2 = list_nth_shared i32 (List_Cons 0 l1) 2 in if not (i2 = 2) then Fail Failure else - let* ls = list_nth_mut_back i32 (ListCons 0 l1) 1 3 in - let* i3 = list_nth_shared_fwd i32 ls 0 in + let* ls = list_nth_mut_back i32 (List_Cons 0 l1) 1 3 in + let* i3 = list_nth_shared i32 ls 0 in if not (i3 = 0) then Fail Failure else - let* i4 = list_nth_shared_fwd i32 ls 1 in + let* i4 = list_nth_shared i32 ls 1 in if not (i4 = 3) then Fail Failure else - let* i5 = list_nth_shared_fwd i32 ls 2 in + let* i5 = list_nth_shared i32 ls 2 in if not (i5 = 2) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_list_functions] *) -let _ = assert_norm (test_list_functions_fwd = Return ()) +let _ = assert_norm (test_list_functions = Return ()) (** [no_nested_borrows::id_mut_pair1]: forward function *) -let id_mut_pair1_fwd (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = +let id_mut_pair1 (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = Return (x, y) (** [no_nested_borrows::id_mut_pair1]: backward function 0 *) @@ -313,7 +310,7 @@ let id_mut_pair1_back let (x0, x1) = ret in Return (x0, x1) (** [no_nested_borrows::id_mut_pair2]: forward function *) -let id_mut_pair2_fwd (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = +let id_mut_pair2 (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = let (x, x0) = p in Return (x, x0) (** [no_nested_borrows::id_mut_pair2]: backward function 0 *) @@ -322,7 +319,7 @@ let id_mut_pair2_back let (x, x0) = ret in Return (x, x0) (** [no_nested_borrows::id_mut_pair3]: forward function *) -let id_mut_pair3_fwd (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = +let id_mut_pair3 (t1 t2 : Type0) (x : t1) (y : t2) : result (t1 & t2) = Return (x, y) (** [no_nested_borrows::id_mut_pair3]: backward function 0 *) @@ -336,7 +333,7 @@ let id_mut_pair3_back'b Return ret (** [no_nested_borrows::id_mut_pair4]: forward function *) -let id_mut_pair4_fwd (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = +let id_mut_pair4 (t1 t2 : Type0) (p : (t1 & t2)) : result (t1 & t2) = let (x, x0) = p in Return (x, x0) (** [no_nested_borrows::id_mut_pair4]: backward function 0 *) @@ -350,81 +347,76 @@ let id_mut_pair4_back'b Return ret (** [no_nested_borrows::StructWithTuple] *) -type struct_with_tuple_t (t1 t2 : Type0) = { struct_with_tuple_p : (t1 & t2); } +type structWithTuple_t (t1 t2 : Type0) = { p : (t1 & t2); } (** [no_nested_borrows::new_tuple1]: forward function *) -let new_tuple1_fwd : result (struct_with_tuple_t u32 u32) = - Return { struct_with_tuple_p = (1, 2) } +let new_tuple1 : result (structWithTuple_t u32 u32) = + Return { p = (1, 2) } (** [no_nested_borrows::new_tuple2]: forward function *) -let new_tuple2_fwd : result (struct_with_tuple_t i16 i16) = - Return { struct_with_tuple_p = (1, 2) } +let new_tuple2 : result (structWithTuple_t i16 i16) = + Return { p = (1, 2) } (** [no_nested_borrows::new_tuple3]: forward function *) -let new_tuple3_fwd : result (struct_with_tuple_t u64 i64) = - Return { struct_with_tuple_p = (1, 2) } +let new_tuple3 : result (structWithTuple_t u64 i64) = + Return { p = (1, 2) } (** [no_nested_borrows::StructWithPair] *) -type struct_with_pair_t (t1 t2 : Type0) = -{ - struct_with_pair_p : pair_t t1 t2; -} +type structWithPair_t (t1 t2 : Type0) = { p : pair_t t1 t2; } (** [no_nested_borrows::new_pair1]: forward function *) -let new_pair1_fwd : result (struct_with_pair_t u32 u32) = - Return { struct_with_pair_p = { pair_x = 1; pair_y = 2 } } +let new_pair1 : result (structWithPair_t u32 u32) = + Return { p = { x = 1; y = 2 } } (** [no_nested_borrows::test_constants]: forward function *) -let test_constants_fwd : result unit = - let* swt = new_tuple1_fwd in - let (i, _) = swt.struct_with_tuple_p in +let test_constants : result unit = + let* swt = new_tuple1 in + let (i, _) = swt.p in if not (i = 1) then Fail Failure else - let* swt0 = new_tuple2_fwd in - let (i0, _) = swt0.struct_with_tuple_p in + let* swt0 = new_tuple2 in + let (i0, _) = swt0.p in if not (i0 = 1) then Fail Failure else - let* swt1 = new_tuple3_fwd in - let (i1, _) = swt1.struct_with_tuple_p in + let* swt1 = new_tuple3 in + let (i1, _) = swt1.p in if not (i1 = 1) then Fail Failure else - let* swp = new_pair1_fwd in - if not (swp.struct_with_pair_p.pair_x = 1) - then Fail Failure - else Return () + let* swp = new_pair1 in + if not (swp.p.x = 1) then Fail Failure else Return () (** Unit test for [no_nested_borrows::test_constants] *) -let _ = assert_norm (test_constants_fwd = Return ()) +let _ = assert_norm (test_constants = Return ()) (** [no_nested_borrows::test_weird_borrows1]: forward function *) -let test_weird_borrows1_fwd : result unit = +let test_weird_borrows1 : result unit = Return () (** Unit test for [no_nested_borrows::test_weird_borrows1] *) -let _ = assert_norm (test_weird_borrows1_fwd = Return ()) +let _ = assert_norm (test_weird_borrows1 = Return ()) (** [no_nested_borrows::test_mem_replace]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -let test_mem_replace_fwd_back (px : u32) : result u32 = - let y = mem_replace_fwd u32 px 1 in +let test_mem_replace (px : u32) : result u32 = + let y = core_mem_replace u32 px 1 in if not (y = 0) then Fail Failure else Return 2 (** [no_nested_borrows::test_shared_borrow_bool1]: forward function *) -let test_shared_borrow_bool1_fwd (b : bool) : result u32 = +let test_shared_borrow_bool1 (b : bool) : result u32 = if b then Return 0 else Return 1 (** [no_nested_borrows::test_shared_borrow_bool2]: forward function *) -let test_shared_borrow_bool2_fwd : result u32 = +let test_shared_borrow_bool2 : result u32 = Return 0 (** [no_nested_borrows::test_shared_borrow_enum1]: forward function *) -let test_shared_borrow_enum1_fwd (l : list_t u32) : result u32 = - begin match l with | ListCons i l0 -> Return 1 | ListNil -> Return 0 end +let test_shared_borrow_enum1 (l : list_t u32) : result u32 = + begin match l with | List_Cons i l0 -> Return 1 | List_Nil -> Return 0 end (** [no_nested_borrows::test_shared_borrow_enum2]: forward function *) -let test_shared_borrow_enum2_fwd : result u32 = +let test_shared_borrow_enum2 : result u32 = Return 0 diff --git a/tests/fstar/misc/Paper.fst b/tests/fstar/misc/Paper.fst index e2d692c2..bfb710dc 100644 --- a/tests/fstar/misc/Paper.fst +++ b/tests/fstar/misc/Paper.fst @@ -7,19 +7,18 @@ open Primitives (** [paper::ref_incr]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -let ref_incr_fwd_back (x : i32) : result i32 = +let ref_incr (x : i32) : result i32 = i32_add x 1 (** [paper::test_incr]: forward function *) -let test_incr_fwd : result unit = - let* x = ref_incr_fwd_back 0 in - if not (x = 1) then Fail Failure else Return () +let test_incr : result unit = + let* x = ref_incr 0 in if not (x = 1) then Fail Failure else Return () (** Unit test for [paper::test_incr] *) -let _ = assert_norm (test_incr_fwd = Return ()) +let _ = assert_norm (test_incr = Return ()) (** [paper::choose]: forward function *) -let choose_fwd (t : Type0) (b : bool) (x : t) (y : t) : result t = +let choose (t : Type0) (b : bool) (x : t) (y : t) : result t = if b then Return x else Return y (** [paper::choose]: backward function 0 *) @@ -28,8 +27,8 @@ let choose_back if b then Return (ret, y) else Return (x, ret) (** [paper::test_choose]: forward function *) -let test_choose_fwd : result unit = - let* z = choose_fwd i32 true 0 0 in +let test_choose : result unit = + let* z = choose i32 true 0 0 in let* z0 = i32_add z 1 in if not (z0 = 1) then Fail Failure @@ -40,62 +39,60 @@ let test_choose_fwd : result unit = else if not (y = 0) then Fail Failure else Return () (** Unit test for [paper::test_choose] *) -let _ = assert_norm (test_choose_fwd = Return ()) +let _ = assert_norm (test_choose = Return ()) (** [paper::List] *) type list_t (t : Type0) = -| ListCons : t -> list_t t -> list_t t -| ListNil : list_t t +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t (** [paper::list_nth_mut]: forward function *) -let rec list_nth_mut_fwd (t : Type0) (l : list_t t) (i : u32) : result t = +let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result t = begin match l with - | ListCons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_fwd t tl i0 - | ListNil -> Fail Failure + | List_Cons x tl -> + if i = 0 then Return x else let* i0 = u32_sub i 1 in list_nth_mut t tl i0 + | List_Nil -> Fail Failure end (** [paper::list_nth_mut]: backward function 0 *) let rec list_nth_mut_back (t : Type0) (l : list_t t) (i : u32) (ret : t) : result (list_t t) = begin match l with - | ListCons x tl -> + | List_Cons x tl -> if i = 0 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else let* i0 = u32_sub i 1 in let* tl0 = list_nth_mut_back t tl i0 ret in - Return (ListCons x tl0) - | ListNil -> Fail Failure + Return (List_Cons x tl0) + | List_Nil -> Fail Failure end (** [paper::sum]: forward function *) -let rec sum_fwd (l : list_t i32) : result i32 = +let rec sum (l : list_t i32) : result i32 = begin match l with - | ListCons x tl -> let* i = sum_fwd tl in i32_add x i - | ListNil -> Return 0 + | List_Cons x tl -> let* i = sum tl in i32_add x i + | List_Nil -> Return 0 end (** [paper::test_nth]: forward function *) -let test_nth_fwd : result unit = - let l = ListNil in - let l0 = ListCons 3 l in - let l1 = ListCons 2 l0 in - let* x = list_nth_mut_fwd i32 (ListCons 1 l1) 2 in +let test_nth : result unit = + let l = List_Nil in + let l0 = List_Cons 3 l in + let l1 = List_Cons 2 l0 in + let* x = list_nth_mut i32 (List_Cons 1 l1) 2 in let* x0 = i32_add x 1 in - let* l2 = list_nth_mut_back i32 (ListCons 1 l1) 2 x0 in - let* i = sum_fwd l2 in + let* l2 = list_nth_mut_back i32 (List_Cons 1 l1) 2 x0 in + let* i = sum l2 in if not (i = 7) then Fail Failure else Return () (** Unit test for [paper::test_nth] *) -let _ = assert_norm (test_nth_fwd = Return ()) +let _ = assert_norm (test_nth = Return ()) (** [paper::call_choose]: forward function *) -let call_choose_fwd (p : (u32 & u32)) : result u32 = +let call_choose (p : (u32 & u32)) : result u32 = let (px, py) = p in - let* pz = choose_fwd u32 true px py in + let* pz = choose u32 true px py in let* pz0 = u32_add pz 1 in let* (px0, _) = choose_back u32 true px py pz0 in Return px0 diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index 79c86606..428c4210 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -7,25 +7,25 @@ open Primitives (** [polonius_list::List] *) type list_t (t : Type0) = -| ListCons : t -> list_t t -> list_t t -| ListNil : list_t t +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t (** [polonius_list::get_list_at_x]: forward function *) -let rec get_list_at_x_fwd (ls : list_t u32) (x : u32) : result (list_t u32) = +let rec get_list_at_x (ls : list_t u32) (x : u32) : result (list_t u32) = begin match ls with - | ListCons hd tl -> - if hd = x then Return (ListCons hd tl) else get_list_at_x_fwd tl x - | ListNil -> Return ListNil + | List_Cons hd tl -> + if hd = x then Return (List_Cons hd tl) else get_list_at_x tl x + | List_Nil -> Return List_Nil end (** [polonius_list::get_list_at_x]: backward function 0 *) let rec get_list_at_x_back (ls : list_t u32) (x : u32) (ret : list_t u32) : result (list_t u32) = begin match ls with - | ListCons hd tl -> + | List_Cons hd tl -> if hd = x then Return ret - else let* tl0 = get_list_at_x_back tl x ret in Return (ListCons hd tl0) - | ListNil -> Return ret + else let* tl0 = get_list_at_x_back tl x ret in Return (List_Cons hd tl0) + | List_Nil -> Return ret end diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index 5e154122..71d75c11 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -55,8 +55,8 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let std_mem_replace (a : Type0) (x : a) (y : a) : a = x -let std_mem_replace_back (a : Type0) (x : a) (y : a) : a = y +let core_mem_replace (a : Type0) (x : a) (y : a) : a = x +let core_mem_replace_back (a : Type0) (x : a) (y : a) : a = y // We don't really use raw pointers for now type mut_raw_ptr (t : Type0) = { v : t } @@ -426,6 +426,13 @@ type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v +// Helper +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = + if i < length v then Return (index v i) else Fail Failure +// Helper +let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + // The **forward** function shouldn't be used let alloc_vec_Vec_push_fwd (a : Type0) (v : alloc_vec_Vec a) (x : a) : unit = () let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -694,3 +701,13 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) index_mut = alloc_vec_Vec_index_mut t idx inst; index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; } + +(*** Theorems *) + +let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : + Lemma ( + alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == + alloc_vec_Vec_update_usize v i x) + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x)] + = + admit() diff --git a/tests/lean/Constants.lean b/tests/lean/Constants.lean index 2603cbbf..bd3a07b7 100644 --- a/tests/lean/Constants.lean +++ b/tests/lean/Constants.lean @@ -56,11 +56,11 @@ def p3_c : Pair U32 U32 := eval_global p3_body (by simp) /- [constants::Wrap] -/ structure Wrap (T : Type) where - val : T + value : T /- [constants::Wrap::{0}::new]: forward function -/ -def Wrap.new (T : Type) (val : T) : Result (Wrap T) := - Result.ret { val := val } +def Wrap.new (T : Type) (value : T) : Result (Wrap T) := + Result.ret { value := value } /- [constants::Y] -/ def y_body : Result (Wrap I32) := Wrap.new I32 2#i32 @@ -68,7 +68,7 @@ def y_c : Wrap I32 := eval_global y_body (by simp) /- [constants::unwrap_y]: forward function -/ def unwrap_y : Result I32 := - Result.ret y_c.val + Result.ret y_c.value /- [constants::YVAL] -/ def yval_body : Result I32 := unwrap_y -- cgit v1.3.1 From c8fce0c24f2f5331f2f1135cc17d45192f2b30e3 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 6 Nov 2023 18:49:27 +0100 Subject: Regenerate part of the trait tests for Lean --- tests/lean/Traits/Funs.lean | 35 ++++++++++++++++++++------------- tests/lean/Traits/Types.lean | 46 +++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 65 insertions(+), 16 deletions(-) (limited to 'tests/lean') diff --git a/tests/lean/Traits/Funs.lean b/tests/lean/Traits/Funs.lean index 52ff0c0a..156ef1e0 100644 --- a/tests/lean/Traits/Funs.lean +++ b/tests/lean/Traits/Funs.lean @@ -31,8 +31,8 @@ def test_bool_trait_bool (x : Bool) : Result Bool := /- [traits::Option::{1}::get_bool]: forward function -/ def Option.get_bool (T : Type) (self : Option T) : Result Bool := match self with - | Option.none => Result.ret false - | Option.some t => Result.ret true + | none => Result.ret false + | some t => Result.ret true /- Trait implementation: [traits::Option::{1}] -/ def Option.BoolTraitInst (T : Type) : BoolTrait (Option T) := { @@ -105,7 +105,7 @@ def h2 (T : Type) (inst : ToU64 T) (x : Wrapper T) : Result U64 := /- [traits::u64::{5}::to_type]: forward function -/ def u64.to_type (self : U64) : Result Bool := - Result.ret (self > (U64.ofInt 0)) + Result.ret (self > 0#u64) /- Trait implementation: [traits::u64::{5}] -/ def u64.ToTypeInst : ToType U64 Bool := { @@ -129,7 +129,7 @@ def h4 /- [traits::TestType::{6}::test::TestType1::{0}::test]: forward function -/ def TestType.test.TestType1.test (self : TestType.test.TestType1) : Result Bool := - Result.ret (self._0 > (U64.ofInt 1)) + Result.ret (self._0 > 1#u64) /- Trait implementation: [traits::TestType::{6}::test::TestType1::{0}] -/ def TestType.test.TestType1.TestTypetestTestTraitInst : TestType.test.TestTrait @@ -142,8 +142,8 @@ def TestType.test (T : Type) (inst : ToU64 T) (self : TestType T) (x : T) : Result Bool := do let x0 ← inst.to_u64 x - if x0 > (U64.ofInt 0) - then TestType.test.TestType1.test { _0 := (U64.ofInt 0) } + if x0 > 0#u64 + then TestType.test.TestType1.test { _0 := 0#u64 } else Result.ret false /- [traits::BoolWrapper::{7}::to_type]: forward function -/ @@ -158,21 +158,21 @@ def BoolWrapper.ToTypeInst (T : Type) (inst : ToType Bool T) : ToType } /- [traits::WithConstTy::LEN2] -/ -def with_const_ty_len2_body : Result Usize := Result.ret (Usize.ofInt 32) +def with_const_ty_len2_body : Result Usize := Result.ret 32#usize def with_const_ty_len2_c : Usize := eval_global with_const_ty_len2_body (by simp) /- [traits::Bool::{8}::LEN1] -/ -def bool_len1_body : Result Usize := Result.ret (Usize.ofInt 12) +def bool_len1_body : Result Usize := Result.ret 12#usize def bool_len1_c : Usize := eval_global bool_len1_body (by simp) /- [traits::Bool::{8}::f]: merged forward/backward function (there is a single backward function, and the forward function returns ()) -/ -def Bool.f (i : U64) (a : Array U8 (Usize.ofInt 32)) : Result U64 := +def Bool.f (i : U64) (a : Array U8 32#usize) : Result U64 := Result.ret i /- Trait implementation: [traits::Bool::{8}] -/ -def Bool.WithConstTyInst : WithConstTy Bool (Usize.ofInt 32) := { +def Bool.WithConstTyInst : WithConstTy Bool 32#usize := { LEN1 := bool_len1_c LEN2 := with_const_ty_len2_c V := U8 @@ -207,9 +207,7 @@ def test_where1 (T : Type) (_x : T) : Result Unit := /- [traits::test_where2]: forward function -/ def test_where2 - (T : Type) (inst : WithConstTy T (Usize.ofInt 32)) (_x : U32) : - Result Unit - := + (T : Type) (inst : WithConstTy T 32#usize) (_x : U32) : Result Unit := Result.ret () /- [traits::test_child_trait1]: forward function -/ @@ -229,4 +227,15 @@ def order1 := Result.ret () +/- [traits::map_option]: forward function -/ +def map_option + (T F : Type) (inst : core.ops.function.Fn F T) (x : Option T) (f0 : F) : + Result (Option T) + := + match x with + | none => Result.ret none + | some x0 => do + let t ← inst.call f0 x0 + Result.ret (some t) + end traits diff --git a/tests/lean/Traits/Types.lean b/tests/lean/Traits/Types.lean index a8c12fe5..e325da6f 100644 --- a/tests/lean/Traits/Types.lean +++ b/tests/lean/Traits/Types.lean @@ -27,7 +27,7 @@ structure OfType (Self : Type) where /- Trait declaration: [traits::OfTypeBis] -/ structure OfTypeBis (Self T : Type) where - parent_clause_0 :ToType T Self + parent_clause_0 : ToType T Self of_type : T → Result Self /- [traits::TestType] -/ @@ -69,8 +69,8 @@ structure ParentTrait1 (Self : Type) where /- Trait declaration: [traits::ChildTrait] -/ structure ChildTrait (Self : Type) where - parent_clause_0 :ParentTrait0 Self - parent_clause_1 :ParentTrait1 Self + parent_clause_0 : ParentTrait0 Self + parent_clause_1 : ParentTrait1 Self /- Trait declaration: [traits::Iterator] -/ structure Iterator (Self : Type) where @@ -83,4 +83,44 @@ structure IntoIterator (Self : Type) where IntoIter_clause_0 : Iterator IntoIter into_iter : Self → Result IntoIter +/- Trait declaration: [traits::FromResidual] -/ +structure FromResidual (Self T : Type) where + +/- Trait declaration: [traits::Try] -/ +structure Try (Self : Type) where + parent_clause_0 : FromResidual Self Residual + Residual : Type + +/- Trait declaration: [traits::CFnOnce] -/ +structure CFnOnce (Self Args : Type) where + Output : Type + call_once : Self → Args → Result Output + +/- Trait declaration: [traits::CFnMut] -/ +structure CFnMut (Self Args : Type) where + parent_clause_0 : CFnOnce Self Args + call_mut : Self → Args → Result parent_clause_0.Output + call_mut_back : Self → Args → parent_clause_0.Output → Result Self + +/- Trait declaration: [traits::CFn] -/ +structure CFn (Self Args : Type) where + parent_clause_0 : CFnMut Self Args + call_mut : Self → Args → Result parent_clause_0.parent_clause_0.Output + +/- Trait declaration: [core::ops::function::FnOnce] -/ +structure core.ops.function.FnOnce (Self Args : Type) where + Output : Type + call_once : Self → Args → Result Output + +/- Trait declaration: [core::ops::function::FnMut] -/ +structure core.ops.function.FnMut (Self Args : Type) where + parent_clause_0 : core.ops.function.FnOnce Self Args + call_mut : Self → Args → Result parent_clause_0.Output + call_mut_back : Self → Args → parent_clause_0.Output → Result Self + +/- Trait declaration: [core::ops::function::Fn] -/ +structure core.ops.function.Fn (Self Args : Type) where + parent_clause_0 : core.ops.function.FnMut Self Args + call : Self → Args → Result parent_clause_0.parent_clause_0.Output + end traits -- cgit v1.3.1 From a745e81c9949f24878f788fffd36667739c59330 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 7 Nov 2023 10:44:58 +0100 Subject: Update the extraction --- compiler/Extract.ml | 4 ++-- tests/lean/Traits/Funs.lean | 9 +++++++++ tests/lean/Traits/Types.lean | 4 ++++ 3 files changed, 15 insertions(+), 2 deletions(-) (limited to 'tests/lean') diff --git a/compiler/Extract.ml b/compiler/Extract.ml index a73bf0fd..8ad8a18d 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -2416,7 +2416,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) * Extract the items *) - (* The parent clauses - we retrieve those from the impl_ref *) + (* The parent clauses *) let trait_decl_id = impl.impl_trait.trait_decl_id in TraitClauseId.iteri (fun clause_id trait_ref -> @@ -2426,7 +2426,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) extract_trait_ref ctx fmt TypeDeclId.Set.empty false trait_ref in extract_trait_impl_item ctx fmt item_name ty) - impl.impl_trait.decl_generics.trait_refs; + impl.parent_trait_refs; (* The constants *) List.iter diff --git a/tests/lean/Traits/Funs.lean b/tests/lean/Traits/Funs.lean index 156ef1e0..6a2834ff 100644 --- a/tests/lean/Traits/Funs.lean +++ b/tests/lean/Traits/Funs.lean @@ -227,6 +227,15 @@ def order1 := Result.ret () +/- Trait implementation: [traits::usize::{9}] -/ +def usize.ParentTrait1Inst : ParentTrait1 Usize := { +} + +/- Trait implementation: [traits::usize::{10}] -/ +def usize.ChildTrait1Inst : ChildTrait1 Usize := { + parent_clause_0 := usize.ParentTrait1Inst +} + /- [traits::map_option]: forward function -/ def map_option (T F : Type) (inst : core.ops.function.Fn F T) (x : Option T) (f0 : F) : diff --git a/tests/lean/Traits/Types.lean b/tests/lean/Traits/Types.lean index e325da6f..20af9cb1 100644 --- a/tests/lean/Traits/Types.lean +++ b/tests/lean/Traits/Types.lean @@ -72,6 +72,10 @@ structure ChildTrait (Self : Type) where parent_clause_0 : ParentTrait0 Self parent_clause_1 : ParentTrait1 Self +/- Trait declaration: [traits::ChildTrait1] -/ +structure ChildTrait1 (Self : Type) where + parent_clause_0 : ParentTrait1 Self + /- Trait declaration: [traits::Iterator] -/ structure Iterator (Self : Type) where Item : Type -- cgit v1.3.1 From 530a5ae56209061f091bbcafee82de07039a8124 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 8 Nov 2023 14:28:44 +0100 Subject: Update the Makefile and regenerate some tests --- Makefile | 4 ++++ tests/coq/misc/NoNestedBorrows.v | 12 ++++++++++++ tests/fstar/misc/NoNestedBorrows.fst | 12 ++++++++++++ tests/lean/NoNestedBorrows.lean | 12 ++++++++++++ 4 files changed, 40 insertions(+) (limited to 'tests/lean') diff --git a/Makefile b/Makefile index 694b47a3..486ba40e 100644 --- a/Makefile +++ b/Makefile @@ -143,6 +143,10 @@ thol4-traits: OPTIONS += thol4-array: echo "Ignoring the array test for HOL4" +# TODO: activate the traits for all the backends +thol4-traits: + echo "Ignoring the traits test for HOL4" + trans-loops: OPTIONS += -no-state trans-loops: SUBDIR := misc tfstar-loops: OPTIONS += -decreases-clauses -template-clauses diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index 47cdc3af..e916ca4a 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -71,6 +71,18 @@ Definition div_test1 (x : u32) : result u32 := Definition rem_test (x : u32) (y : u32) : result u32 := u32_rem x y. +(** [no_nested_borrows::mul_test]: forward function *) +Definition mul_test (x : u32) (y : u32) : result u32 := + u32_mul x y. + +(** [no_nested_borrows::CONST0] *) +Definition const0_body : result usize := usize_add 1%usize 1%usize. +Definition const0_c : usize := const0_body%global. + +(** [no_nested_borrows::CONST1] *) +Definition const1_body : result usize := usize_mul 2%usize 2%usize. +Definition const1_c : usize := const1_body%global. + (** [no_nested_borrows::cast_test]: forward function *) Definition cast_test (x : u32) : result i32 := scalar_cast U32 I32 x. diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 33142250..e97927aa 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -54,6 +54,18 @@ let div_test1 (x : u32) : result u32 = let rem_test (x : u32) (y : u32) : result u32 = u32_rem x y +(** [no_nested_borrows::mul_test]: forward function *) +let mul_test (x : u32) (y : u32) : result u32 = + u32_mul x y + +(** [no_nested_borrows::CONST0] *) +let const0_body : result usize = usize_add 1 1 +let const0_c : usize = eval_global const0_body + +(** [no_nested_borrows::CONST1] *) +let const1_body : result usize = usize_mul 2 2 +let const1_c : usize = eval_global const1_body + (** [no_nested_borrows::cast_test]: forward function *) let cast_test (x : u32) : result i32 = scalar_cast U32 I32 x diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index d6d603ce..c4a6a265 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -60,6 +60,18 @@ def div_test1 (x : U32) : Result U32 := def rem_test (x : U32) (y : U32) : Result U32 := x % y +/- [no_nested_borrows::mul_test]: forward function -/ +def mul_test (x : U32) (y : U32) : Result U32 := + x * y + +/- [no_nested_borrows::CONST0] -/ +def const0_body : Result Usize := 1#usize + 1#usize +def const0_c : Usize := eval_global const0_body (by simp) + +/- [no_nested_borrows::CONST1] -/ +def const1_body : Result Usize := 2#usize * 2#usize +def const1_c : Usize := eval_global const1_body (by simp) + /- [no_nested_borrows::cast_test]: forward function -/ def cast_test (x : U32) : Result I32 := Scalar.cast .I32 x -- cgit v1.3.1 From eb9ff46c69b9a95c453d64eee059916130d59846 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 9 Nov 2023 11:22:39 +0100 Subject: Regenerate some Lean tests --- tests/lean/Traits/Funs.lean | 25 +++++++++++++++++++++++++ tests/lean/Traits/Types.lean | 14 ++++++++++++++ 2 files changed, 39 insertions(+) (limited to 'tests/lean') diff --git a/tests/lean/Traits/Funs.lean b/tests/lean/Traits/Funs.lean index 6a2834ff..8d423280 100644 --- a/tests/lean/Traits/Funs.lean +++ b/tests/lean/Traits/Funs.lean @@ -247,4 +247,29 @@ def map_option let t ← inst.call f0 x0 Result.ret (some t) +/- Trait implementation: [traits::u32::{11}] -/ +def u32.WithTargetInst : WithTarget U32 := { + Target := U32 +} + +/- Trait implementation: [traits::u32::{12}] -/ +def u32.ParentTrait2Inst : ParentTrait2 U32 := { + U := U32 + U_clause_0 := u32.WithTargetInst +} + +/- [traits::u32::{13}::convert]: forward function -/ +def u32.convert (x : U32) : Result U32 := + Result.ret x + +/- Trait implementation: [traits::u32::{13}] -/ +def u32.ChildTrait2Inst : ChildTrait2 U32 := { + parent_clause_0 := u32.ParentTrait2Inst + convert := u32.convert +} + +/- [traits::incr_u32]: forward function -/ +def incr_u32 (x : U32) : Result U32 := + x + 1#u32 + end traits diff --git a/tests/lean/Traits/Types.lean b/tests/lean/Traits/Types.lean index 20af9cb1..4c5dd874 100644 --- a/tests/lean/Traits/Types.lean +++ b/tests/lean/Traits/Types.lean @@ -127,4 +127,18 @@ structure core.ops.function.Fn (Self Args : Type) where parent_clause_0 : core.ops.function.FnMut Self Args call : Self → Args → Result parent_clause_0.parent_clause_0.Output +/- Trait declaration: [traits::WithTarget] -/ +structure WithTarget (Self : Type) where + Target : Type + +/- Trait declaration: [traits::ParentTrait2] -/ +structure ParentTrait2 (Self : Type) where + U : Type + U_clause_0 : WithTarget U + +/- Trait declaration: [traits::ChildTrait2] -/ +structure ChildTrait2 (Self : Type) where + parent_clause_0 : ParentTrait2 Self + convert : parent_clause_0.U → Result parent_clause_0.U_clause_0.Target + end traits -- cgit v1.3.1 From c57dec640d4e12c3dc66969d626bbbca2eb733fd Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 9 Nov 2023 11:43:47 +0100 Subject: Modify some options and update the Makefile --- Makefile | 26 +- compiler/Config.ml | 4 +- compiler/Driver.ml | 14 +- tests/fstar/misc/Loops.fst | 784 +++++++++++++++++++++++++++++++++++++++++++ tests/lean/Array.lean | 436 +++++++++++++++++++++++- tests/lean/Loops.lean | 630 +++++++++++++++++++++++++++++++++- tests/lean/Loops/Funs.lean | 625 ---------------------------------- tests/lean/Loops/Types.lean | 13 - tests/lean/Traits.lean | 411 ++++++++++++++++++++++- tests/lean/Traits/Funs.lean | 275 --------------- tests/lean/Traits/Types.lean | 144 -------- 11 files changed, 2280 insertions(+), 1082 deletions(-) create mode 100644 tests/fstar/misc/Loops.fst delete mode 100644 tests/lean/Loops/Funs.lean delete mode 100644 tests/lean/Loops/Types.lean delete mode 100644 tests/lean/Traits/Funs.lean delete mode 100644 tests/lean/Traits/Types.lean (limited to 'tests/lean') diff --git a/Makefile b/Makefile index bdabe878..19992442 100644 --- a/Makefile +++ b/Makefile @@ -115,7 +115,7 @@ AENEAS_CMD = $(AENEAS_EXE) $(CHARON_TEST_DIR)/llbc/$(FILE).llbc -dest tests/$(BA # Add specific options to some tests test-no_nested_borrows test-paper: \ - OPTIONS += -test-trans-units -no-split-files -no-state + OPTIONS += -test-trans-units test-no_nested_borrows test-paper: SUBDIR := misc tfstar-no_nested_borrows tfstar-paper: tlean-no_nested_borrows: SUBDIR := @@ -123,7 +123,7 @@ tlean-paper: SUBDIR := thol4-no_nested_borrows: SUBDIR := misc-no_nested_borrows thol4-paper: SUBDIR := misc-paper -test-array: OPTIONS += -no-state +test-array: OPTIONS += test-array: SUBDIR := array tfstar-array: OPTIONS += -decreases-clauses -template-clauses tcoq-array: OPTIONS += -use-fuel @@ -131,7 +131,7 @@ tlean-array: SUBDIR := tlean-array: OPTIONS += thol4-array: OPTIONS += -test-traits: OPTIONS += -no-state +test-traits: OPTIONS += test-traits: SUBDIR := traits tfstar-traits: OPTIONS += -decreases-clauses -template-clauses tcoq-traits: OPTIONS += -use-fuel @@ -147,15 +147,15 @@ thol4-array: thol4-traits: echo "Ignoring the traits test for HOL4" -test-loops: OPTIONS += -no-state +test-loops: OPTIONS += test-loops: SUBDIR := misc -tfstar-loops: OPTIONS += -decreases-clauses -template-clauses -tcoq-loops: OPTIONS += -use-fuel -no-split-files +tfstar-loops: OPTIONS += -decreases-clauses -template-clauses -split-files +tcoq-loops: OPTIONS += -use-fuel tlean-loops: SUBDIR := thol4-loops: SUBDIR := misc-loops # TODO: reactivate -test-trans-units -test-hashmap: OPTIONS += -no-state +test-hashmap: OPTIONS += -split-files test-hashmap: SUBDIR := hashmap tfstar-hashmap: OPTIONS += -decreases-clauses -template-clauses tcoq-hashmap: OPTIONS += -use-fuel @@ -164,14 +164,14 @@ tlean-hashmap: OPTIONS += -no-gen-lib-entry # We add a custom import in the Hash thol4-hashmap: OPTIONS += # TODO: reactivate -test-trans-units -test-hashmap_main: OPTIONS += +test-hashmap_main: OPTIONS += -state -split-files test-hashmap_main: SUBDIR := hashmap_on_disk tfstar-hashmap_main: OPTIONS += -decreases-clauses -template-clauses tcoq-hashmap_main: OPTIONS += -use-fuel tlean-hashmap_main: SUBDIR := thol4-hashmap_main: OPTIONS += -testp-polonius_list: OPTIONS += -test-trans-units -no-split-files -no-state +testp-polonius_list: OPTIONS += -test-trans-units testp-polonius_list: SUBDIR := misc tfstarp-polonius_list: OPTIONS += tcoqp-polonius_list: OPTIONS += @@ -180,7 +180,7 @@ tleanp-polonius_list: OPTIONS += thol4p-polonius_list: SUBDIR := misc-polonius_list thol4p-polonius_list: OPTIONS += -test-constants: OPTIONS += -test-trans-units -no-split-files -no-state +test-constants: OPTIONS += -test-trans-units test-constants: SUBDIR := misc tfstar-constants: OPTIONS += tcoq-constants: OPTIONS += @@ -189,7 +189,7 @@ tlean-constants: OPTIONS += thol4-constants: SUBDIR := misc-constants thol4-constants: OPTIONS += -test-external: OPTIONS += -test-trans-units +test-external: OPTIONS += -test-trans-units -state -split-files test-external: SUBDIR := misc tfstar-external: OPTIONS += tcoq-external: OPTIONS += @@ -199,7 +199,7 @@ thol4-external: SUBDIR := misc-external thol4-external: OPTIONS += BETREE_FSTAR_OPTIONS = -decreases-clauses -template-clauses -testp-betree_main: OPTIONS += -backward-no-state-update -test-trans-units +testp-betree_main: OPTIONS += -backward-no-state-update -test-trans-units -state -split-files testp-betree_main: SUBDIR:=betree tfstarp-betree_main: OPTIONS += $(BETREE_FSTAR_OPTIONS) tcoqp-betree_main: OPTIONS += -use-fuel @@ -211,7 +211,7 @@ thol4-betree_main: OPTIONS += # This generates very ugly code, but is good to test the translation. .PHONY: ctest-testp-betree_main ctest-testp-betree_main: testp-betree_main -ctest-testp-betree_main: OPTIONS += -backend fstar -test-trans-units +ctest-testp-betree_main: OPTIONS += -backend fstar -test-trans-units -state -split-files ctest-testp-betree_main: OPTIONS += $(BETREE_FSTAR_OPTIONS) ctest-testp-betree_main: BACKEND_SUBDIR := "fstar" ctest-testp-betree_main: SUBDIR:=betree_back_stateful diff --git a/compiler/Config.ml b/compiler/Config.ml index 8483c879..a487f9e2 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -124,7 +124,7 @@ let always_deconstruct_adts_with_matches = ref false (** Controls whether we need to use a state to model the external world (I/O, for instance). *) -let use_state = ref true +let use_state = ref false (** Controls whether we use fuel to control termination. *) @@ -160,7 +160,7 @@ let backward_no_state_update = ref false files for the types, clauses and functions, or if we group them in one file. *) -let split_files = ref true +let split_files = ref false (** Generate the library entry point, if the crate is split between different files. diff --git a/compiler/Driver.ml b/compiler/Driver.ml index 14668632..128ae890 100644 --- a/compiler/Driver.ml +++ b/compiler/Driver.ml @@ -93,9 +93,9 @@ let () = Arg.Set extract_decreases_clauses, " Use decreases clauses/termination measures for the recursive \ definitions" ); - ( "-no-state", - Arg.Clear use_state, - " Do not use state-error monads, simply use error monads" ); + ( "-state", + Arg.Set use_state, + " Use a *state*-error monads, instead of an error monads" ); ( "-use-fuel", Arg.Set use_fuel, " Use a fuel parameter to control divergence" ); @@ -106,10 +106,10 @@ let () = Arg.Set extract_template_decreases_clauses, " Generate templates for the required decreases clauses/termination \ measures, in a dedicated file. Implies -decreases-clauses" ); - ( "-no-split-files", - Arg.Clear split_files, - " Do not split the definitions between different files for types, \ - functions, etc." ); + ( "-split-files", + Arg.Set split_files, + " Split the definitions between different files for types, functions, \ + etc." ); ( "-no-check-inv", Arg.Clear check_invariants, " Deactivate the invariant sanity checks performed at every evaluation \ diff --git a/tests/fstar/misc/Loops.fst b/tests/fstar/misc/Loops.fst new file mode 100644 index 00000000..823acdd4 --- /dev/null +++ b/tests/fstar/misc/Loops.fst @@ -0,0 +1,784 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [loops] *) +module Loops +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [loops::sum]: decreases clause *) +unfold let sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = admit () + +(** [loops::sum]: loop 0: forward function *) +let rec sum_loop + (max : u32) (i : u32) (s : u32) : + Tot (result u32) (decreases (sum_loop_decreases max i s)) + = + if i < max + then let* s0 = u32_add s i in let* i0 = u32_add i 1 in sum_loop max i0 s0 + else u32_mul s 2 + +(** [loops::sum]: forward function *) +let sum (max : u32) : result u32 = + sum_loop max 0 0 + +(** [loops::sum_with_mut_borrows]: decreases clause *) +unfold +let sum_with_mut_borrows_loop_decreases (max : u32) (mi : u32) (ms : u32) : nat + = + admit () + +(** [loops::sum_with_mut_borrows]: loop 0: forward function *) +let rec sum_with_mut_borrows_loop + (max : u32) (mi : u32) (ms : u32) : + Tot (result u32) (decreases (sum_with_mut_borrows_loop_decreases max mi ms)) + = + if mi < max + then + let* ms0 = u32_add ms mi in + let* mi0 = u32_add mi 1 in + sum_with_mut_borrows_loop max mi0 ms0 + else u32_mul ms 2 + +(** [loops::sum_with_mut_borrows]: forward function *) +let sum_with_mut_borrows (max : u32) : result u32 = + sum_with_mut_borrows_loop max 0 0 + +(** [loops::sum_with_shared_borrows]: decreases clause *) +unfold +let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : + nat = + admit () + +(** [loops::sum_with_shared_borrows]: loop 0: forward function *) +let rec sum_with_shared_borrows_loop + (max : u32) (i : u32) (s : u32) : + Tot (result u32) (decreases (sum_with_shared_borrows_loop_decreases max i s)) + = + if i < max + then + let* i0 = u32_add i 1 in + let* s0 = u32_add s i0 in + sum_with_shared_borrows_loop max i0 s0 + else u32_mul s 2 + +(** [loops::sum_with_shared_borrows]: forward function *) +let sum_with_shared_borrows (max : u32) : result u32 = + sum_with_shared_borrows_loop max 0 0 + +(** [loops::clear]: decreases clause *) +unfold +let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = admit () + +(** [loops::clear]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) *) +let rec clear_loop + (v : alloc_vec_Vec u32) (i : usize) : + Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i)) + = + let i0 = alloc_vec_Vec_len u32 v in + if i < i0 + then + let* i1 = usize_add i 1 in + let* v0 = + alloc_vec_Vec_index_mut_back u32 usize + (core_slice_index_usize_coresliceindexSliceIndexInst u32) v i 0 in + clear_loop v0 i1 + else Return v + +(** [loops::clear]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) *) +let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) = + clear_loop v 0 + +(** [loops::List] *) +type list_t (t : Type0) = +| List_Cons : t -> list_t t -> list_t t +| List_Nil : list_t t + +(** [loops::list_mem]: decreases clause *) +unfold let list_mem_loop_decreases (x : u32) (ls : list_t u32) : nat = admit () + +(** [loops::list_mem]: loop 0: forward function *) +let rec list_mem_loop + (x : u32) (ls : list_t u32) : + Tot (result bool) (decreases (list_mem_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> if y = x then Return true else list_mem_loop x tl + | List_Nil -> Return false + end + +(** [loops::list_mem]: forward function *) +let list_mem (x : u32) (ls : list_t u32) : result bool = + list_mem_loop x ls + +(** [loops::list_nth_mut_loop]: decreases clause *) +unfold +let list_nth_mut_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : + nat = + admit () + +(** [loops::list_nth_mut_loop]: loop 0: forward function *) +let rec list_nth_mut_loop_loop + (t : Type0) (ls : list_t t) (i : u32) : + Tot (result t) (decreases (list_nth_mut_loop_loop_decreases t ls i)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i0 = u32_sub i 1 in list_nth_mut_loop_loop t tl i0 + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop]: forward function *) +let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result t = + list_nth_mut_loop_loop t ls i + +(** [loops::list_nth_mut_loop]: loop 0: backward function 0 *) +let rec list_nth_mut_loop_loop_back + (t : Type0) (ls : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) (decreases (list_nth_mut_loop_loop_decreases t ls i)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return (List_Cons ret tl) + else + let* i0 = u32_sub i 1 in + let* tl0 = list_nth_mut_loop_loop_back t tl i0 ret in + Return (List_Cons x tl0) + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop]: backward function 0 *) +let list_nth_mut_loop_back + (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = + list_nth_mut_loop_loop_back t ls i ret + +(** [loops::list_nth_shared_loop]: decreases clause *) +unfold +let list_nth_shared_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : + nat = + admit () + +(** [loops::list_nth_shared_loop]: loop 0: forward function *) +let rec list_nth_shared_loop_loop + (t : Type0) (ls : list_t t) (i : u32) : + Tot (result t) (decreases (list_nth_shared_loop_loop_decreases t ls i)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i0 = u32_sub i 1 in list_nth_shared_loop_loop t tl i0 + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop]: forward function *) +let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t = + list_nth_shared_loop_loop t ls i + +(** [loops::get_elem_mut]: decreases clause *) +unfold +let get_elem_mut_loop_decreases (x : usize) (ls : list_t usize) : nat = + admit () + +(** [loops::get_elem_mut]: loop 0: forward function *) +let rec get_elem_mut_loop + (x : usize) (ls : list_t usize) : + Tot (result usize) (decreases (get_elem_mut_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> if y = x then Return y else get_elem_mut_loop x tl + | List_Nil -> Fail Failure + end + +(** [loops::get_elem_mut]: forward function *) +let get_elem_mut + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = + let* l = + alloc_vec_Vec_index_mut (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) + slots 0 in + get_elem_mut_loop x l + +(** [loops::get_elem_mut]: loop 0: backward function 0 *) +let rec get_elem_mut_loop_back + (x : usize) (ls : list_t usize) (ret : usize) : + Tot (result (list_t usize)) (decreases (get_elem_mut_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> + if y = x + then Return (List_Cons ret tl) + else let* tl0 = get_elem_mut_loop_back x tl ret in Return (List_Cons y tl0) + | List_Nil -> Fail Failure + end + +(** [loops::get_elem_mut]: backward function 0 *) +let get_elem_mut_back + (slots : alloc_vec_Vec (list_t usize)) (x : usize) (ret : usize) : + result (alloc_vec_Vec (list_t usize)) + = + let* l = + alloc_vec_Vec_index_mut (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) + slots 0 in + let* l0 = get_elem_mut_loop_back x l ret in + alloc_vec_Vec_index_mut_back (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) slots + 0 l0 + +(** [loops::get_elem_shared]: decreases clause *) +unfold +let get_elem_shared_loop_decreases (x : usize) (ls : list_t usize) : nat = + admit () + +(** [loops::get_elem_shared]: loop 0: forward function *) +let rec get_elem_shared_loop + (x : usize) (ls : list_t usize) : + Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls)) + = + begin match ls with + | List_Cons y tl -> if y = x then Return y else get_elem_shared_loop x tl + | List_Nil -> Fail Failure + end + +(** [loops::get_elem_shared]: forward function *) +let get_elem_shared + (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = + let* l = + alloc_vec_Vec_index (list_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) + slots 0 in + get_elem_shared_loop x l + +(** [loops::id_mut]: forward function *) +let id_mut (t : Type0) (ls : list_t t) : result (list_t t) = + Return ls + +(** [loops::id_mut]: backward function 0 *) +let id_mut_back + (t : Type0) (ls : list_t t) (ret : list_t t) : result (list_t t) = + Return ret + +(** [loops::id_shared]: forward function *) +let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = + Return ls + +(** [loops::list_nth_mut_loop_with_id]: decreases clause *) +unfold +let list_nth_mut_loop_with_id_loop_decreases (t : Type0) (i : u32) + (ls : list_t t) : nat = + admit () + +(** [loops::list_nth_mut_loop_with_id]: loop 0: forward function *) +let rec list_nth_mut_loop_with_id_loop + (t : Type0) (i : u32) (ls : list_t t) : + Tot (result t) (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i0 = u32_sub i 1 in list_nth_mut_loop_with_id_loop t i0 tl + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_with_id]: forward function *) +let list_nth_mut_loop_with_id + (t : Type0) (ls : list_t t) (i : u32) : result t = + let* ls0 = id_mut t ls in list_nth_mut_loop_with_id_loop t i ls0 + +(** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 *) +let rec list_nth_mut_loop_with_id_loop_back + (t : Type0) (i : u32) (ls : list_t t) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return (List_Cons ret tl) + else + let* i0 = u32_sub i 1 in + let* tl0 = list_nth_mut_loop_with_id_loop_back t i0 tl ret in + Return (List_Cons x tl0) + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_with_id]: backward function 0 *) +let list_nth_mut_loop_with_id_back + (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = + let* ls0 = id_mut t ls in + let* l = list_nth_mut_loop_with_id_loop_back t i ls0 ret in + id_mut_back t ls l + +(** [loops::list_nth_shared_loop_with_id]: decreases clause *) +unfold +let list_nth_shared_loop_with_id_loop_decreases (t : Type0) (i : u32) + (ls : list_t t) : nat = + admit () + +(** [loops::list_nth_shared_loop_with_id]: loop 0: forward function *) +let rec list_nth_shared_loop_with_id_loop + (t : Type0) (i : u32) (ls : list_t t) : + Tot (result t) + (decreases (list_nth_shared_loop_with_id_loop_decreases t i ls)) + = + begin match ls with + | List_Cons x tl -> + if i = 0 + then Return x + else let* i0 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i0 tl + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop_with_id]: forward function *) +let list_nth_shared_loop_with_id + (t : Type0) (ls : list_t t) (i : u32) : result t = + let* ls0 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls0 + +(** [loops::list_nth_mut_loop_pair]: decreases clause *) +unfold +let list_nth_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_loop_pair]: loop 0: forward function *) +let rec list_nth_mut_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair]: forward function *) +let list_nth_mut_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 *) +let rec list_nth_mut_loop_pair_loop_back'a + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl0) + else + let* i0 = u32_sub i 1 in + let* tl00 = list_nth_mut_loop_pair_loop_back'a t tl0 tl1 i0 ret in + Return (List_Cons x0 tl00) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair]: backward function 0 *) +let list_nth_mut_loop_pair_back'a + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_loop_pair_loop_back'a t ls0 ls1 i ret + +(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 *) +let rec list_nth_mut_loop_pair_loop_back'b + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl1) + else + let* i0 = u32_sub i 1 in + let* tl10 = list_nth_mut_loop_pair_loop_back'b t tl0 tl1 i0 ret in + Return (List_Cons x1 tl10) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair]: backward function 1 *) +let list_nth_mut_loop_pair_back'b + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_loop_pair_loop_back'b t ls0 ls1 i ret + +(** [loops::list_nth_shared_loop_pair]: decreases clause *) +unfold +let list_nth_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_loop_pair]: loop 0: forward function *) +let rec list_nth_shared_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else let* i0 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop_pair]: forward function *) +let list_nth_shared_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_mut_loop_pair_merge]: decreases clause *) +unfold +let list_nth_mut_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function *) +let rec list_nth_mut_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair_merge]: forward function *) +let list_nth_mut_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 *) +let rec list_nth_mut_loop_pair_merge_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : + Tot (result ((list_t t) & (list_t t))) + (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) + else + let* i0 = u32_sub i 1 in + let* (tl00, tl10) = + list_nth_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in + Return (List_Cons x0 tl00, List_Cons x1 tl10) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_loop_pair_merge]: backward function 0 *) +let list_nth_mut_loop_pair_merge_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : + result ((list_t t) & (list_t t)) + = + list_nth_mut_loop_pair_merge_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_shared_loop_pair_merge]: decreases clause *) +unfold +let list_nth_shared_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function *) +let rec list_nth_shared_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i0 = u32_sub i 1 in + list_nth_shared_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_loop_pair_merge]: forward function *) +let list_nth_shared_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_mut_shared_loop_pair]: decreases clause *) +unfold +let list_nth_mut_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function *) +let rec list_nth_mut_shared_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i0 = u32_sub i 1 in + list_nth_mut_shared_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair]: forward function *) +let list_nth_mut_shared_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_shared_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 *) +let rec list_nth_mut_shared_loop_pair_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl0) + else + let* i0 = u32_sub i 1 in + let* tl00 = list_nth_mut_shared_loop_pair_loop_back t tl0 tl1 i0 ret in + Return (List_Cons x0 tl00) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair]: backward function 0 *) +let list_nth_mut_shared_loop_pair_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_shared_loop_pair_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_mut_shared_loop_pair_merge]: decreases clause *) +unfold +let list_nth_mut_shared_loop_pair_merge_loop_decreases (t : Type0) + (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function *) +let rec list_nth_mut_shared_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i0 = u32_sub i 1 in + list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair_merge]: forward function *) +let list_nth_mut_shared_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 *) +let rec list_nth_mut_shared_loop_pair_merge_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl0) + else + let* i0 = u32_sub i 1 in + let* tl00 = + list_nth_mut_shared_loop_pair_merge_loop_back t tl0 tl1 i0 ret in + Return (List_Cons x0 tl00) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 *) +let list_nth_mut_shared_loop_pair_merge_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_mut_shared_loop_pair_merge_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_shared_mut_loop_pair]: decreases clause *) +unfold +let list_nth_shared_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) + (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function *) +let rec list_nth_shared_mut_loop_pair_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i0 = u32_sub i 1 in + list_nth_shared_mut_loop_pair_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair]: forward function *) +let list_nth_shared_mut_loop_pair + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_mut_loop_pair_loop t ls0 ls1 i + +(** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 *) +let rec list_nth_shared_mut_loop_pair_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl1) + else + let* i0 = u32_sub i 1 in + let* tl10 = list_nth_shared_mut_loop_pair_loop_back t tl0 tl1 i0 ret in + Return (List_Cons x1 tl10) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair]: backward function 1 *) +let list_nth_shared_mut_loop_pair_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_shared_mut_loop_pair_loop_back t ls0 ls1 i ret + +(** [loops::list_nth_shared_mut_loop_pair_merge]: decreases clause *) +unfold +let list_nth_shared_mut_loop_pair_merge_loop_decreases (t : Type0) + (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = + admit () + +(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function *) +let rec list_nth_shared_mut_loop_pair_merge_loop + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : + Tot (result (t & t)) + (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (x0, x1) + else + let* i0 = u32_sub i 1 in + list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i0 + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair_merge]: forward function *) +let list_nth_shared_mut_loop_pair_merge + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = + list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i + +(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 *) +let rec list_nth_shared_mut_loop_pair_merge_loop_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + Tot (result (list_t t)) + (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) + = + begin match ls0 with + | List_Cons x0 tl0 -> + begin match ls1 with + | List_Cons x1 tl1 -> + if i = 0 + then Return (List_Cons ret tl1) + else + let* i0 = u32_sub i 1 in + let* tl10 = + list_nth_shared_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in + Return (List_Cons x1 tl10) + | List_Nil -> Fail Failure + end + | List_Nil -> Fail Failure + end + +(** [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 *) +let list_nth_shared_mut_loop_pair_merge_back + (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : + result (list_t t) + = + list_nth_shared_mut_loop_pair_merge_loop_back t ls0 ls1 i ret + diff --git a/tests/lean/Array.lean b/tests/lean/Array.lean index 277b63d9..20f02e97 100644 --- a/tests/lean/Array.lean +++ b/tests/lean/Array.lean @@ -1 +1,435 @@ -import Array.Funs +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [array] +import Base +open Primitives + +namespace array + +/- [array::AB] -/ +inductive AB := +| A : AB +| B : AB + +/- [array::incr]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def incr (x : U32) : Result U32 := + x + 1#u32 + +/- [array::array_to_shared_slice_]: forward function -/ +def array_to_shared_slice_ + (T : Type) (s : Array T 32#usize) : Result (Slice T) := + Array.to_slice T 32#usize s + +/- [array::array_to_mut_slice_]: forward function -/ +def array_to_mut_slice_ (T : Type) (s : Array T 32#usize) : Result (Slice T) := + Array.to_slice T 32#usize s + +/- [array::array_to_mut_slice_]: backward function 0 -/ +def array_to_mut_slice__back + (T : Type) (s : Array T 32#usize) (ret0 : Slice T) : + Result (Array T 32#usize) + := + Array.from_slice T 32#usize s ret0 + +/- [array::array_len]: forward function -/ +def array_len (T : Type) (s : Array T 32#usize) : Result Usize := + do + let s0 ← Array.to_slice T 32#usize s + let i := Slice.len T s0 + Result.ret i + +/- [array::shared_array_len]: forward function -/ +def shared_array_len (T : Type) (s : Array T 32#usize) : Result Usize := + do + let s0 ← Array.to_slice T 32#usize s + let i := Slice.len T s0 + Result.ret i + +/- [array::shared_slice_len]: forward function -/ +def shared_slice_len (T : Type) (s : Slice T) : Result Usize := + let i := Slice.len T s + Result.ret i + +/- [array::index_array_shared]: forward function -/ +def index_array_shared + (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := + Array.index_usize T 32#usize s i + +/- [array::index_array_u32]: forward function -/ +def index_array_u32 (s : Array U32 32#usize) (i : Usize) : Result U32 := + Array.index_usize U32 32#usize s i + +/- [array::index_array_copy]: forward function -/ +def index_array_copy (x : Array U32 32#usize) : Result U32 := + Array.index_usize U32 32#usize x 0#usize + +/- [array::index_mut_array]: forward function -/ +def index_mut_array (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := + Array.index_usize T 32#usize s i + +/- [array::index_mut_array]: backward function 0 -/ +def index_mut_array_back + (T : Type) (s : Array T 32#usize) (i : Usize) (ret0 : T) : + Result (Array T 32#usize) + := + Array.update_usize T 32#usize s i ret0 + +/- [array::index_slice]: forward function -/ +def index_slice (T : Type) (s : Slice T) (i : Usize) : Result T := + Slice.index_usize T s i + +/- [array::index_mut_slice]: forward function -/ +def index_mut_slice (T : Type) (s : Slice T) (i : Usize) : Result T := + Slice.index_usize T s i + +/- [array::index_mut_slice]: backward function 0 -/ +def index_mut_slice_back + (T : Type) (s : Slice T) (i : Usize) (ret0 : T) : Result (Slice T) := + Slice.update_usize T s i ret0 + +/- [array::slice_subslice_shared_]: forward function -/ +def slice_subslice_shared_ + (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := + core.slice.index.Slice.index U32 (core.ops.range.Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32) x + { start := y, end_ := z } + +/- [array::slice_subslice_mut_]: forward function -/ +def slice_subslice_mut_ + (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := + core.slice.index.Slice.index_mut U32 (core.ops.range.Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32) x + { start := y, end_ := z } + +/- [array::slice_subslice_mut_]: backward function 0 -/ +def slice_subslice_mut__back + (x : Slice U32) (y : Usize) (z : Usize) (ret0 : Slice U32) : + Result (Slice U32) + := + core.slice.index.Slice.index_mut_back U32 (core.ops.range.Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32) x + { start := y, end_ := z } ret0 + +/- [array::array_to_slice_shared_]: forward function -/ +def array_to_slice_shared_ (x : Array U32 32#usize) : Result (Slice U32) := + Array.to_slice U32 32#usize x + +/- [array::array_to_slice_mut_]: forward function -/ +def array_to_slice_mut_ (x : Array U32 32#usize) : Result (Slice U32) := + Array.to_slice U32 32#usize x + +/- [array::array_to_slice_mut_]: backward function 0 -/ +def array_to_slice_mut__back + (x : Array U32 32#usize) (ret0 : Slice U32) : Result (Array U32 32#usize) := + Array.from_slice U32 32#usize x ret0 + +/- [array::array_subslice_shared_]: forward function -/ +def array_subslice_shared_ + (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := + core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } + +/- [array::array_subslice_mut_]: forward function -/ +def array_subslice_mut_ + (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := + core.array.Array.index_mut U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } + +/- [array::array_subslice_mut_]: backward function 0 -/ +def array_subslice_mut__back + (x : Array U32 32#usize) (y : Usize) (z : Usize) (ret0 : Slice U32) : + Result (Array U32 32#usize) + := + core.array.Array.index_mut_back U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } ret0 + +/- [array::index_slice_0]: forward function -/ +def index_slice_0 (T : Type) (s : Slice T) : Result T := + Slice.index_usize T s 0#usize + +/- [array::index_array_0]: forward function -/ +def index_array_0 (T : Type) (s : Array T 32#usize) : Result T := + Array.index_usize T 32#usize s 0#usize + +/- [array::index_index_array]: forward function -/ +def index_index_array + (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : + Result U32 + := + do + let a ← Array.index_usize (Array U32 32#usize) 32#usize s i + Array.index_usize U32 32#usize a j + +/- [array::update_update_array]: forward function -/ +def update_update_array + (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : + Result Unit + := + do + let a ← Array.index_usize (Array U32 32#usize) 32#usize s i + let a0 ← Array.update_usize U32 32#usize a j 0#u32 + let _ ← Array.update_usize (Array U32 32#usize) 32#usize s i a0 + Result.ret () + +/- [array::array_local_deep_copy]: forward function -/ +def array_local_deep_copy (x : Array U32 32#usize) : Result Unit := + Result.ret () + +/- [array::take_array]: forward function -/ +def take_array (a : Array U32 2#usize) : Result Unit := + Result.ret () + +/- [array::take_array_borrow]: forward function -/ +def take_array_borrow (a : Array U32 2#usize) : Result Unit := + Result.ret () + +/- [array::take_slice]: forward function -/ +def take_slice (s : Slice U32) : Result Unit := + Result.ret () + +/- [array::take_mut_slice]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def take_mut_slice (s : Slice U32) : Result (Slice U32) := + Result.ret s + +/- [array::take_all]: forward function -/ +def take_all : Result Unit := + do + let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← take_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let _ ← take_slice s + let s0 ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s1 ← take_mut_slice s0 + let _ ← + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 + Result.ret () + +/- [array::index_array]: forward function -/ +def index_array (x : Array U32 2#usize) : Result U32 := + Array.index_usize U32 2#usize x 0#usize + +/- [array::index_array_borrow]: forward function -/ +def index_array_borrow (x : Array U32 2#usize) : Result U32 := + Array.index_usize U32 2#usize x 0#usize + +/- [array::index_slice_u32_0]: forward function -/ +def index_slice_u32_0 (x : Slice U32) : Result U32 := + Slice.index_usize U32 x 0#usize + +/- [array::index_mut_slice_u32_0]: forward function -/ +def index_mut_slice_u32_0 (x : Slice U32) : Result U32 := + Slice.index_usize U32 x 0#usize + +/- [array::index_mut_slice_u32_0]: backward function 0 -/ +def index_mut_slice_u32_0_back (x : Slice U32) : Result (Slice U32) := + do + let _ ← Slice.index_usize U32 x 0#usize + Result.ret x + +/- [array::index_all]: forward function -/ +def index_all : Result U32 := + do + let i ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i0 ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i1 ← i + i0 + let i2 ← index_array_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i3 ← i1 + i2 + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i4 ← index_slice_u32_0 s + let i5 ← i3 + i4 + let s0 ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let i6 ← index_mut_slice_u32_0 s0 + let i7 ← i5 + i6 + let s1 ← index_mut_slice_u32_0_back s0 + let _ ← + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 + Result.ret i7 + +/- [array::update_array]: forward function -/ +def update_array (x : Array U32 2#usize) : Result Unit := + do + let _ ← Array.update_usize U32 2#usize x 0#usize 1#u32 + Result.ret () + +/- [array::update_array_mut_borrow]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def update_array_mut_borrow + (x : Array U32 2#usize) : Result (Array U32 2#usize) := + Array.update_usize U32 2#usize x 0#usize 1#u32 + +/- [array::update_mut_slice]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def update_mut_slice (x : Slice U32) : Result (Slice U32) := + Slice.update_usize U32 x 0#usize 1#u32 + +/- [array::update_all]: forward function -/ +def update_all : Result Unit := + do + let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let x ← update_array_mut_borrow (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s ← Array.to_slice U32 2#usize x + let s0 ← update_mut_slice s + let _ ← Array.from_slice U32 2#usize x s0 + Result.ret () + +/- [array::range_all]: forward function -/ +def range_all : Result Unit := + do + let s ← + core.array.Array.index_mut U32 (core.ops.range.Range Usize) 4#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 + (core.ops.range.Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) + (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) + { start := 1#usize, end_ := 3#usize } + let s0 ← update_mut_slice s + let _ ← + core.array.Array.index_mut_back U32 (core.ops.range.Range Usize) 4#usize + (core.slice.index.Slice.coreopsindexIndexMutInst U32 + (core.ops.range.Range Usize) + (core.slice.index.Range.coresliceindexSliceIndexInst U32)) + (Array.make U32 4#usize [ 0#u32, 0#u32, 0#u32, 0#u32 ]) + { start := 1#usize, end_ := 3#usize } s0 + Result.ret () + +/- [array::deref_array_borrow]: forward function -/ +def deref_array_borrow (x : Array U32 2#usize) : Result U32 := + Array.index_usize U32 2#usize x 0#usize + +/- [array::deref_array_mut_borrow]: forward function -/ +def deref_array_mut_borrow (x : Array U32 2#usize) : Result U32 := + Array.index_usize U32 2#usize x 0#usize + +/- [array::deref_array_mut_borrow]: backward function 0 -/ +def deref_array_mut_borrow_back + (x : Array U32 2#usize) : Result (Array U32 2#usize) := + do + let _ ← Array.index_usize U32 2#usize x 0#usize + Result.ret x + +/- [array::take_array_t]: forward function -/ +def take_array_t (a : Array AB 2#usize) : Result Unit := + Result.ret () + +/- [array::non_copyable_array]: forward function -/ +def non_copyable_array : Result Unit := + do + let _ ← take_array_t (Array.make AB 2#usize [ AB.A, AB.B ]) + Result.ret () + +/- [array::sum]: loop 0: forward function -/ +divergent def sum_loop (s : Slice U32) (sum0 : U32) (i : Usize) : Result U32 := + let i0 := Slice.len U32 s + if i < i0 + then + do + let i1 ← Slice.index_usize U32 s i + let sum1 ← sum0 + i1 + let i2 ← i + 1#usize + sum_loop s sum1 i2 + else Result.ret sum0 + +/- [array::sum]: forward function -/ +def sum (s : Slice U32) : Result U32 := + sum_loop s 0#u32 0#usize + +/- [array::sum2]: loop 0: forward function -/ +divergent def sum2_loop + (s : Slice U32) (s2 : Slice U32) (sum0 : U32) (i : Usize) : Result U32 := + let i0 := Slice.len U32 s + if i < i0 + then + do + let i1 ← Slice.index_usize U32 s i + let i2 ← Slice.index_usize U32 s2 i + let i3 ← i1 + i2 + let sum1 ← sum0 + i3 + let i4 ← i + 1#usize + sum2_loop s s2 sum1 i4 + else Result.ret sum0 + +/- [array::sum2]: forward function -/ +def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 := + let i := Slice.len U32 s + let i0 := Slice.len U32 s2 + if not (i = i0) + then Result.fail Error.panic + else sum2_loop s s2 0#u32 0#usize + +/- [array::f0]: forward function -/ +def f0 : Result Unit := + do + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let s0 ← Slice.update_usize U32 s 0#usize 1#u32 + let _ ← + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) s0 + Result.ret () + +/- [array::f1]: forward function -/ +def f1 : Result Unit := + do + let _ ← + Array.update_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + 0#usize 1#u32 + Result.ret () + +/- [array::f2]: forward function -/ +def f2 (i : U32) : Result Unit := + Result.ret () + +/- [array::f4]: forward function -/ +def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := + core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize + (core.slice.index.Slice.coreopsindexIndexInst U32 (core.ops.range.Range + Usize) (core.slice.index.Range.coresliceindexSliceIndexInst U32)) x + { start := y, end_ := z } + +/- [array::f3]: forward function -/ +def f3 : Result U32 := + do + let i ← + Array.index_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + 0#usize + let _ ← f2 i + let b := Array.repeat U32 32#usize 0#u32 + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) + let s0 ← f4 b 16#usize 18#usize + sum2 s s0 + +/- [array::SZ] -/ +def sz_body : Result Usize := Result.ret 32#usize +def sz_c : Usize := eval_global sz_body (by simp) + +/- [array::f5]: forward function -/ +def f5 (x : Array U32 32#usize) : Result U32 := + Array.index_usize U32 32#usize x 0#usize + +/- [array::ite]: forward function -/ +def ite : Result Unit := + do + let s ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s0 ← + Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + let s1 ← index_mut_slice_u32_0_back s0 + let _ ← + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s1 + let s2 ← index_mut_slice_u32_0_back s + let _ ← + Array.from_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) s2 + Result.ret () + +end array diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index 60c73776..c6360338 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -1 +1,629 @@ -import Loops.Funs +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [loops] +import Base +open Primitives + +namespace loops + +/- [loops::sum]: loop 0: forward function -/ +divergent def sum_loop (max : U32) (i : U32) (s : U32) : Result U32 := + if i < max + then do + let s0 ← s + i + let i0 ← i + 1#u32 + sum_loop max i0 s0 + else s * 2#u32 + +/- [loops::sum]: forward function -/ +def sum (max : U32) : Result U32 := + sum_loop max 0#u32 0#u32 + +/- [loops::sum_with_mut_borrows]: loop 0: forward function -/ +divergent def sum_with_mut_borrows_loop + (max : U32) (mi : U32) (ms : U32) : Result U32 := + if mi < max + then + do + let ms0 ← ms + mi + let mi0 ← mi + 1#u32 + sum_with_mut_borrows_loop max mi0 ms0 + else ms * 2#u32 + +/- [loops::sum_with_mut_borrows]: forward function -/ +def sum_with_mut_borrows (max : U32) : Result U32 := + sum_with_mut_borrows_loop max 0#u32 0#u32 + +/- [loops::sum_with_shared_borrows]: loop 0: forward function -/ +divergent def sum_with_shared_borrows_loop + (max : U32) (i : U32) (s : U32) : Result U32 := + if i < max + then + do + let i0 ← i + 1#u32 + let s0 ← s + i0 + sum_with_shared_borrows_loop max i0 s0 + else s * 2#u32 + +/- [loops::sum_with_shared_borrows]: forward function -/ +def sum_with_shared_borrows (max : U32) : Result U32 := + sum_with_shared_borrows_loop max 0#u32 0#u32 + +/- [loops::clear]: loop 0: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +divergent def clear_loop + (v : alloc.vec.Vec U32) (i : Usize) : Result (alloc.vec.Vec U32) := + let i0 := alloc.vec.Vec.len U32 v + if i < i0 + then + do + let i1 ← i + 1#usize + let v0 ← + alloc.vec.Vec.index_mut_back U32 Usize + (core.slice.index.usize.coresliceindexSliceIndexInst U32) v i 0#u32 + clear_loop v0 i1 + else Result.ret v + +/- [loops::clear]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def clear (v : alloc.vec.Vec U32) : Result (alloc.vec.Vec U32) := + clear_loop v 0#usize + +/- [loops::List] -/ +inductive List (T : Type) := +| Cons : T → List T → List T +| Nil : List T + +/- [loops::list_mem]: loop 0: forward function -/ +divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := + match ls with + | List.Cons y tl => if y = x + then Result.ret true + else list_mem_loop x tl + | List.Nil => Result.ret false + +/- [loops::list_mem]: forward function -/ +def list_mem (x : U32) (ls : List U32) : Result Bool := + list_mem_loop x ls + +/- [loops::list_nth_mut_loop]: loop 0: forward function -/ +divergent def list_nth_mut_loop_loop + (T : Type) (ls : List T) (i : U32) : Result T := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret x + else do + let i0 ← i - 1#u32 + list_nth_mut_loop_loop T tl i0 + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop]: forward function -/ +def list_nth_mut_loop (T : Type) (ls : List T) (i : U32) : Result T := + list_nth_mut_loop_loop T ls i + +/- [loops::list_nth_mut_loop]: loop 0: backward function 0 -/ +divergent def list_nth_mut_loop_loop_back + (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl) + else + do + let i0 ← i - 1#u32 + let tl0 ← list_nth_mut_loop_loop_back T tl i0 ret0 + Result.ret (List.Cons x tl0) + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop]: backward function 0 -/ +def list_nth_mut_loop_back + (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := + list_nth_mut_loop_loop_back T ls i ret0 + +/- [loops::list_nth_shared_loop]: loop 0: forward function -/ +divergent def list_nth_shared_loop_loop + (T : Type) (ls : List T) (i : U32) : Result T := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret x + else do + let i0 ← i - 1#u32 + list_nth_shared_loop_loop T tl i0 + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_loop]: forward function -/ +def list_nth_shared_loop (T : Type) (ls : List T) (i : U32) : Result T := + list_nth_shared_loop_loop T ls i + +/- [loops::get_elem_mut]: loop 0: forward function -/ +divergent def get_elem_mut_loop (x : Usize) (ls : List Usize) : Result Usize := + match ls with + | List.Cons y tl => if y = x + then Result.ret y + else get_elem_mut_loop x tl + | List.Nil => Result.fail Error.panic + +/- [loops::get_elem_mut]: forward function -/ +def get_elem_mut + (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := + do + let l ← + alloc.vec.Vec.index_mut (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) + slots 0#usize + get_elem_mut_loop x l + +/- [loops::get_elem_mut]: loop 0: backward function 0 -/ +divergent def get_elem_mut_loop_back + (x : Usize) (ls : List Usize) (ret0 : Usize) : Result (List Usize) := + match ls with + | List.Cons y tl => + if y = x + then Result.ret (List.Cons ret0 tl) + else + do + let tl0 ← get_elem_mut_loop_back x tl ret0 + Result.ret (List.Cons y tl0) + | List.Nil => Result.fail Error.panic + +/- [loops::get_elem_mut]: backward function 0 -/ +def get_elem_mut_back + (slots : alloc.vec.Vec (List Usize)) (x : Usize) (ret0 : Usize) : + Result (alloc.vec.Vec (List Usize)) + := + do + let l ← + alloc.vec.Vec.index_mut (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) + slots 0#usize + let l0 ← get_elem_mut_loop_back x l ret0 + alloc.vec.Vec.index_mut_back (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) slots + 0#usize l0 + +/- [loops::get_elem_shared]: loop 0: forward function -/ +divergent def get_elem_shared_loop + (x : Usize) (ls : List Usize) : Result Usize := + match ls with + | List.Cons y tl => if y = x + then Result.ret y + else get_elem_shared_loop x tl + | List.Nil => Result.fail Error.panic + +/- [loops::get_elem_shared]: forward function -/ +def get_elem_shared + (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := + do + let l ← + alloc.vec.Vec.index (List Usize) Usize + (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) + slots 0#usize + get_elem_shared_loop x l + +/- [loops::id_mut]: forward function -/ +def id_mut (T : Type) (ls : List T) : Result (List T) := + Result.ret ls + +/- [loops::id_mut]: backward function 0 -/ +def id_mut_back (T : Type) (ls : List T) (ret0 : List T) : Result (List T) := + Result.ret ret0 + +/- [loops::id_shared]: forward function -/ +def id_shared (T : Type) (ls : List T) : Result (List T) := + Result.ret ls + +/- [loops::list_nth_mut_loop_with_id]: loop 0: forward function -/ +divergent def list_nth_mut_loop_with_id_loop + (T : Type) (i : U32) (ls : List T) : Result T := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret x + else do + let i0 ← i - 1#u32 + list_nth_mut_loop_with_id_loop T i0 tl + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_with_id]: forward function -/ +def list_nth_mut_loop_with_id (T : Type) (ls : List T) (i : U32) : Result T := + do + let ls0 ← id_mut T ls + list_nth_mut_loop_with_id_loop T i ls0 + +/- [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 -/ +divergent def list_nth_mut_loop_with_id_loop_back + (T : Type) (i : U32) (ls : List T) (ret0 : T) : Result (List T) := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl) + else + do + let i0 ← i - 1#u32 + let tl0 ← list_nth_mut_loop_with_id_loop_back T i0 tl ret0 + Result.ret (List.Cons x tl0) + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_with_id]: backward function 0 -/ +def list_nth_mut_loop_with_id_back + (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := + do + let ls0 ← id_mut T ls + let l ← list_nth_mut_loop_with_id_loop_back T i ls0 ret0 + id_mut_back T ls l + +/- [loops::list_nth_shared_loop_with_id]: loop 0: forward function -/ +divergent def list_nth_shared_loop_with_id_loop + (T : Type) (i : U32) (ls : List T) : Result T := + match ls with + | List.Cons x tl => + if i = 0#u32 + then Result.ret x + else do + let i0 ← i - 1#u32 + list_nth_shared_loop_with_id_loop T i0 tl + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_loop_with_id]: forward function -/ +def list_nth_shared_loop_with_id + (T : Type) (ls : List T) (i : U32) : Result T := + do + let ls0 ← id_shared T ls + list_nth_shared_loop_with_id_loop T i ls0 + +/- [loops::list_nth_mut_loop_pair]: loop 0: forward function -/ +divergent def list_nth_mut_loop_pair_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else do + let i0 ← i - 1#u32 + list_nth_mut_loop_pair_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_pair]: forward function -/ +def list_nth_mut_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_mut_loop_pair_loop T ls0 ls1 i + +/- [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 -/ +divergent def list_nth_mut_loop_pair_loop_back'a + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl0) + else + do + let i0 ← i - 1#u32 + let tl00 ← list_nth_mut_loop_pair_loop_back'a T tl0 tl1 i0 ret0 + Result.ret (List.Cons x0 tl00) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_pair]: backward function 0 -/ +def list_nth_mut_loop_pair_back'a + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + list_nth_mut_loop_pair_loop_back'a T ls0 ls1 i ret0 + +/- [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 -/ +divergent def list_nth_mut_loop_pair_loop_back'b + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl1) + else + do + let i0 ← i - 1#u32 + let tl10 ← list_nth_mut_loop_pair_loop_back'b T tl0 tl1 i0 ret0 + Result.ret (List.Cons x1 tl10) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_pair]: backward function 1 -/ +def list_nth_mut_loop_pair_back'b + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + list_nth_mut_loop_pair_loop_back'b T ls0 ls1 i ret0 + +/- [loops::list_nth_shared_loop_pair]: loop 0: forward function -/ +divergent def list_nth_shared_loop_pair_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else do + let i0 ← i - 1#u32 + list_nth_shared_loop_pair_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_loop_pair]: forward function -/ +def list_nth_shared_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_shared_loop_pair_loop T ls0 ls1 i + +/- [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function -/ +divergent def list_nth_mut_loop_pair_merge_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else + do + let i0 ← i - 1#u32 + list_nth_mut_loop_pair_merge_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_pair_merge]: forward function -/ +def list_nth_mut_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_mut_loop_pair_merge_loop T ls0 ls1 i + +/- [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 -/ +divergent def list_nth_mut_loop_pair_merge_loop_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : (T × T)) : + Result ((List T) × (List T)) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then let (t, t0) := ret0 + Result.ret (List.Cons t tl0, List.Cons t0 tl1) + else + do + let i0 ← i - 1#u32 + let (tl00, tl10) ← + list_nth_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 + Result.ret (List.Cons x0 tl00, List.Cons x1 tl10) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_loop_pair_merge]: backward function 0 -/ +def list_nth_mut_loop_pair_merge_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : (T × T)) : + Result ((List T) × (List T)) + := + list_nth_mut_loop_pair_merge_loop_back T ls0 ls1 i ret0 + +/- [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function -/ +divergent def list_nth_shared_loop_pair_merge_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else + do + let i0 ← i - 1#u32 + list_nth_shared_loop_pair_merge_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_loop_pair_merge]: forward function -/ +def list_nth_shared_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_shared_loop_pair_merge_loop T ls0 ls1 i + +/- [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function -/ +divergent def list_nth_mut_shared_loop_pair_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else + do + let i0 ← i - 1#u32 + list_nth_mut_shared_loop_pair_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_shared_loop_pair]: forward function -/ +def list_nth_mut_shared_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_mut_shared_loop_pair_loop T ls0 ls1 i + +/- [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 -/ +divergent def list_nth_mut_shared_loop_pair_loop_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl0) + else + do + let i0 ← i - 1#u32 + let tl00 ← + list_nth_mut_shared_loop_pair_loop_back T tl0 tl1 i0 ret0 + Result.ret (List.Cons x0 tl00) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_shared_loop_pair]: backward function 0 -/ +def list_nth_mut_shared_loop_pair_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + list_nth_mut_shared_loop_pair_loop_back T ls0 ls1 i ret0 + +/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function -/ +divergent def list_nth_mut_shared_loop_pair_merge_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else + do + let i0 ← i - 1#u32 + list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_shared_loop_pair_merge]: forward function -/ +def list_nth_mut_shared_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i + +/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 -/ +divergent def list_nth_mut_shared_loop_pair_merge_loop_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl0) + else + do + let i0 ← i - 1#u32 + let tl00 ← + list_nth_mut_shared_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 + Result.ret (List.Cons x0 tl00) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 -/ +def list_nth_mut_shared_loop_pair_merge_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + list_nth_mut_shared_loop_pair_merge_loop_back T ls0 ls1 i ret0 + +/- [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function -/ +divergent def list_nth_shared_mut_loop_pair_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else + do + let i0 ← i - 1#u32 + list_nth_shared_mut_loop_pair_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_mut_loop_pair]: forward function -/ +def list_nth_shared_mut_loop_pair + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_shared_mut_loop_pair_loop T ls0 ls1 i + +/- [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 -/ +divergent def list_nth_shared_mut_loop_pair_loop_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl1) + else + do + let i0 ← i - 1#u32 + let tl10 ← + list_nth_shared_mut_loop_pair_loop_back T tl0 tl1 i0 ret0 + Result.ret (List.Cons x1 tl10) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_mut_loop_pair]: backward function 1 -/ +def list_nth_shared_mut_loop_pair_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + list_nth_shared_mut_loop_pair_loop_back T ls0 ls1 i ret0 + +/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function -/ +divergent def list_nth_shared_mut_loop_pair_merge_loop + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (x0, x1) + else + do + let i0 ← i - 1#u32 + list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i0 + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_mut_loop_pair_merge]: forward function -/ +def list_nth_shared_mut_loop_pair_merge + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := + list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i + +/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 -/ +divergent def list_nth_shared_mut_loop_pair_merge_loop_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + match ls0 with + | List.Cons x0 tl0 => + match ls1 with + | List.Cons x1 tl1 => + if i = 0#u32 + then Result.ret (List.Cons ret0 tl1) + else + do + let i0 ← i - 1#u32 + let tl10 ← + list_nth_shared_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 + Result.ret (List.Cons x1 tl10) + | List.Nil => Result.fail Error.panic + | List.Nil => Result.fail Error.panic + +/- [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 -/ +def list_nth_shared_mut_loop_pair_merge_back + (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : + Result (List T) + := + list_nth_shared_mut_loop_pair_merge_loop_back T ls0 ls1 i ret0 + +end loops diff --git a/tests/lean/Loops/Funs.lean b/tests/lean/Loops/Funs.lean deleted file mode 100644 index f9c7569e..00000000 --- a/tests/lean/Loops/Funs.lean +++ /dev/null @@ -1,625 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [loops]: function definitions -import Base -import Loops.Types -open Primitives - -namespace loops - -/- [loops::sum]: loop 0: forward function -/ -divergent def sum_loop (max : U32) (i : U32) (s : U32) : Result U32 := - if i < max - then do - let s0 ← s + i - let i0 ← i + 1#u32 - sum_loop max i0 s0 - else s * 2#u32 - -/- [loops::sum]: forward function -/ -def sum (max : U32) : Result U32 := - sum_loop max 0#u32 0#u32 - -/- [loops::sum_with_mut_borrows]: loop 0: forward function -/ -divergent def sum_with_mut_borrows_loop - (max : U32) (mi : U32) (ms : U32) : Result U32 := - if mi < max - then - do - let ms0 ← ms + mi - let mi0 ← mi + 1#u32 - sum_with_mut_borrows_loop max mi0 ms0 - else ms * 2#u32 - -/- [loops::sum_with_mut_borrows]: forward function -/ -def sum_with_mut_borrows (max : U32) : Result U32 := - sum_with_mut_borrows_loop max 0#u32 0#u32 - -/- [loops::sum_with_shared_borrows]: loop 0: forward function -/ -divergent def sum_with_shared_borrows_loop - (max : U32) (i : U32) (s : U32) : Result U32 := - if i < max - then - do - let i0 ← i + 1#u32 - let s0 ← s + i0 - sum_with_shared_borrows_loop max i0 s0 - else s * 2#u32 - -/- [loops::sum_with_shared_borrows]: forward function -/ -def sum_with_shared_borrows (max : U32) : Result U32 := - sum_with_shared_borrows_loop max 0#u32 0#u32 - -/- [loops::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) -/ -divergent def clear_loop - (v : alloc.vec.Vec U32) (i : Usize) : Result (alloc.vec.Vec U32) := - let i0 := alloc.vec.Vec.len U32 v - if i < i0 - then - do - let i1 ← i + 1#usize - let v0 ← - alloc.vec.Vec.index_mut_back U32 Usize - (core.slice.index.usize.coresliceindexSliceIndexInst U32) v i 0#u32 - clear_loop v0 i1 - else Result.ret v - -/- [loops::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) -/ -def clear (v : alloc.vec.Vec U32) : Result (alloc.vec.Vec U32) := - clear_loop v 0#usize - -/- [loops::list_mem]: loop 0: forward function -/ -divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := - match ls with - | List.Cons y tl => if y = x - then Result.ret true - else list_mem_loop x tl - | List.Nil => Result.ret false - -/- [loops::list_mem]: forward function -/ -def list_mem (x : U32) (ls : List U32) : Result Bool := - list_mem_loop x ls - -/- [loops::list_nth_mut_loop]: loop 0: forward function -/ -divergent def list_nth_mut_loop_loop - (T : Type) (ls : List T) (i : U32) : Result T := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_mut_loop_loop T tl i0 - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop]: forward function -/ -def list_nth_mut_loop (T : Type) (ls : List T) (i : U32) : Result T := - list_nth_mut_loop_loop T ls i - -/- [loops::list_nth_mut_loop]: loop 0: backward function 0 -/ -divergent def list_nth_mut_loop_loop_back - (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl) - else - do - let i0 ← i - 1#u32 - let tl0 ← list_nth_mut_loop_loop_back T tl i0 ret0 - Result.ret (List.Cons x tl0) - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop]: backward function 0 -/ -def list_nth_mut_loop_back - (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := - list_nth_mut_loop_loop_back T ls i ret0 - -/- [loops::list_nth_shared_loop]: loop 0: forward function -/ -divergent def list_nth_shared_loop_loop - (T : Type) (ls : List T) (i : U32) : Result T := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_shared_loop_loop T tl i0 - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_loop]: forward function -/ -def list_nth_shared_loop (T : Type) (ls : List T) (i : U32) : Result T := - list_nth_shared_loop_loop T ls i - -/- [loops::get_elem_mut]: loop 0: forward function -/ -divergent def get_elem_mut_loop (x : Usize) (ls : List Usize) : Result Usize := - match ls with - | List.Cons y tl => if y = x - then Result.ret y - else get_elem_mut_loop x tl - | List.Nil => Result.fail Error.panic - -/- [loops::get_elem_mut]: forward function -/ -def get_elem_mut - (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := - do - let l ← - alloc.vec.Vec.index_mut (List Usize) Usize - (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) - slots 0#usize - get_elem_mut_loop x l - -/- [loops::get_elem_mut]: loop 0: backward function 0 -/ -divergent def get_elem_mut_loop_back - (x : Usize) (ls : List Usize) (ret0 : Usize) : Result (List Usize) := - match ls with - | List.Cons y tl => - if y = x - then Result.ret (List.Cons ret0 tl) - else - do - let tl0 ← get_elem_mut_loop_back x tl ret0 - Result.ret (List.Cons y tl0) - | List.Nil => Result.fail Error.panic - -/- [loops::get_elem_mut]: backward function 0 -/ -def get_elem_mut_back - (slots : alloc.vec.Vec (List Usize)) (x : Usize) (ret0 : Usize) : - Result (alloc.vec.Vec (List Usize)) - := - do - let l ← - alloc.vec.Vec.index_mut (List Usize) Usize - (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) - slots 0#usize - let l0 ← get_elem_mut_loop_back x l ret0 - alloc.vec.Vec.index_mut_back (List Usize) Usize - (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) slots - 0#usize l0 - -/- [loops::get_elem_shared]: loop 0: forward function -/ -divergent def get_elem_shared_loop - (x : Usize) (ls : List Usize) : Result Usize := - match ls with - | List.Cons y tl => if y = x - then Result.ret y - else get_elem_shared_loop x tl - | List.Nil => Result.fail Error.panic - -/- [loops::get_elem_shared]: forward function -/ -def get_elem_shared - (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := - do - let l ← - alloc.vec.Vec.index (List Usize) Usize - (core.slice.index.usize.coresliceindexSliceIndexInst (List Usize)) - slots 0#usize - get_elem_shared_loop x l - -/- [loops::id_mut]: forward function -/ -def id_mut (T : Type) (ls : List T) : Result (List T) := - Result.ret ls - -/- [loops::id_mut]: backward function 0 -/ -def id_mut_back (T : Type) (ls : List T) (ret0 : List T) : Result (List T) := - Result.ret ret0 - -/- [loops::id_shared]: forward function -/ -def id_shared (T : Type) (ls : List T) : Result (List T) := - Result.ret ls - -/- [loops::list_nth_mut_loop_with_id]: loop 0: forward function -/ -divergent def list_nth_mut_loop_with_id_loop - (T : Type) (i : U32) (ls : List T) : Result T := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_mut_loop_with_id_loop T i0 tl - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_with_id]: forward function -/ -def list_nth_mut_loop_with_id (T : Type) (ls : List T) (i : U32) : Result T := - do - let ls0 ← id_mut T ls - list_nth_mut_loop_with_id_loop T i ls0 - -/- [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 -/ -divergent def list_nth_mut_loop_with_id_loop_back - (T : Type) (i : U32) (ls : List T) (ret0 : T) : Result (List T) := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl) - else - do - let i0 ← i - 1#u32 - let tl0 ← list_nth_mut_loop_with_id_loop_back T i0 tl ret0 - Result.ret (List.Cons x tl0) - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_with_id]: backward function 0 -/ -def list_nth_mut_loop_with_id_back - (T : Type) (ls : List T) (i : U32) (ret0 : T) : Result (List T) := - do - let ls0 ← id_mut T ls - let l ← list_nth_mut_loop_with_id_loop_back T i ls0 ret0 - id_mut_back T ls l - -/- [loops::list_nth_shared_loop_with_id]: loop 0: forward function -/ -divergent def list_nth_shared_loop_with_id_loop - (T : Type) (i : U32) (ls : List T) : Result T := - match ls with - | List.Cons x tl => - if i = 0#u32 - then Result.ret x - else do - let i0 ← i - 1#u32 - list_nth_shared_loop_with_id_loop T i0 tl - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_loop_with_id]: forward function -/ -def list_nth_shared_loop_with_id - (T : Type) (ls : List T) (i : U32) : Result T := - do - let ls0 ← id_shared T ls - list_nth_shared_loop_with_id_loop T i ls0 - -/- [loops::list_nth_mut_loop_pair]: loop 0: forward function -/ -divergent def list_nth_mut_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else do - let i0 ← i - 1#u32 - list_nth_mut_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_pair]: forward function -/ -def list_nth_mut_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 -/ -divergent def list_nth_mut_loop_pair_loop_back'a - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl0) - else - do - let i0 ← i - 1#u32 - let tl00 ← list_nth_mut_loop_pair_loop_back'a T tl0 tl1 i0 ret0 - Result.ret (List.Cons x0 tl00) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_pair]: backward function 0 -/ -def list_nth_mut_loop_pair_back'a - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - list_nth_mut_loop_pair_loop_back'a T ls0 ls1 i ret0 - -/- [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 -/ -divergent def list_nth_mut_loop_pair_loop_back'b - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl1) - else - do - let i0 ← i - 1#u32 - let tl10 ← list_nth_mut_loop_pair_loop_back'b T tl0 tl1 i0 ret0 - Result.ret (List.Cons x1 tl10) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_pair]: backward function 1 -/ -def list_nth_mut_loop_pair_back'b - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - list_nth_mut_loop_pair_loop_back'b T ls0 ls1 i ret0 - -/- [loops::list_nth_shared_loop_pair]: loop 0: forward function -/ -divergent def list_nth_shared_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else do - let i0 ← i - 1#u32 - list_nth_shared_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_loop_pair]: forward function -/ -def list_nth_shared_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_shared_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function -/ -divergent def list_nth_mut_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_mut_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_pair_merge]: forward function -/ -def list_nth_mut_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 -/ -divergent def list_nth_mut_loop_pair_merge_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : (T × T)) : - Result ((List T) × (List T)) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then let (t, t0) := ret0 - Result.ret (List.Cons t tl0, List.Cons t0 tl1) - else - do - let i0 ← i - 1#u32 - let (tl00, tl10) ← - list_nth_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 - Result.ret (List.Cons x0 tl00, List.Cons x1 tl10) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_loop_pair_merge]: backward function 0 -/ -def list_nth_mut_loop_pair_merge_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : (T × T)) : - Result ((List T) × (List T)) - := - list_nth_mut_loop_pair_merge_loop_back T ls0 ls1 i ret0 - -/- [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function -/ -divergent def list_nth_shared_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_shared_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_loop_pair_merge]: forward function -/ -def list_nth_shared_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_shared_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function -/ -divergent def list_nth_mut_shared_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_mut_shared_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_shared_loop_pair]: forward function -/ -def list_nth_mut_shared_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_shared_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 -/ -divergent def list_nth_mut_shared_loop_pair_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl0) - else - do - let i0 ← i - 1#u32 - let tl00 ← - list_nth_mut_shared_loop_pair_loop_back T tl0 tl1 i0 ret0 - Result.ret (List.Cons x0 tl00) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_shared_loop_pair]: backward function 0 -/ -def list_nth_mut_shared_loop_pair_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - list_nth_mut_shared_loop_pair_loop_back T ls0 ls1 i ret0 - -/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function -/ -divergent def list_nth_mut_shared_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_shared_loop_pair_merge]: forward function -/ -def list_nth_mut_shared_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 -/ -divergent def list_nth_mut_shared_loop_pair_merge_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl0) - else - do - let i0 ← i - 1#u32 - let tl00 ← - list_nth_mut_shared_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 - Result.ret (List.Cons x0 tl00) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 -/ -def list_nth_mut_shared_loop_pair_merge_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - list_nth_mut_shared_loop_pair_merge_loop_back T ls0 ls1 i ret0 - -/- [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function -/ -divergent def list_nth_shared_mut_loop_pair_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_shared_mut_loop_pair_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_mut_loop_pair]: forward function -/ -def list_nth_shared_mut_loop_pair - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_shared_mut_loop_pair_loop T ls0 ls1 i - -/- [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 -/ -divergent def list_nth_shared_mut_loop_pair_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl1) - else - do - let i0 ← i - 1#u32 - let tl10 ← - list_nth_shared_mut_loop_pair_loop_back T tl0 tl1 i0 ret0 - Result.ret (List.Cons x1 tl10) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_mut_loop_pair]: backward function 1 -/ -def list_nth_shared_mut_loop_pair_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - list_nth_shared_mut_loop_pair_loop_back T ls0 ls1 i ret0 - -/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function -/ -divergent def list_nth_shared_mut_loop_pair_merge_loop - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (x0, x1) - else - do - let i0 ← i - 1#u32 - list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i0 - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_mut_loop_pair_merge]: forward function -/ -def list_nth_shared_mut_loop_pair_merge - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := - list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i - -/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 -/ -divergent def list_nth_shared_mut_loop_pair_merge_loop_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - match ls0 with - | List.Cons x0 tl0 => - match ls1 with - | List.Cons x1 tl1 => - if i = 0#u32 - then Result.ret (List.Cons ret0 tl1) - else - do - let i0 ← i - 1#u32 - let tl10 ← - list_nth_shared_mut_loop_pair_merge_loop_back T tl0 tl1 i0 ret0 - Result.ret (List.Cons x1 tl10) - | List.Nil => Result.fail Error.panic - | List.Nil => Result.fail Error.panic - -/- [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 -/ -def list_nth_shared_mut_loop_pair_merge_back - (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) (ret0 : T) : - Result (List T) - := - list_nth_shared_mut_loop_pair_merge_loop_back T ls0 ls1 i ret0 - -end loops diff --git a/tests/lean/Loops/Types.lean b/tests/lean/Loops/Types.lean deleted file mode 100644 index 018af901..00000000 --- a/tests/lean/Loops/Types.lean +++ /dev/null @@ -1,13 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [loops]: type definitions -import Base -open Primitives - -namespace loops - -/- [loops::List] -/ -inductive List (T : Type) := -| Cons : T → List T → List T -| Nil : List T - -end loops diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index 5e812e95..94ae0bb0 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -1 +1,410 @@ -import Traits.Funs +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [traits] +import Base +open Primitives + +namespace traits + +/- Trait declaration: [traits::BoolTrait] -/ +structure BoolTrait (Self : Type) where + get_bool : Self → Result Bool + +/- [traits::Bool::{0}::get_bool]: forward function -/ +def Bool.get_bool (self : Bool) : Result Bool := + Result.ret self + +/- Trait implementation: [traits::Bool::{0}] -/ +def Bool.BoolTraitInst : BoolTrait Bool := { + get_bool := Bool.get_bool +} + +/- [traits::BoolTrait::ret_true]: forward function -/ +def BoolTrait.ret_true + {Self : Type} (self_clause : BoolTrait Self) (self : Self) : Result Bool := + Result.ret true + +/- [traits::test_bool_trait_bool]: forward function -/ +def test_bool_trait_bool (x : Bool) : Result Bool := + do + let b ← Bool.get_bool x + if b + then BoolTrait.ret_true Bool.BoolTraitInst x + else Result.ret false + +/- [traits::Option::{1}::get_bool]: forward function -/ +def Option.get_bool (T : Type) (self : Option T) : Result Bool := + match self with + | none => Result.ret false + | some t => Result.ret true + +/- Trait implementation: [traits::Option::{1}] -/ +def Option.BoolTraitInst (T : Type) : BoolTrait (Option T) := { + get_bool := Option.get_bool T +} + +/- [traits::test_bool_trait_option]: forward function -/ +def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := + do + let b ← Option.get_bool T x + if b + then BoolTrait.ret_true (Option.BoolTraitInst T) x + else Result.ret false + +/- [traits::test_bool_trait]: forward function -/ +def test_bool_trait (T : Type) (inst : BoolTrait T) (x : T) : Result Bool := + inst.get_bool x + +/- Trait declaration: [traits::ToU64] -/ +structure ToU64 (Self : Type) where + to_u64 : Self → Result U64 + +/- [traits::u64::{2}::to_u64]: forward function -/ +def u64.to_u64 (self : U64) : Result U64 := + Result.ret self + +/- Trait implementation: [traits::u64::{2}] -/ +def u64.ToU64Inst : ToU64 U64 := { + to_u64 := u64.to_u64 +} + +/- [traits::Tuple2::{3}::to_u64]: forward function -/ +def Tuple2.to_u64 (A : Type) (inst : ToU64 A) (self : (A × A)) : Result U64 := + do + let (t, t0) := self + let i ← inst.to_u64 t + let i0 ← inst.to_u64 t0 + i + i0 + +/- Trait implementation: [traits::Tuple2::{3}] -/ +def Tuple2.ToU64Inst (A : Type) (inst : ToU64 A) : ToU64 (A × A) := { + to_u64 := Tuple2.to_u64 A inst +} + +/- [traits::f]: forward function -/ +def f (T : Type) (inst : ToU64 T) (x : (T × T)) : Result U64 := + Tuple2.to_u64 T inst x + +/- [traits::g]: forward function -/ +def g (T : Type) (inst : ToU64 (T × T)) (x : (T × T)) : Result U64 := + inst.to_u64 x + +/- [traits::h0]: forward function -/ +def h0 (x : U64) : Result U64 := + u64.to_u64 x + +/- [traits::Wrapper] -/ +structure Wrapper (T : Type) where + x : T + +/- [traits::Wrapper::{4}::to_u64]: forward function -/ +def Wrapper.to_u64 + (T : Type) (inst : ToU64 T) (self : Wrapper T) : Result U64 := + inst.to_u64 self.x + +/- Trait implementation: [traits::Wrapper::{4}] -/ +def Wrapper.ToU64Inst (T : Type) (inst : ToU64 T) : ToU64 (Wrapper T) := { + to_u64 := Wrapper.to_u64 T inst +} + +/- [traits::h1]: forward function -/ +def h1 (x : Wrapper U64) : Result U64 := + Wrapper.to_u64 U64 u64.ToU64Inst x + +/- [traits::h2]: forward function -/ +def h2 (T : Type) (inst : ToU64 T) (x : Wrapper T) : Result U64 := + Wrapper.to_u64 T inst x + +/- Trait declaration: [traits::ToType] -/ +structure ToType (Self T : Type) where + to_type : Self → Result T + +/- [traits::u64::{5}::to_type]: forward function -/ +def u64.to_type (self : U64) : Result Bool := + Result.ret (self > 0#u64) + +/- Trait implementation: [traits::u64::{5}] -/ +def u64.ToTypeInst : ToType U64 Bool := { + to_type := u64.to_type +} + +/- Trait declaration: [traits::OfType] -/ +structure OfType (Self : Type) where + of_type : forall (T : Type) (inst : ToType T Self), T → Result Self + +/- [traits::h3]: forward function -/ +def h3 + (T1 T2 : Type) (inst : OfType T1) (inst0 : ToType T2 T1) (y : T2) : + Result T1 + := + inst.of_type T2 inst0 y + +/- Trait declaration: [traits::OfTypeBis] -/ +structure OfTypeBis (Self T : Type) where + parent_clause_0 : ToType T Self + of_type : T → Result Self + +/- [traits::h4]: forward function -/ +def h4 + (T1 T2 : Type) (inst : OfTypeBis T1 T2) (inst0 : ToType T2 T1) (y : T2) : + Result T1 + := + inst.of_type y + +/- [traits::TestType] -/ +structure TestType (T : Type) where + _0 : T + +/- [traits::TestType::{6}::test::TestType1] -/ +structure TestType.test.TestType1 where + _0 : U64 + +/- Trait declaration: [traits::TestType::{6}::test::TestTrait] -/ +structure TestType.test.TestTrait (Self : Type) where + test : Self → Result Bool + +/- [traits::TestType::{6}::test::TestType1::{0}::test]: forward function -/ +def TestType.test.TestType1.test + (self : TestType.test.TestType1) : Result Bool := + Result.ret (self._0 > 1#u64) + +/- Trait implementation: [traits::TestType::{6}::test::TestType1::{0}] -/ +def TestType.test.TestType1.TestTypetestTestTraitInst : TestType.test.TestTrait + TestType.test.TestType1 := { + test := TestType.test.TestType1.test +} + +/- [traits::TestType::{6}::test]: forward function -/ +def TestType.test + (T : Type) (inst : ToU64 T) (self : TestType T) (x : T) : Result Bool := + do + let x0 ← inst.to_u64 x + if x0 > 0#u64 + then TestType.test.TestType1.test { _0 := 0#u64 } + else Result.ret false + +/- [traits::BoolWrapper] -/ +structure BoolWrapper where + _0 : Bool + +/- [traits::BoolWrapper::{7}::to_type]: forward function -/ +def BoolWrapper.to_type + (T : Type) (inst : ToType Bool T) (self : BoolWrapper) : Result T := + inst.to_type self._0 + +/- Trait implementation: [traits::BoolWrapper::{7}] -/ +def BoolWrapper.ToTypeInst (T : Type) (inst : ToType Bool T) : ToType + BoolWrapper T := { + to_type := BoolWrapper.to_type T inst +} + +/- [traits::WithConstTy::LEN2] -/ +def with_const_ty_len2_body : Result Usize := Result.ret 32#usize +def with_const_ty_len2_c : Usize := + eval_global with_const_ty_len2_body (by simp) + +/- Trait declaration: [traits::WithConstTy] -/ +structure WithConstTy (Self : Type) (LEN : Usize) where + LEN1 : Usize + LEN2 : Usize + V : Type + W : Type + W_clause_0 : ToU64 W + f : W → Array U8 LEN → Result W + +/- [traits::Bool::{8}::LEN1] -/ +def bool_len1_body : Result Usize := Result.ret 12#usize +def bool_len1_c : Usize := eval_global bool_len1_body (by simp) + +/- [traits::Bool::{8}::f]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) -/ +def Bool.f (i : U64) (a : Array U8 32#usize) : Result U64 := + Result.ret i + +/- Trait implementation: [traits::Bool::{8}] -/ +def Bool.WithConstTyInst : WithConstTy Bool 32#usize := { + LEN1 := bool_len1_c + LEN2 := with_const_ty_len2_c + V := U8 + W := U64 + W_clause_0 := u64.ToU64Inst + f := Bool.f +} + +/- [traits::use_with_const_ty1]: forward function -/ +def use_with_const_ty1 + (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) : Result Usize := + let i := inst.LEN1 + Result.ret i + +/- [traits::use_with_const_ty2]: forward function -/ +def use_with_const_ty2 + (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) (w : inst.W) : + Result Unit + := + Result.ret () + +/- [traits::use_with_const_ty3]: forward function -/ +def use_with_const_ty3 + (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) (x : inst.W) : + Result U64 + := + inst.W_clause_0.to_u64 x + +/- [traits::test_where1]: forward function -/ +def test_where1 (T : Type) (_x : T) : Result Unit := + Result.ret () + +/- [traits::test_where2]: forward function -/ +def test_where2 + (T : Type) (inst : WithConstTy T 32#usize) (_x : U32) : Result Unit := + Result.ret () + +/- [alloc::string::String] -/ +axiom alloc.string.String : Type + +/- Trait declaration: [traits::ParentTrait0] -/ +structure ParentTrait0 (Self : Type) where + W : Type + get_name : Self → Result alloc.string.String + get_w : Self → Result W + +/- Trait declaration: [traits::ParentTrait1] -/ +structure ParentTrait1 (Self : Type) where + +/- Trait declaration: [traits::ChildTrait] -/ +structure ChildTrait (Self : Type) where + parent_clause_0 : ParentTrait0 Self + parent_clause_1 : ParentTrait1 Self + +/- [traits::test_child_trait1]: forward function -/ +def test_child_trait1 + (T : Type) (inst : ChildTrait T) (x : T) : Result alloc.string.String := + inst.parent_clause_0.get_name x + +/- [traits::test_child_trait2]: forward function -/ +def test_child_trait2 + (T : Type) (inst : ChildTrait T) (x : T) : Result inst.parent_clause_0.W := + inst.parent_clause_0.get_w x + +/- [traits::order1]: forward function -/ +def order1 + (T U : Type) (inst : ParentTrait0 T) (inst0 : ParentTrait0 U) : + Result Unit + := + Result.ret () + +/- Trait declaration: [traits::ChildTrait1] -/ +structure ChildTrait1 (Self : Type) where + parent_clause_0 : ParentTrait1 Self + +/- Trait implementation: [traits::usize::{9}] -/ +def usize.ParentTrait1Inst : ParentTrait1 Usize := { +} + +/- Trait implementation: [traits::usize::{10}] -/ +def usize.ChildTrait1Inst : ChildTrait1 Usize := { + parent_clause_0 := usize.ParentTrait1Inst +} + +/- Trait declaration: [traits::Iterator] -/ +structure Iterator (Self : Type) where + Item : Type + +/- Trait declaration: [traits::IntoIterator] -/ +structure IntoIterator (Self : Type) where + Item : Type + IntoIter : Type + IntoIter_clause_0 : Iterator IntoIter + into_iter : Self → Result IntoIter + +/- Trait declaration: [traits::FromResidual] -/ +structure FromResidual (Self T : Type) where + +/- Trait declaration: [traits::Try] -/ +structure Try (Self : Type) where + parent_clause_0 : FromResidual Self Residual + Residual : Type + +/- Trait declaration: [traits::CFnOnce] -/ +structure CFnOnce (Self Args : Type) where + Output : Type + call_once : Self → Args → Result Output + +/- Trait declaration: [traits::CFnMut] -/ +structure CFnMut (Self Args : Type) where + parent_clause_0 : CFnOnce Self Args + call_mut : Self → Args → Result parent_clause_0.Output + call_mut_back : Self → Args → parent_clause_0.Output → Result Self + +/- Trait declaration: [traits::CFn] -/ +structure CFn (Self Args : Type) where + parent_clause_0 : CFnMut Self Args + call_mut : Self → Args → Result parent_clause_0.parent_clause_0.Output + +/- Trait declaration: [core::ops::function::FnOnce] -/ +structure core.ops.function.FnOnce (Self Args : Type) where + Output : Type + call_once : Self → Args → Result Output + +/- Trait declaration: [core::ops::function::FnMut] -/ +structure core.ops.function.FnMut (Self Args : Type) where + parent_clause_0 : core.ops.function.FnOnce Self Args + call_mut : Self → Args → Result parent_clause_0.Output + call_mut_back : Self → Args → parent_clause_0.Output → Result Self + +/- Trait declaration: [core::ops::function::Fn] -/ +structure core.ops.function.Fn (Self Args : Type) where + parent_clause_0 : core.ops.function.FnMut Self Args + call : Self → Args → Result parent_clause_0.parent_clause_0.Output + +/- [traits::map_option]: forward function -/ +def map_option + (T F : Type) (inst : core.ops.function.Fn F T) (x : Option T) (f0 : F) : + Result (Option T) + := + match x with + | none => Result.ret none + | some x0 => do + let t ← inst.call f0 x0 + Result.ret (some t) + +/- Trait declaration: [traits::WithTarget] -/ +structure WithTarget (Self : Type) where + Target : Type + +/- Trait declaration: [traits::ParentTrait2] -/ +structure ParentTrait2 (Self : Type) where + U : Type + U_clause_0 : WithTarget U + +/- Trait declaration: [traits::ChildTrait2] -/ +structure ChildTrait2 (Self : Type) where + parent_clause_0 : ParentTrait2 Self + convert : parent_clause_0.U → Result parent_clause_0.U_clause_0.Target + +/- Trait implementation: [traits::u32::{11}] -/ +def u32.WithTargetInst : WithTarget U32 := { + Target := U32 +} + +/- Trait implementation: [traits::u32::{12}] -/ +def u32.ParentTrait2Inst : ParentTrait2 U32 := { + U := U32 + U_clause_0 := u32.WithTargetInst +} + +/- [traits::u32::{13}::convert]: forward function -/ +def u32.convert (x : U32) : Result U32 := + Result.ret x + +/- Trait implementation: [traits::u32::{13}] -/ +def u32.ChildTrait2Inst : ChildTrait2 U32 := { + parent_clause_0 := u32.ParentTrait2Inst + convert := u32.convert +} + +/- [traits::incr_u32]: forward function -/ +def incr_u32 (x : U32) : Result U32 := + x + 1#u32 + +end traits diff --git a/tests/lean/Traits/Funs.lean b/tests/lean/Traits/Funs.lean deleted file mode 100644 index 8d423280..00000000 --- a/tests/lean/Traits/Funs.lean +++ /dev/null @@ -1,275 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [traits]: function definitions -import Base -import Traits.Types -open Primitives - -namespace traits - -/- [traits::Bool::{0}::get_bool]: forward function -/ -def Bool.get_bool (self : Bool) : Result Bool := - Result.ret self - -/- Trait implementation: [traits::Bool::{0}] -/ -def Bool.BoolTraitInst : BoolTrait Bool := { - get_bool := Bool.get_bool -} - -/- [traits::BoolTrait::ret_true]: forward function -/ -def BoolTrait.ret_true - {Self : Type} (self_clause : BoolTrait Self) (self : Self) : Result Bool := - Result.ret true - -/- [traits::test_bool_trait_bool]: forward function -/ -def test_bool_trait_bool (x : Bool) : Result Bool := - do - let b ← Bool.get_bool x - if b - then BoolTrait.ret_true Bool.BoolTraitInst x - else Result.ret false - -/- [traits::Option::{1}::get_bool]: forward function -/ -def Option.get_bool (T : Type) (self : Option T) : Result Bool := - match self with - | none => Result.ret false - | some t => Result.ret true - -/- Trait implementation: [traits::Option::{1}] -/ -def Option.BoolTraitInst (T : Type) : BoolTrait (Option T) := { - get_bool := Option.get_bool T -} - -/- [traits::test_bool_trait_option]: forward function -/ -def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := - do - let b ← Option.get_bool T x - if b - then BoolTrait.ret_true (Option.BoolTraitInst T) x - else Result.ret false - -/- [traits::test_bool_trait]: forward function -/ -def test_bool_trait (T : Type) (inst : BoolTrait T) (x : T) : Result Bool := - inst.get_bool x - -/- [traits::u64::{2}::to_u64]: forward function -/ -def u64.to_u64 (self : U64) : Result U64 := - Result.ret self - -/- Trait implementation: [traits::u64::{2}] -/ -def u64.ToU64Inst : ToU64 U64 := { - to_u64 := u64.to_u64 -} - -/- [traits::Tuple2::{3}::to_u64]: forward function -/ -def Tuple2.to_u64 (A : Type) (inst : ToU64 A) (self : (A × A)) : Result U64 := - do - let (t, t0) := self - let i ← inst.to_u64 t - let i0 ← inst.to_u64 t0 - i + i0 - -/- Trait implementation: [traits::Tuple2::{3}] -/ -def Tuple2.ToU64Inst (A : Type) (inst : ToU64 A) : ToU64 (A × A) := { - to_u64 := Tuple2.to_u64 A inst -} - -/- [traits::f]: forward function -/ -def f (T : Type) (inst : ToU64 T) (x : (T × T)) : Result U64 := - Tuple2.to_u64 T inst x - -/- [traits::g]: forward function -/ -def g (T : Type) (inst : ToU64 (T × T)) (x : (T × T)) : Result U64 := - inst.to_u64 x - -/- [traits::h0]: forward function -/ -def h0 (x : U64) : Result U64 := - u64.to_u64 x - -/- [traits::Wrapper::{4}::to_u64]: forward function -/ -def Wrapper.to_u64 - (T : Type) (inst : ToU64 T) (self : Wrapper T) : Result U64 := - inst.to_u64 self.x - -/- Trait implementation: [traits::Wrapper::{4}] -/ -def Wrapper.ToU64Inst (T : Type) (inst : ToU64 T) : ToU64 (Wrapper T) := { - to_u64 := Wrapper.to_u64 T inst -} - -/- [traits::h1]: forward function -/ -def h1 (x : Wrapper U64) : Result U64 := - Wrapper.to_u64 U64 u64.ToU64Inst x - -/- [traits::h2]: forward function -/ -def h2 (T : Type) (inst : ToU64 T) (x : Wrapper T) : Result U64 := - Wrapper.to_u64 T inst x - -/- [traits::u64::{5}::to_type]: forward function -/ -def u64.to_type (self : U64) : Result Bool := - Result.ret (self > 0#u64) - -/- Trait implementation: [traits::u64::{5}] -/ -def u64.ToTypeInst : ToType U64 Bool := { - to_type := u64.to_type -} - -/- [traits::h3]: forward function -/ -def h3 - (T1 T2 : Type) (inst : OfType T1) (inst0 : ToType T2 T1) (y : T2) : - Result T1 - := - inst.of_type T2 inst0 y - -/- [traits::h4]: forward function -/ -def h4 - (T1 T2 : Type) (inst : OfTypeBis T1 T2) (inst0 : ToType T2 T1) (y : T2) : - Result T1 - := - inst.of_type y - -/- [traits::TestType::{6}::test::TestType1::{0}::test]: forward function -/ -def TestType.test.TestType1.test - (self : TestType.test.TestType1) : Result Bool := - Result.ret (self._0 > 1#u64) - -/- Trait implementation: [traits::TestType::{6}::test::TestType1::{0}] -/ -def TestType.test.TestType1.TestTypetestTestTraitInst : TestType.test.TestTrait - TestType.test.TestType1 := { - test := TestType.test.TestType1.test -} - -/- [traits::TestType::{6}::test]: forward function -/ -def TestType.test - (T : Type) (inst : ToU64 T) (self : TestType T) (x : T) : Result Bool := - do - let x0 ← inst.to_u64 x - if x0 > 0#u64 - then TestType.test.TestType1.test { _0 := 0#u64 } - else Result.ret false - -/- [traits::BoolWrapper::{7}::to_type]: forward function -/ -def BoolWrapper.to_type - (T : Type) (inst : ToType Bool T) (self : BoolWrapper) : Result T := - inst.to_type self._0 - -/- Trait implementation: [traits::BoolWrapper::{7}] -/ -def BoolWrapper.ToTypeInst (T : Type) (inst : ToType Bool T) : ToType - BoolWrapper T := { - to_type := BoolWrapper.to_type T inst -} - -/- [traits::WithConstTy::LEN2] -/ -def with_const_ty_len2_body : Result Usize := Result.ret 32#usize -def with_const_ty_len2_c : Usize := - eval_global with_const_ty_len2_body (by simp) - -/- [traits::Bool::{8}::LEN1] -/ -def bool_len1_body : Result Usize := Result.ret 12#usize -def bool_len1_c : Usize := eval_global bool_len1_body (by simp) - -/- [traits::Bool::{8}::f]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) -/ -def Bool.f (i : U64) (a : Array U8 32#usize) : Result U64 := - Result.ret i - -/- Trait implementation: [traits::Bool::{8}] -/ -def Bool.WithConstTyInst : WithConstTy Bool 32#usize := { - LEN1 := bool_len1_c - LEN2 := with_const_ty_len2_c - V := U8 - W := U64 - W_clause_0 := u64.ToU64Inst - f := Bool.f -} - -/- [traits::use_with_const_ty1]: forward function -/ -def use_with_const_ty1 - (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) : Result Usize := - let i := inst.LEN1 - Result.ret i - -/- [traits::use_with_const_ty2]: forward function -/ -def use_with_const_ty2 - (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) (w : inst.W) : - Result Unit - := - Result.ret () - -/- [traits::use_with_const_ty3]: forward function -/ -def use_with_const_ty3 - (H : Type) (LEN : Usize) (inst : WithConstTy H LEN) (x : inst.W) : - Result U64 - := - inst.W_clause_0.to_u64 x - -/- [traits::test_where1]: forward function -/ -def test_where1 (T : Type) (_x : T) : Result Unit := - Result.ret () - -/- [traits::test_where2]: forward function -/ -def test_where2 - (T : Type) (inst : WithConstTy T 32#usize) (_x : U32) : Result Unit := - Result.ret () - -/- [traits::test_child_trait1]: forward function -/ -def test_child_trait1 - (T : Type) (inst : ChildTrait T) (x : T) : Result alloc.string.String := - inst.parent_clause_0.get_name x - -/- [traits::test_child_trait2]: forward function -/ -def test_child_trait2 - (T : Type) (inst : ChildTrait T) (x : T) : Result inst.parent_clause_0.W := - inst.parent_clause_0.get_w x - -/- [traits::order1]: forward function -/ -def order1 - (T U : Type) (inst : ParentTrait0 T) (inst0 : ParentTrait0 U) : - Result Unit - := - Result.ret () - -/- Trait implementation: [traits::usize::{9}] -/ -def usize.ParentTrait1Inst : ParentTrait1 Usize := { -} - -/- Trait implementation: [traits::usize::{10}] -/ -def usize.ChildTrait1Inst : ChildTrait1 Usize := { - parent_clause_0 := usize.ParentTrait1Inst -} - -/- [traits::map_option]: forward function -/ -def map_option - (T F : Type) (inst : core.ops.function.Fn F T) (x : Option T) (f0 : F) : - Result (Option T) - := - match x with - | none => Result.ret none - | some x0 => do - let t ← inst.call f0 x0 - Result.ret (some t) - -/- Trait implementation: [traits::u32::{11}] -/ -def u32.WithTargetInst : WithTarget U32 := { - Target := U32 -} - -/- Trait implementation: [traits::u32::{12}] -/ -def u32.ParentTrait2Inst : ParentTrait2 U32 := { - U := U32 - U_clause_0 := u32.WithTargetInst -} - -/- [traits::u32::{13}::convert]: forward function -/ -def u32.convert (x : U32) : Result U32 := - Result.ret x - -/- Trait implementation: [traits::u32::{13}] -/ -def u32.ChildTrait2Inst : ChildTrait2 U32 := { - parent_clause_0 := u32.ParentTrait2Inst - convert := u32.convert -} - -/- [traits::incr_u32]: forward function -/ -def incr_u32 (x : U32) : Result U32 := - x + 1#u32 - -end traits diff --git a/tests/lean/Traits/Types.lean b/tests/lean/Traits/Types.lean deleted file mode 100644 index 4c5dd874..00000000 --- a/tests/lean/Traits/Types.lean +++ /dev/null @@ -1,144 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [traits]: type definitions -import Base -open Primitives - -namespace traits - -/- Trait declaration: [traits::BoolTrait] -/ -structure BoolTrait (Self : Type) where - get_bool : Self → Result Bool - -/- Trait declaration: [traits::ToU64] -/ -structure ToU64 (Self : Type) where - to_u64 : Self → Result U64 - -/- [traits::Wrapper] -/ -structure Wrapper (T : Type) where - x : T - -/- Trait declaration: [traits::ToType] -/ -structure ToType (Self T : Type) where - to_type : Self → Result T - -/- Trait declaration: [traits::OfType] -/ -structure OfType (Self : Type) where - of_type : forall (T : Type) (inst : ToType T Self), T → Result Self - -/- Trait declaration: [traits::OfTypeBis] -/ -structure OfTypeBis (Self T : Type) where - parent_clause_0 : ToType T Self - of_type : T → Result Self - -/- [traits::TestType] -/ -structure TestType (T : Type) where - _0 : T - -/- [traits::TestType::{6}::test::TestType1] -/ -structure TestType.test.TestType1 where - _0 : U64 - -/- Trait declaration: [traits::TestType::{6}::test::TestTrait] -/ -structure TestType.test.TestTrait (Self : Type) where - test : Self → Result Bool - -/- [traits::BoolWrapper] -/ -structure BoolWrapper where - _0 : Bool - -/- Trait declaration: [traits::WithConstTy] -/ -structure WithConstTy (Self : Type) (LEN : Usize) where - LEN1 : Usize - LEN2 : Usize - V : Type - W : Type - W_clause_0 : ToU64 W - f : W → Array U8 LEN → Result W - -/- [alloc::string::String] -/ -axiom alloc.string.String : Type - -/- Trait declaration: [traits::ParentTrait0] -/ -structure ParentTrait0 (Self : Type) where - W : Type - get_name : Self → Result alloc.string.String - get_w : Self → Result W - -/- Trait declaration: [traits::ParentTrait1] -/ -structure ParentTrait1 (Self : Type) where - -/- Trait declaration: [traits::ChildTrait] -/ -structure ChildTrait (Self : Type) where - parent_clause_0 : ParentTrait0 Self - parent_clause_1 : ParentTrait1 Self - -/- Trait declaration: [traits::ChildTrait1] -/ -structure ChildTrait1 (Self : Type) where - parent_clause_0 : ParentTrait1 Self - -/- Trait declaration: [traits::Iterator] -/ -structure Iterator (Self : Type) where - Item : Type - -/- Trait declaration: [traits::IntoIterator] -/ -structure IntoIterator (Self : Type) where - Item : Type - IntoIter : Type - IntoIter_clause_0 : Iterator IntoIter - into_iter : Self → Result IntoIter - -/- Trait declaration: [traits::FromResidual] -/ -structure FromResidual (Self T : Type) where - -/- Trait declaration: [traits::Try] -/ -structure Try (Self : Type) where - parent_clause_0 : FromResidual Self Residual - Residual : Type - -/- Trait declaration: [traits::CFnOnce] -/ -structure CFnOnce (Self Args : Type) where - Output : Type - call_once : Self → Args → Result Output - -/- Trait declaration: [traits::CFnMut] -/ -structure CFnMut (Self Args : Type) where - parent_clause_0 : CFnOnce Self Args - call_mut : Self → Args → Result parent_clause_0.Output - call_mut_back : Self → Args → parent_clause_0.Output → Result Self - -/- Trait declaration: [traits::CFn] -/ -structure CFn (Self Args : Type) where - parent_clause_0 : CFnMut Self Args - call_mut : Self → Args → Result parent_clause_0.parent_clause_0.Output - -/- Trait declaration: [core::ops::function::FnOnce] -/ -structure core.ops.function.FnOnce (Self Args : Type) where - Output : Type - call_once : Self → Args → Result Output - -/- Trait declaration: [core::ops::function::FnMut] -/ -structure core.ops.function.FnMut (Self Args : Type) where - parent_clause_0 : core.ops.function.FnOnce Self Args - call_mut : Self → Args → Result parent_clause_0.Output - call_mut_back : Self → Args → parent_clause_0.Output → Result Self - -/- Trait declaration: [core::ops::function::Fn] -/ -structure core.ops.function.Fn (Self Args : Type) where - parent_clause_0 : core.ops.function.FnMut Self Args - call : Self → Args → Result parent_clause_0.parent_clause_0.Output - -/- Trait declaration: [traits::WithTarget] -/ -structure WithTarget (Self : Type) where - Target : Type - -/- Trait declaration: [traits::ParentTrait2] -/ -structure ParentTrait2 (Self : Type) where - U : Type - U_clause_0 : WithTarget U - -/- Trait declaration: [traits::ChildTrait2] -/ -structure ChildTrait2 (Self : Type) where - parent_clause_0 : ParentTrait2 Self - convert : parent_clause_0.U → Result parent_clause_0.U_clause_0.Target - -end traits -- cgit v1.3.1 From 38a01551719d0cefdd4a1c21a050674154b0b087 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 9 Nov 2023 13:44:03 +0100 Subject: Regenerate the tests --- tests/fstar/traits/Traits.fst | 70 +++++++++++++------------------------------ tests/lean/Traits.lean | 61 +++++++++++-------------------------- 2 files changed, 37 insertions(+), 94 deletions(-) (limited to 'tests/lean') diff --git a/tests/fstar/traits/Traits.fst b/tests/fstar/traits/Traits.fst index 42b43cf2..318efa2b 100644 --- a/tests/fstar/traits/Traits.fst +++ b/tests/fstar/traits/Traits.fst @@ -308,59 +308,10 @@ type fromResidual_t (self t : Type0) = unit (** Trait declaration: [traits::Try] *) noeq type try_t (self : Type0) = { - parent_clause_0 : fromResidual_t self tResidual; tResidual : Type0; + parent_clause_0 : fromResidual_t self tResidual; } -(** Trait declaration: [traits::CFnOnce] *) -noeq type cFnOnce_t (self args : Type0) = { - tOutput : Type0; - call_once : self -> args -> result tOutput; -} - -(** Trait declaration: [traits::CFnMut] *) -noeq type cFnMut_t (self args : Type0) = { - parent_clause_0 : cFnOnce_t self args; - call_mut : self -> args -> result parent_clause_0.tOutput; - call_mut_back : self -> args -> parent_clause_0.tOutput -> result self; -} - -(** Trait declaration: [traits::CFn] *) -noeq type cFn_t (self args : Type0) = { - parent_clause_0 : cFnMut_t self args; - call_mut : self -> args -> result parent_clause_0.parent_clause_0.tOutput; -} - -(** Trait declaration: [core::ops::function::FnOnce] *) -noeq type core_ops_function_FnOnce_t (self args : Type0) = { - tOutput : Type0; - call_once : self -> args -> result tOutput; -} - -(** Trait declaration: [core::ops::function::FnMut] *) -noeq type core_ops_function_FnMut_t (self args : Type0) = { - parent_clause_0 : core_ops_function_FnOnce_t self args; - call_mut : self -> args -> result parent_clause_0.tOutput; - call_mut_back : self -> args -> parent_clause_0.tOutput -> result self; -} - -(** Trait declaration: [core::ops::function::Fn] *) -noeq type core_ops_function_Fn_t (self args : Type0) = { - parent_clause_0 : core_ops_function_FnMut_t self args; - call : self -> args -> result parent_clause_0.parent_clause_0.tOutput; -} - -(** [traits::map_option]: forward function *) -let map_option - (t f0 : Type0) (inst : core_ops_function_Fn_t f0 t) (x : option t) - (f1 : f0) : - result (option t) - = - begin match x with - | None -> Return None - | Some x0 -> let* x1 = inst.call f1 x0 in Return (Some x1) - end - (** Trait declaration: [traits::WithTarget] *) noeq type withTarget_t (self : Type0) = { tTarget : Type0; } @@ -399,3 +350,22 @@ let u32_ChildTrait2Inst : childTrait2_t u32 = { let incr_u32 (x : u32) : result u32 = u32_add x 1 +(** Trait declaration: [traits::CFnOnce] *) +noeq type cFnOnce_t (self args : Type0) = { + tOutput : Type0; + call_once : self -> args -> result tOutput; +} + +(** Trait declaration: [traits::CFnMut] *) +noeq type cFnMut_t (self args : Type0) = { + parent_clause_0 : cFnOnce_t self args; + call_mut : self -> args -> result parent_clause_0.tOutput; + call_mut_back : self -> args -> parent_clause_0.tOutput -> result self; +} + +(** Trait declaration: [traits::CFn] *) +noeq type cFn_t (self args : Type0) = { + parent_clause_0 : cFnMut_t self args; + call_mut : self -> args -> result parent_clause_0.parent_clause_0.tOutput; +} + diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index 94ae0bb0..12e7eafa 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -322,51 +322,8 @@ structure FromResidual (Self T : Type) where /- Trait declaration: [traits::Try] -/ structure Try (Self : Type) where - parent_clause_0 : FromResidual Self Residual Residual : Type - -/- Trait declaration: [traits::CFnOnce] -/ -structure CFnOnce (Self Args : Type) where - Output : Type - call_once : Self → Args → Result Output - -/- Trait declaration: [traits::CFnMut] -/ -structure CFnMut (Self Args : Type) where - parent_clause_0 : CFnOnce Self Args - call_mut : Self → Args → Result parent_clause_0.Output - call_mut_back : Self → Args → parent_clause_0.Output → Result Self - -/- Trait declaration: [traits::CFn] -/ -structure CFn (Self Args : Type) where - parent_clause_0 : CFnMut Self Args - call_mut : Self → Args → Result parent_clause_0.parent_clause_0.Output - -/- Trait declaration: [core::ops::function::FnOnce] -/ -structure core.ops.function.FnOnce (Self Args : Type) where - Output : Type - call_once : Self → Args → Result Output - -/- Trait declaration: [core::ops::function::FnMut] -/ -structure core.ops.function.FnMut (Self Args : Type) where - parent_clause_0 : core.ops.function.FnOnce Self Args - call_mut : Self → Args → Result parent_clause_0.Output - call_mut_back : Self → Args → parent_clause_0.Output → Result Self - -/- Trait declaration: [core::ops::function::Fn] -/ -structure core.ops.function.Fn (Self Args : Type) where - parent_clause_0 : core.ops.function.FnMut Self Args - call : Self → Args → Result parent_clause_0.parent_clause_0.Output - -/- [traits::map_option]: forward function -/ -def map_option - (T F : Type) (inst : core.ops.function.Fn F T) (x : Option T) (f0 : F) : - Result (Option T) - := - match x with - | none => Result.ret none - | some x0 => do - let t ← inst.call f0 x0 - Result.ret (some t) + parent_clause_0 : FromResidual Self Residual /- Trait declaration: [traits::WithTarget] -/ structure WithTarget (Self : Type) where @@ -407,4 +364,20 @@ def u32.ChildTrait2Inst : ChildTrait2 U32 := { def incr_u32 (x : U32) : Result U32 := x + 1#u32 +/- Trait declaration: [traits::CFnOnce] -/ +structure CFnOnce (Self Args : Type) where + Output : Type + call_once : Self → Args → Result Output + +/- Trait declaration: [traits::CFnMut] -/ +structure CFnMut (Self Args : Type) where + parent_clause_0 : CFnOnce Self Args + call_mut : Self → Args → Result parent_clause_0.Output + call_mut_back : Self → Args → parent_clause_0.Output → Result Self + +/- Trait declaration: [traits::CFn] -/ +structure CFn (Self Args : Type) where + parent_clause_0 : CFnMut Self Args + call_mut : Self → Args → Result parent_clause_0.parent_clause_0.Output + end traits -- cgit v1.3.1 From 00705bba68fed61d3b0bcde2c5fe0ecc83880870 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 9 Nov 2023 18:37:07 +0100 Subject: Update the failing proofs --- backends/fstar/Primitives.fst | 18 +- backends/lean/Base/Primitives/Vec.lean | 26 +- backends/lean/Base/Progress/Progress.lean | 2 +- tests/fstar/array/Array.Opaque.fsti | 24 - tests/fstar/array/Primitives.fst | 18 +- tests/fstar/betree/Primitives.fst | 18 +- tests/fstar/betree_back_stateful/Primitives.fst | 18 +- tests/fstar/hashmap/Hashmap.Properties.fst | 1648 ++++++++++---------- tests/fstar/hashmap/Hashmap.Properties.fsti | 100 +- tests/fstar/hashmap/Primitives.fst | 18 +- .../hashmap_on_disk/HashmapMain.Properties.fst | 20 +- tests/fstar/hashmap_on_disk/Primitives.fst | 18 +- tests/fstar/misc/Loops.fst | 784 ---------- tests/fstar/misc/Primitives.fst | 18 +- tests/fstar/traits/Primitives.fst | 18 +- tests/lean/Hashmap/Properties.lean | 11 +- 16 files changed, 1049 insertions(+), 1710 deletions(-) delete mode 100644 tests/fstar/array/Array.Opaque.fsti delete mode 100644 tests/fstar/misc/Loops.fst (limited to 'tests/lean') diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 71d75c11..3297803c 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index e1b7e87b..bbed6082 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -81,7 +81,7 @@ theorem Vec.insert_spec {α : Type u} (v: Vec α) (i: Usize) (x: α) ∃ nv, v.insert α i x = ret nv ∧ nv.val = v.val.update i.val x := by simp [insert, *] -def Vec.index_usize (α : Type u) (v: Vec α) (i: Usize) : Result α := +def Vec.index_usize {α : Type u} (v: Vec α) (i: Usize) : Result α := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some x => ret x @@ -94,13 +94,13 @@ def Vec.index_usize (α : Type u) (v: Vec α) (i: Usize) : Result α := @[pspec] theorem Vec.index_usize_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_usize α i = ret x ∧ x = v.val.index i.val := by + ∃ x, v.index_usize i = ret x ∧ x = v.val.index i.val := by simp only [index_usize] -- TODO: dependent rewrite have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) simp [*] -def Vec.update_usize (α : Type u) (v: Vec α) (i: Usize) (x: α) : Result (Vec α) := +def Vec.update_usize {α : Type u} (v: Vec α) (i: Usize) (x: α) : Result (Vec α) := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some _ => @@ -109,7 +109,7 @@ def Vec.update_usize (α : Type u) (v: Vec α) (i: Usize) (x: α) : Result (Vec @[pspec] theorem Vec.update_usize_spec {α : Type u} (v: Vec α) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.update_usize α i x = ret nv ∧ + ∃ nv, v.update_usize i x = ret nv ∧ nv.val = v.val.update i.val x := by simp only [update_usize] @@ -151,6 +151,24 @@ def Vec.coreopsindexIndexMutInst (T I : Type) index_mut_back := Vec.index_mut_back T I inst } +@[simp] +theorem Vec.index_slice_index {α : Type} (v : Vec α) (i : Usize) : + Vec.index α Usize (core.slice.index.usize.coresliceindexSliceIndexInst α) v i = + Vec.index_usize v i := + sorry + +@[simp] +theorem Vec.index_mut_slice_index {α : Type} (v : Vec α) (i : Usize) : + Vec.index_mut α Usize (core.slice.index.usize.coresliceindexSliceIndexInst α) v i = + Vec.index_usize v i := + sorry + +@[simp] +theorem Vec.index_mut_back_slice_index {α : Type} (v : Vec α) (i : Usize) (x : α) : + Vec.index_mut_back α Usize (core.slice.index.usize.coresliceindexSliceIndexInst α) v i x = + Vec.update_usize v i x := + sorry + end alloc.vec end Primitives diff --git a/backends/lean/Base/Progress/Progress.lean b/backends/lean/Base/Progress/Progress.lean index 24c6f912..ba63f09d 100644 --- a/backends/lean/Base/Progress/Progress.lean +++ b/backends/lean/Base/Progress/Progress.lean @@ -409,7 +409,7 @@ namespace Test `α : Type u` where u is quantified, while here we use `α : Type 0` -/ example {α : Type} (v: Vec α) (i: Usize) (x : α) (hbounds : i.val < v.length) : - ∃ nv, v.update_usize α i x = ret nv ∧ + ∃ nv, v.update_usize i x = ret nv ∧ nv.val = v.val.update i.val x := by progress simp [*] diff --git a/tests/fstar/array/Array.Opaque.fsti b/tests/fstar/array/Array.Opaque.fsti deleted file mode 100644 index 484cb9ee..00000000 --- a/tests/fstar/array/Array.Opaque.fsti +++ /dev/null @@ -1,24 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [array]: external function declarations *) -module Array.Opaque -open Primitives -include Array.Types - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [core::array::[T; N]::{15}::index]: forward function *) -val core_array_[T; N]_index_fwd - (t i : Type0) (n : usize) (inst : core_ops_index_Index (slice t) i) : - array t n -> i -> result inst.core_ops_index_Index_Output - -(** [core::array::[T; N]::{16}::index_mut]: forward function *) -val core_array_[T; N]_index_mut_fwd - (t i : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) i) : - array t n -> i -> result inst.index_inst.core_ops_index_Index_Output - -(** [core::array::[T; N]::{16}::index_mut]: backward function 0 *) -val core_array_[T; N]_index_mut_back - (t i : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) i) : - array t n -> i -> inst.index_inst.core_ops_index_Index_Output -> result - (array t n) - diff --git a/tests/fstar/array/Primitives.fst b/tests/fstar/array/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/array/Primitives.fst +++ b/tests/fstar/array/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ b/tests/fstar/betree_back_stateful/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/fstar/hashmap/Hashmap.Properties.fst b/tests/fstar/hashmap/Hashmap.Properties.fst index 49d96cd5..def520f0 100644 --- a/tests/fstar/hashmap/Hashmap.Properties.fst +++ b/tests/fstar/hashmap/Hashmap.Properties.fst @@ -272,7 +272,7 @@ type pos_usize = x:usize{x > 0} type binding (t : Type0) = key & t -type slots_t (t : Type0) = vec (list_t t) +type slots_t (t : Type0) = alloc_vec_Vec (list_t t) /// We represent hash maps as associative lists type assoc_list (t : Type0) = list (binding t) @@ -280,8 +280,8 @@ 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 + | List_Nil -> [] + | List_Cons k v tl -> (k,v) :: list_t_v tl let list_t_len (#t : Type0) (ls : list_t t) : nat = length (list_t_v ls) let list_t_index (#t : Type0) (ls : list_t t) (i : nat{i < list_t_len ls}) : binding t = @@ -305,30 +305,30 @@ let slots_t_al_v (#t : Type0) (slots : slots_t t) : assoc_list t = /// list per slot). This is the representation we use most, internally. Note that /// we later introduce a [map_s] representation, which is the one used in the /// lemmas shown to the user. -type hash_map_s t = list (slot_s t) +type hashMap_s t = list (slot_s t) // TODO: why not always have the condition on the length? // 'nes': "non-empty slots" -type hash_map_s_nes (t : Type0) : Type0 = - hm:hash_map_s t{is_pos_usize (length hm)} +type hashMap_s_nes (t : Type0) : Type0 = + hm:hashMap_s t{is_pos_usize (length hm)} -/// Representation function for [hash_map_t] as a list of slots -let hash_map_t_v (#t : Type0) (hm : hash_map_t t) : hash_map_s t = - map list_t_v hm.hash_map_slots +/// Representation function for [hashMap_t] as a list of slots +let hashMap_t_v (#t : Type0) (hm : hashMap_t t) : hashMap_s t = + map list_t_v hm.slots -/// Representation function for [hash_map_t] as an associative list -let hash_map_t_al_v (#t : Type0) (hm : hash_map_t t) : assoc_list t = - flatten (hash_map_t_v hm) +/// Representation function for [hashMap_t] as an associative list +let hashMap_t_al_v (#t : Type0) (hm : hashMap_t t) : assoc_list t = + flatten (hashMap_t_v hm) // 'nes': "non-empty slots" -type hash_map_t_nes (t : Type0) : Type0 = - hm:hash_map_t t{is_pos_usize (length hm.hash_map_slots)} +type hashMap_t_nes (t : Type0) : Type0 = + hm:hashMap_t t{is_pos_usize (length hm.slots)} -let hash_key (k : key) : hash = - Return?.v (hash_key_fwd k) +let hash_key_s (k : key) : hash = + Return?.v (hash_key k) let hash_mod_key (k : key) (len : usize{len > 0}) : hash = - (hash_key k) % len + (hash_key_s k) % len let not_same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b <> k let same_key (#t : Type0) (k : key) (b : binding t) : bool = fst b = k @@ -339,8 +339,8 @@ let same_hash_mod_key (#t : Type0) (len : usize{len > 0}) (h : nat) (b : binding let binding_neq (#t : Type0) (b0 b1 : binding t) : bool = fst b0 <> fst b1 -let hash_map_t_len_s (#t : Type0) (hm : hash_map_t t) : nat = - hm.hash_map_num_entries +let hashMap_t_len_s (#t : Type0) (hm : hashMap_t t) : nat = + hm.num_entries let assoc_list_find (#t : Type0) (k : key) (slot : assoc_list t) : option t = match find (same_key k) slot with @@ -354,26 +354,26 @@ let slot_t_find_s (#t : Type0) (k : key) (slot : list_t t) : option t = slot_s_find k (slot_t_v slot) // This is a simpler version of the "find" function, which captures the essence -// of what happens and operates on [hash_map_s]. -let hash_map_s_find - (#t : Type0) (hm : hash_map_s_nes t) +// of what happens and operates on [hashMap_s]. +let hashMap_s_find + (#t : Type0) (hm : hashMap_s_nes t) (k : key) : option t = let i = hash_mod_key k (length hm) in let slot = index hm i in slot_s_find k slot -let hash_map_s_len - (#t : Type0) (hm : hash_map_s t) : +let hashMap_s_len + (#t : Type0) (hm : hashMap_s t) : nat = length (flatten hm) -// Same as above, but operates on [hash_map_t] +// Same as above, but operates on [hashMap_t] // Note that we don't reuse the above function on purpose: converting to a -// [hash_map_s] then looking up an element is not the same as what we +// [hashMap_s] then looking up an element is not the same as what we // wrote below. -let hash_map_t_find_s - (#t : Type0) (hm : hash_map_t t{length hm.hash_map_slots > 0}) (k : key) : option t = - let slots = hm.hash_map_slots in +let hashMap_t_find_s + (#t : Type0) (hm : hashMap_t t{length hm.slots > 0}) (k : key) : option t = + let slots = hm.slots in let i = hash_mod_key k (length slots) in let slot = index slots i in slot_t_find_s k slot @@ -404,74 +404,74 @@ let slots_t_inv (#t : Type0) (slots : slots_t t{length slots <= usize_max}) : Ty {:pattern index slots i} slot_t_inv (length slots) i (index slots i) -let hash_map_s_inv (#t : Type0) (hm : hash_map_s t) : Type0 = +let hashMap_s_inv (#t : Type0) (hm : hashMap_s t) : Type0 = length hm <= usize_max /\ length hm > 0 /\ slots_s_inv hm /// Base invariant for the hashmap (the complete invariant can be temporarily /// broken between the moment we inserted an element and the moment we resize) -let hash_map_t_base_inv (#t : Type0) (hm : hash_map_t t) : Type0 = - let al = hash_map_t_al_v hm in +let hashMap_t_base_inv (#t : Type0) (hm : hashMap_t t) : Type0 = + let al = hashMap_t_al_v hm in // [num_entries] correctly tracks the number of entries in the table // Note that it gives us that the length of the slots array is <= usize_max: // [> length <= usize_max - // (because hash_map_num_entries has type `usize`) - hm.hash_map_num_entries = length al /\ + // (because hashMap_num_entries has type `usize`) + hm.num_entries = length al /\ // Slots invariant - slots_t_inv hm.hash_map_slots /\ + slots_t_inv hm.slots /\ // The capacity must be > 0 (otherwise we can't resize, because we // multiply the capacity by two!) - length hm.hash_map_slots > 0 /\ + length hm.slots > 0 /\ // Load computation begin - let capacity = length hm.hash_map_slots in - let (dividend, divisor) = hm.hash_map_max_load_factor in + let capacity = length hm.slots in + let (dividend, divisor) = hm.max_load_factor in 0 < dividend /\ dividend < divisor /\ capacity * dividend >= divisor /\ - hm.hash_map_max_load = (capacity * dividend) / divisor + hm.max_load = (capacity * dividend) / divisor end /// We often need to frame some values -let hash_map_t_same_params (#t : Type0) (hm0 hm1 : hash_map_t t) : Type0 = - length hm0.hash_map_slots = length hm1.hash_map_slots /\ - hm0.hash_map_max_load = hm1.hash_map_max_load /\ - hm0.hash_map_max_load_factor = hm1.hash_map_max_load_factor +let hashMap_t_same_params (#t : Type0) (hm0 hm1 : hashMap_t t) : Type0 = + length hm0.slots = length hm1.slots /\ + hm0.max_load = hm1.max_load /\ + hm0.max_load_factor = hm1.max_load_factor /// The following invariants, etc. are meant to be revealed to the user through /// the .fsti. /// Invariant for the hashmap -let hash_map_t_inv (#t : Type0) (hm : hash_map_t t) : Type0 = +let hashMap_t_inv (#t : Type0) (hm : hashMap_t t) : Type0 = // Base invariant - hash_map_t_base_inv hm /\ + hashMap_t_base_inv hm /\ // The hash map is either: not overloaded, or we can't resize it begin - let (dividend, divisor) = hm.hash_map_max_load_factor in - hm.hash_map_num_entries <= hm.hash_map_max_load - || length hm.hash_map_slots * 2 * dividend > usize_max + let (dividend, divisor) = hm.max_load_factor in + hm.num_entries <= hm.max_load + || length hm.slots * 2 * dividend > usize_max end (*** .fsti *) /// We reveal slightly different version of the above functions to the user -let len_s (#t : Type0) (hm : hash_map_t t) : nat = hash_map_t_len_s hm +let len_s (#t : Type0) (hm : hashMap_t t) : nat = hashMap_t_len_s hm -/// This version doesn't take any precondition (contrary to [hash_map_t_find_s]) -let find_s (#t : Type0) (hm : hash_map_t t) (k : key) : option t = - if length hm.hash_map_slots = 0 then None - else hash_map_t_find_s hm k +/// This version doesn't take any precondition (contrary to [hashMap_t_find_s]) +let find_s (#t : Type0) (hm : hashMap_t t) (k : key) : option t = + if length hm.slots = 0 then None + else hashMap_t_find_s hm k (*** Overloading *) -let hash_map_not_overloaded_lem #t hm = () +let hashMap_not_overloaded_lem #t hm = () (*** allocate_slots *) /// Auxiliary lemma val slots_t_all_nil_inv_lem - (#t : Type0) (slots : vec (list_t t){length slots <= usize_max}) : - Lemma (requires (forall (i:nat{i < length slots}). index slots i == ListNil)) + (#t : Type0) (slots : alloc_vec_Vec (list_t t){length slots <= usize_max}) : + Lemma (requires (forall (i:nat{i < length slots}). index slots i == List_Nil)) (ensures (slots_t_inv slots)) #push-options "--fuel 1" @@ -479,8 +479,8 @@ let slots_t_all_nil_inv_lem #t slots = () #pop-options val slots_t_al_v_all_nil_is_empty_lem - (#t : Type0) (slots : vec (list_t t)) : - Lemma (requires (forall (i:nat{i < length slots}). index slots i == ListNil)) + (#t : Type0) (slots : alloc_vec_Vec (list_t t)) : + Lemma (requires (forall (i:nat{i < length slots}). index slots i == List_Nil)) (ensures (slots_t_al_v slots == [])) #push-options "--fuel 1" @@ -492,44 +492,44 @@ let rec slots_t_al_v_all_nil_is_empty_lem #t slots = slots_t_al_v_all_nil_is_empty_lem #t slots'; assert(slots_t_al_v slots == list_t_v s @ slots_t_al_v slots'); assert(slots_t_al_v slots == list_t_v s); - assert(index slots 0 == ListNil) + assert(index slots 0 == List_Nil) #pop-options /// [allocate_slots] -val hash_map_allocate_slots_fwd_lem - (t : Type0) (slots : vec (list_t t)) (n : usize) : +val hashMap_allocate_slots_lem + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : Lemma (requires (length slots + n <= usize_max)) (ensures ( - match hash_map_allocate_slots_fwd t slots n with + match hashMap_allocate_slots t slots n with | Fail _ -> False | Return slots' -> length slots' = length slots + n /\ // We leave the already allocated slots unchanged (forall (i:nat{i < length slots}). index slots' i == index slots i) /\ // We allocate n additional empty slots - (forall (i:nat{length slots <= i /\ i < length slots'}). index slots' i == ListNil))) - (decreases (hash_map_allocate_slots_loop_decreases t slots n)) + (forall (i:nat{length slots <= i /\ i < length slots'}). index slots' i == List_Nil))) + (decreases (hashMap_allocate_slots_loop_decreases t slots n)) #push-options "--fuel 1" -let rec hash_map_allocate_slots_fwd_lem t slots n = +let rec hashMap_allocate_slots_lem t slots n = begin match n with | 0 -> () | _ -> - begin match vec_push_back (list_t t) slots ListNil with + begin match alloc_vec_Vec_push (list_t t) slots List_Nil with | Fail _ -> () | Return slots1 -> begin match usize_sub n 1 with | Fail _ -> () | Return i -> - hash_map_allocate_slots_fwd_lem t slots1 i; - begin match hash_map_allocate_slots_fwd t slots1 i with + hashMap_allocate_slots_lem t slots1 i; + begin match hashMap_allocate_slots t slots1 i with | Fail _ -> () | Return slots2 -> assert(length slots1 = length slots + 1); - assert(slots1 == slots @ [ListNil]); // Triggers patterns - assert(index slots1 (length slots) == index [ListNil] 0); // Triggers patterns - assert(index slots1 (length slots) == ListNil) + assert(slots1 == slots @ [List_Nil]); // Triggers patterns + assert(index slots1 (length slots) == index [List_Nil] 0); // Triggers patterns + assert(index slots1 (length slots) == List_Nil) end end end @@ -538,7 +538,7 @@ let rec hash_map_allocate_slots_fwd_lem t slots n = (*** new_with_capacity *) /// Under proper conditions, [new_with_capacity] doesn't fail and returns an empty hash map. -val hash_map_new_with_capacity_fwd_lem +val hashMap_new_with_capacity_lem (t : Type0) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : Lemma @@ -549,31 +549,31 @@ val hash_map_new_with_capacity_fwd_lem capacity * max_load_dividend >= max_load_divisor /\ capacity * max_load_dividend <= usize_max)) (ensures ( - match hash_map_new_with_capacity_fwd t capacity max_load_dividend max_load_divisor with + match hashMap_new_with_capacity t capacity max_load_dividend max_load_divisor with | Fail _ -> False | Return hm -> // The hash map invariant is satisfied - hash_map_t_inv hm /\ + hashMap_t_inv hm /\ // The parameters are correct - hm.hash_map_max_load_factor = (max_load_dividend, max_load_divisor) /\ - hm.hash_map_max_load = (capacity * max_load_dividend) / max_load_divisor /\ + hm.max_load_factor = (max_load_dividend, max_load_divisor) /\ + hm.max_load = (capacity * max_load_dividend) / max_load_divisor /\ // The hash map has the specified capacity - we need to reveal this - // otherwise the pre of [hash_map_t_find_s] is not satisfied. - length hm.hash_map_slots = capacity /\ + // otherwise the pre of [hashMap_t_find_s] is not satisfied. + length hm.slots = capacity /\ // The hash map has 0 values - hash_map_t_len_s hm = 0 /\ + hashMap_t_len_s hm = 0 /\ // It contains no bindings - (forall k. hash_map_t_find_s hm k == None) /\ + (forall k. hashMap_t_find_s hm k == None) /\ // We need this low-level property for the invariant - (forall(i:nat{i < length hm.hash_map_slots}). index hm.hash_map_slots i == ListNil))) + (forall(i:nat{i < length hm.slots}). index hm.slots i == List_Nil))) #push-options "--z3rlimit 50 --fuel 1" -let hash_map_new_with_capacity_fwd_lem (t : Type0) (capacity : usize) +let hashMap_new_with_capacity_lem (t : Type0) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) = - let v = vec_new (list_t t) in + let v = alloc_vec_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 + hashMap_allocate_slots_lem t v capacity; + begin match hashMap_allocate_slots t v capacity with | Fail _ -> assert(False) | Return v0 -> begin match usize_mul capacity max_load_dividend with @@ -582,9 +582,9 @@ let hash_map_new_with_capacity_fwd_lem (t : Type0) (capacity : usize) 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 + let hm = MkhashMap_t 0 (max_load_dividend, max_load_divisor) i0 v0 in slots_t_all_nil_inv_lem v0; - slots_t_al_v_all_nil_is_empty_lem hm.hash_map_slots + slots_t_al_v_all_nil_is_empty_lem hm.slots end end end @@ -593,65 +593,65 @@ let hash_map_new_with_capacity_fwd_lem (t : Type0) (capacity : usize) (*** new *) /// [new] doesn't fail and returns an empty hash map -val hash_map_new_fwd_lem_aux (t : Type0) : +val hashMap_new_lem_aux (t : Type0) : Lemma (ensures ( - match hash_map_new_fwd t with + match hashMap_new t with | Fail _ -> False | Return hm -> // The hash map invariant is satisfied - hash_map_t_inv hm /\ + hashMap_t_inv hm /\ // The hash map has 0 values - hash_map_t_len_s hm = 0 /\ + hashMap_t_len_s hm = 0 /\ // It contains no bindings - (forall k. hash_map_t_find_s hm k == None))) + (forall k. hashMap_t_find_s hm k == None))) #push-options "--fuel 1" -let hash_map_new_fwd_lem_aux t = - hash_map_new_with_capacity_fwd_lem t 32 4 5; - match hash_map_new_with_capacity_fwd t 32 4 5 with +let hashMap_new_lem_aux t = + hashMap_new_with_capacity_lem t 32 4 5; + match hashMap_new_with_capacity t 32 4 5 with | Fail _ -> () | Return hm -> () #pop-options /// The lemma we reveal in the .fsti -let hash_map_new_fwd_lem t = hash_map_new_fwd_lem_aux t +let hashMap_new_lem t = hashMap_new_lem_aux t (*** clear *) /// [clear]: the loop doesn't fail and simply clears the slots starting at index i #push-options "--fuel 1" -let rec hash_map_clear_loop_fwd_back_lem - (t : Type0) (slots : vec (list_t t)) (i : usize) : +let rec hashMap_clear_loop_lem + (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : Lemma (ensures ( - match hash_map_clear_loop_fwd_back t slots i with + match hashMap_clear_loop t slots i with | Fail _ -> False | Return slots' -> // The length is preserved length slots' == length slots /\ // The slots before i are left unchanged (forall (j:nat{j < i /\ j < length slots}). index slots' j == index slots j) /\ - // The slots after i are set to ListNil - (forall (j:nat{i <= j /\ j < length slots}). index slots' j == ListNil))) - (decreases (hash_map_clear_loop_decreases t slots i)) + // The slots after i are set to List_Nil + (forall (j:nat{i <= j /\ j < length slots}). index slots' j == List_Nil))) + (decreases (hashMap_clear_loop_decreases t slots i)) = - let i0 = vec_len (list_t t) slots in + let i0 = alloc_vec_Vec_len (list_t t) slots in let b = i < i0 in if b then - begin match vec_index_mut_back (list_t t) slots i ListNil with + begin match alloc_vec_Vec_update_usize slots i List_Nil with | Fail _ -> () | Return v -> begin match usize_add i 1 with | Fail _ -> () | Return i1 -> - hash_map_clear_loop_fwd_back_lem t v i1; - begin match hash_map_clear_loop_fwd_back t v i1 with + hashMap_clear_loop_lem t v i1; + begin match hashMap_clear_loop t v i1 with | Fail _ -> () | Return slots1 -> assert(length slots1 == length slots); - assert(forall (j:nat{i+1 <= j /\ j < length slots}). index slots1 j == ListNil); - assert(index slots1 i == ListNil) + assert(forall (j:nat{i+1 <= j /\ j < length slots}). index slots1 j == List_Nil); + assert(index slots1 i == List_Nil) end end end @@ -659,80 +659,80 @@ let rec hash_map_clear_loop_fwd_back_lem #pop-options /// [clear] doesn't fail and turns the hash map into an empty map -val hash_map_clear_fwd_back_lem_aux - (#t : Type0) (self : hash_map_t t) : +val hashMap_clear_lem_aux + (#t : Type0) (self : hashMap_t t) : Lemma - (requires (hash_map_t_base_inv self)) + (requires (hashMap_t_base_inv self)) (ensures ( - match hash_map_clear_fwd_back t self with + match hashMap_clear t self with | Fail _ -> False | Return hm -> // The hash map invariant is satisfied - hash_map_t_base_inv hm /\ + hashMap_t_base_inv hm /\ // We preserved the parameters - hash_map_t_same_params hm self /\ + hashMap_t_same_params hm self /\ // The hash map has 0 values - hash_map_t_len_s hm = 0 /\ + hashMap_t_len_s hm = 0 /\ // It contains no bindings - (forall k. hash_map_t_find_s hm k == None))) + (forall k. hashMap_t_find_s hm k == None))) // Being lazy: fuel 1 helps a lot... #push-options "--fuel 1" -let hash_map_clear_fwd_back_lem_aux #t self = - let p = self.hash_map_max_load_factor in - let i = self.hash_map_max_load in - let v = self.hash_map_slots in - hash_map_clear_loop_fwd_back_lem t v 0; - begin match hash_map_clear_loop_fwd_back t v 0 with +let hashMap_clear_lem_aux #t self = + let p = self.max_load_factor in + let i = self.max_load in + let v = self.slots in + hashMap_clear_loop_lem t v 0; + begin match hashMap_clear_loop t v 0 with | Fail _ -> () | Return slots1 -> slots_t_al_v_all_nil_is_empty_lem slots1; - let hm1 = Mkhash_map_t 0 p i slots1 in - assert(hash_map_t_base_inv hm1); - assert(hash_map_t_inv hm1) + let hm1 = MkhashMap_t 0 p i slots1 in + assert(hashMap_t_base_inv hm1); + assert(hashMap_t_inv hm1) end #pop-options -let hash_map_clear_fwd_back_lem #t self = hash_map_clear_fwd_back_lem_aux #t self +let hashMap_clear_lem #t self = hashMap_clear_lem_aux #t self (*** len *) /// [len]: we link it to a non-failing function. /// Rk.: we might want to make an analysis to not use an error monad to translate /// functions which statically can't fail. -let hash_map_len_fwd_lem #t self = () +let hashMap_len_lem #t self = () (*** insert_in_list *) (**** insert_in_list'fwd *) -/// [insert_in_list_fwd]: returns true iff the key is not in the list (functional version) -val hash_map_insert_in_list_fwd_lem +/// [insert_in_list]: returns true iff the key is not in the list (functional version) +val hashMap_insert_in_list_lem (t : Type0) (key : usize) (value : t) (ls : list_t t) : Lemma (ensures ( - match hash_map_insert_in_list_fwd t key value ls with + match hashMap_insert_in_list t key value ls with | Fail _ -> False | Return b -> b <==> (slot_t_find_s key ls == None))) - (decreases (hash_map_insert_in_list_loop_decreases t key value ls)) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) #push-options "--fuel 1" -let rec hash_map_insert_in_list_fwd_lem t key value ls = +let rec hashMap_insert_in_list_lem t key value ls = begin match ls with - | ListCons ckey cvalue ls0 -> + | List_Cons ckey cvalue ls0 -> let b = ckey = key in if b then () else begin - hash_map_insert_in_list_fwd_lem t key value ls0; - match hash_map_insert_in_list_fwd t key value ls0 with + hashMap_insert_in_list_lem t key value ls0; + match hashMap_insert_in_list t key value ls0 with | Fail _ -> () | Return b0 -> () end - | ListNil -> + | List_Nil -> assert(list_t_v ls == []); assert_norm(find (same_key #t key) [] == None) end @@ -748,7 +748,7 @@ let rec hash_map_insert_in_list_fwd_lem t key value ls = /// We write a helper which "captures" what [insert_in_list] does. /// We then reason about this helper to prove the high-level properties we want /// (functional properties, preservation of invariants, etc.). -let hash_map_insert_in_list_s +let hashMap_insert_in_list_s (#t : Type0) (key : usize) (value : t) (ls : list (binding t)) : list (binding t) = // Check if there is already a binding for the key @@ -761,86 +761,86 @@ let hash_map_insert_in_list_s find_update (same_key key) ls (key,value) /// [insert_in_list]: if the key is not in the map, appends a new bindings (functional version) -val hash_map_insert_in_list_back_lem_append_s +val hashMap_insert_in_list_back_lem_append_s (t : Type0) (key : usize) (value : t) (ls : list_t t) : Lemma (requires ( slot_t_find_s key ls == None)) (ensures ( - match hash_map_insert_in_list_back t key value ls with + match hashMap_insert_in_list_back t key value ls with | Fail _ -> False | Return ls' -> list_t_v ls' == list_t_v ls @ [(key,value)])) - (decreases (hash_map_insert_in_list_loop_decreases t key value ls)) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) #push-options "--fuel 1" -let rec hash_map_insert_in_list_back_lem_append_s t key value ls = +let rec hashMap_insert_in_list_back_lem_append_s t key value ls = begin match ls with - | ListCons ckey cvalue ls0 -> + | List_Cons ckey cvalue ls0 -> let b = ckey = key in if b then () else begin - hash_map_insert_in_list_back_lem_append_s t key value ls0; - match hash_map_insert_in_list_back t key value ls0 with + hashMap_insert_in_list_back_lem_append_s t key value ls0; + match hashMap_insert_in_list_back t key value ls0 with | Fail _ -> () | Return l -> () end - | ListNil -> () + | List_Nil -> () end #pop-options /// [insert_in_list]: if the key is in the map, we update the binding (functional version) -val hash_map_insert_in_list_back_lem_update_s +val hashMap_insert_in_list_back_lem_update_s (t : Type0) (key : usize) (value : t) (ls : list_t t) : Lemma (requires ( Some? (find (same_key key) (list_t_v ls)))) (ensures ( - match hash_map_insert_in_list_back t key value ls with + match hashMap_insert_in_list_back t key value ls with | Fail _ -> False | Return ls' -> list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,value))) - (decreases (hash_map_insert_in_list_loop_decreases t key value ls)) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) #push-options "--fuel 1" -let rec hash_map_insert_in_list_back_lem_update_s t key value ls = +let rec hashMap_insert_in_list_back_lem_update_s t key value ls = begin match ls with - | ListCons ckey cvalue ls0 -> + | List_Cons ckey cvalue ls0 -> let b = ckey = key in if b then () else begin - hash_map_insert_in_list_back_lem_update_s t key value ls0; - match hash_map_insert_in_list_back t key value ls0 with + hashMap_insert_in_list_back_lem_update_s t key value ls0; + match hashMap_insert_in_list_back t key value ls0 with | Fail _ -> () | Return l -> () end - | ListNil -> () + | List_Nil -> () end #pop-options /// Put everything together -val hash_map_insert_in_list_back_lem_s +val hashMap_insert_in_list_back_lem_s (t : Type0) (key : usize) (value : t) (ls : list_t t) : Lemma (ensures ( - match hash_map_insert_in_list_back t key value ls with + match hashMap_insert_in_list_back t key value ls with | Fail _ -> False | Return ls' -> - list_t_v ls' == hash_map_insert_in_list_s key value (list_t_v ls))) + list_t_v ls' == hashMap_insert_in_list_s key value (list_t_v ls))) -let hash_map_insert_in_list_back_lem_s t key value ls = +let hashMap_insert_in_list_back_lem_s t key value ls = match find (same_key key) (list_t_v ls) with - | None -> hash_map_insert_in_list_back_lem_append_s t key value ls - | Some _ -> hash_map_insert_in_list_back_lem_update_s t key value ls + | None -> hashMap_insert_in_list_back_lem_append_s t key value ls + | Some _ -> hashMap_insert_in_list_back_lem_update_s t key value ls (**** Invariants of insert_in_list_s *) /// Auxiliary lemmas -/// We work on [hash_map_insert_in_list_s], the "high-level" version of [insert_in_list'back]. +/// We work on [hashMap_insert_in_list_s], the "high-level" version of [insert_in_list'back]. /// /// Note that in F* we can't have recursive proofs inside of other proofs, contrary /// to Coq, which makes it a bit cumbersome to prove auxiliary results like the @@ -893,14 +893,14 @@ let rec slot_s_inv_not_find_append_end_inv_lem t len key value ls = #pop-options /// [insert_in_list]: if the key is not in the map, appends a new bindings -val hash_map_insert_in_list_s_lem_append +val hashMap_insert_in_list_s_lem_append (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : Lemma (requires ( slot_s_inv len (hash_mod_key key len) ls /\ slot_s_find key ls == None)) (ensures ( - let ls' = hash_map_insert_in_list_s key value ls in + let ls' = hashMap_insert_in_list_s key value ls in ls' == ls @ [(key,value)] /\ // The invariant is preserved slot_s_inv len (hash_mod_key key len) ls' /\ @@ -909,20 +909,20 @@ val hash_map_insert_in_list_s_lem_append // The other bindings are preserved (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) -let hash_map_insert_in_list_s_lem_append t len key value ls = +let hashMap_insert_in_list_s_lem_append t len key value ls = slot_s_inv_not_find_append_end_inv_lem t len key value ls /// [insert_in_list]: if the key is not in the map, appends a new bindings (quantifiers) /// Rk.: we don't use this lemma. /// TODO: remove? -val hash_map_insert_in_list_back_lem_append +val hashMap_insert_in_list_back_lem_append (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : Lemma (requires ( slot_t_inv len (hash_mod_key key len) ls /\ slot_t_find_s key ls == None)) (ensures ( - match hash_map_insert_in_list_back t key value ls with + match hashMap_insert_in_list_back t key value ls with | Fail _ -> False | Return ls' -> list_t_v ls' == list_t_v ls @ [(key,value)] /\ @@ -933,9 +933,9 @@ val hash_map_insert_in_list_back_lem_append // The other bindings are preserved (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls))) -let hash_map_insert_in_list_back_lem_append t len key value ls = - hash_map_insert_in_list_back_lem_s t key value ls; - hash_map_insert_in_list_s_lem_append t len key value (list_t_v ls) +let hashMap_insert_in_list_back_lem_append t len key value ls = + hashMap_insert_in_list_back_lem_s t key value ls; + hashMap_insert_in_list_s_lem_append t len key value (list_t_v ls) (** Auxiliary lemmas: update case *) @@ -1013,14 +1013,14 @@ let rec slot_s_inv_find_append_end_inv_lem t len key value ls = #pop-options /// [insert_in_list]: if the key is in the map, update the bindings -val hash_map_insert_in_list_s_lem_update +val hashMap_insert_in_list_s_lem_update (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : Lemma (requires ( slot_s_inv len (hash_mod_key key len) ls /\ Some? (slot_s_find key ls))) (ensures ( - let ls' = hash_map_insert_in_list_s key value ls in + let ls' = hashMap_insert_in_list_s key value ls in ls' == find_update (same_key key) ls (key,value) /\ // The invariant is preserved slot_s_inv len (hash_mod_key key len) ls' /\ @@ -1029,20 +1029,20 @@ val hash_map_insert_in_list_s_lem_update // The other bindings are preserved (forall k'. k' <> key ==> slot_s_find k' ls' == slot_s_find k' ls))) -let hash_map_insert_in_list_s_lem_update t len key value ls = +let hashMap_insert_in_list_s_lem_update t len key value ls = slot_s_inv_find_append_end_inv_lem t len key value ls /// [insert_in_list]: if the key is in the map, update the bindings /// TODO: not used: remove? -val hash_map_insert_in_list_back_lem_update +val hashMap_insert_in_list_back_lem_update (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : Lemma (requires ( slot_t_inv len (hash_mod_key key len) ls /\ Some? (slot_t_find_s key ls))) (ensures ( - match hash_map_insert_in_list_back t key value ls with + match hashMap_insert_in_list_back t key value ls with | Fail _ -> False | Return ls' -> let als = list_t_v ls in @@ -1054,20 +1054,20 @@ val hash_map_insert_in_list_back_lem_update // The other bindings are preserved (forall k'. k' <> key ==> slot_t_find_s k' ls' == slot_t_find_s k' ls))) -let hash_map_insert_in_list_back_lem_update t len key value ls = - hash_map_insert_in_list_back_lem_s t key value ls; - hash_map_insert_in_list_s_lem_update t len key value (list_t_v ls) +let hashMap_insert_in_list_back_lem_update t len key value ls = + hashMap_insert_in_list_back_lem_s t key value ls; + hashMap_insert_in_list_s_lem_update t len key value (list_t_v ls) (** Final lemmas about [insert_in_list] *) /// High-level version -val hash_map_insert_in_list_s_lem +val hashMap_insert_in_list_s_lem (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list (binding t)) : Lemma (requires ( slot_s_inv len (hash_mod_key key len) ls)) (ensures ( - let ls' = hash_map_insert_in_list_s key value ls in + let ls' = hashMap_insert_in_list_s key value ls in // The invariant is preserved slot_s_inv len (hash_mod_key key len) ls' /\ // [key] maps to [value] @@ -1079,22 +1079,22 @@ val hash_map_insert_in_list_s_lem | None -> length ls' = length ls + 1 | Some _ -> length ls' = length ls))) -let hash_map_insert_in_list_s_lem t len key value ls = +let hashMap_insert_in_list_s_lem t len key value ls = match slot_s_find key ls with | None -> assert_norm(length [(key,value)] = 1); - hash_map_insert_in_list_s_lem_append t len key value ls + hashMap_insert_in_list_s_lem_append t len key value ls | Some _ -> - hash_map_insert_in_list_s_lem_update t len key value ls + hashMap_insert_in_list_s_lem_update t len key value ls /// [insert_in_list] /// TODO: not used: remove? -val hash_map_insert_in_list_back_lem +val hashMap_insert_in_list_back_lem (t : Type0) (len : usize{len > 0}) (key : usize) (value : t) (ls : list_t t) : Lemma (requires (slot_t_inv len (hash_mod_key key len) ls)) (ensures ( - match hash_map_insert_in_list_back t key value ls with + match hashMap_insert_in_list_back t key value ls with | Fail _ -> False | Return ls' -> // The invariant is preserved @@ -1111,127 +1111,127 @@ val hash_map_insert_in_list_back_lem | Some _ -> list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,value) /\ list_t_len ls' = list_t_len ls))) - (decreases (hash_map_insert_in_list_loop_decreases t key value ls)) + (decreases (hashMap_insert_in_list_loop_decreases t key value ls)) -let hash_map_insert_in_list_back_lem t len key value ls = - hash_map_insert_in_list_back_lem_s t key value ls; - hash_map_insert_in_list_s_lem t len key value (list_t_v ls) +let hashMap_insert_in_list_back_lem t len key value ls = + hashMap_insert_in_list_back_lem_s t key value ls; + hashMap_insert_in_list_s_lem t len key value (list_t_v ls) (*** insert_no_resize *) (**** Refinement proof *) /// Same strategy as for [insert_in_list]: we introduce a high-level version of /// the function, and reason about it. -/// We work on [hash_map_s] (we use a higher-level view of the hash-map, but +/// We work on [hashMap_s] (we use a higher-level view of the hash-map, but /// not too high). /// A high-level version of insert, which doesn't check if the table is saturated -let hash_map_insert_no_fail_s - (#t : Type0) (hm : hash_map_s_nes t) +let hashMap_insert_no_fail_s + (#t : Type0) (hm : hashMap_s_nes t) (key : usize) (value : t) : - hash_map_s t = + hashMap_s t = let len = length hm in let i = hash_mod_key key len in let slot = index hm i in - let slot' = hash_map_insert_in_list_s key value slot in + let slot' = hashMap_insert_in_list_s key value slot in let hm' = list_update hm i slot' in hm' -// TODO: at some point I used hash_map_s_nes and it broke proofs...x -let hash_map_insert_no_resize_s - (#t : Type0) (hm : hash_map_s_nes t) +// TODO: at some point I used hashMap_s_nes and it broke proofs...x +let hashMap_insert_no_resize_s + (#t : Type0) (hm : hashMap_s_nes t) (key : usize) (value : t) : - result (hash_map_s t) = + result (hashMap_s t) = // Check if the table is saturated (too many entries, and we need to insert one) let num_entries = length (flatten hm) in - if None? (hash_map_s_find hm key) && num_entries = usize_max then Fail Failure - else Return (hash_map_insert_no_fail_s hm key value) + if None? (hashMap_s_find hm key) && num_entries = usize_max then Fail Failure + else Return (hashMap_insert_no_fail_s hm key value) -/// Prove that [hash_map_insert_no_resize_s] is refined by -/// [hash_map_insert_no_resize'fwd_back] -val hash_map_insert_no_resize_fwd_back_lem_s - (t : Type0) (self : hash_map_t t) (key : usize) (value : t) : +/// Prove that [hashMap_insert_no_resize_s] is refined by +/// [hashMap_insert_no_resize'fwd_back] +val hashMap_insert_no_resize_lem_s + (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : Lemma (requires ( - hash_map_t_base_inv self /\ - hash_map_s_len (hash_map_t_v self) = hash_map_t_len_s self)) + hashMap_t_base_inv self /\ + hashMap_s_len (hashMap_t_v self) = hashMap_t_len_s self)) (ensures ( begin - match hash_map_insert_no_resize_fwd_back t self key value, - hash_map_insert_no_resize_s (hash_map_t_v self) key value + match hashMap_insert_no_resize t self key value, + hashMap_insert_no_resize_s (hashMap_t_v self) key value with | Fail _, Fail _ -> True | Return hm, Return hm_v -> - hash_map_t_base_inv hm /\ - hash_map_t_same_params hm self /\ - hash_map_t_v hm == hm_v /\ - hash_map_s_len hm_v == hash_map_t_len_s hm + hashMap_t_base_inv hm /\ + hashMap_t_same_params hm self /\ + hashMap_t_v hm == hm_v /\ + hashMap_s_len hm_v == hashMap_t_len_s hm | _ -> False end)) -let hash_map_insert_no_resize_fwd_back_lem_s t self key value = - begin match hash_key_fwd key with +let hashMap_insert_no_resize_lem_s t self key value = + begin match hash_key key with | Fail _ -> () | Return i -> - let i0 = self.hash_map_num_entries in - let p = self.hash_map_max_load_factor in - let i1 = self.hash_map_max_load in - let v = self.hash_map_slots in - let i2 = vec_len (list_t t) v in + let i0 = self.num_entries in + let p = self.max_load_factor in + let i1 = self.max_load in + let v = self.slots in + let i2 = alloc_vec_Vec_len (list_t t) v in let len = length v in begin match usize_rem i i2 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_mut_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> begin - // Checking that: list_t_v (index ...) == index (hash_map_t_v ...) ... - assert(list_t_v l == index (hash_map_t_v self) hash_mod); - hash_map_insert_in_list_fwd_lem t key value l; - match hash_map_insert_in_list_fwd t key value l with + // Checking that: list_t_v (index ...) == index (hashMap_t_v ...) ... + assert(list_t_v l == index (hashMap_t_v self) hash_mod); + hashMap_insert_in_list_lem t key value l; + match hashMap_insert_in_list t key value l with | Fail _ -> () | Return b -> assert(b = None? (slot_s_find key (list_t_v l))); - hash_map_insert_in_list_back_lem t len key value l; + hashMap_insert_in_list_back_lem t len key value l; if b then begin match usize_add i0 1 with | Fail _ -> () | Return i3 -> begin - match hash_map_insert_in_list_back t key value l with + match hashMap_insert_in_list_back t key value l with | Fail _ -> () | Return l0 -> - begin match vec_index_mut_back (list_t t) v hash_mod l0 with + begin match alloc_vec_Vec_update_usize v hash_mod l0 with | Fail _ -> () | Return v0 -> - let self_v = hash_map_t_v self in - let hm = Mkhash_map_t i3 p i1 v0 in - let hm_v = hash_map_t_v hm in + let self_v = hashMap_t_v self in + let hm = MkhashMap_t i3 p i1 v0 in + let hm_v = hashMap_t_v hm in assert(hm_v == list_update self_v hash_mod (list_t_v l0)); assert_norm(length [(key,value)] = 1); assert(length (list_t_v l0) = length (list_t_v l) + 1); length_flatten_update self_v hash_mod (list_t_v l0); - assert(hash_map_s_len hm_v = hash_map_t_len_s hm) + assert(hashMap_s_len hm_v = hashMap_t_len_s hm) end end end else begin - match hash_map_insert_in_list_back t key value l with + match hashMap_insert_in_list_back t key value l with | Fail _ -> () | Return l0 -> - begin match vec_index_mut_back (list_t t) v hash_mod l0 with + begin match alloc_vec_Vec_update_usize v hash_mod l0 with | Fail _ -> () | Return v0 -> - let self_v = hash_map_t_v self in - let hm = Mkhash_map_t i0 p i1 v0 in - let hm_v = hash_map_t_v hm in + let self_v = hashMap_t_v self in + let hm = MkhashMap_t i0 p i1 v0 in + let hm_v = hashMap_t_v hm in assert(hm_v == list_update self_v hash_mod (list_t_v l0)); assert(length (list_t_v l0) = length (list_t_v l)); length_flatten_update self_v hash_mod (list_t_v l0); - assert(hash_map_s_len hm_v = hash_map_t_len_s hm) + assert(hashMap_s_len hm_v = hashMap_t_len_s hm) end end end @@ -1241,108 +1241,108 @@ let hash_map_insert_no_resize_fwd_back_lem_s t self key value = (**** insert_{no_fail,no_resize}: invariants *) -let hash_map_s_updated_binding - (#t : Type0) (hm : hash_map_s_nes t) - (key : usize) (opt_value : option t) (hm' : hash_map_s_nes t) : Type0 = +let hashMap_s_updated_binding + (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (opt_value : option t) (hm' : hashMap_s_nes t) : Type0 = // [key] maps to [value] - hash_map_s_find hm' key == opt_value /\ + hashMap_s_find hm' key == opt_value /\ // The other bindings are preserved - (forall k'. k' <> key ==> hash_map_s_find hm' k' == hash_map_s_find hm k') + (forall k'. k' <> key ==> hashMap_s_find hm' k' == hashMap_s_find hm k') -let insert_post (#t : Type0) (hm : hash_map_s_nes t) - (key : usize) (value : t) (hm' : hash_map_s_nes t) : Type0 = +let insert_post (#t : Type0) (hm : hashMap_s_nes t) + (key : usize) (value : t) (hm' : hashMap_s_nes t) : Type0 = // The invariant is preserved - hash_map_s_inv hm' /\ + hashMap_s_inv hm' /\ // [key] maps to [value] and the other bindings are preserved - hash_map_s_updated_binding hm key (Some value) hm' /\ + hashMap_s_updated_binding hm key (Some value) hm' /\ // The length is incremented, iff we inserted a new key - (match hash_map_s_find hm key with - | None -> hash_map_s_len hm' = hash_map_s_len hm + 1 - | Some _ -> hash_map_s_len hm' = hash_map_s_len hm) + (match hashMap_s_find hm key with + | None -> hashMap_s_len hm' = hashMap_s_len hm + 1 + | Some _ -> hashMap_s_len hm' = hashMap_s_len hm) -val hash_map_insert_no_fail_s_lem - (#t : Type0) (hm : hash_map_s_nes t) +val hashMap_insert_no_fail_s_lem + (#t : Type0) (hm : hashMap_s_nes t) (key : usize) (value : t) : Lemma - (requires (hash_map_s_inv hm)) + (requires (hashMap_s_inv hm)) (ensures ( - let hm' = hash_map_insert_no_fail_s hm key value in + let hm' = hashMap_insert_no_fail_s hm key value in insert_post hm key value hm')) -let hash_map_insert_no_fail_s_lem #t hm key value = +let hashMap_insert_no_fail_s_lem #t hm key value = let len = length hm in let i = hash_mod_key key len in let slot = index hm i in - hash_map_insert_in_list_s_lem t len key value slot; - let slot' = hash_map_insert_in_list_s key value slot in + hashMap_insert_in_list_s_lem t len key value slot; + let slot' = hashMap_insert_in_list_s key value slot in length_flatten_update hm i slot' -val hash_map_insert_no_resize_s_lem - (#t : Type0) (hm : hash_map_s_nes t) +val hashMap_insert_no_resize_s_lem + (#t : Type0) (hm : hashMap_s_nes t) (key : usize) (value : t) : Lemma - (requires (hash_map_s_inv hm)) + (requires (hashMap_s_inv hm)) (ensures ( - match hash_map_insert_no_resize_s hm key value with + match hashMap_insert_no_resize_s hm key value with | Fail _ -> // Can fail only if we need to create a new binding in // an already saturated map - hash_map_s_len hm = usize_max /\ - None? (hash_map_s_find hm key) + hashMap_s_len hm = usize_max /\ + None? (hashMap_s_find hm key) | Return hm' -> insert_post hm key value hm')) -let hash_map_insert_no_resize_s_lem #t hm key value = +let hashMap_insert_no_resize_s_lem #t hm key value = let num_entries = length (flatten hm) in - if None? (hash_map_s_find hm key) && num_entries = usize_max then () - else hash_map_insert_no_fail_s_lem hm key value + if None? (hashMap_s_find hm key) && num_entries = usize_max then () + else hashMap_insert_no_fail_s_lem hm key value (**** find after insert *) /// Lemmas about what happens if we call [find] after an insertion -val hash_map_insert_no_resize_s_get_same_lem - (#t : Type0) (hm : hash_map_s t) +val hashMap_insert_no_resize_s_get_same_lem + (#t : Type0) (hm : hashMap_s t) (key : usize) (value : t) : - Lemma (requires (hash_map_s_inv hm)) + Lemma (requires (hashMap_s_inv hm)) (ensures ( - match hash_map_insert_no_resize_s hm key value with + match hashMap_insert_no_resize_s hm key value with | Fail _ -> True | Return hm' -> - hash_map_s_find hm' key == Some value)) + hashMap_s_find hm' key == Some value)) -let hash_map_insert_no_resize_s_get_same_lem #t hm key value = +let hashMap_insert_no_resize_s_get_same_lem #t hm key value = let num_entries = length (flatten hm) in - if None? (hash_map_s_find hm key) && num_entries = usize_max then () + if None? (hashMap_s_find hm key) && num_entries = usize_max then () else begin - let hm' = Return?.v (hash_map_insert_no_resize_s hm key value) in + let hm' = Return?.v (hashMap_insert_no_resize_s hm key value) in let len = length hm in let i = hash_mod_key key len in let slot = index hm i in - hash_map_insert_in_list_s_lem t len key value slot + hashMap_insert_in_list_s_lem t len key value slot end -val hash_map_insert_no_resize_s_get_diff_lem - (#t : Type0) (hm : hash_map_s t) +val hashMap_insert_no_resize_s_get_diff_lem + (#t : Type0) (hm : hashMap_s t) (key : usize) (value : t) (key' : usize{key' <> key}) : - Lemma (requires (hash_map_s_inv hm)) + Lemma (requires (hashMap_s_inv hm)) (ensures ( - match hash_map_insert_no_resize_s hm key value with + match hashMap_insert_no_resize_s hm key value with | Fail _ -> True | Return hm' -> - hash_map_s_find hm' key' == hash_map_s_find hm key')) + hashMap_s_find hm' key' == hashMap_s_find hm key')) -let hash_map_insert_no_resize_s_get_diff_lem #t hm key value key' = +let hashMap_insert_no_resize_s_get_diff_lem #t hm key value key' = let num_entries = length (flatten hm) in - if None? (hash_map_s_find hm key) && num_entries = usize_max then () + if None? (hashMap_s_find hm key) && num_entries = usize_max then () else begin - let hm' = Return?.v (hash_map_insert_no_resize_s hm key value) in + let hm' = Return?.v (hashMap_insert_no_resize_s hm key value) in let len = length hm in let i = hash_mod_key key len in let slot = index hm i in - hash_map_insert_in_list_s_lem t len key value slot; + hashMap_insert_in_list_s_lem t len key value slot; let i' = hash_mod_key key' len in if i <> i' then () else @@ -1354,116 +1354,116 @@ let hash_map_insert_no_resize_s_get_diff_lem #t hm key value key' = (*** move_elements_from_list *) -/// Having a great time here: if we use `result (hash_map_s_res t)` as the -/// return type for [hash_map_move_elements_from_list_s] instead of having this -/// awkward match, the proof of [hash_map_move_elements_fwd_back_lem_refin] fails. +/// Having a great time here: if we use `result (hashMap_s_res t)` as the +/// return type for [hashMap_move_elements_from_list_s] instead of having this +/// awkward match, the proof of [hashMap_move_elements_lem_refin] fails. /// I guess it comes from F*'s poor subtyping. -/// Followingly, I'm not taking any chance and using [result_hash_map_s] +/// Followingly, I'm not taking any chance and using [result_hashMap_s] /// everywhere. -type result_hash_map_s_nes (t : Type0) : Type0 = - res:result (hash_map_s t) { +type result_hashMap_s_nes (t : Type0) : Type0 = + res:result (hashMap_s t) { match res with | Fail _ -> True | Return hm -> is_pos_usize (length hm) } -let rec hash_map_move_elements_from_list_s - (#t : Type0) (hm : hash_map_s_nes t) +let rec hashMap_move_elements_from_list_s + (#t : Type0) (hm : hashMap_s_nes t) (ls : slot_s t) : - // Do *NOT* use `result (hash_map_s t)` - Tot (result_hash_map_s_nes t) + // Do *NOT* use `result (hashMap_s t)` + Tot (result_hashMap_s_nes t) (decreases ls) = match ls with | [] -> Return hm | (key, value) :: ls' -> - match hash_map_insert_no_resize_s hm key value with + match hashMap_insert_no_resize_s hm key value with | Fail e -> Fail e | Return hm' -> - hash_map_move_elements_from_list_s hm' ls' + hashMap_move_elements_from_list_s hm' ls' /// Refinement lemma -val hash_map_move_elements_from_list_fwd_back_lem - (t : Type0) (ntable : hash_map_t_nes t) (ls : list_t t) : - Lemma (requires (hash_map_t_base_inv ntable)) +val hashMap_move_elements_from_list_lem + (t : Type0) (ntable : hashMap_t_nes t) (ls : list_t t) : + Lemma (requires (hashMap_t_base_inv ntable)) (ensures ( - match hash_map_move_elements_from_list_fwd_back t ntable ls, - hash_map_move_elements_from_list_s (hash_map_t_v ntable) (slot_t_v ls) + match hashMap_move_elements_from_list t ntable ls, + hashMap_move_elements_from_list_s (hashMap_t_v ntable) (slot_t_v ls) with | Fail _, Fail _ -> True | Return hm', Return hm_v -> - hash_map_t_base_inv hm' /\ - hash_map_t_v hm' == hm_v /\ - hash_map_t_same_params hm' ntable + hashMap_t_base_inv hm' /\ + hashMap_t_v hm' == hm_v /\ + hashMap_t_same_params hm' ntable | _ -> False)) - (decreases (hash_map_move_elements_from_list_loop_decreases t ntable ls)) + (decreases (hashMap_move_elements_from_list_loop_decreases t ntable ls)) #push-options "--fuel 1" -let rec hash_map_move_elements_from_list_fwd_back_lem t ntable ls = +let rec hashMap_move_elements_from_list_lem t ntable ls = begin match ls with - | ListCons k v tl -> + | List_Cons k v tl -> assert(list_t_v ls == (k, v) :: list_t_v tl); let ls_v = list_t_v ls in let (_,_) :: tl_v = ls_v in - hash_map_insert_no_resize_fwd_back_lem_s t ntable k v; - begin match hash_map_insert_no_resize_fwd_back t ntable k v with + hashMap_insert_no_resize_lem_s t ntable k v; + begin match hashMap_insert_no_resize t ntable k v with | Fail _ -> () | Return h -> - let h_v = Return?.v (hash_map_insert_no_resize_s (hash_map_t_v ntable) k v) in - assert(hash_map_t_v h == h_v); - hash_map_move_elements_from_list_fwd_back_lem t h tl; - begin match hash_map_move_elements_from_list_fwd_back t h tl with + let h_v = Return?.v (hashMap_insert_no_resize_s (hashMap_t_v ntable) k v) in + assert(hashMap_t_v h == h_v); + hashMap_move_elements_from_list_lem t h tl; + begin match hashMap_move_elements_from_list t h tl with | Fail _ -> () | Return h0 -> () end end - | ListNil -> () + | List_Nil -> () end #pop-options (*** move_elements *) (**** move_elements: refinement 0 *) -/// The proof for [hash_map_move_elements_fwd_back_lem_refin] broke so many times +/// The proof for [hashMap_move_elements_lem_refin] broke so many times /// (while it is supposed to be super simple!) that we decided to add one refinement /// level, to really do things step by step... /// Doing this refinement layer made me notice that maybe the problem came from -/// the fact that at some point we have to prove `list_t_v ListNil == []`: I +/// the fact that at some point we have to prove `list_t_v List_Nil == []`: I /// added the corresponding assert to help Z3 and everything became stable. /// I finally didn't use this "simple" refinement lemma, but I still keep it here -/// because it allows for easy comparisons with [hash_map_move_elements_s]. +/// because it allows for easy comparisons with [hashMap_move_elements_s]. -/// [hash_map_move_elements_fwd] refines this function, which is actually almost +/// [hashMap_move_elements] refines this function, which is actually almost /// the same (just a little bit shorter and cleaner, and has a pre). /// /// The way I wrote the high-level model is the following: -/// - I copy-pasted the definition of [hash_map_move_elements_fwd], wrote the -/// signature which links this new definition to [hash_map_move_elements_fwd] and +/// - I copy-pasted the definition of [hashMap_move_elements], wrote the +/// signature which links this new definition to [hashMap_move_elements] and /// checked that the proof passed /// - I gradually simplified it, while making sure the proof still passes #push-options "--fuel 1" -let rec hash_map_move_elements_s_simpl - (t : Type0) (ntable : hash_map_t t) - (slots : vec (list_t t)) +let rec hashMap_move_elements_s_simpl + (t : Type0) (ntable : hashMap_t t) + (slots : alloc_vec_Vec (list_t t)) (i : usize{i <= length slots /\ length slots <= usize_max}) : - Pure (result ((hash_map_t t) & (vec (list_t t)))) + Pure (result ((hashMap_t t) & (alloc_vec_Vec (list_t t)))) (requires (True)) (ensures (fun res -> - match res, hash_map_move_elements_fwd_back t ntable slots i with + match res, hashMap_move_elements t ntable slots i with | Fail _, Fail _ -> True | Return (ntable1, slots1), Return (ntable2, slots2) -> ntable1 == ntable2 /\ slots1 == slots2 | _ -> False)) - (decreases (hash_map_move_elements_loop_decreases t ntable slots i)) + (decreases (hashMap_move_elements_loop_decreases t ntable slots i)) = if i < length slots then let slot = index slots i in - begin match hash_map_move_elements_from_list_fwd_back t ntable slot with + begin match hashMap_move_elements_from_list t ntable slot with | Fail e -> Fail e | Return hm' -> - let slots' = list_update slots i ListNil in - hash_map_move_elements_s_simpl t hm' slots' (i+1) + let slots' = list_update slots i List_Nil in + hashMap_move_elements_s_simpl t hm' slots' (i+1) end else Return (ntable, slots) #pop-options @@ -1476,71 +1476,71 @@ let rec hash_map_move_elements_s_simpl // Note that we ignore the returned slots (we thus don't return a pair: // only the new hash map in which we moved the elements from the slots): // this returned value is not used. -let rec hash_map_move_elements_s - (#t : Type0) (hm : hash_map_s_nes t) +let rec hashMap_move_elements_s + (#t : Type0) (hm : hashMap_s_nes t) (slots : slots_s t) (i : usize{i <= length slots /\ length slots <= usize_max}) : - Tot (result_hash_map_s_nes t) + Tot (result_hashMap_s_nes t) (decreases (length slots - i)) = let len = length slots in if i < len then begin let slot = index slots i in - match hash_map_move_elements_from_list_s hm slot with + match hashMap_move_elements_from_list_s hm slot with | Fail e -> Fail e | Return hm' -> let slots' = list_update slots i [] in - hash_map_move_elements_s hm' slots' (i+1) + hashMap_move_elements_s hm' slots' (i+1) end else Return hm -val hash_map_move_elements_fwd_back_lem_refin - (t : Type0) (ntable : hash_map_t t) - (slots : vec (list_t t)) (i : usize{i <= length slots}) : +val hashMap_move_elements_lem_refin + (t : Type0) (ntable : hashMap_t t) + (slots : alloc_vec_Vec (list_t t)) (i : usize{i <= length slots}) : Lemma (requires ( - hash_map_t_base_inv ntable)) + hashMap_t_base_inv ntable)) (ensures ( - match hash_map_move_elements_fwd_back t ntable slots i, - hash_map_move_elements_s (hash_map_t_v ntable) (slots_t_v slots) i + match hashMap_move_elements t ntable slots i, + hashMap_move_elements_s (hashMap_t_v ntable) (slots_t_v slots) i with | Fail _, Fail _ -> True // We will prove later that this is not possible | Return (ntable', _), Return ntable'_v -> - hash_map_t_base_inv ntable' /\ - hash_map_t_v ntable' == ntable'_v /\ - hash_map_t_same_params ntable' ntable + hashMap_t_base_inv ntable' /\ + hashMap_t_v ntable' == ntable'_v /\ + hashMap_t_same_params ntable' ntable | _ -> False)) (decreases (length slots - i)) #restart-solver #push-options "--fuel 1" -let rec hash_map_move_elements_fwd_back_lem_refin t ntable slots i = - assert(hash_map_t_base_inv ntable); - let i0 = vec_len (list_t t) slots in +let rec hashMap_move_elements_lem_refin t ntable slots i = + assert(hashMap_t_base_inv ntable); + let i0 = alloc_vec_Vec_len (list_t t) slots in let b = i < i0 in if b then - begin match vec_index_mut_fwd (list_t t) slots i with + begin match alloc_vec_Vec_index_usize slots i with | Fail _ -> () | Return l -> - let l0 = mem_replace_fwd (list_t t) l ListNil in + let l0 = core_mem_replace (list_t t) l List_Nil in assert(l0 == l); - hash_map_move_elements_from_list_fwd_back_lem t ntable l0; - begin match hash_map_move_elements_from_list_fwd_back t ntable l0 with + hashMap_move_elements_from_list_lem t ntable l0; + begin match hashMap_move_elements_from_list t ntable l0 with | Fail _ -> () | Return h -> - let l1 = mem_replace_back (list_t t) l ListNil in - assert(l1 == ListNil); - assert(slot_t_v #t ListNil == []); // THIS IS IMPORTANT - begin match vec_index_mut_back (list_t t) slots i l1 with + let l1 = core_mem_replace_back (list_t t) l List_Nil in + assert(l1 == List_Nil); + assert(slot_t_v #t List_Nil == []); // THIS IS IMPORTANT + begin match alloc_vec_Vec_update_usize slots i l1 with | Fail _ -> () | Return v -> begin match usize_add i 1 with | Fail _ -> () | Return i1 -> - hash_map_move_elements_fwd_back_lem_refin t h v i1; - begin match hash_map_move_elements_fwd_back t h v i1 with + hashMap_move_elements_lem_refin t h v i1; + begin match hashMap_move_elements t h v i1 with | Fail _ -> - assert(Fail? (hash_map_move_elements_fwd_back t ntable slots i)); + assert(Fail? (hashMap_move_elements t ntable slots i)); () | Return (ntable', v0) -> () end @@ -1560,19 +1560,19 @@ let rec hash_map_move_elements_fwd_back_lem_refin t ntable slots i = /// [ntable] is the hash map to which we move the elements /// [slots] is the current hash map, from which we remove the elements, and seen /// as a "flat" associative list (and not a list of lists) -/// This is actually exactly [hash_map_move_elements_from_list_s]... -let rec hash_map_move_elements_s_flat - (#t : Type0) (ntable : hash_map_s_nes t) +/// This is actually exactly [hashMap_move_elements_from_list_s]... +let rec hashMap_move_elements_s_flat + (#t : Type0) (ntable : hashMap_s_nes t) (slots : assoc_list t) : - Tot (result_hash_map_s_nes t) + Tot (result_hashMap_s_nes t) (decreases slots) = match slots with | [] -> Return ntable | (k,v) :: slots' -> - match hash_map_insert_no_resize_s ntable k v with + match hashMap_insert_no_resize_s ntable k v with | Fail e -> Fail e | Return ntable' -> - hash_map_move_elements_s_flat ntable' slots' + hashMap_move_elements_s_flat ntable' slots' /// The refinment lemmas /// First, auxiliary helpers. @@ -1656,42 +1656,42 @@ let rec flatten_nil_prefix_as_flatten_i #a l i = /// The proof is trivial, the functions are the same. /// Just keeping two definitions to allow changes... -val hash_map_move_elements_from_list_s_as_flat_lem - (#t : Type0) (hm : hash_map_s_nes t) +val hashMap_move_elements_from_list_s_as_flat_lem + (#t : Type0) (hm : hashMap_s_nes t) (ls : slot_s t) : Lemma (ensures ( - hash_map_move_elements_from_list_s hm ls == - hash_map_move_elements_s_flat hm ls)) + hashMap_move_elements_from_list_s hm ls == + hashMap_move_elements_s_flat hm ls)) (decreases ls) #push-options "--fuel 1" -let rec hash_map_move_elements_from_list_s_as_flat_lem #t hm ls = +let rec hashMap_move_elements_from_list_s_as_flat_lem #t hm ls = match ls with | [] -> () | (key, value) :: ls' -> - match hash_map_insert_no_resize_s hm key value with + match hashMap_insert_no_resize_s hm key value with | Fail _ -> () | Return hm' -> - hash_map_move_elements_from_list_s_as_flat_lem hm' ls' + hashMap_move_elements_from_list_s_as_flat_lem hm' ls' #pop-options -/// Composition of two calls to [hash_map_move_elements_s_flat] -let hash_map_move_elements_s_flat_comp - (#t : Type0) (hm : hash_map_s_nes t) (slot0 slot1 : slot_s t) : - Tot (result_hash_map_s_nes t) = - match hash_map_move_elements_s_flat hm slot0 with +/// Composition of two calls to [hashMap_move_elements_s_flat] +let hashMap_move_elements_s_flat_comp + (#t : Type0) (hm : hashMap_s_nes t) (slot0 slot1 : slot_s t) : + Tot (result_hashMap_s_nes t) = + match hashMap_move_elements_s_flat hm slot0 with | Fail e -> Fail e - | Return hm1 -> hash_map_move_elements_s_flat hm1 slot1 + | Return hm1 -> hashMap_move_elements_s_flat hm1 slot1 /// High-level desc: /// move_elements (move_elements hm slot0) slo1 == move_elements hm (slot0 @ slot1) -val hash_map_move_elements_s_flat_append_lem - (#t : Type0) (hm : hash_map_s_nes t) (slot0 slot1 : slot_s t) : +val hashMap_move_elements_s_flat_append_lem + (#t : Type0) (hm : hashMap_s_nes t) (slot0 slot1 : slot_s t) : Lemma (ensures ( - match hash_map_move_elements_s_flat_comp hm slot0 slot1, - hash_map_move_elements_s_flat hm (slot0 @ slot1) + match hashMap_move_elements_s_flat_comp hm slot0 slot1, + hashMap_move_elements_s_flat hm (slot0 @ slot1) with | Fail _, Fail _ -> True | Return hm1, Return hm2 -> hm1 == hm2 @@ -1699,14 +1699,14 @@ val hash_map_move_elements_s_flat_append_lem (decreases (slot0)) #push-options "--fuel 1" -let rec hash_map_move_elements_s_flat_append_lem #t hm slot0 slot1 = +let rec hashMap_move_elements_s_flat_append_lem #t hm slot0 slot1 = match slot0 with | [] -> () | (k,v) :: slot0' -> - match hash_map_insert_no_resize_s hm k v with + match hashMap_insert_no_resize_s hm k v with | Fail _ -> () | Return hm' -> - hash_map_move_elements_s_flat_append_lem hm' slot0' slot1 + hashMap_move_elements_s_flat_append_lem hm' slot0' slot1 #pop-options val flatten_i_same_suffix (#a : Type) (l0 l1 : list (list a)) (i : nat) : @@ -1726,16 +1726,16 @@ let rec flatten_i_same_suffix #a l0 l1 i = #pop-options /// Refinement lemma: -/// [hash_map_move_elements_s] refines [hash_map_move_elements_s_flat] +/// [hashMap_move_elements_s] refines [hashMap_move_elements_s_flat] /// (actually the functions are equal on all inputs). -val hash_map_move_elements_s_lem_refin_flat - (#t : Type0) (hm : hash_map_s_nes t) +val hashMap_move_elements_s_lem_refin_flat + (#t : Type0) (hm : hashMap_s_nes t) (slots : slots_s t) (i : nat{i <= length slots /\ length slots <= usize_max}) : Lemma (ensures ( - match hash_map_move_elements_s hm slots i, - hash_map_move_elements_s_flat hm (flatten_i slots i) + match hashMap_move_elements_s hm slots i, + hashMap_move_elements_s_flat hm (flatten_i slots i) with | Fail _, Fail _ -> True | Return hm, Return hm' -> hm == hm' @@ -1743,22 +1743,22 @@ val hash_map_move_elements_s_lem_refin_flat (decreases (length slots - i)) #push-options "--fuel 1" -let rec hash_map_move_elements_s_lem_refin_flat #t hm slots i = +let rec hashMap_move_elements_s_lem_refin_flat #t hm slots i = let len = length slots in if i < len then begin let slot = index slots i in - hash_map_move_elements_from_list_s_as_flat_lem hm slot; - match hash_map_move_elements_from_list_s hm slot with + hashMap_move_elements_from_list_s_as_flat_lem hm slot; + match hashMap_move_elements_from_list_s hm slot with | Fail _ -> assert(flatten_i slots i == slot @ flatten_i slots (i+1)); - hash_map_move_elements_s_flat_append_lem hm slot (flatten_i slots (i+1)); - assert(Fail? (hash_map_move_elements_s_flat hm (flatten_i slots i))) + hashMap_move_elements_s_flat_append_lem hm slot (flatten_i slots (i+1)); + assert(Fail? (hashMap_move_elements_s_flat hm (flatten_i slots i))) | Return hm' -> let slots' = list_update slots i [] in flatten_i_same_suffix slots slots' (i+1); - hash_map_move_elements_s_lem_refin_flat hm' slots' (i+1); - hash_map_move_elements_s_flat_append_lem hm slot (flatten_i slots' (i+1)); + hashMap_move_elements_s_lem_refin_flat hm' slots' (i+1); + hashMap_move_elements_s_flat_append_lem hm slot (flatten_i slots' (i+1)); () end else () @@ -1769,21 +1769,21 @@ let assoc_list_inv (#t : Type0) (al : assoc_list t) : Type0 = pairwise_rel binding_neq al let disjoint_hm_al_on_key - (#t : Type0) (hm : hash_map_s_nes t) (al : assoc_list t) (k : key) : Type0 = - match hash_map_s_find hm k, assoc_list_find k al with + (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) (k : key) : Type0 = + match hashMap_s_find hm k, assoc_list_find k al with | Some _, None | None, Some _ | None, None -> True | Some _, Some _ -> False /// Playing a dangerous game here: using forall quantifiers -let disjoint_hm_al (#t : Type0) (hm : hash_map_s_nes t) (al : assoc_list t) : Type0 = +let disjoint_hm_al (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) : Type0 = forall (k:key). disjoint_hm_al_on_key hm al k let find_in_union_hm_al - (#t : Type0) (hm : hash_map_s_nes t) (al : assoc_list t) (k : key) : + (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) (k : key) : option t = - match hash_map_s_find hm k with + match hashMap_s_find hm k with | Some b -> Some b | None -> assoc_list_find k al @@ -1799,58 +1799,58 @@ let rec for_all_binding_neq_find_lem #t k v al = | b :: al' -> for_all_binding_neq_find_lem k v al' #pop-options -val hash_map_move_elements_s_flat_lem - (#t : Type0) (hm : hash_map_s_nes t) (al : assoc_list t) : +val hashMap_move_elements_s_flat_lem + (#t : Type0) (hm : hashMap_s_nes t) (al : assoc_list t) : Lemma (requires ( // Invariants - hash_map_s_inv hm /\ + hashMap_s_inv hm /\ assoc_list_inv al /\ // The two are disjoint disjoint_hm_al hm al /\ // We can add all the elements to the hashmap - hash_map_s_len hm + length al <= usize_max)) + hashMap_s_len hm + length al <= usize_max)) (ensures ( - match hash_map_move_elements_s_flat hm al with + match hashMap_move_elements_s_flat hm al with | Fail _ -> False // We can't fail | Return hm' -> // The invariant is preserved - hash_map_s_inv hm' /\ + hashMap_s_inv hm' /\ // The new hash map is the union of the two maps - (forall (k:key). hash_map_s_find hm' k == find_in_union_hm_al hm al k) /\ - hash_map_s_len hm' = hash_map_s_len hm + length al)) + (forall (k:key). hashMap_s_find hm' k == find_in_union_hm_al hm al k) /\ + hashMap_s_len hm' = hashMap_s_len hm + length al)) (decreases al) #restart-solver #push-options "--z3rlimit 200 --fuel 1" -let rec hash_map_move_elements_s_flat_lem #t hm al = +let rec hashMap_move_elements_s_flat_lem #t hm al = match al with | [] -> () | (k,v) :: al' -> - hash_map_insert_no_resize_s_lem hm k v; - match hash_map_insert_no_resize_s hm k v with + hashMap_insert_no_resize_s_lem hm k v; + match hashMap_insert_no_resize_s hm k v with | Fail _ -> () | Return hm' -> - assert(hash_map_s_inv hm'); + assert(hashMap_s_inv hm'); assert(assoc_list_inv al'); let disjoint_lem (k' : key) : Lemma (disjoint_hm_al_on_key hm' al' k') [SMTPat (disjoint_hm_al_on_key hm' al' k')] = if k' = k then begin - assert(hash_map_s_find hm' k' == Some v); + assert(hashMap_s_find hm' k' == Some v); for_all_binding_neq_find_lem k v al'; assert(assoc_list_find k' al' == None) end else begin - assert(hash_map_s_find hm' k' == hash_map_s_find hm k'); + assert(hashMap_s_find hm' k' == hashMap_s_find hm k'); assert(assoc_list_find k' al' == assoc_list_find k' al) end in assert(disjoint_hm_al hm' al'); - assert(hash_map_s_len hm' + length al' <= usize_max); - hash_map_move_elements_s_flat_lem hm' al' + assert(hashMap_s_len hm' + length al' <= usize_max); + hashMap_move_elements_s_flat_lem hm' al' #pop-options /// We need to prove that the invariants on the "low-level" representations of @@ -1866,18 +1866,18 @@ let slots_t_inv_implies_slots_s_inv #t slots = // Problem is: I can never really predict for sure with F*... () -val hash_map_t_base_inv_implies_hash_map_s_inv - (#t : Type0) (hm : hash_map_t t) : - Lemma (requires (hash_map_t_base_inv hm)) - (ensures (hash_map_s_inv (hash_map_t_v hm))) +val hashMap_t_base_inv_implies_hashMap_s_inv + (#t : Type0) (hm : hashMap_t t) : + Lemma (requires (hashMap_t_base_inv hm)) + (ensures (hashMap_s_inv (hashMap_t_v hm))) -let hash_map_t_base_inv_implies_hash_map_s_inv #t hm = () // same as previous +let hashMap_t_base_inv_implies_hashMap_s_inv #t hm = () // same as previous /// Introducing a "partial" version of the hash map invariant, which operates on /// a suffix of the hash map. -let partial_hash_map_s_inv +let partial_hashMap_s_inv (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hash_map_s t{offset + length hm <= usize_max}) : Type0 = + (hm : hashMap_s t{offset + length hm <= usize_max}) : Type0 = forall(i:nat{i < length hm}). {:pattern index hm i} slot_s_inv len (offset + i) (index hm i) /// Auxiliary lemma. @@ -1887,13 +1887,13 @@ val binding_in_previous_slot_implies_neq (#t : Type0) (len : usize{len > 0}) (i : usize) (b : binding t) (offset : usize{i < offset}) - (slots : hash_map_s t{offset + length slots <= usize_max}) : + (slots : hashMap_s t{offset + length slots <= usize_max}) : Lemma (requires ( // The binding comes from a slot not in [slots] hash_mod_key (fst b) len = i /\ // The slots are the well-formed suffix of a hash map - partial_hash_map_s_inv len offset slots)) + partial_hashMap_s_inv len offset slots)) (ensures ( for_all (binding_neq b) (flatten slots))) (decreases slots) @@ -1924,17 +1924,17 @@ let rec binding_in_previous_slot_implies_neq #t len i b offset slots = for_all_append (binding_neq b) s (flatten slots') #pop-options -val partial_hash_map_s_inv_implies_assoc_list_lem +val partial_hashMap_s_inv_implies_assoc_list_lem (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hash_map_s t{offset + length hm <= usize_max}) : + (hm : hashMap_s t{offset + length hm <= usize_max}) : Lemma (requires ( - partial_hash_map_s_inv len offset hm)) + partial_hashMap_s_inv len offset hm)) (ensures (assoc_list_inv (flatten hm))) (decreases (length hm + length (flatten hm))) #push-options "--fuel 1" -let rec partial_hash_map_s_inv_implies_assoc_list_lem #t len offset hm = +let rec partial_hashMap_s_inv_implies_assoc_list_lem #t len offset hm = match hm with | [] -> () | slot :: hm' -> @@ -1943,8 +1943,8 @@ let rec partial_hash_map_s_inv_implies_assoc_list_lem #t len offset hm = match slot with | [] -> assert(flatten hm == flatten hm'); - assert(partial_hash_map_s_inv len (offset+1) hm'); // Triggers instantiations - partial_hash_map_s_inv_implies_assoc_list_lem len (offset+1) hm' + assert(partial_hashMap_s_inv len (offset+1) hm'); // Triggers instantiations + partial_hashMap_s_inv_implies_assoc_list_lem len (offset+1) hm' | x :: slot' -> assert(flatten (slot' :: hm') == slot' @ flatten hm'); let hm'' = slot' :: hm' in @@ -1953,45 +1953,45 @@ let rec partial_hash_map_s_inv_implies_assoc_list_lem #t len offset hm = assert(index hm 0 == slot); // Triggers instantiations assert(slot_s_inv len offset slot); assert(slot_s_inv len offset slot'); - assert(partial_hash_map_s_inv len offset hm''); - partial_hash_map_s_inv_implies_assoc_list_lem len offset (slot' :: hm'); + assert(partial_hashMap_s_inv len offset hm''); + partial_hashMap_s_inv_implies_assoc_list_lem len offset (slot' :: hm'); // Proving that the key in `x` is different from all the other keys in // the flattened map assert(for_all (binding_neq x) slot'); for_all_append (binding_neq x) slot' (flatten hm'); - assert(partial_hash_map_s_inv len (offset+1) hm'); + assert(partial_hashMap_s_inv len (offset+1) hm'); binding_in_previous_slot_implies_neq #t len offset x (offset+1) hm'; assert(for_all (binding_neq x) (flatten hm')); assert(for_all (binding_neq x) (flatten (slot' :: hm'))) #pop-options -val hash_map_s_inv_implies_assoc_list_lem - (#t : Type0) (hm : hash_map_s t) : - Lemma (requires (hash_map_s_inv hm)) +val hashMap_s_inv_implies_assoc_list_lem + (#t : Type0) (hm : hashMap_s t) : + Lemma (requires (hashMap_s_inv hm)) (ensures (assoc_list_inv (flatten hm))) -let hash_map_s_inv_implies_assoc_list_lem #t hm = - partial_hash_map_s_inv_implies_assoc_list_lem (length hm) 0 hm +let hashMap_s_inv_implies_assoc_list_lem #t hm = + partial_hashMap_s_inv_implies_assoc_list_lem (length hm) 0 hm -val hash_map_t_base_inv_implies_assoc_list_lem - (#t : Type0) (hm : hash_map_t t): - Lemma (requires (hash_map_t_base_inv hm)) - (ensures (assoc_list_inv (hash_map_t_al_v hm))) +val hashMap_t_base_inv_implies_assoc_list_lem + (#t : Type0) (hm : hashMap_t t): + Lemma (requires (hashMap_t_base_inv hm)) + (ensures (assoc_list_inv (hashMap_t_al_v hm))) -let hash_map_t_base_inv_implies_assoc_list_lem #t hm = - hash_map_s_inv_implies_assoc_list_lem (hash_map_t_v hm) +let hashMap_t_base_inv_implies_assoc_list_lem #t hm = + hashMap_s_inv_implies_assoc_list_lem (hashMap_t_v hm) /// For some reason, we can't write the below [forall] directly in the [ensures] /// clause of the next lemma: it makes Z3 fails even with a huge rlimit. /// I have no idea what's going on. -let hash_map_is_assoc_list - (#t : Type0) (ntable : hash_map_t t{length ntable.hash_map_slots > 0}) +let hashMap_is_assoc_list + (#t : Type0) (ntable : hashMap_t t{length ntable.slots > 0}) (al : assoc_list t) : Type0 = - (forall (k:key). hash_map_t_find_s ntable k == assoc_list_find k al) + (forall (k:key). hashMap_t_find_s ntable k == assoc_list_find k al) -let partial_hash_map_s_find +let partial_hashMap_s_find (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hash_map_s_nes t{offset + length hm = len}) + (hm : hashMap_s_nes t{offset + length hm = len}) (k : key{hash_mod_key k len >= offset}) : option t = let i = hash_mod_key k len in let slot = index hm (i - offset) in @@ -2021,13 +2021,13 @@ val key_in_previous_slot_implies_not_found (#t : Type0) (len : usize{len > 0}) (k : key) (offset : usize) - (slots : hash_map_s t{offset + length slots = len}) : + (slots : hashMap_s t{offset + length slots = len}) : Lemma (requires ( // The binding comes from a slot not in [slots] hash_mod_key k len < offset /\ // The slots are the well-formed suffix of a hash map - partial_hash_map_s_inv len offset slots)) + partial_hashMap_s_inv len offset slots)) (ensures ( assoc_list_find k (flatten slots) == None)) (decreases slots) @@ -2045,19 +2045,19 @@ let rec key_in_previous_slot_implies_not_found #t len k offset slots = key_in_previous_slot_implies_not_found len k (offset+1) slots' #pop-options -val partial_hash_map_s_is_assoc_list_lem +val partial_hashMap_s_is_assoc_list_lem (#t : Type0) (len : usize{len > 0}) (offset : usize) - (hm : hash_map_s_nes t{offset + length hm = len}) + (hm : hashMap_s_nes t{offset + length hm = len}) (k : key{hash_mod_key k len >= offset}) : Lemma (requires ( - partial_hash_map_s_inv len offset hm)) + partial_hashMap_s_inv len offset hm)) (ensures ( - partial_hash_map_s_find len offset hm k == assoc_list_find k (flatten hm))) + partial_hashMap_s_find len offset hm k == assoc_list_find k (flatten hm))) (decreases hm) #push-options "--fuel 1" -let rec partial_hash_map_s_is_assoc_list_lem #t len offset hm k = +let rec partial_hashMap_s_is_assoc_list_lem #t len offset hm k = match hm with | [] -> () | slot :: hm' -> @@ -2066,7 +2066,7 @@ let rec partial_hash_map_s_is_assoc_list_lem #t len offset hm k = if i = 0 then begin // We must look in the current slot - assert(partial_hash_map_s_find len offset hm k == slot_s_find k slot); + assert(partial_hashMap_s_find len offset hm k == slot_s_find k slot); find_append (same_key k) slot (flatten hm'); assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations key_in_previous_slot_implies_not_found #t len k (offset+1) hm'; @@ -2085,64 +2085,64 @@ let rec partial_hash_map_s_is_assoc_list_lem #t len offset hm k = else begin // We must ignore the current slot - assert(partial_hash_map_s_find len offset hm k == - partial_hash_map_s_find len (offset+1) hm' k); + assert(partial_hashMap_s_find len offset hm k == + partial_hashMap_s_find len (offset+1) hm' k); find_append (same_key k) slot (flatten hm'); assert(index hm 0 == slot); // Triggers instantiations not_same_hash_key_not_found_in_slot #t len k offset slot; assert(forall (i:nat{i < length hm'}). index hm' i == index hm (i+1)); // Triggers instantiations - partial_hash_map_s_is_assoc_list_lem #t len (offset+1) hm' k + partial_hashMap_s_is_assoc_list_lem #t len (offset+1) hm' k end #pop-options -val hash_map_is_assoc_list_lem (#t : Type0) (hm : hash_map_t t) : - Lemma (requires (hash_map_t_base_inv hm)) - (ensures (hash_map_is_assoc_list hm (hash_map_t_al_v hm))) +val hashMap_is_assoc_list_lem (#t : Type0) (hm : hashMap_t t) : + Lemma (requires (hashMap_t_base_inv hm)) + (ensures (hashMap_is_assoc_list hm (hashMap_t_al_v hm))) -let hash_map_is_assoc_list_lem #t hm = +let hashMap_is_assoc_list_lem #t hm = let aux (k:key) : - Lemma (hash_map_t_find_s hm k == assoc_list_find k (hash_map_t_al_v hm)) - [SMTPat (hash_map_t_find_s hm k)] = - let hm_v = hash_map_t_v hm in + Lemma (hashMap_t_find_s hm k == assoc_list_find k (hashMap_t_al_v hm)) + [SMTPat (hashMap_t_find_s hm k)] = + let hm_v = hashMap_t_v hm in let len = length hm_v in - partial_hash_map_s_is_assoc_list_lem #t len 0 hm_v k + partial_hashMap_s_is_assoc_list_lem #t len 0 hm_v k in () /// The final lemma about [move_elements]: calling it on an empty hash table moves /// all the elements to this empty table. -val hash_map_move_elements_fwd_back_lem - (t : Type0) (ntable : hash_map_t t) (slots : vec (list_t t)) : +val hashMap_move_elements_lem + (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) : Lemma (requires ( let al = flatten (slots_t_v slots) in - hash_map_t_base_inv ntable /\ + hashMap_t_base_inv ntable /\ length al <= usize_max /\ assoc_list_inv al /\ // The table is empty - hash_map_t_len_s ntable = 0 /\ - (forall (k:key). hash_map_t_find_s ntable k == None))) + hashMap_t_len_s ntable = 0 /\ + (forall (k:key). hashMap_t_find_s ntable k == None))) (ensures ( let al = flatten (slots_t_v slots) in - match hash_map_move_elements_fwd_back t ntable slots 0, - hash_map_move_elements_s_flat (hash_map_t_v ntable) al + match hashMap_move_elements t ntable slots 0, + hashMap_move_elements_s_flat (hashMap_t_v ntable) al with | Return (ntable', _), Return ntable'_v -> // The invariant is preserved - hash_map_t_base_inv ntable' /\ + hashMap_t_base_inv ntable' /\ // We preserved the parameters - hash_map_t_same_params ntable' ntable /\ + hashMap_t_same_params ntable' ntable /\ // The table has the same number of slots - length ntable'.hash_map_slots = length ntable.hash_map_slots /\ + length ntable'.slots = length ntable.slots /\ // The count is good - hash_map_t_len_s ntable' = length al /\ + hashMap_t_len_s ntable' = length al /\ // The table can be linked to its model (we need this only to reveal // "pretty" functional lemmas to the user in the fsti - so that we // can write lemmas with SMT patterns - this is very F* specific) - hash_map_t_v ntable' == ntable'_v /\ + hashMap_t_v ntable' == ntable'_v /\ // The new table contains exactly all the bindings from the slots - // Rk.: see the comment for [hash_map_is_assoc_list] - hash_map_is_assoc_list ntable' al + // Rk.: see the comment for [hashMap_is_assoc_list] + hashMap_is_assoc_list ntable' al | _ -> False // We can only succeed )) @@ -2154,41 +2154,41 @@ val hash_map_move_elements_fwd_back_lem // lack of ifuel (this kind of proofs is annoying, really). #restart-solver #push-options "--z3rlimit 100" -let hash_map_move_elements_fwd_back_lem t ntable slots = - let ntable_v = hash_map_t_v ntable in +let hashMap_move_elements_lem t ntable slots = + let ntable_v = hashMap_t_v ntable in let slots_v = slots_t_v slots in let al = flatten slots_v in - hash_map_move_elements_fwd_back_lem_refin t ntable slots 0; + hashMap_move_elements_lem_refin t ntable slots 0; begin - match hash_map_move_elements_fwd_back t ntable slots 0, - hash_map_move_elements_s ntable_v slots_v 0 + match hashMap_move_elements t ntable slots 0, + hashMap_move_elements_s ntable_v slots_v 0 with | Fail _, Fail _ -> () | Return (ntable', _), Return ntable'_v -> - assert(hash_map_t_base_inv ntable'); - assert(hash_map_t_v ntable' == ntable'_v) + assert(hashMap_t_base_inv ntable'); + assert(hashMap_t_v ntable' == ntable'_v) | _ -> assert(False) end; - hash_map_move_elements_s_lem_refin_flat ntable_v slots_v 0; + hashMap_move_elements_s_lem_refin_flat ntable_v slots_v 0; begin - match hash_map_move_elements_s ntable_v slots_v 0, - hash_map_move_elements_s_flat ntable_v (flatten_i slots_v 0) + match hashMap_move_elements_s ntable_v slots_v 0, + hashMap_move_elements_s_flat ntable_v (flatten_i slots_v 0) with | Fail _, Fail _ -> () | Return hm, Return hm' -> assert(hm == hm') | _ -> assert(False) end; flatten_0_is_flatten slots_v; // flatten_i slots_v 0 == flatten slots_v - hash_map_move_elements_s_flat_lem ntable_v al; - match hash_map_move_elements_fwd_back t ntable slots 0, - hash_map_move_elements_s_flat ntable_v al + hashMap_move_elements_s_flat_lem ntable_v al; + match hashMap_move_elements t ntable slots 0, + hashMap_move_elements_s_flat ntable_v al with | Return (ntable', _), Return ntable'_v -> - assert(hash_map_t_base_inv ntable'); - assert(length ntable'.hash_map_slots = length ntable.hash_map_slots); - assert(hash_map_t_len_s ntable' = length al); - assert(hash_map_t_v ntable' == ntable'_v); - assert(hash_map_is_assoc_list ntable' al) + assert(hashMap_t_base_inv ntable'); + assert(length ntable'.slots = length ntable.slots); + assert(hashMap_t_len_s ntable' = length al); + assert(hashMap_t_v ntable' == ntable'_v); + assert(hashMap_is_assoc_list ntable' al) | _ -> assert(False) #pop-options @@ -2197,47 +2197,47 @@ let hash_map_move_elements_fwd_back_lem t ntable slots = /// High-level model 1. /// This is one is slightly "crude": we just simplify a bit the function. -let hash_map_try_resize_s_simpl +let hashMap_try_resize_s_simpl (#t : Type0) - (hm : hash_map_t t) : - Pure (result (hash_map_t t)) + (hm : hashMap_t t) : + Pure (result (hashMap_t t)) (requires ( - let (divid, divis) = hm.hash_map_max_load_factor in + let (divid, divis) = hm.max_load_factor in divid > 0 /\ divis > 0)) (ensures (fun _ -> True)) = - let capacity = length hm.hash_map_slots in - let (divid, divis) = hm.hash_map_max_load_factor in + let capacity = length hm.slots in + let (divid, divis) = hm.max_load_factor in if capacity <= (usize_max / 2) / divid then let ncapacity : usize = capacity * 2 in - begin match hash_map_new_with_capacity_fwd t ncapacity divid divis with + begin match hashMap_new_with_capacity t ncapacity divid divis with | Fail e -> Fail e | Return ntable -> - match hash_map_move_elements_fwd_back t ntable hm.hash_map_slots 0 with + match hashMap_move_elements t ntable hm.slots 0 with | Fail e -> Fail e | Return (ntable', _) -> let hm = - { hm with hash_map_slots = ntable'.hash_map_slots; - hash_map_max_load = ntable'.hash_map_max_load } + { hm with slots = ntable'.slots; + max_load = ntable'.max_load } in Return hm end else Return hm -val hash_map_try_resize_fwd_back_lem_refin - (t : Type0) (self : hash_map_t t) : +val hashMap_try_resize_lem_refin + (t : Type0) (self : hashMap_t t) : Lemma (requires ( - let (divid, divis) = self.hash_map_max_load_factor in + let (divid, divis) = self.max_load_factor in divid > 0 /\ divis > 0)) (ensures ( - match hash_map_try_resize_fwd_back t self, - hash_map_try_resize_s_simpl self + match hashMap_try_resize t self, + hashMap_try_resize_s_simpl self with | Fail _, Fail _ -> True | Return hm1, Return hm2 -> hm1 == hm2 | _ -> False)) -let hash_map_try_resize_fwd_back_lem_refin t self = () +let hashMap_try_resize_lem_refin t self = () /// Isolating arithmetic proofs @@ -2342,78 +2342,78 @@ let new_max_load_lem len capacity divid divis = assert(nmax_load >= max_load + 1) #pop-options -val hash_map_try_resize_s_simpl_lem (#t : Type0) (hm : hash_map_t t) : +val hashMap_try_resize_s_simpl_lem (#t : Type0) (hm : hashMap_t t) : Lemma (requires ( // The base invariant is satisfied - hash_map_t_base_inv hm /\ + hashMap_t_base_inv hm /\ // However, the "full" invariant is broken, as we call [try_resize] // only if the current number of entries is > the max load. // // There are two situations: // - either we just reached the max load // - or we were already saturated and can't resize - (let (dividend, divisor) = hm.hash_map_max_load_factor in - hm.hash_map_num_entries == hm.hash_map_max_load + 1 \/ - length hm.hash_map_slots * 2 * dividend > usize_max) + (let (dividend, divisor) = hm.max_load_factor in + hm.num_entries == hm.max_load + 1 \/ + length hm.slots * 2 * dividend > usize_max) )) (ensures ( - match hash_map_try_resize_s_simpl hm with + match hashMap_try_resize_s_simpl hm with | Fail _ -> False | Return hm' -> // The full invariant is now satisfied (the full invariant is "base // invariant" + the map is not overloaded (or can't be resized because // already too big) - hash_map_t_inv hm' /\ + hashMap_t_inv hm' /\ // It contains the same bindings as the initial map - (forall (k:key). hash_map_t_find_s hm' k == hash_map_t_find_s hm k))) + (forall (k:key). hashMap_t_find_s hm' k == hashMap_t_find_s hm k))) #restart-solver #push-options "--z3rlimit 400" -let hash_map_try_resize_s_simpl_lem #t hm = - let capacity = length hm.hash_map_slots in - let (divid, divis) = hm.hash_map_max_load_factor in +let hashMap_try_resize_s_simpl_lem #t hm = + let capacity = length hm.slots in + let (divid, divis) = hm.max_load_factor in if capacity <= (usize_max / 2) / divid then begin let ncapacity : usize = capacity * 2 in assert(ncapacity * divid <= usize_max); - assert(hash_map_t_len_s hm = hm.hash_map_max_load + 1); - new_max_load_lem (hash_map_t_len_s hm) capacity divid divis; - hash_map_new_with_capacity_fwd_lem t ncapacity divid divis; - match hash_map_new_with_capacity_fwd t ncapacity divid divis with + assert(hashMap_t_len_s hm = hm.max_load + 1); + new_max_load_lem (hashMap_t_len_s hm) capacity divid divis; + hashMap_new_with_capacity_lem t ncapacity divid divis; + match hashMap_new_with_capacity t ncapacity divid divis with | Fail _ -> () | Return ntable -> - let slots = hm.hash_map_slots in + let slots = hm.slots in let al = flatten (slots_t_v slots) in - // Proving that: length al = hm.hash_map_num_entries + // Proving that: length al = hm.num_entries assert(al == flatten (map slot_t_v slots)); assert(al == flatten (map list_t_v slots)); - assert(hash_map_t_al_v hm == flatten (hash_map_t_v hm)); - assert(hash_map_t_al_v hm == flatten (map list_t_v hm.hash_map_slots)); - assert(al == hash_map_t_al_v hm); - assert(hash_map_t_base_inv ntable); - assert(length al = hm.hash_map_num_entries); + assert(hashMap_t_al_v hm == flatten (hashMap_t_v hm)); + assert(hashMap_t_al_v hm == flatten (map list_t_v hm.slots)); + assert(al == hashMap_t_al_v hm); + assert(hashMap_t_base_inv ntable); + assert(length al = hm.num_entries); assert(length al <= usize_max); - hash_map_t_base_inv_implies_assoc_list_lem hm; + hashMap_t_base_inv_implies_assoc_list_lem hm; assert(assoc_list_inv al); - assert(hash_map_t_len_s ntable = 0); - assert(forall (k:key). hash_map_t_find_s ntable k == None); - hash_map_move_elements_fwd_back_lem t ntable hm.hash_map_slots; - match hash_map_move_elements_fwd_back t ntable hm.hash_map_slots 0 with + assert(hashMap_t_len_s ntable = 0); + assert(forall (k:key). hashMap_t_find_s ntable k == None); + hashMap_move_elements_lem t ntable hm.slots; + match hashMap_move_elements t ntable hm.slots 0 with | Fail _ -> () | Return (ntable', _) -> - hash_map_is_assoc_list_lem hm; - assert(hash_map_is_assoc_list hm (hash_map_t_al_v hm)); + hashMap_is_assoc_list_lem hm; + assert(hashMap_is_assoc_list hm (hashMap_t_al_v hm)); let hm' = - { hm with hash_map_slots = ntable'.hash_map_slots; - hash_map_max_load = ntable'.hash_map_max_load } + { hm with slots = ntable'.slots; + max_load = ntable'.max_load } in - assert(hash_map_t_base_inv ntable'); - assert(hash_map_t_base_inv hm'); - assert(hash_map_t_len_s hm' = hash_map_t_len_s hm); - new_max_load_lem (hash_map_t_len_s hm') capacity divid divis; - assert(hash_map_t_len_s hm' <= hm'.hash_map_max_load); // Requires a lemma - assert(hash_map_t_inv hm') + assert(hashMap_t_base_inv ntable'); + assert(hashMap_t_base_inv hm'); + assert(hashMap_t_len_s hm' = hashMap_t_len_s hm); + new_max_load_lem (hashMap_t_len_s hm') capacity divid divis; + assert(hashMap_t_len_s hm' <= hm'.max_load); // Requires a lemma + assert(hashMap_t_inv hm') end else begin @@ -2422,203 +2422,203 @@ let hash_map_try_resize_s_simpl_lem #t hm = end #pop-options -let hash_map_t_same_bindings (#t : Type0) (hm hm' : hash_map_t_nes t) : Type0 = - forall (k:key). hash_map_t_find_s hm k == hash_map_t_find_s hm' k +let hashMap_t_same_bindings (#t : Type0) (hm hm' : hashMap_t_nes t) : Type0 = + forall (k:key). hashMap_t_find_s hm k == hashMap_t_find_s hm' k /// The final lemma about [try_resize] -val hash_map_try_resize_fwd_back_lem (#t : Type0) (hm : hash_map_t t) : +val hashMap_try_resize_lem (#t : Type0) (hm : hashMap_t t) : Lemma (requires ( - hash_map_t_base_inv hm /\ + hashMap_t_base_inv hm /\ // However, the "full" invariant is broken, as we call [try_resize] // only if the current number of entries is > the max load. // // There are two situations: // - either we just reached the max load // - or we were already saturated and can't resize - (let (dividend, divisor) = hm.hash_map_max_load_factor in - hm.hash_map_num_entries == hm.hash_map_max_load + 1 \/ - length hm.hash_map_slots * 2 * dividend > usize_max))) + (let (dividend, divisor) = hm.max_load_factor in + hm.num_entries == hm.max_load + 1 \/ + length hm.slots * 2 * dividend > usize_max))) (ensures ( - match hash_map_try_resize_fwd_back t hm with + match hashMap_try_resize t hm with | Fail _ -> False | Return hm' -> // The full invariant is now satisfied (the full invariant is "base // invariant" + the map is not overloaded (or can't be resized because // already too big) - hash_map_t_inv hm' /\ + hashMap_t_inv hm' /\ // The length is the same - hash_map_t_len_s hm' = hash_map_t_len_s hm /\ + hashMap_t_len_s hm' = hashMap_t_len_s hm /\ // It contains the same bindings as the initial map - hash_map_t_same_bindings hm' hm)) + hashMap_t_same_bindings hm' hm)) -let hash_map_try_resize_fwd_back_lem #t hm = - hash_map_try_resize_fwd_back_lem_refin t hm; - hash_map_try_resize_s_simpl_lem hm +let hashMap_try_resize_lem #t hm = + hashMap_try_resize_lem_refin t hm; + hashMap_try_resize_s_simpl_lem hm (*** insert *) /// The high-level model (very close to the original function: we don't need something /// very high level, just to clean it a bit) -let hash_map_insert_s - (#t : Type0) (self : hash_map_t t) (key : usize) (value : t) : - result (hash_map_t t) = - match hash_map_insert_no_resize_fwd_back t self key value with +let hashMap_insert_s + (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + result (hashMap_t t) = + match hashMap_insert_no_resize t self key value with | Fail e -> Fail e | Return hm' -> - if hash_map_t_len_s hm' > hm'.hash_map_max_load then - hash_map_try_resize_fwd_back t hm' + if hashMap_t_len_s hm' > hm'.max_load then + hashMap_try_resize t hm' else Return hm' -val hash_map_insert_fwd_back_lem_refin - (t : Type0) (self : hash_map_t t) (key : usize) (value : t) : +val hashMap_insert_lem_refin + (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : Lemma (requires True) (ensures ( - match hash_map_insert_fwd_back t self key value, - hash_map_insert_s self key value + match hashMap_insert t self key value, + hashMap_insert_s self key value with | Fail _, Fail _ -> True | Return hm1, Return hm2 -> hm1 == hm2 | _ -> False)) -let hash_map_insert_fwd_back_lem_refin t self key value = () +let hashMap_insert_lem_refin t self key value = () /// Helper -let hash_map_insert_fwd_back_bindings_lem - (t : Type0) (self : hash_map_t_nes t) (key : usize) (value : t) - (hm' hm'' : hash_map_t_nes t) : +let hashMap_insert_bindings_lem + (t : Type0) (self : hashMap_t_nes t) (key : usize) (value : t) + (hm' hm'' : hashMap_t_nes t) : Lemma (requires ( - hash_map_s_updated_binding (hash_map_t_v self) key - (Some value) (hash_map_t_v hm') /\ - hash_map_t_same_bindings hm' hm'')) + hashMap_s_updated_binding (hashMap_t_v self) key + (Some value) (hashMap_t_v hm') /\ + hashMap_t_same_bindings hm' hm'')) (ensures ( - hash_map_s_updated_binding (hash_map_t_v self) key - (Some value) (hash_map_t_v hm''))) + hashMap_s_updated_binding (hashMap_t_v self) key + (Some value) (hashMap_t_v hm''))) = () -val hash_map_insert_fwd_back_lem_aux - (#t : Type0) (self : hash_map_t t) (key : usize) (value : t) : - Lemma (requires (hash_map_t_inv self)) +val hashMap_insert_lem_aux + (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : + Lemma (requires (hashMap_t_inv self)) (ensures ( - match hash_map_insert_fwd_back t self key value with + match hashMap_insert t self key value with | Fail _ -> // We can fail only if: // - the key is not in the map and we need to add it // - we are already saturated - hash_map_t_len_s self = usize_max /\ - None? (hash_map_t_find_s self key) + hashMap_t_len_s self = usize_max /\ + None? (hashMap_t_find_s self key) | Return hm' -> // The invariant is preserved - hash_map_t_inv hm' /\ + hashMap_t_inv hm' /\ // [key] maps to [value] and the other bindings are preserved - hash_map_s_updated_binding (hash_map_t_v self) key (Some value) (hash_map_t_v hm') /\ + hashMap_s_updated_binding (hashMap_t_v self) key (Some value) (hashMap_t_v hm') /\ // The length is incremented, iff we inserted a new key - (match hash_map_t_find_s self key with - | None -> hash_map_t_len_s hm' = hash_map_t_len_s self + 1 - | Some _ -> hash_map_t_len_s hm' = hash_map_t_len_s self))) + (match hashMap_t_find_s self key with + | None -> hashMap_t_len_s hm' = hashMap_t_len_s self + 1 + | Some _ -> hashMap_t_len_s hm' = hashMap_t_len_s self))) #restart-solver #push-options "--z3rlimit 200" -let hash_map_insert_fwd_back_lem_aux #t self key value = - hash_map_insert_no_resize_fwd_back_lem_s t self key value; - hash_map_insert_no_resize_s_lem (hash_map_t_v self) key value; - match hash_map_insert_no_resize_fwd_back t self key value with +let hashMap_insert_lem_aux #t self key value = + hashMap_insert_no_resize_lem_s t self key value; + hashMap_insert_no_resize_s_lem (hashMap_t_v self) key value; + match hashMap_insert_no_resize t self key value with | Fail _ -> () | Return hm' -> - // Expanding the post of [hash_map_insert_no_resize_fwd_back_lem_s] - let self_v = hash_map_t_v self in - let hm'_v = Return?.v (hash_map_insert_no_resize_s self_v key value) in - assert(hash_map_t_base_inv hm'); - assert(hash_map_t_same_params hm' self); - assert(hash_map_t_v hm' == hm'_v); - assert(hash_map_s_len hm'_v == hash_map_t_len_s hm'); - // Expanding the post of [hash_map_insert_no_resize_s_lem] + // Expanding the post of [hashMap_insert_no_resize_lem_s] + let self_v = hashMap_t_v self in + let hm'_v = Return?.v (hashMap_insert_no_resize_s self_v key value) in + assert(hashMap_t_base_inv hm'); + assert(hashMap_t_same_params hm' self); + assert(hashMap_t_v hm' == hm'_v); + assert(hashMap_s_len hm'_v == hashMap_t_len_s hm'); + // Expanding the post of [hashMap_insert_no_resize_s_lem] assert(insert_post self_v key value hm'_v); // Expanding [insert_post] - assert(hash_map_s_inv hm'_v); + assert(hashMap_s_inv hm'_v); assert( - match hash_map_s_find self_v key with - | None -> hash_map_s_len hm'_v = hash_map_s_len self_v + 1 - | Some _ -> hash_map_s_len hm'_v = hash_map_s_len self_v); - if hash_map_t_len_s hm' > hm'.hash_map_max_load then + match hashMap_s_find self_v key with + | None -> hashMap_s_len hm'_v = hashMap_s_len self_v + 1 + | Some _ -> hashMap_s_len hm'_v = hashMap_s_len self_v); + if hashMap_t_len_s hm' > hm'.max_load then begin - hash_map_try_resize_fwd_back_lem hm'; - // Expanding the post of [hash_map_try_resize_fwd_back_lem] - let hm'' = Return?.v (hash_map_try_resize_fwd_back t hm') in - assert(hash_map_t_inv hm''); - let hm''_v = hash_map_t_v hm'' in - assert(forall k. hash_map_t_find_s hm'' k == hash_map_t_find_s hm' k); - assert(hash_map_t_len_s hm'' = hash_map_t_len_s hm'); // TODO + hashMap_try_resize_lem hm'; + // Expanding the post of [hashMap_try_resize_lem] + let hm'' = Return?.v (hashMap_try_resize t hm') in + assert(hashMap_t_inv hm''); + let hm''_v = hashMap_t_v hm'' in + assert(forall k. hashMap_t_find_s hm'' k == hashMap_t_find_s hm' k); + assert(hashMap_t_len_s hm'' = hashMap_t_len_s hm'); // TODO // Proving the post - assert(hash_map_t_inv hm''); - hash_map_insert_fwd_back_bindings_lem t self key value hm' hm''; + assert(hashMap_t_inv hm''); + hashMap_insert_bindings_lem t self key value hm' hm''; assert( - match hash_map_t_find_s self key with - | None -> hash_map_t_len_s hm'' = hash_map_t_len_s self + 1 - | Some _ -> hash_map_t_len_s hm'' = hash_map_t_len_s self) + match hashMap_t_find_s self key with + | None -> hashMap_t_len_s hm'' = hashMap_t_len_s self + 1 + | Some _ -> hashMap_t_len_s hm'' = hashMap_t_len_s self) end else () #pop-options -let hash_map_insert_fwd_back_lem #t self key value = - hash_map_insert_fwd_back_lem_aux #t self key value +let hashMap_insert_lem #t self key value = + hashMap_insert_lem_aux #t self key value (*** contains_key *) (**** contains_key_in_list *) -val hash_map_contains_key_in_list_fwd_lem +val hashMap_contains_key_in_list_lem (#t : Type0) (key : usize) (ls : list_t t) : Lemma (ensures ( - match hash_map_contains_key_in_list_fwd t key ls with + match hashMap_contains_key_in_list t key ls with | Fail _ -> False | Return b -> b = Some? (slot_t_find_s key ls))) #push-options "--fuel 1" -let rec hash_map_contains_key_in_list_fwd_lem #t key ls = +let rec hashMap_contains_key_in_list_lem #t key ls = match ls with - | ListCons ckey x ls0 -> + | List_Cons ckey x ls0 -> let b = ckey = key in if b then () else begin - hash_map_contains_key_in_list_fwd_lem key ls0; - match hash_map_contains_key_in_list_fwd t key ls0 with + hashMap_contains_key_in_list_lem key ls0; + match hashMap_contains_key_in_list t key ls0 with | Fail _ -> () | Return b0 -> () end - | ListNil -> () + | List_Nil -> () #pop-options (**** contains_key *) -val hash_map_contains_key_fwd_lem_aux - (#t : Type0) (self : hash_map_t_nes t) (key : usize) : +val hashMap_contains_key_lem_aux + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : Lemma (ensures ( - match hash_map_contains_key_fwd t self key with + match hashMap_contains_key t self key with | Fail _ -> False - | Return b -> b = Some? (hash_map_t_find_s self key))) + | Return b -> b = Some? (hashMap_t_find_s self key))) -let hash_map_contains_key_fwd_lem_aux #t self key = - begin match hash_key_fwd key with +let hashMap_contains_key_lem_aux #t self key = + begin match hash_key key with | Fail _ -> () | Return i -> - let v = self.hash_map_slots in - let i0 = vec_len (list_t t) v in + let v = self.slots in + let i0 = alloc_vec_Vec_len (list_t t) v in begin match usize_rem i i0 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> - hash_map_contains_key_in_list_fwd_lem key l; - begin match hash_map_contains_key_in_list_fwd t key l with + hashMap_contains_key_in_list_lem key l; + begin match hashMap_contains_key_in_list t key l with | Fail _ -> () | Return b -> () end @@ -2627,66 +2627,66 @@ let hash_map_contains_key_fwd_lem_aux #t self key = end /// The lemma in the .fsti -let hash_map_contains_key_fwd_lem #t self key = - hash_map_contains_key_fwd_lem_aux #t self key +let hashMap_contains_key_lem #t self key = + hashMap_contains_key_lem_aux #t self key (*** get *) (**** get_in_list *) -val hash_map_get_in_list_fwd_lem +val hashMap_get_in_list_lem (#t : Type0) (key : usize) (ls : list_t t) : Lemma (ensures ( - match hash_map_get_in_list_fwd t key ls, slot_t_find_s key ls with + match hashMap_get_in_list t key ls, slot_t_find_s key ls with | Fail _, None -> True | Return x, Some x' -> x == x' | _ -> False)) #push-options "--fuel 1" -let rec hash_map_get_in_list_fwd_lem #t key ls = +let rec hashMap_get_in_list_lem #t key ls = begin match ls with - | ListCons ckey cvalue ls0 -> + | List_Cons ckey cvalue ls0 -> let b = ckey = key in if b then () else begin - hash_map_get_in_list_fwd_lem key ls0; - match hash_map_get_in_list_fwd t key ls0 with + hashMap_get_in_list_lem key ls0; + match hashMap_get_in_list t key ls0 with | Fail _ -> () | Return x -> () end - | ListNil -> () + | List_Nil -> () end #pop-options (**** get *) -val hash_map_get_fwd_lem_aux - (#t : Type0) (self : hash_map_t_nes t) (key : usize) : +val hashMap_get_lem_aux + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : Lemma (ensures ( - match hash_map_get_fwd t self key, hash_map_t_find_s self key with + match hashMap_get t self key, hashMap_t_find_s self key with | Fail _, None -> True | Return x, Some x' -> x == x' | _ -> False)) -let hash_map_get_fwd_lem_aux #t self key = - begin match hash_key_fwd key with +let hashMap_get_lem_aux #t self key = + begin match hash_key key with | Fail _ -> () | Return i -> - let v = self.hash_map_slots in - let i0 = vec_len (list_t t) v in + let v = self.slots in + let i0 = alloc_vec_Vec_len (list_t t) v in begin match usize_rem i i0 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> begin - hash_map_get_in_list_fwd_lem key l; - match hash_map_get_in_list_fwd t key l with + hashMap_get_in_list_lem key l; + match hashMap_get_in_list t key l with | Fail _ -> () | Return x -> () end @@ -2695,66 +2695,66 @@ let hash_map_get_fwd_lem_aux #t self key = end /// .fsti -let hash_map_get_fwd_lem #t self key = hash_map_get_fwd_lem_aux #t self key +let hashMap_get_lem #t self key = hashMap_get_lem_aux #t self key (*** get_mut'fwd *) (**** get_mut_in_list'fwd *) -val hash_map_get_mut_in_list_loop_fwd_lem +val hashMap_get_mut_in_list_loop_lem (#t : Type0) (ls : list_t t) (key : usize) : Lemma (ensures ( - match hash_map_get_mut_in_list_loop_fwd t ls key, slot_t_find_s key ls with + match hashMap_get_mut_in_list_loop t ls key, slot_t_find_s key ls with | Fail _, None -> True | Return x, Some x' -> x == x' | _ -> False)) #push-options "--fuel 1" -let rec hash_map_get_mut_in_list_loop_fwd_lem #t ls key = +let rec hashMap_get_mut_in_list_loop_lem #t ls key = begin match ls with - | ListCons ckey cvalue ls0 -> + | List_Cons ckey cvalue ls0 -> let b = ckey = key in if b then () else begin - hash_map_get_mut_in_list_loop_fwd_lem ls0 key; - match hash_map_get_mut_in_list_loop_fwd t ls0 key with + hashMap_get_mut_in_list_loop_lem ls0 key; + match hashMap_get_mut_in_list_loop t ls0 key with | Fail _ -> () | Return x -> () end - | ListNil -> () + | List_Nil -> () end #pop-options (**** get_mut'fwd *) -val hash_map_get_mut_fwd_lem_aux - (#t : Type0) (self : hash_map_t_nes t) (key : usize) : +val hashMap_get_mut_lem_aux + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : Lemma (ensures ( - match hash_map_get_mut_fwd t self key, hash_map_t_find_s self key with + match hashMap_get_mut t self key, hashMap_t_find_s self key with | Fail _, None -> True | Return x, Some x' -> x == x' | _ -> False)) -let hash_map_get_mut_fwd_lem_aux #t self key = - begin match hash_key_fwd key with +let hashMap_get_mut_lem_aux #t self key = + begin match hash_key key with | Fail _ -> () | Return i -> - let v = self.hash_map_slots in - let i0 = vec_len (list_t t) v in + let v = self.slots in + let i0 = alloc_vec_Vec_len (list_t t) v in begin match usize_rem i i0 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> begin - hash_map_get_mut_in_list_loop_fwd_lem l key; - match hash_map_get_mut_in_list_loop_fwd t l key with + hashMap_get_mut_in_list_loop_lem l key; + match hashMap_get_mut_in_list_loop t l key with | Fail _ -> () | Return x -> () end @@ -2762,78 +2762,78 @@ let hash_map_get_mut_fwd_lem_aux #t self key = end end -let hash_map_get_mut_fwd_lem #t self key = - hash_map_get_mut_fwd_lem_aux #t self key +let hashMap_get_mut_lem #t self key = + hashMap_get_mut_lem_aux #t self key (*** get_mut'back *) (**** get_mut_in_list'back *) -val hash_map_get_mut_in_list_loop_back_lem +val hashMap_get_mut_in_list_loop_back_lem (#t : Type0) (ls : list_t t) (key : usize) (ret : t) : Lemma (requires (Some? (slot_t_find_s key ls))) (ensures ( - match hash_map_get_mut_in_list_loop_back t ls key ret with + match hashMap_get_mut_in_list_loop_back t ls key ret with | Fail _ -> False | Return ls' -> list_t_v ls' == find_update (same_key key) (list_t_v ls) (key,ret) | _ -> False)) #push-options "--fuel 1" -let rec hash_map_get_mut_in_list_loop_back_lem #t ls key ret = +let rec hashMap_get_mut_in_list_loop_back_lem #t ls key ret = begin match ls with - | ListCons ckey cvalue ls0 -> + | List_Cons ckey cvalue ls0 -> let b = ckey = key in if b - then let ls1 = ListCons ckey ret ls0 in () + then let ls1 = List_Cons ckey ret ls0 in () else begin - hash_map_get_mut_in_list_loop_back_lem ls0 key ret; - match hash_map_get_mut_in_list_loop_back t ls0 key ret with + hashMap_get_mut_in_list_loop_back_lem ls0 key ret; + match hashMap_get_mut_in_list_loop_back t ls0 key ret with | Fail _ -> () - | Return l -> let ls1 = ListCons ckey cvalue l in () + | Return l -> let ls1 = List_Cons ckey cvalue l in () end - | ListNil -> () + | List_Nil -> () end #pop-options (**** get_mut'back *) /// Refinement lemma -val hash_map_get_mut_back_lem_refin - (#t : Type0) (self : hash_map_t t{length self.hash_map_slots > 0}) +val hashMap_get_mut_back_lem_refin + (#t : Type0) (self : hashMap_t t{length self.slots > 0}) (key : usize) (ret : t) : Lemma - (requires (Some? (hash_map_t_find_s self key))) + (requires (Some? (hashMap_t_find_s self key))) (ensures ( - match hash_map_get_mut_back t self key ret with + match hashMap_get_mut_back t self key ret with | Fail _ -> False | Return hm' -> - hash_map_t_v hm' == hash_map_insert_no_fail_s (hash_map_t_v self) key ret)) + hashMap_t_v hm' == hashMap_insert_no_fail_s (hashMap_t_v self) key ret)) -let hash_map_get_mut_back_lem_refin #t self key ret = - begin match hash_key_fwd key with +let hashMap_get_mut_back_lem_refin #t self key ret = + begin match hash_key key with | Fail _ -> () | Return i -> - let i0 = self.hash_map_num_entries in - let p = self.hash_map_max_load_factor in - let i1 = self.hash_map_max_load in - let v = self.hash_map_slots in - let i2 = vec_len (list_t t) v in + let i0 = self.num_entries in + let p = self.max_load_factor in + let i1 = self.max_load in + let v = self.slots in + let i2 = alloc_vec_Vec_len (list_t t) v in begin match usize_rem i i2 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_mut_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> begin - hash_map_get_mut_in_list_loop_back_lem l key ret; - match hash_map_get_mut_in_list_loop_back t l key ret with + hashMap_get_mut_in_list_loop_back_lem l key ret; + match hashMap_get_mut_in_list_loop_back t l key ret with | Fail _ -> () | Return l0 -> - begin match vec_index_mut_back (list_t t) v hash_mod l0 with + begin match alloc_vec_Vec_update_usize v hash_mod l0 with | Fail _ -> () - | Return v0 -> let self0 = Mkhash_map_t i0 p i1 v0 in () + | Return v0 -> let self0 = MkhashMap_t i0 p i1 v0 in () end end end @@ -2841,102 +2841,102 @@ let hash_map_get_mut_back_lem_refin #t self key ret = end /// Final lemma -val hash_map_get_mut_back_lem_aux - (#t : Type0) (hm : hash_map_t t) +val hashMap_get_mut_back_lem_aux + (#t : Type0) (hm : hashMap_t t) (key : usize) (ret : t) : Lemma (requires ( - hash_map_t_inv hm /\ - Some? (hash_map_t_find_s hm key))) + hashMap_t_inv hm /\ + Some? (hashMap_t_find_s hm key))) (ensures ( - match hash_map_get_mut_back t hm key ret with + match hashMap_get_mut_back t hm key ret with | Fail _ -> False | Return hm' -> // Functional spec - hash_map_t_v hm' == hash_map_insert_no_fail_s (hash_map_t_v hm) key ret /\ + hashMap_t_v hm' == hashMap_insert_no_fail_s (hashMap_t_v hm) key ret /\ // The invariant is preserved - hash_map_t_inv hm' /\ + hashMap_t_inv hm' /\ // The length is preserved - hash_map_t_len_s hm' = hash_map_t_len_s hm /\ + hashMap_t_len_s hm' = hashMap_t_len_s hm /\ // [key] maps to [value] - hash_map_t_find_s hm' key == Some ret /\ + hashMap_t_find_s hm' key == Some ret /\ // The other bindings are preserved - (forall k'. k' <> key ==> hash_map_t_find_s hm' k' == hash_map_t_find_s hm k'))) + (forall k'. k' <> key ==> hashMap_t_find_s hm' k' == hashMap_t_find_s hm k'))) -let hash_map_get_mut_back_lem_aux #t hm key ret = - let hm_v = hash_map_t_v hm in - hash_map_get_mut_back_lem_refin hm key ret; - match hash_map_get_mut_back t hm key ret with +let hashMap_get_mut_back_lem_aux #t hm key ret = + let hm_v = hashMap_t_v hm in + hashMap_get_mut_back_lem_refin hm key ret; + match hashMap_get_mut_back t hm key ret with | Fail _ -> assert(False) | Return hm' -> - hash_map_insert_no_fail_s_lem hm_v key ret + hashMap_insert_no_fail_s_lem hm_v key ret /// .fsti -let hash_map_get_mut_back_lem #t hm key ret = hash_map_get_mut_back_lem_aux hm key ret +let hashMap_get_mut_back_lem #t hm key ret = hashMap_get_mut_back_lem_aux hm key ret (*** remove'fwd *) -val hash_map_remove_from_list_fwd_lem +val hashMap_remove_from_list_lem (#t : Type0) (key : usize) (ls : list_t t) : Lemma (ensures ( - match hash_map_remove_from_list_fwd t key ls with + match hashMap_remove_from_list t key ls with | Fail _ -> False | Return opt_x -> opt_x == slot_t_find_s key ls /\ (Some? opt_x ==> length (slot_t_v ls) > 0))) #push-options "--fuel 1" -let rec hash_map_remove_from_list_fwd_lem #t key ls = +let rec hashMap_remove_from_list_lem #t key ls = begin match ls with - | ListCons ckey x tl -> + | List_Cons ckey x tl -> let b = ckey = key in if b then - let mv_ls = mem_replace_fwd (list_t t) (ListCons ckey x tl) ListNil in + let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in begin match mv_ls with - | ListCons i cvalue tl0 -> () - | ListNil -> () + | List_Cons i cvalue tl0 -> () + | List_Nil -> () end else begin - hash_map_remove_from_list_fwd_lem key tl; - match hash_map_remove_from_list_fwd t key tl with + hashMap_remove_from_list_lem key tl; + match hashMap_remove_from_list t key tl with | Fail _ -> () | Return opt -> () end - | ListNil -> () + | List_Nil -> () end #pop-options -val hash_map_remove_fwd_lem_aux - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_remove_lem_aux + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma (requires ( // We need the invariant to prove that upon decrementing the entries counter, // the counter doesn't become negative - hash_map_t_inv self)) + hashMap_t_inv self)) (ensures ( - match hash_map_remove_fwd t self key with + match hashMap_remove t self key with | Fail _ -> False - | Return opt_x -> opt_x == hash_map_t_find_s self key)) + | Return opt_x -> opt_x == hashMap_t_find_s self key)) -let hash_map_remove_fwd_lem_aux #t self key = - begin match hash_key_fwd key with +let hashMap_remove_lem_aux #t self key = + begin match hash_key key with | Fail _ -> () | Return i -> - let i0 = self.hash_map_num_entries in - let v = self.hash_map_slots in - let i1 = vec_len (list_t t) v in + let i0 = self.num_entries in + let v = self.slots in + let i1 = alloc_vec_Vec_len (list_t t) v in begin match usize_rem i i1 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_mut_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> begin - hash_map_remove_from_list_fwd_lem key l; - match hash_map_remove_from_list_fwd t key l with + hashMap_remove_from_list_lem key l; + match hashMap_remove_from_list t key l with | Fail _ -> () | Return x -> begin match x with @@ -2945,7 +2945,7 @@ let hash_map_remove_fwd_lem_aux #t self key = begin assert(l == index v hash_mod); assert(length (list_t_v #t l) > 0); - length_flatten_index (hash_map_t_v self) hash_mod; + length_flatten_index (hashMap_t_v self) hash_mod; match usize_sub i0 1 with | Fail _ -> () | Return _ -> () @@ -2957,27 +2957,27 @@ let hash_map_remove_fwd_lem_aux #t self key = end /// .fsti -let hash_map_remove_fwd_lem #t self key = hash_map_remove_fwd_lem_aux #t self key +let hashMap_remove_lem #t self key = hashMap_remove_lem_aux #t self key (*** remove'back *) (**** Refinement proofs *) /// High-level model for [remove_from_list'back] -let hash_map_remove_from_list_s +let hashMap_remove_from_list_s (#t : Type0) (key : usize) (ls : slot_s t) : slot_s t = filter_one (not_same_key key) ls /// Refinement lemma -val hash_map_remove_from_list_back_lem_refin +val hashMap_remove_from_list_back_lem_refin (#t : Type0) (key : usize) (ls : list_t t) : Lemma (ensures ( - match hash_map_remove_from_list_back t key ls with + match hashMap_remove_from_list_back t key ls with | Fail _ -> False | Return ls' -> - list_t_v ls' == hash_map_remove_from_list_s key (list_t_v ls) /\ + list_t_v ls' == hashMap_remove_from_list_s key (list_t_v ls) /\ // The length is decremented, iff the key was in the slot (let len = length (list_t_v ls) in let len' = length (list_t_v ls') in @@ -2986,89 +2986,89 @@ val hash_map_remove_from_list_back_lem_refin | Some _ -> len = len' + 1))) #push-options "--fuel 1" -let rec hash_map_remove_from_list_back_lem_refin #t key ls = +let rec hashMap_remove_from_list_back_lem_refin #t key ls = begin match ls with - | ListCons ckey x tl -> + | List_Cons ckey x tl -> let b = ckey = key in if b then - let mv_ls = mem_replace_fwd (list_t t) (ListCons ckey x tl) ListNil in + let mv_ls = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in begin match mv_ls with - | ListCons i cvalue tl0 -> () - | ListNil -> () + | List_Cons i cvalue tl0 -> () + | List_Nil -> () end else begin - hash_map_remove_from_list_back_lem_refin key tl; - match hash_map_remove_from_list_back t key tl with + hashMap_remove_from_list_back_lem_refin key tl; + match hashMap_remove_from_list_back t key tl with | Fail _ -> () - | Return l -> let ls0 = ListCons ckey x l in () + | Return l -> let ls0 = List_Cons ckey x l in () end - | ListNil -> () + | List_Nil -> () end #pop-options /// High-level model for [remove_from_list'back] -let hash_map_remove_s - (#t : Type0) (self : hash_map_s_nes t) (key : usize) : - hash_map_s t = +let hashMap_remove_s + (#t : Type0) (self : hashMap_s_nes t) (key : usize) : + hashMap_s t = let len = length self in let hash = hash_mod_key key len in let slot = index self hash in - let slot' = hash_map_remove_from_list_s key slot in + let slot' = hashMap_remove_from_list_s key slot in list_update self hash slot' /// Refinement lemma -val hash_map_remove_back_lem_refin - (#t : Type0) (self : hash_map_t_nes t) (key : usize) : +val hashMap_remove_back_lem_refin + (#t : Type0) (self : hashMap_t_nes t) (key : usize) : Lemma (requires ( // We need the invariant to prove that upon decrementing the entries counter, // the counter doesn't become negative - hash_map_t_inv self)) + hashMap_t_inv self)) (ensures ( - match hash_map_remove_back t self key with + match hashMap_remove_back t self key with | Fail _ -> False | Return hm' -> - hash_map_t_same_params hm' self /\ - hash_map_t_v hm' == hash_map_remove_s (hash_map_t_v self) key /\ + hashMap_t_same_params hm' self /\ + hashMap_t_v hm' == hashMap_remove_s (hashMap_t_v self) key /\ // The length is decremented iff the key was in the map - (let len = hash_map_t_len_s self in - let len' = hash_map_t_len_s hm' in - match hash_map_t_find_s self key with + (let len = hashMap_t_len_s self in + let len' = hashMap_t_len_s hm' in + match hashMap_t_find_s self key with | None -> len = len' | Some _ -> len = len' + 1))) -let hash_map_remove_back_lem_refin #t self key = - begin match hash_key_fwd key with +let hashMap_remove_back_lem_refin #t self key = + begin match hash_key key with | Fail _ -> () | Return i -> - let i0 = self.hash_map_num_entries in - let p = self.hash_map_max_load_factor in - let i1 = self.hash_map_max_load in - let v = self.hash_map_slots in - let i2 = vec_len (list_t t) v in + let i0 = self.num_entries in + let p = self.max_load_factor in + let i1 = self.max_load in + let v = self.slots in + let i2 = alloc_vec_Vec_len (list_t t) v in begin match usize_rem i i2 with | Fail _ -> () | Return hash_mod -> - begin match vec_index_mut_fwd (list_t t) v hash_mod with + begin match alloc_vec_Vec_index_usize v hash_mod with | Fail _ -> () | Return l -> begin - hash_map_remove_from_list_fwd_lem key l; - match hash_map_remove_from_list_fwd t key l with + hashMap_remove_from_list_lem key l; + match hashMap_remove_from_list t key l with | Fail _ -> () | Return x -> begin match x with | None -> begin - hash_map_remove_from_list_back_lem_refin key l; - match hash_map_remove_from_list_back t key l with + hashMap_remove_from_list_back_lem_refin key l; + match hashMap_remove_from_list_back t key l with | Fail _ -> () | Return l0 -> begin length_flatten_update (slots_t_v v) hash_mod (list_t_v l0); - match vec_index_mut_back (list_t t) v hash_mod l0 with + match alloc_vec_Vec_update_usize v hash_mod l0 with | Fail _ -> () | Return v0 -> () end @@ -3077,18 +3077,18 @@ let hash_map_remove_back_lem_refin #t self key = begin assert(l == index v hash_mod); assert(length (list_t_v #t l) > 0); - length_flatten_index (hash_map_t_v self) hash_mod; + length_flatten_index (hashMap_t_v self) hash_mod; match usize_sub i0 1 with | Fail _ -> () | Return i3 -> begin - hash_map_remove_from_list_back_lem_refin key l; - match hash_map_remove_from_list_back t key l with + hashMap_remove_from_list_back_lem_refin key l; + match hashMap_remove_from_list_back t key l with | Fail _ -> () | Return l0 -> begin length_flatten_update (slots_t_v v) hash_mod (list_t_v l0); - match vec_index_mut_back (list_t t) v hash_mod l0 with + match alloc_vec_Vec_update_usize v hash_mod l0 with | Fail _ -> () | Return v0 -> () end @@ -3102,12 +3102,12 @@ let hash_map_remove_back_lem_refin #t self key = (**** Invariants, high-level properties *) -val hash_map_remove_from_list_s_lem +val hashMap_remove_from_list_s_lem (#t : Type0) (k : usize) (slot : slot_s t) (len : usize{len > 0}) (i : usize) : Lemma (requires (slot_s_inv len i slot)) (ensures ( - let slot' = hash_map_remove_from_list_s k slot in + let slot' = hashMap_remove_from_list_s k slot in slot_s_inv len i slot' /\ slot_s_find k slot' == None /\ (forall (k':key{k' <> k}). slot_s_find k' slot' == slot_s_find k' slot) /\ @@ -3117,14 +3117,14 @@ val hash_map_remove_from_list_s_lem )) #push-options "--fuel 1" -let rec hash_map_remove_from_list_s_lem #t key slot len i = +let rec hashMap_remove_from_list_s_lem #t key slot len i = match slot with | [] -> () | (k',v) :: slot' -> if k' <> key then begin - hash_map_remove_from_list_s_lem key slot' len i; - let slot'' = hash_map_remove_from_list_s key slot' in + hashMap_remove_from_list_s_lem key slot' len i; + let slot'' = hashMap_remove_from_list_s key slot' in assert(for_all (same_hash_mod_key len i) ((k',v)::slot'')); assert(for_all (binding_neq (k',v)) slot'); // Triggers instanciation assert(for_all (binding_neq (k',v)) slot'') @@ -3136,51 +3136,51 @@ let rec hash_map_remove_from_list_s_lem #t key slot len i = end #pop-options -val hash_map_remove_s_lem - (#t : Type0) (self : hash_map_s_nes t) (key : usize) : +val hashMap_remove_s_lem + (#t : Type0) (self : hashMap_s_nes t) (key : usize) : Lemma - (requires (hash_map_s_inv self)) + (requires (hashMap_s_inv self)) (ensures ( - let hm' = hash_map_remove_s self key in + let hm' = hashMap_remove_s self key in // The invariant is preserved - hash_map_s_inv hm' /\ + hashMap_s_inv hm' /\ // We updated the binding - hash_map_s_updated_binding self key None hm')) + hashMap_s_updated_binding self key None hm')) -let hash_map_remove_s_lem #t self key = +let hashMap_remove_s_lem #t self key = let len = length self in let hash = hash_mod_key key len in let slot = index self hash in - hash_map_remove_from_list_s_lem key slot len hash; - let slot' = hash_map_remove_from_list_s key slot in + hashMap_remove_from_list_s_lem key slot len hash; + let slot' = hashMap_remove_from_list_s key slot in let hm' = list_update self hash slot' in - assert(hash_map_s_inv self) + assert(hashMap_s_inv self) /// Final lemma about [remove'back] -val hash_map_remove_back_lem_aux - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_remove_back_lem_aux + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_remove_back t self key with + match hashMap_remove_back t self key with | Fail _ -> False | Return hm' -> - hash_map_t_inv self /\ - hash_map_t_same_params hm' self /\ + hashMap_t_inv self /\ + hashMap_t_same_params hm' self /\ // We updated the binding - hash_map_s_updated_binding (hash_map_t_v self) key None (hash_map_t_v hm') /\ - hash_map_t_v hm' == hash_map_remove_s (hash_map_t_v self) key /\ + hashMap_s_updated_binding (hashMap_t_v self) key None (hashMap_t_v hm') /\ + hashMap_t_v hm' == hashMap_remove_s (hashMap_t_v self) key /\ // The length is decremented iff the key was in the map - (let len = hash_map_t_len_s self in - let len' = hash_map_t_len_s hm' in - match hash_map_t_find_s self key with + (let len = hashMap_t_len_s self in + let len' = hashMap_t_len_s hm' in + match hashMap_t_find_s self key with | None -> len = len' | Some _ -> len = len' + 1))) -let hash_map_remove_back_lem_aux #t self key = - hash_map_remove_back_lem_refin self key; - hash_map_remove_s_lem (hash_map_t_v self) key +let hashMap_remove_back_lem_aux #t self key = + hashMap_remove_back_lem_refin self key; + hashMap_remove_s_lem (hashMap_t_v self) key /// .fsti -let hash_map_remove_back_lem #t self key = - hash_map_remove_back_lem_aux #t self key +let hashMap_remove_back_lem #t self key = + hashMap_remove_back_lem_aux #t self key diff --git a/tests/fstar/hashmap/Hashmap.Properties.fsti b/tests/fstar/hashmap/Hashmap.Properties.fsti index 0a4f0134..26c0ec06 100644 --- a/tests/fstar/hashmap/Hashmap.Properties.fsti +++ b/tests/fstar/hashmap/Hashmap.Properties.fsti @@ -18,11 +18,11 @@ type key : eqtype = usize type hash : eqtype = usize -val hash_map_t_inv (#t : Type0) (hm : hash_map_t t) : Type0 +val hashMap_t_inv (#t : Type0) (hm : hashMap_t t) : Type0 -val len_s (#t : Type0) (hm : hash_map_t t) : nat +val len_s (#t : Type0) (hm : hashMap_t t) : nat -val find_s (#t : Type0) (hm : hash_map_t t) (k : key) : option t +val find_s (#t : Type0) (hm : hashMap_t t) (k : key) : option t (*** Overloading *) @@ -32,16 +32,16 @@ val find_s (#t : Type0) (hm : hash_map_t t) (k : key) : option t /// limiting the hash collisions. /// This is expressed by the following property, which is maintained in the hash /// map invariant. -val hash_map_not_overloaded_lem (#t : Type0) (hm : hash_map_t t) : +val hashMap_not_overloaded_lem (#t : Type0) (hm : hashMap_t t) : Lemma - (requires (hash_map_t_inv hm)) + (requires (hashMap_t_inv hm)) (ensures ( // The capacity is the number of slots - let capacity = length hm.hash_map_slots in + let capacity = length hm.slots in // The max load factor defines a threshold on the number of entries: // if there are more entries than a given fraction of the number of slots, // we resize the slots vector to limit the hash collisions - let (dividend, divisor) = hm.hash_map_max_load_factor in + let (dividend, divisor) = hm.max_load_factor in // technicality: this postcondition won't typecheck if we don't reveal // that divisor > 0 (because of the division) divisor > 0 /\ @@ -63,14 +63,14 @@ val hash_map_not_overloaded_lem (#t : Type0) (hm : hash_map_t t) : (**** [new'fwd] *) /// [new] doesn't fail and returns an empty hash map -val hash_map_new_fwd_lem (t : Type0) : +val hashMap_new_lem (t : Type0) : Lemma (ensures ( - match hash_map_new_fwd t with + match hashMap_new t with | Fail _ -> False | Return hm -> // The hash map invariant is satisfied - hash_map_t_inv hm /\ + hashMap_t_inv hm /\ // The hash map has a length of 0 len_s hm = 0 /\ // It contains no bindings @@ -79,16 +79,16 @@ val hash_map_new_fwd_lem (t : Type0) : (**** [clear] *) /// [clear] doesn't fail and turns the hash map into an empty map -val hash_map_clear_fwd_back_lem - (#t : Type0) (self : hash_map_t t) : +val hashMap_clear_lem + (#t : Type0) (self : hashMap_t t) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_clear_fwd_back t self with + match hashMap_clear t self with | Fail _ -> False | Return hm -> // The hash map invariant is satisfied - hash_map_t_inv hm /\ + hashMap_t_inv hm /\ // The hash map has a length of 0 len_s hm = 0 /\ // It contains no bindings @@ -97,11 +97,11 @@ val hash_map_clear_fwd_back_lem (**** [len] *) /// [len] can't fail and returns the length (the number of elements) of the hash map -val hash_map_len_fwd_lem (#t : Type0) (self : hash_map_t t) : +val hashMap_len_lem (#t : Type0) (self : hashMap_t t) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_len_fwd t self with + match hashMap_len t self with | Fail _ -> False | Return l -> l = len_s self)) @@ -114,12 +114,12 @@ val hash_map_len_fwd_lem (#t : Type0) (self : hash_map_t t) : /// entirely encompassed by the effect of the backward function alone). /// /// [insert'fwd_back] simply inserts a binding. -val hash_map_insert_fwd_back_lem - (#t : Type0) (self : hash_map_t t) (key : usize) (value : t) : +val hashMap_insert_lem + (#t : Type0) (self : hashMap_t t) (key : usize) (value : t) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_insert_fwd_back t self key value with + match hashMap_insert t self key value with | Fail _ -> // We can fail only if: // - the key is not in the map and we thus need to add it @@ -128,7 +128,7 @@ val hash_map_insert_fwd_back_lem len_s self = usize_max | Return hm' -> // The invariant is preserved - hash_map_t_inv hm' /\ + hashMap_t_inv hm' /\ // [key] maps to [value] find_s hm' key == Some value /\ // The other bindings are preserved @@ -145,24 +145,24 @@ val hash_map_insert_fwd_back_lem /// [contains_key'fwd] can't fail and returns `true` if and only if there is /// a binding for key [key] -val hash_map_contains_key_fwd_lem - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_contains_key_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_contains_key_fwd t self key with + match hashMap_contains_key t self key with | Fail _ -> False | Return b -> b = Some? (find_s self key))) (**** [get'fwd] *) /// [get] returns (a shared borrow to) the binding for key [key] -val hash_map_get_fwd_lem - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_get_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_get_fwd t self key, find_s self key with + match hashMap_get t self key, find_s self key with | Fail _, None -> True | Return x, Some x' -> x == x' | _ -> False)) @@ -175,12 +175,12 @@ val hash_map_get_fwd_lem /// in Rust, which gives the possibility of modifying this element in place. Then, /// upon ending the borrow, the effect of the modification is modelled in the /// translation through a call to the backward function. -val hash_map_get_mut_fwd_lem - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_get_mut_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_get_mut_fwd t self key, find_s self key with + match hashMap_get_mut t self key, find_s self key with | Fail _, None -> True | Return x, Some x' -> x == x' | _ -> False)) @@ -192,11 +192,11 @@ val hash_map_get_mut_fwd_lem /// A call to [get_mut'back] must follow a call to [get_mut'fwd], which gives /// us that there must be a binding for key [key] in the map (otherwise we /// can't prove the absence of failure). -val hash_map_get_mut_back_lem - (#t : Type0) (hm : hash_map_t t) (key : usize) (ret : t) : +val hashMap_get_mut_back_lem + (#t : Type0) (hm : hashMap_t t) (key : usize) (ret : t) : Lemma (requires ( - hash_map_t_inv hm /\ + hashMap_t_inv hm /\ // A call to the backward function must follow a call to the forward // function, whose success gives us that there is a binding for the key. // In the case of *forward* functions, "success" has to be understood as @@ -207,14 +207,14 @@ val hash_map_get_mut_back_lem // "failure" is to be understood as the semantics getting stuck. // This is of course true unless we filtered the call to the forward function // because its effect is encompassed by the backward function, as with - // [hash_map_clear_fwd_back]). + // [hashMap_clear]). Some? (find_s hm key))) (ensures ( - match hash_map_get_mut_back t hm key ret with + match hashMap_get_mut_back t hm key ret with | Fail _ -> False // Can't fail | Return hm' -> // The invariant is preserved - hash_map_t_inv hm' /\ + hashMap_t_inv hm' /\ // The length is preserved len_s hm' = len_s hm /\ // [key] maps to the update value, [ret] @@ -228,12 +228,12 @@ val hash_map_get_mut_back_lem /// (the rust function *moves* it out of the map). Note that the effect of the update /// on the map is modelles through the call to [remove'back] ([remove] takes a /// mutable borrow to the hash map as parameter). -val hash_map_remove_fwd_lem - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_remove_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_remove_fwd t self key with + match hashMap_remove t self key with | Fail _ -> False | Return opt_x -> opt_x == find_s self key)) @@ -243,16 +243,16 @@ val hash_map_remove_fwd_lem /// The hash map given as parameter to [remove] is given through a mutable borrow: /// hence the backward function which gives back the updated map, without the /// binding. -val hash_map_remove_back_lem - (#t : Type0) (self : hash_map_t t) (key : usize) : +val hashMap_remove_back_lem + (#t : Type0) (self : hashMap_t t) (key : usize) : Lemma - (requires (hash_map_t_inv self)) + (requires (hashMap_t_inv self)) (ensures ( - match hash_map_remove_back t self key with + match hashMap_remove_back t self key with | Fail _ -> False | Return hm' -> // The invariant is preserved - hash_map_t_inv self /\ + hashMap_t_inv self /\ // The binding for [key] is not there anymore find_s hm' key == None /\ // The other bindings are preserved diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst index 106fe05a..358df29e 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst @@ -13,36 +13,36 @@ open HashmapMain.Funs /// [state_v] gives us the hash map currently stored on disk assume -val state_v : state -> hashmap_hash_map_t u64 +val state_v : state -> hashmap_HashMap_t u64 /// [serialize] updates the hash map stored on disk assume -val serialize_lem (hm : hashmap_hash_map_t u64) (st : state) : Lemma ( - match hashmap_utils_serialize_fwd hm st with +val serialize_lem (hm : hashmap_HashMap_t u64) (st : state) : Lemma ( + match hashmap_utils_serialize hm st with | Fail _ -> True | Return (st', ()) -> state_v st' == hm) - [SMTPat (hashmap_utils_serialize_fwd hm st)] + [SMTPat (hashmap_utils_serialize hm st)] /// [deserialize] gives us the hash map stored on disk, without updating it assume val deserialize_lem (st : state) : Lemma ( - match hashmap_utils_deserialize_fwd st with + match hashmap_utils_deserialize st with | Fail _ -> True | Return (st', hm) -> hm == state_v st /\ st' == st) - [SMTPat (hashmap_utils_deserialize_fwd st)] + [SMTPat (hashmap_utils_deserialize st)] (*** Lemmas *) /// The obvious lemma about [insert_on_disk]: the updated hash map stored on disk /// is exactly the hash map produced from inserting the binding ([key], [value]) /// in the hash map previously stored on disk. -val insert_on_disk_fwd_lem (key : usize) (value : u64) (st : state) : Lemma ( - match insert_on_disk_fwd key value st with +val insert_on_disk_lem (key : usize) (value : u64) (st : state) : Lemma ( + match insert_on_disk key value st with | Fail _ -> True | Return (st', ()) -> let hm = state_v st in - match hashmap_hash_map_insert_fwd_back u64 hm key value with + match hashmap_HashMap_insert u64 hm key value with | Fail _ -> False | Return hm' -> hm' == state_v st') -let insert_on_disk_fwd_lem key value st = () +let insert_on_disk_lem key value st = () diff --git a/tests/fstar/hashmap_on_disk/Primitives.fst b/tests/fstar/hashmap_on_disk/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/hashmap_on_disk/Primitives.fst +++ b/tests/fstar/hashmap_on_disk/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/fstar/misc/Loops.fst b/tests/fstar/misc/Loops.fst deleted file mode 100644 index 823acdd4..00000000 --- a/tests/fstar/misc/Loops.fst +++ /dev/null @@ -1,784 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [loops] *) -module Loops -open Primitives - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [loops::sum]: decreases clause *) -unfold let sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = admit () - -(** [loops::sum]: loop 0: forward function *) -let rec sum_loop - (max : u32) (i : u32) (s : u32) : - Tot (result u32) (decreases (sum_loop_decreases max i s)) - = - if i < max - then let* s0 = u32_add s i in let* i0 = u32_add i 1 in sum_loop max i0 s0 - else u32_mul s 2 - -(** [loops::sum]: forward function *) -let sum (max : u32) : result u32 = - sum_loop max 0 0 - -(** [loops::sum_with_mut_borrows]: decreases clause *) -unfold -let sum_with_mut_borrows_loop_decreases (max : u32) (mi : u32) (ms : u32) : nat - = - admit () - -(** [loops::sum_with_mut_borrows]: loop 0: forward function *) -let rec sum_with_mut_borrows_loop - (max : u32) (mi : u32) (ms : u32) : - Tot (result u32) (decreases (sum_with_mut_borrows_loop_decreases max mi ms)) - = - if mi < max - then - let* ms0 = u32_add ms mi in - let* mi0 = u32_add mi 1 in - sum_with_mut_borrows_loop max mi0 ms0 - else u32_mul ms 2 - -(** [loops::sum_with_mut_borrows]: forward function *) -let sum_with_mut_borrows (max : u32) : result u32 = - sum_with_mut_borrows_loop max 0 0 - -(** [loops::sum_with_shared_borrows]: decreases clause *) -unfold -let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : - nat = - admit () - -(** [loops::sum_with_shared_borrows]: loop 0: forward function *) -let rec sum_with_shared_borrows_loop - (max : u32) (i : u32) (s : u32) : - Tot (result u32) (decreases (sum_with_shared_borrows_loop_decreases max i s)) - = - if i < max - then - let* i0 = u32_add i 1 in - let* s0 = u32_add s i0 in - sum_with_shared_borrows_loop max i0 s0 - else u32_mul s 2 - -(** [loops::sum_with_shared_borrows]: forward function *) -let sum_with_shared_borrows (max : u32) : result u32 = - sum_with_shared_borrows_loop max 0 0 - -(** [loops::clear]: decreases clause *) -unfold -let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = admit () - -(** [loops::clear]: loop 0: merged forward/backward function - (there is a single backward function, and the forward function returns ()) *) -let rec clear_loop - (v : alloc_vec_Vec u32) (i : usize) : - Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i)) - = - let i0 = alloc_vec_Vec_len u32 v in - if i < i0 - then - let* i1 = usize_add i 1 in - let* v0 = - alloc_vec_Vec_index_mut_back u32 usize - (core_slice_index_usize_coresliceindexSliceIndexInst u32) v i 0 in - clear_loop v0 i1 - else Return v - -(** [loops::clear]: merged forward/backward function - (there is a single backward function, and the forward function returns ()) *) -let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) = - clear_loop v 0 - -(** [loops::List] *) -type list_t (t : Type0) = -| List_Cons : t -> list_t t -> list_t t -| List_Nil : list_t t - -(** [loops::list_mem]: decreases clause *) -unfold let list_mem_loop_decreases (x : u32) (ls : list_t u32) : nat = admit () - -(** [loops::list_mem]: loop 0: forward function *) -let rec list_mem_loop - (x : u32) (ls : list_t u32) : - Tot (result bool) (decreases (list_mem_loop_decreases x ls)) - = - begin match ls with - | List_Cons y tl -> if y = x then Return true else list_mem_loop x tl - | List_Nil -> Return false - end - -(** [loops::list_mem]: forward function *) -let list_mem (x : u32) (ls : list_t u32) : result bool = - list_mem_loop x ls - -(** [loops::list_nth_mut_loop]: decreases clause *) -unfold -let list_nth_mut_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : - nat = - admit () - -(** [loops::list_nth_mut_loop]: loop 0: forward function *) -let rec list_nth_mut_loop_loop - (t : Type0) (ls : list_t t) (i : u32) : - Tot (result t) (decreases (list_nth_mut_loop_loop_decreases t ls i)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_loop_loop t tl i0 - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop]: forward function *) -let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result t = - list_nth_mut_loop_loop t ls i - -(** [loops::list_nth_mut_loop]: loop 0: backward function 0 *) -let rec list_nth_mut_loop_loop_back - (t : Type0) (ls : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) (decreases (list_nth_mut_loop_loop_decreases t ls i)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return (List_Cons ret tl) - else - let* i0 = u32_sub i 1 in - let* tl0 = list_nth_mut_loop_loop_back t tl i0 ret in - Return (List_Cons x tl0) - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop]: backward function 0 *) -let list_nth_mut_loop_back - (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = - list_nth_mut_loop_loop_back t ls i ret - -(** [loops::list_nth_shared_loop]: decreases clause *) -unfold -let list_nth_shared_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : - nat = - admit () - -(** [loops::list_nth_shared_loop]: loop 0: forward function *) -let rec list_nth_shared_loop_loop - (t : Type0) (ls : list_t t) (i : u32) : - Tot (result t) (decreases (list_nth_shared_loop_loop_decreases t ls i)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_loop_loop t tl i0 - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_loop]: forward function *) -let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t = - list_nth_shared_loop_loop t ls i - -(** [loops::get_elem_mut]: decreases clause *) -unfold -let get_elem_mut_loop_decreases (x : usize) (ls : list_t usize) : nat = - admit () - -(** [loops::get_elem_mut]: loop 0: forward function *) -let rec get_elem_mut_loop - (x : usize) (ls : list_t usize) : - Tot (result usize) (decreases (get_elem_mut_loop_decreases x ls)) - = - begin match ls with - | List_Cons y tl -> if y = x then Return y else get_elem_mut_loop x tl - | List_Nil -> Fail Failure - end - -(** [loops::get_elem_mut]: forward function *) -let get_elem_mut - (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = - let* l = - alloc_vec_Vec_index_mut (list_t usize) usize - (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) - slots 0 in - get_elem_mut_loop x l - -(** [loops::get_elem_mut]: loop 0: backward function 0 *) -let rec get_elem_mut_loop_back - (x : usize) (ls : list_t usize) (ret : usize) : - Tot (result (list_t usize)) (decreases (get_elem_mut_loop_decreases x ls)) - = - begin match ls with - | List_Cons y tl -> - if y = x - then Return (List_Cons ret tl) - else let* tl0 = get_elem_mut_loop_back x tl ret in Return (List_Cons y tl0) - | List_Nil -> Fail Failure - end - -(** [loops::get_elem_mut]: backward function 0 *) -let get_elem_mut_back - (slots : alloc_vec_Vec (list_t usize)) (x : usize) (ret : usize) : - result (alloc_vec_Vec (list_t usize)) - = - let* l = - alloc_vec_Vec_index_mut (list_t usize) usize - (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) - slots 0 in - let* l0 = get_elem_mut_loop_back x l ret in - alloc_vec_Vec_index_mut_back (list_t usize) usize - (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) slots - 0 l0 - -(** [loops::get_elem_shared]: decreases clause *) -unfold -let get_elem_shared_loop_decreases (x : usize) (ls : list_t usize) : nat = - admit () - -(** [loops::get_elem_shared]: loop 0: forward function *) -let rec get_elem_shared_loop - (x : usize) (ls : list_t usize) : - Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls)) - = - begin match ls with - | List_Cons y tl -> if y = x then Return y else get_elem_shared_loop x tl - | List_Nil -> Fail Failure - end - -(** [loops::get_elem_shared]: forward function *) -let get_elem_shared - (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = - let* l = - alloc_vec_Vec_index (list_t usize) usize - (core_slice_index_usize_coresliceindexSliceIndexInst (list_t usize)) - slots 0 in - get_elem_shared_loop x l - -(** [loops::id_mut]: forward function *) -let id_mut (t : Type0) (ls : list_t t) : result (list_t t) = - Return ls - -(** [loops::id_mut]: backward function 0 *) -let id_mut_back - (t : Type0) (ls : list_t t) (ret : list_t t) : result (list_t t) = - Return ret - -(** [loops::id_shared]: forward function *) -let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = - Return ls - -(** [loops::list_nth_mut_loop_with_id]: decreases clause *) -unfold -let list_nth_mut_loop_with_id_loop_decreases (t : Type0) (i : u32) - (ls : list_t t) : nat = - admit () - -(** [loops::list_nth_mut_loop_with_id]: loop 0: forward function *) -let rec list_nth_mut_loop_with_id_loop - (t : Type0) (i : u32) (ls : list_t t) : - Tot (result t) (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_mut_loop_with_id_loop t i0 tl - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_with_id]: forward function *) -let list_nth_mut_loop_with_id - (t : Type0) (ls : list_t t) (i : u32) : result t = - let* ls0 = id_mut t ls in list_nth_mut_loop_with_id_loop t i ls0 - -(** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 *) -let rec list_nth_mut_loop_with_id_loop_back - (t : Type0) (i : u32) (ls : list_t t) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return (List_Cons ret tl) - else - let* i0 = u32_sub i 1 in - let* tl0 = list_nth_mut_loop_with_id_loop_back t i0 tl ret in - Return (List_Cons x tl0) - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_with_id]: backward function 0 *) -let list_nth_mut_loop_with_id_back - (t : Type0) (ls : list_t t) (i : u32) (ret : t) : result (list_t t) = - let* ls0 = id_mut t ls in - let* l = list_nth_mut_loop_with_id_loop_back t i ls0 ret in - id_mut_back t ls l - -(** [loops::list_nth_shared_loop_with_id]: decreases clause *) -unfold -let list_nth_shared_loop_with_id_loop_decreases (t : Type0) (i : u32) - (ls : list_t t) : nat = - admit () - -(** [loops::list_nth_shared_loop_with_id]: loop 0: forward function *) -let rec list_nth_shared_loop_with_id_loop - (t : Type0) (i : u32) (ls : list_t t) : - Tot (result t) - (decreases (list_nth_shared_loop_with_id_loop_decreases t i ls)) - = - begin match ls with - | List_Cons x tl -> - if i = 0 - then Return x - else let* i0 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i0 tl - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_loop_with_id]: forward function *) -let list_nth_shared_loop_with_id - (t : Type0) (ls : list_t t) (i : u32) : result t = - let* ls0 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls0 - -(** [loops::list_nth_mut_loop_pair]: decreases clause *) -unfold -let list_nth_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) - (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_mut_loop_pair]: loop 0: forward function *) -let rec list_nth_mut_loop_pair_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair]: forward function *) -let list_nth_mut_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 *) -let rec list_nth_mut_loop_pair_loop_back'a - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl0) - else - let* i0 = u32_sub i 1 in - let* tl00 = list_nth_mut_loop_pair_loop_back'a t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair]: backward function 0 *) -let list_nth_mut_loop_pair_back'a - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_mut_loop_pair_loop_back'a t ls0 ls1 i ret - -(** [loops::list_nth_mut_loop_pair]: loop 0: backward function 1 *) -let rec list_nth_mut_loop_pair_loop_back'b - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl1) - else - let* i0 = u32_sub i 1 in - let* tl10 = list_nth_mut_loop_pair_loop_back'b t tl0 tl1 i0 ret in - Return (List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair]: backward function 1 *) -let list_nth_mut_loop_pair_back'b - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_mut_loop_pair_loop_back'b t ls0 ls1 i ret - -(** [loops::list_nth_shared_loop_pair]: decreases clause *) -unfold -let list_nth_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) - (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_shared_loop_pair]: loop 0: forward function *) -let rec list_nth_shared_loop_pair_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_shared_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else let* i0 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_loop_pair]: forward function *) -let list_nth_shared_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_mut_loop_pair_merge]: decreases clause *) -unfold -let list_nth_mut_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) - (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_mut_loop_pair_merge_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else - let* i0 = u32_sub i 1 in list_nth_mut_loop_pair_merge_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair_merge]: forward function *) -let list_nth_mut_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 *) -let rec list_nth_mut_loop_pair_merge_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : - Tot (result ((list_t t) & (list_t t))) - (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) - else - let* i0 = u32_sub i 1 in - let* (tl00, tl10) = - list_nth_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00, List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_loop_pair_merge]: backward function 0 *) -let list_nth_mut_loop_pair_merge_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : (t & t)) : - result ((list_t t) & (list_t t)) - = - list_nth_mut_loop_pair_merge_loop_back t ls0 ls1 i ret - -(** [loops::list_nth_shared_loop_pair_merge]: decreases clause *) -unfold -let list_nth_shared_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) - (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_shared_loop_pair_merge_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else - let* i0 = u32_sub i 1 in - list_nth_shared_loop_pair_merge_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_loop_pair_merge]: forward function *) -let list_nth_shared_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_mut_shared_loop_pair]: decreases clause *) -unfold -let list_nth_mut_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) - (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function *) -let rec list_nth_mut_shared_loop_pair_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else - let* i0 = u32_sub i 1 in - list_nth_mut_shared_loop_pair_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_shared_loop_pair]: forward function *) -let list_nth_mut_shared_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_shared_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 *) -let rec list_nth_mut_shared_loop_pair_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl0) - else - let* i0 = u32_sub i 1 in - let* tl00 = list_nth_mut_shared_loop_pair_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_shared_loop_pair]: backward function 0 *) -let list_nth_mut_shared_loop_pair_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_mut_shared_loop_pair_loop_back t ls0 ls1 i ret - -(** [loops::list_nth_mut_shared_loop_pair_merge]: decreases clause *) -unfold -let list_nth_mut_shared_loop_pair_merge_loop_decreases (t : Type0) - (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_mut_shared_loop_pair_merge_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else - let* i0 = u32_sub i 1 in - list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_shared_loop_pair_merge]: forward function *) -let list_nth_mut_shared_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 *) -let rec list_nth_mut_shared_loop_pair_merge_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl0) - else - let* i0 = u32_sub i 1 in - let* tl00 = - list_nth_mut_shared_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x0 tl00) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_mut_shared_loop_pair_merge]: backward function 0 *) -let list_nth_mut_shared_loop_pair_merge_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_mut_shared_loop_pair_merge_loop_back t ls0 ls1 i ret - -(** [loops::list_nth_shared_mut_loop_pair]: decreases clause *) -unfold -let list_nth_shared_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) - (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function *) -let rec list_nth_shared_mut_loop_pair_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else - let* i0 = u32_sub i 1 in - list_nth_shared_mut_loop_pair_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_mut_loop_pair]: forward function *) -let list_nth_shared_mut_loop_pair - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_mut_loop_pair_loop t ls0 ls1 i - -(** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 *) -let rec list_nth_shared_mut_loop_pair_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl1) - else - let* i0 = u32_sub i 1 in - let* tl10 = list_nth_shared_mut_loop_pair_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_mut_loop_pair]: backward function 1 *) -let list_nth_shared_mut_loop_pair_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_shared_mut_loop_pair_loop_back t ls0 ls1 i ret - -(** [loops::list_nth_shared_mut_loop_pair_merge]: decreases clause *) -unfold -let list_nth_shared_mut_loop_pair_merge_loop_decreases (t : Type0) - (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = - admit () - -(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function *) -let rec list_nth_shared_mut_loop_pair_merge_loop - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : - Tot (result (t & t)) - (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (x0, x1) - else - let* i0 = u32_sub i 1 in - list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i0 - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_mut_loop_pair_merge]: forward function *) -let list_nth_shared_mut_loop_pair_merge - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = - list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i - -(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 *) -let rec list_nth_shared_mut_loop_pair_merge_loop_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - Tot (result (list_t t)) - (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i)) - = - begin match ls0 with - | List_Cons x0 tl0 -> - begin match ls1 with - | List_Cons x1 tl1 -> - if i = 0 - then Return (List_Cons ret tl1) - else - let* i0 = u32_sub i 1 in - let* tl10 = - list_nth_shared_mut_loop_pair_merge_loop_back t tl0 tl1 i0 ret in - Return (List_Cons x1 tl10) - | List_Nil -> Fail Failure - end - | List_Nil -> Fail Failure - end - -(** [loops::list_nth_shared_mut_loop_pair_merge]: backward function 0 *) -let list_nth_shared_mut_loop_pair_merge_back - (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) (ret : t) : - result (list_t t) - = - list_nth_shared_mut_loop_pair_merge_loop_back t ls0 ls1 i ret - diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/fstar/traits/Primitives.fst b/tests/fstar/traits/Primitives.fst index 71d75c11..3297803c 100644 --- a/tests/fstar/traits/Primitives.fst +++ b/tests/fstar/traits/Primitives.fst @@ -427,7 +427,7 @@ let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result a = +let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = if i < length v then Return (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = @@ -704,6 +704,22 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) (*** Theorems *) +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i)] + = + admit() + let alloc_vec_Vec_index_mut_back_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : Lemma ( alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x == diff --git a/tests/lean/Hashmap/Properties.lean b/tests/lean/Hashmap/Properties.lean index 4db54316..e79c422d 100644 --- a/tests/lean/Hashmap/Properties.lean +++ b/tests/lean/Hashmap/Properties.lean @@ -157,7 +157,7 @@ instance : Inhabited (List α) where def slots_s_inv (s : Core.List (List α)) : Prop := ∀ (i : Int), 0 ≤ i → i < s.len → slot_t_inv s.len i (s.index i) -def slots_t_inv (s : Vec (List α)) : Prop := +def slots_t_inv (s : alloc.vec.Vec (List α)) : Prop := slots_s_inv s.v @[simp] @@ -302,13 +302,14 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value | none => nhm.len_s = hm.len_s + 1 | some _ => nhm.len_s = hm.len_s) := by rw [insert_no_resize] - simp only [hash_key, bind_tc_ret] -- TODO: annoying - have _ : (Vec.len (List α) hm.slots).val ≠ 0 := by + -- Simplify. Note that this also simplifies some function calls, like array index + simp [hash_key, bind_tc_ret] + have _ : (alloc.vec.Vec.len (List α) hm.slots).val ≠ 0 := by intro simp_all [inv] progress as ⟨ hash_mod, hhm ⟩ have _ : 0 ≤ hash_mod.val := by scalar_tac - have _ : hash_mod.val < Vec.length hm.slots := by + have _ : hash_mod.val < alloc.vec.Vec.length hm.slots := by have : 0 < hm.slots.val.len := by simp [inv] at hinv simp [hinv] @@ -374,7 +375,7 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value -- TODO: we want to automate this simp apply Int.emod_nonneg k.val hvnz - have _ : k_hash_mod < Vec.length hm.slots := by + have _ : k_hash_mod < alloc.vec.Vec.length hm.slots := by -- TODO: we want to automate this simp have h := Int.emod_lt_of_pos k.val hvpos -- cgit v1.3.1