From 8b18c0da053e069b5a2d9fbf06f45eae2f05a029 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 7 Sep 2023 15:28:06 +0200 Subject: Map some globals like u32::MAX to standard definitions --- backends/lean/Base/Primitives/Scalar.lean | 42 +++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) (limited to 'backends') diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean index ffc969f3..fa5a63cd 100644 --- a/backends/lean/Base/Primitives/Scalar.lean +++ b/backends/lean/Base/Primitives/Scalar.lean @@ -230,6 +230,20 @@ def Scalar.cMax (ty : ScalarTy) : Int := | .Usize => Scalar.max .U32 | _ => Scalar.max ty +theorem Scalar.min_lt_max (ty : ScalarTy) : Scalar.min ty < Scalar.max ty := by + cases ty <;> simp [Scalar.min, Scalar.max] + . simp [Isize.min, Isize.max] + have h1 := Isize.refined_min.property + have h2 := Isize.refined_max.property + cases h1 <;> cases h2 <;> simp [*] + . simp [Usize.max] + have h := Usize.refined_max.property + cases h <;> simp [*] + +theorem Scalar.min_le_max (ty : ScalarTy) : Scalar.min ty ≤ Scalar.max ty := by + have := Scalar.min_lt_max ty + int_tac + theorem Scalar.cMin_bound ty : Scalar.min ty ≤ Scalar.cMin ty := by cases ty <;> simp [Scalar.min, Scalar.max, Scalar.cMin, Scalar.cMax] at * have h := Isize.refined_min.property @@ -395,6 +409,34 @@ def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Re @[reducible] def U64 := Scalar .U64 @[reducible] def U128 := Scalar .U128 +-- TODO: reducible? +@[reducible] def isize_min : Isize := Scalar.ofInt Isize.min (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize)) +@[reducible] def isize_max : Isize := Scalar.ofInt Isize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize)) +@[reducible] def i8_min : I8 := Scalar.ofInt I8.min +@[reducible] def i8_max : I8 := Scalar.ofInt I8.max +@[reducible] def i16_min : I16 := Scalar.ofInt I16.min +@[reducible] def i16_max : I16 := Scalar.ofInt I16.max +@[reducible] def i32_min : I32 := Scalar.ofInt I32.min +@[reducible] def i32_max : I32 := Scalar.ofInt I32.max +@[reducible] def i64_min : I64 := Scalar.ofInt I64.min +@[reducible] def i64_max : I64 := Scalar.ofInt I64.max +@[reducible] def i128_min : I128 := Scalar.ofInt I128.min +@[reducible] def i128_max : I128 := Scalar.ofInt I128.max + +-- TODO: reducible? +@[reducible] def usize_min : Usize := Scalar.ofInt Usize.min +@[reducible] def usize_max : Usize := Scalar.ofInt Usize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Usize)) +@[reducible] def u8_min : U8 := Scalar.ofInt U8.min +@[reducible] def u8_max : U8 := Scalar.ofInt U8.max +@[reducible] def u16_min : U16 := Scalar.ofInt U16.min +@[reducible] def u16_max : U16 := Scalar.ofInt U16.max +@[reducible] def u32_min : U32 := Scalar.ofInt U32.min +@[reducible] def u32_max : U32 := Scalar.ofInt U32.max +@[reducible] def u64_min : U64 := Scalar.ofInt U64.min +@[reducible] def u64_max : U64 := Scalar.ofInt U64.max +@[reducible] def u128_min : U128 := Scalar.ofInt U128.min +@[reducible] def u128_max : U128 := Scalar.ofInt U128.max + -- TODO: below: not sure this is the best way. -- Should we rather overload operations like +, -, etc.? -- Also, it is possible to automate the generation of those definitions -- cgit v1.3.1 From 1181aecddbcb3232c21b191fbde59c2e9596846a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 7 Sep 2023 16:02:43 +0200 Subject: Fix some issues --- backends/coq/Primitives.v | 14 ++++ backends/fstar/Primitives.fst | 47 +++++++++--- backends/hol4/primitivesScript.sml | 26 +++++++ backends/hol4/primitivesTheory.sig | 120 ++++++++++++++++++++++++++++++ backends/lean/Base/Primitives/Scalar.lean | 48 ++++++------ compiler/Extract.ml | 1 - compiler/ExtractAssumed.ml | 40 ++++++---- 7 files changed, 247 insertions(+), 49 deletions(-) (limited to 'backends') diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 71a2d9c3..8d6c9c8d 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/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/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 9db82069..cd18cf29 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/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/backends/hol4/primitivesScript.sml b/backends/hol4/primitivesScript.sml index 82da4de9..916988be 100644 --- a/backends/hol4/primitivesScript.sml +++ b/backends/hol4/primitivesScript.sml @@ -555,6 +555,32 @@ Proof QED val _ = evalLib.add_unfold_thm "mk_isize_unfold" +(** Constants *) +val core_i8_min_def = Define ‘core_i8_min = int_to_i8 i8_min’ +val core_i8_max_def = Define ‘core_i8_max = int_to_i8 i8_max’ +val core_i16_min_def = Define ‘core_i16_min = int_to_i16 i16_min’ +val core_i16_max_def = Define ‘core_i16_max = int_to_i16 i16_max’ +val core_i32_min_def = Define ‘core_i32_min = int_to_i32 i32_min’ +val core_i32_max_def = Define ‘core_i32_max = int_to_i32 i32_max’ +val core_i64_min_def = Define ‘core_i64_min = int_to_i64 i64_min’ +val core_i64_max_def = Define ‘core_i64_max = int_to_i64 i64_max’ +val core_i128_min_def = Define ‘core_i128_min = int_to_i128 i128_min’ +val core_i128_max_def = Define ‘core_i128_max = int_to_i128 i128_max’ +val core_isize_min_def = Define ‘core_isize_min = int_to_isize isize_min’ +val core_isize_max_def = Define ‘core_isize_max = int_to_isize isize_max’ +val core_u8_min_def = Define ‘core_u8_min = int_to_u8 0’ +val core_u8_max_def = Define ‘core_u8_max = int_to_u8 u8_max’ +val core_u16_min_def = Define ‘core_u16_min = int_to_u16 0’ +val core_u16_max_def = Define ‘core_u16_max = int_to_u16 u16_max’ +val core_u32_min_def = Define ‘core_u32_min = int_to_u32 0’ +val core_u32_max_def = Define ‘core_u32_max = int_to_u32 u32_max’ +val core_u64_min_def = Define ‘core_u64_min = int_to_u64 0’ +val core_u64_max_def = Define ‘core_u64_max = int_to_u64 u64_max’ +val core_u128_min_def = Define ‘core_u128_min = int_to_u128 0’ +val core_u128_max_def = Define ‘core_u128_max = int_to_u128 u128_max’ +val core_usize_min_def = Define ‘core_usize_min = int_to_usize 0’ +val core_usize_max_def = Define ‘core_usize_max = int_to_usize usize_max’ + val isize_neg_def = Define ‘isize_neg x = mk_isize (- (isize_to_int x))’ val i8_neg_def = Define ‘i8_neg x = mk_i8 (- (i8_to_int x))’ val i16_neg_def = Define ‘i16_neg x = mk_i16 (- (i16_to_int x))’ diff --git a/backends/hol4/primitivesTheory.sig b/backends/hol4/primitivesTheory.sig index 6660b02d..4ae6bb3e 100644 --- a/backends/hol4/primitivesTheory.sig +++ b/backends/hol4/primitivesTheory.sig @@ -46,6 +46,30 @@ sig (* Definitions *) val bind_def : thm + val core_i128_max_def : thm + val core_i128_min_def : thm + val core_i16_max_def : thm + val core_i16_min_def : thm + val core_i32_max_def : thm + val core_i32_min_def : thm + val core_i64_max_def : thm + val core_i64_min_def : thm + val core_i8_max_def : thm + val core_i8_min_def : thm + val core_isize_max_def : thm + val core_isize_min_def : thm + val core_u128_max_def : thm + val core_u128_min_def : thm + val core_u16_max_def : thm + val core_u16_min_def : thm + val core_u32_max_def : thm + val core_u32_min_def : thm + val core_u64_max_def : thm + val core_u64_min_def : thm + val core_u8_max_def : thm + val core_u8_min_def : thm + val core_usize_max_def : thm + val core_usize_min_def : thm val error_BIJ : thm val error_CASE : thm val error_TY_DEF : thm @@ -566,6 +590,102 @@ sig monad_bind x f = case x of Return y => f y | Fail e => Fail e | Diverge => Diverge + [core_i128_max_def] Definition + + ⊢ core_i128_max = int_to_i128 i128_max + + [core_i128_min_def] Definition + + ⊢ core_i128_min = int_to_i128 i128_min + + [core_i16_max_def] Definition + + ⊢ core_i16_max = int_to_i16 i16_max + + [core_i16_min_def] Definition + + ⊢ core_i16_min = int_to_i16 i16_min + + [core_i32_max_def] Definition + + ⊢ core_i32_max = int_to_i32 i32_max + + [core_i32_min_def] Definition + + ⊢ core_i32_min = int_to_i32 i32_min + + [core_i64_max_def] Definition + + ⊢ core_i64_max = int_to_i64 i64_max + + [core_i64_min_def] Definition + + ⊢ core_i64_min = int_to_i64 i64_min + + [core_i8_max_def] Definition + + ⊢ core_i8_max = int_to_i8 i8_max + + [core_i8_min_def] Definition + + ⊢ core_i8_min = int_to_i8 i8_min + + [core_isize_max_def] Definition + + ⊢ core_isize_max = int_to_isize isize_max + + [core_isize_min_def] Definition + + ⊢ core_isize_min = int_to_isize isize_min + + [core_u128_max_def] Definition + + ⊢ core_u128_max = int_to_u128 u128_max + + [core_u128_min_def] Definition + + ⊢ core_u128_min = int_to_u128 0 + + [core_u16_max_def] Definition + + ⊢ core_u16_max = int_to_u16 u16_max + + [core_u16_min_def] Definition + + ⊢ core_u16_min = int_to_u16 0 + + [core_u32_max_def] Definition + + ⊢ core_u32_max = int_to_u32 u32_max + + [core_u32_min_def] Definition + + ⊢ core_u32_min = int_to_u32 0 + + [core_u64_max_def] Definition + + ⊢ core_u64_max = int_to_u64 u64_max + + [core_u64_min_def] Definition + + ⊢ core_u64_min = int_to_u64 0 + + [core_u8_max_def] Definition + + ⊢ core_u8_max = int_to_u8 u8_max + + [core_u8_min_def] Definition + + ⊢ core_u8_min = int_to_u8 0 + + [core_usize_max_def] Definition + + ⊢ core_usize_max = int_to_usize usize_max + + [core_usize_min_def] Definition + + ⊢ core_usize_min = int_to_usize 0 + [error_BIJ] Definition ⊢ (∀a. num2error (error2num a) = a) ∧ diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean index fa5a63cd..6e7733a7 100644 --- a/backends/lean/Base/Primitives/Scalar.lean +++ b/backends/lean/Base/Primitives/Scalar.lean @@ -410,32 +410,32 @@ def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Re @[reducible] def U128 := Scalar .U128 -- TODO: reducible? -@[reducible] def isize_min : Isize := Scalar.ofInt Isize.min (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize)) -@[reducible] def isize_max : Isize := Scalar.ofInt Isize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize)) -@[reducible] def i8_min : I8 := Scalar.ofInt I8.min -@[reducible] def i8_max : I8 := Scalar.ofInt I8.max -@[reducible] def i16_min : I16 := Scalar.ofInt I16.min -@[reducible] def i16_max : I16 := Scalar.ofInt I16.max -@[reducible] def i32_min : I32 := Scalar.ofInt I32.min -@[reducible] def i32_max : I32 := Scalar.ofInt I32.max -@[reducible] def i64_min : I64 := Scalar.ofInt I64.min -@[reducible] def i64_max : I64 := Scalar.ofInt I64.max -@[reducible] def i128_min : I128 := Scalar.ofInt I128.min -@[reducible] def i128_max : I128 := Scalar.ofInt I128.max +@[reducible] def core_isize_min : Isize := Scalar.ofInt Isize.min (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize)) +@[reducible] def core_isize_max : Isize := Scalar.ofInt Isize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Isize)) +@[reducible] def core_i8_min : I8 := Scalar.ofInt I8.min +@[reducible] def core_i8_max : I8 := Scalar.ofInt I8.max +@[reducible] def core_i16_min : I16 := Scalar.ofInt I16.min +@[reducible] def core_i16_max : I16 := Scalar.ofInt I16.max +@[reducible] def core_i32_min : I32 := Scalar.ofInt I32.min +@[reducible] def core_i32_max : I32 := Scalar.ofInt I32.max +@[reducible] def core_i64_min : I64 := Scalar.ofInt I64.min +@[reducible] def core_i64_max : I64 := Scalar.ofInt I64.max +@[reducible] def core_i128_min : I128 := Scalar.ofInt I128.min +@[reducible] def core_i128_max : I128 := Scalar.ofInt I128.max -- TODO: reducible? -@[reducible] def usize_min : Usize := Scalar.ofInt Usize.min -@[reducible] def usize_max : Usize := Scalar.ofInt Usize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Usize)) -@[reducible] def u8_min : U8 := Scalar.ofInt U8.min -@[reducible] def u8_max : U8 := Scalar.ofInt U8.max -@[reducible] def u16_min : U16 := Scalar.ofInt U16.min -@[reducible] def u16_max : U16 := Scalar.ofInt U16.max -@[reducible] def u32_min : U32 := Scalar.ofInt U32.min -@[reducible] def u32_max : U32 := Scalar.ofInt U32.max -@[reducible] def u64_min : U64 := Scalar.ofInt U64.min -@[reducible] def u64_max : U64 := Scalar.ofInt U64.max -@[reducible] def u128_min : U128 := Scalar.ofInt U128.min -@[reducible] def u128_max : U128 := Scalar.ofInt U128.max +@[reducible] def core_usize_min : Usize := Scalar.ofInt Usize.min +@[reducible] def core_usize_max : Usize := Scalar.ofInt Usize.max (by simp [Scalar.min, Scalar.max]; apply (Scalar.min_le_max .Usize)) +@[reducible] def core_u8_min : U8 := Scalar.ofInt U8.min +@[reducible] def core_u8_max : U8 := Scalar.ofInt U8.max +@[reducible] def core_u16_min : U16 := Scalar.ofInt U16.min +@[reducible] def core_u16_max : U16 := Scalar.ofInt U16.max +@[reducible] def core_u32_min : U32 := Scalar.ofInt U32.min +@[reducible] def core_u32_max : U32 := Scalar.ofInt U32.max +@[reducible] def core_u64_min : U64 := Scalar.ofInt U64.min +@[reducible] def core_u64_max : U64 := Scalar.ofInt U64.max +@[reducible] def core_u128_min : U128 := Scalar.ofInt U128.min +@[reducible] def core_u128_max : U128 := Scalar.ofInt U128.max -- TODO: below: not sure this is the best way. -- Should we rather overload operations like +, -, etc.? diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 74540787..8baa3c88 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -8,7 +8,6 @@ open Pure open PureUtils open TranslateCore open ExtractBase -open ExtractAssumed open StringUtils open Config module F = Format diff --git a/compiler/ExtractAssumed.ml b/compiler/ExtractAssumed.ml index bbcedb2b..7f094b24 100644 --- a/compiler/ExtractAssumed.ml +++ b/compiler/ExtractAssumed.ml @@ -1,8 +1,6 @@ (** This file declares external identifiers that we catch to map them to definitions coming from the standard libraries in our backends. *) -open Utils -open StringUtils open Names type simple_name = string list [@@deriving show, ord] @@ -30,18 +28,32 @@ module SimpleNameMap = Collections.MakeMap (SimpleNameOrd) let assumed_globals : (string * string) list = [ - ("core::num::usize::MAX", "usize_max"); - ("core::num::u8::MAX", "u8_max"); - ("core::num::u16::MAX", "u16_max"); - ("core::num::u32::MAX", "u32_max"); - ("core::num::u64::MAX", "u64_max"); - ("core::num::u128::MAX", "u128_max"); - ("core::num::isize::MAX", "isize_max"); - ("core::num::i8::MAX", "i8_max"); - ("core::num::i16::MAX", "i16_max"); - ("core::num::i32::MAX", "i32_max"); - ("core::num::i64::MAX", "i64_max"); - ("core::num::i128::MAX", "i128_max"); + (* Min *) + ("core::num::usize::MIN", "core_usize_min"); + ("core::num::u8::MIN", "core_u8_min"); + ("core::num::u16::MIN", "core_u16_min"); + ("core::num::u32::MIN", "core_u32_min"); + ("core::num::u64::MIN", "core_u64_min"); + ("core::num::u128::MIN", "core_u128_min"); + ("core::num::isize::MIN", "core_isize_min"); + ("core::num::i8::MIN", "core_i8_min"); + ("core::num::i16::MIN", "core_i16_min"); + ("core::num::i32::MIN", "core_i32_min"); + ("core::num::i64::MIN", "core_i64_min"); + ("core::num::i128::MIN", "core_i128_min"); + (* Max *) + ("core::num::usize::MAX", "core_usize_max"); + ("core::num::u8::MAX", "core_u8_max"); + ("core::num::u16::MAX", "core_u16_max"); + ("core::num::u32::MAX", "core_u32_max"); + ("core::num::u64::MAX", "core_u64_max"); + ("core::num::u128::MAX", "core_u128_max"); + ("core::num::isize::MAX", "core_isize_max"); + ("core::num::i8::MAX", "core_i8_max"); + ("core::num::i16::MAX", "core_i16_max"); + ("core::num::i32::MAX", "core_i32_max"); + ("core::num::i64::MAX", "core_i64_max"); + ("core::num::i128::MAX", "core_i128_max"); ] let assumed_globals_map : string SimpleNameMap.t = -- cgit v1.3.1 From 0f0e4be7dc746e2676db33f850bbeddf239eaec8 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Oct 2023 00:40:37 +0200 Subject: Add sup --- backends/coq/Primitives.v | 3 ++ backends/lean/Base/IList/IList.lean | 57 +++++++++++++++++++++++++++++++- backends/lean/Base/Primitives/Array.lean | 9 +++++ compiler/Assumed.ml | 15 +++++++++ compiler/Driver.ml | 2 ++ compiler/Extract.ml | 4 ++- compiler/InterpreterStatements.ml | 2 +- compiler/PrintPure.ml | 1 + compiler/PureMicroPasses.ml | 2 +- 9 files changed, 91 insertions(+), 4 deletions(-) (limited to 'backends') diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 8d6c9c8d..b92eb967 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -433,6 +433,9 @@ Qed. (* TODO: finish the definitions *) Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. +(* For initialization *) +Axiom array_repeat : forall {T : Type} (n : usize) (x : T), array T n. + Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). diff --git a/backends/lean/Base/IList/IList.lean b/backends/lean/Base/IList/IList.lean index 0b483e90..f10ec4e7 100644 --- a/backends/lean/Base/IList/IList.lean +++ b/backends/lean/Base/IList/IList.lean @@ -112,7 +112,19 @@ def pairwise_rel section Lemmas -variable {α : Type u} +variable {α : Type u} + +def ireplicate {α : Type u} (i : ℤ) (x : α) : List α := + if i ≤ 0 then [] + else x :: ireplicate (i - 1) x +termination_by ireplicate i x => i.toNat +decreasing_by + simp_wf + -- TODO: simplify this kind of proofs + simp at * + have : 0 ≤ i := by linarith + have : 1 ≤ i := by linarith + simp [Int.toNat_sub_of_le, *] @[simp] theorem update_nil : update ([] : List α) i y = [] := by simp [update] @[simp] theorem update_zero_cons : update ((x :: tl) : List α) 0 y = y :: tl := by simp [update] @@ -129,6 +141,10 @@ variable {α : Type u} @[simp] theorem slice_nil : slice i j ([] : List α) = [] := by simp [slice] @[simp] theorem slice_zero : slice 0 0 (ls : List α) = [] := by cases ls <;> simp [slice] +@[simp] theorem ireplicate_zero : ireplicate 0 x = [] := by rw [ireplicate]; simp +@[simp] theorem ireplicate_nzero_cons (hne : 0 < i) : ireplicate i x = x :: ireplicate (i - 1) x := by + rw [ireplicate]; simp [*]; intro; linarith + @[simp] theorem slice_nzero_cons (i j : Int) (x : α) (tl : List α) (hne : i ≠ 0) : slice i j ((x :: tl) : List α) = slice (i - 1) (j - 1) tl := match tl with @@ -144,6 +160,45 @@ theorem slice_nzero_cons (i j : Int) (x : α) (tl : List α) (hne : i ≠ 0) : s conv at this => lhs; simp [slice, *] simp [*, slice] +@[simp] +theorem ireplicate_replicate {α : Type u} (l : ℤ) (x : α) (h : 0 ≤ l) : + ireplicate l x = replicate l.toNat x := + if hz: l = 0 then by + simp [*] + else by + have : 0 < l := by int_tac + have hr := ireplicate_replicate (l - 1) x (by int_tac) + simp [*] + have hl : l.toNat = .succ (l.toNat - 1) := by + cases hl: l.toNat <;> simp_all + conv => rhs; rw[hl] +termination_by ireplicate_replicate l x h => l.toNat +decreasing_by + simp_wf + -- TODO: simplify this kind of proofs + simp at * + have : 0 ≤ l := by linarith + have : 1 ≤ l := by linarith + simp [Int.toNat_sub_of_le, *] + +@[simp] +theorem ireplicate_len {α : Type u} (l : ℤ) (x : α) (h : 0 ≤ l) : + (ireplicate l x).len = l := + if hz: l = 0 then by + simp [*] + else by + have : 0 < l := by int_tac + have hr := ireplicate_len (l - 1) x (by int_tac) + simp [*] +termination_by ireplicate_len l x h => l.toNat +decreasing_by + simp_wf + -- TODO: simplify this kind of proofs + simp at * + have : 0 ≤ l := by linarith + have : 1 ≤ l := by linarith + simp [Int.toNat_sub_of_le, *] + theorem len_eq_length (ls : List α) : ls.len = ls.length := by induction ls . rfl diff --git a/backends/lean/Base/Primitives/Array.lean b/backends/lean/Base/Primitives/Array.lean index 6c95fd78..49c84bee 100644 --- a/backends/lean/Base/Primitives/Array.lean +++ b/backends/lean/Base/Primitives/Array.lean @@ -51,6 +51,15 @@ def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Re | none => fail .arrayOutOfBounds | some x => ret x +-- For initialization +def Array.repeat (α : Type u) (n : Usize) (x : α) : Array α n := + ⟨ List.ireplicate n.val x, by have h := n.hmin; simp_all [Scalar.min] ⟩ + +@[pspec] +theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) : + ∃ a, Array.repeat α n x = a ∧ a.val = List.ireplicate n.val x := by + simp [Array.repeat] + /- In the theorems below: we don't always need the `∃ ..`, but we use one so that `progress` introduces an opaque variable and an equality. This helps control the context. diff --git a/compiler/Assumed.ml b/compiler/Assumed.ml index e156c335..109175af 100644 --- a/compiler/Assumed.ml +++ b/compiler/Assumed.ml @@ -298,6 +298,19 @@ module Sig = struct let array_subslice_sig (is_mut : bool) = mk_array_slice_subslice_sig true is_mut + let array_repeat_sig = + let generics = + (* *) + mk_generic_params [] [ type_param_0 ] [ cg_param_0 ] + in + let regions_hierarchy = [] (* <> *) in + let inputs = [ tvar_0 (* T *) ] in + let output = + (* [T; N] *) + mk_array_ty tvar_0 cgvar_0 + in + mk_sig generics regions_hierarchy inputs output + let slice_subslice_sig (is_mut : bool) = mk_array_slice_subslice_sig false is_mut @@ -384,6 +397,8 @@ let assumed_infos : assumed_info list = Sig.array_subslice_sig true, true, to_name [ "@ArraySubsliceMut" ] ); + (* Array Repeat *) + (ArrayRepeat, Sig.array_repeat_sig, false, to_name [ "@ArrayRepeat" ]); (* Slice Index *) ( SliceIndexShared, Sig.slice_index_sig false, diff --git a/compiler/Driver.ml b/compiler/Driver.ml index 0fde1d74..8a30ead9 100644 --- a/compiler/Driver.ml +++ b/compiler/Driver.ml @@ -24,6 +24,8 @@ let _ = main_log#set_level EL.Info; llbc_of_json_logger#set_level EL.Info; pre_passes_log#set_level EL.Info; + associated_types_log#set_level EL.Info; + contexts_log#set_level EL.Info; interpreter_log#set_level EL.Info; statements_log#set_level EL.Info; loops_match_ctxs_log#set_level EL.Info; diff --git a/compiler/Extract.ml b/compiler/Extract.ml index ce423acf..99ea14a4 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -338,6 +338,7 @@ let assumed_llbc_functions () : (ArraySubsliceShared, None, "array_subslice_shared"); (ArraySubsliceMut, None, "array_subslice_mut_fwd"); (ArraySubsliceMut, rg0, "array_subslice_mut_back"); + (ArrayRepeat, None, "array_repeat"); (SliceIndexShared, None, "slice_index_shared"); (SliceIndexMut, None, "slice_index_mut_fwd"); (SliceIndexMut, rg0, "slice_index_mut_back"); @@ -369,6 +370,7 @@ let assumed_llbc_functions () : (ArraySubsliceShared, None, "Array.subslice_shared"); (ArraySubsliceMut, None, "Array.subslice_mut"); (ArraySubsliceMut, rg0, "Array.subslice_mut_back"); + (ArrayRepeat, None, "Array.repeat"); (SliceIndexShared, None, "Slice.index_shared"); (SliceIndexMut, None, "Slice.index_mut"); (SliceIndexMut, rg0, "Slice.index_mut_back"); @@ -3212,7 +3214,7 @@ and extract_StructUpdate (ctx : extraction_ctx) (fmt : F.formatter) F.pp_open_hvbox fmt ctx.indent_incr; let need_paren = inside in if need_paren then F.pp_print_string fmt "("; - (* Open the box for `Array.mk T N [` *) + (* Open the box for `Array.replicate T N [` *) F.pp_open_hovbox fmt ctx.indent_incr; (* Print the array constructor *) let cs = ctx_get_struct false (Assumed Array) ctx in diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index 42073f0b..36bc3492 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -646,7 +646,7 @@ let eval_assumed_function_call_concrete (config : C.config) eval_vec_function_concrete config fid generics | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut | ArraySubsliceShared | ArraySubsliceMut - | SliceIndexShared | SliceIndexMut | SliceSubsliceShared + | ArrayRepeat | SliceIndexShared | SliceIndexMut | SliceSubsliceShared | SliceSubsliceMut | SliceLen -> raise (Failure "Unimplemented") in diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index d539dcf6..5fb5978b 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -610,6 +610,7 @@ let llbc_assumed_fun_id_to_string (fid : A.assumed_fun_id) : string = | ArrayToSliceMut -> "@ArrayToSliceMut" | ArraySubsliceShared -> "@ArraySubsliceShared" | ArraySubsliceMut -> "@ArraySubsliceMut" + | ArrayRepeat -> "@ArrayRepeat" | SliceLen -> "@SliceLen" | SliceIndexShared -> "@SliceIndexShared" | SliceIndexMut -> "@SliceIndexMut" diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 2130d5c2..cedc3559 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -1563,7 +1563,7 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl = | ArraySubsliceMut | SliceIndexShared | SliceIndexMut | SliceSubsliceShared | SliceSubsliceMut | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut - | SliceLen ), + | ArrayRepeat | SliceLen ), _ ) -> super#visit_texpression env e) | _ -> super#visit_texpression env e) -- cgit v1.3.1 From 8ac8d00b2958d007facb5162196831d0a2138db8 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 13 Oct 2023 10:31:06 +0200 Subject: Update Primitives.fst --- backends/fstar/Primitives.fst | 3 +++ 1 file changed, 3 insertions(+) (limited to 'backends') diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index cd18cf29..e9391834 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -352,6 +352,9 @@ let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range us let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = admit() +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = admit() -- cgit v1.3.1 From cbb2d05e0db6bedf9d6844f29ee25b95429b994c Mon Sep 17 00:00:00 2001 From: Son Ho Date: Mon, 16 Oct 2023 11:06:46 +0200 Subject: Improve formatting of scalars in Lean --- backends/lean/Base/Primitives/Scalar.lean | 15 ++++++++++++++ compiler/Extract.ml | 33 ++++++++++--------------------- 2 files changed, 25 insertions(+), 23 deletions(-) (limited to 'backends') diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean index 6e7733a7..9e65d3c0 100644 --- a/backends/lean/Base/Primitives/Scalar.lean +++ b/backends/lean/Base/Primitives/Scalar.lean @@ -764,6 +764,21 @@ def U32.ofInt := @Scalar.ofInt .U32 def U64.ofInt := @Scalar.ofInt .U64 def U128.ofInt := @Scalar.ofInt .U128 +postfix:74 "%isize" => Isize.ofInt +postfix:74 "%i8" => I8.ofInt +postfix:74 "%i16" => I16.ofInt +postfix:74 "%i32" => I32.ofInt +postfix:74 "%i64" => I64.ofInt +postfix:74 "%i128" => I128.ofInt +postfix:74 "%usize" => Usize.ofInt +postfix:74 "%u8" => U8.ofInt +postfix:74 "%u16" => U16.ofInt +postfix:74 "%u32" => U32.ofInt +postfix:74 "%u64" => U64.ofInt +postfix:74 "%u128" => U128.ofInt + +example : Result U32 := 1%u32 + 2%u32 + -- TODO: factor those lemmas out @[simp] theorem Scalar.ofInt_val_eq {ty} (h : Scalar.min ty ≤ x ∧ x ≤ Scalar.max ty) : (Scalar.ofInt x h).val = x := by simp [Scalar.ofInt, Scalar.ofIntCore] diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 99ea14a4..b56d8c51 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -912,11 +912,11 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string) | Scalar sv -> ( match !backend with | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value) - | Coq | HOL4 -> + | Coq | HOL4 | Lean -> let print_brackets = inside && !backend = HOL4 in if print_brackets then F.pp_print_string fmt "("; (match !backend with - | Coq -> () + | Coq | Lean -> () | HOL4 -> F.pp_print_string fmt ("int_to_" ^ int_name sv.PV.int_ty); F.pp_print_space fmt () @@ -924,30 +924,17 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string) (* We need to add parentheses if the value is negative *) if sv.PV.value >= Z.of_int 0 then F.pp_print_string fmt (Z.to_string sv.PV.value) - else F.pp_print_string fmt ("(" ^ Z.to_string sv.PV.value ^ ")"); + else + F.pp_print_string fmt + ("(" ^ Z.to_string sv.PV.value + ^ if !backend = Lean then ":Int" else "" ^ ")"); (match !backend with - | Coq -> F.pp_print_string fmt ("%" ^ int_name sv.PV.int_ty) + | Coq | Lean -> + let iname = String.lowercase_ascii (int_name sv.PV.int_ty) in + F.pp_print_string fmt ("%" ^ iname) | HOL4 -> () | _ -> raise (Failure "Unreachable")); - if print_brackets then F.pp_print_string fmt ")" - | Lean -> - F.pp_print_string fmt "("; - F.pp_print_string fmt (int_name sv.int_ty); - F.pp_print_string fmt ".ofInt "; - (* Something very annoying: negated values like `-3` are - ambiguous in Lean because of conversions, so we have to - be extremely explicit with negative numbers. - *) - if Z.lt sv.value Z.zero then ( - F.pp_print_string fmt "("; - F.pp_print_string fmt "-"; - F.pp_print_string fmt "("; - Z.pp_print fmt (Z.neg sv.value); - F.pp_print_string fmt ":Int"; - F.pp_print_string fmt ")"; - F.pp_print_string fmt ")") - else Z.pp_print fmt sv.value; - F.pp_print_string fmt ")") + if print_brackets then F.pp_print_string fmt ")") | Bool b -> let b = match !backend with -- cgit v1.3.1 From 584726e9c4e4378129a35f6cfbbbf934448d10a9 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Oct 2023 09:36:55 +0200 Subject: Implement tactics for termination proofs which involve arithmetic --- backends/lean/Base/Arith/Base.lean | 12 ++++++++++++ backends/lean/Base/Arith/Int.lean | 11 +++++++++++ backends/lean/Base/Arith/Scalar.lean | 11 +++++++++++ backends/lean/Base/IList/IList.lean | 24 +++--------------------- 4 files changed, 37 insertions(+), 21 deletions(-) (limited to 'backends') diff --git a/backends/lean/Base/Arith/Base.lean b/backends/lean/Base/Arith/Base.lean index 9c11ed45..8ada4171 100644 --- a/backends/lean/Base/Arith/Base.lean +++ b/backends/lean/Base/Arith/Base.lean @@ -57,4 +57,16 @@ theorem int_pos_ind (p : Int → Prop) : -- TODO: there is probably something more general to do theorem nat_zero_eq_int_zero : (0 : Nat) = (0 : Int) := by simp +-- This is mostly used in termination proofs +theorem to_int_to_nat_lt (x y : ℤ) (h0 : 0 ≤ x) (h1 : x < y) : + ↑(x.toNat) < y := by + simp [*] + +-- This is mostly used in termination proofs +theorem to_int_sub_to_nat_lt (x y : ℤ) (x' : ℕ) + (h0 : ↑x' ≤ x) (h1 : x - ↑x' < y) : + ↑(x.toNat - x') < y := by + have : 0 ≤ x := by linarith + simp [Int.toNat_sub_of_le, *] + end Arith diff --git a/backends/lean/Base/Arith/Int.lean b/backends/lean/Base/Arith/Int.lean index 3359ecdb..2959e245 100644 --- a/backends/lean/Base/Arith/Int.lean +++ b/backends/lean/Base/Arith/Int.lean @@ -270,6 +270,17 @@ elab "int_tac" args:(" split_goal"?): tactic => let split := args.raw.getArgs.size > 0 intTac split (do pure ()) +-- For termination proofs +syntax "int_decr_tac" : tactic +macro_rules + | `(tactic| int_decr_tac) => + `(tactic| + simp_wf; + -- TODO: don't use a macro (namespace problems) + (first | apply Arith.to_int_to_nat_lt + | apply Arith.to_int_sub_to_nat_lt) <;> + simp_all <;> int_tac) + example (x : Int) (h0: 0 ≤ x) (h1: x ≠ 0) : 0 < x := by int_tac_preprocess linarith diff --git a/backends/lean/Base/Arith/Scalar.lean b/backends/lean/Base/Arith/Scalar.lean index 47751c8a..66c31129 100644 --- a/backends/lean/Base/Arith/Scalar.lean +++ b/backends/lean/Base/Arith/Scalar.lean @@ -36,6 +36,17 @@ def scalarTac (splitGoalConjs : Bool) : Tactic.TacticM Unit := do elab "scalar_tac" : tactic => scalarTac false +-- For termination proofs +syntax "scalar_decr_tac" : tactic +macro_rules + | `(tactic| scalar_decr_tac) => + `(tactic| + simp_wf; + -- TODO: don't use a macro (namespace problems) + (first | apply Arith.to_int_to_nat_lt + | apply Arith.to_int_sub_to_nat_lt) <;> + simp_all <;> scalar_tac) + instance (ty : ScalarTy) : HasIntProp (Scalar ty) where -- prop_ty is inferred prop := λ x => And.intro x.hmin x.hmax diff --git a/backends/lean/Base/IList/IList.lean b/backends/lean/Base/IList/IList.lean index 79de93d5..f71f2de2 100644 --- a/backends/lean/Base/IList/IList.lean +++ b/backends/lean/Base/IList/IList.lean @@ -118,13 +118,7 @@ def ireplicate {α : Type u} (i : ℤ) (x : α) : List α := if i ≤ 0 then [] else x :: ireplicate (i - 1) x termination_by ireplicate i x => i.toNat -decreasing_by - simp_wf - -- TODO: simplify this kind of proofs - simp at * - have : 0 ≤ i := by linarith - have : 1 ≤ i := by linarith - simp [Int.toNat_sub_of_le, *] +decreasing_by int_decr_tac @[simp] theorem update_nil : update ([] : List α) i y = [] := by simp [update] @[simp] theorem update_zero_cons : update ((x :: tl) : List α) 0 y = y :: tl := by simp [update] @@ -173,13 +167,7 @@ theorem ireplicate_replicate {α : Type u} (l : ℤ) (x : α) (h : 0 ≤ l) : cases hl: l.toNat <;> simp_all conv => rhs; rw[hl] termination_by ireplicate_replicate l x h => l.toNat -decreasing_by - simp_wf - -- TODO: simplify this kind of proofs - simp at * - have : 0 ≤ l := by linarith - have : 1 ≤ l := by linarith - simp [Int.toNat_sub_of_le, *] +decreasing_by int_decr_tac @[simp] theorem ireplicate_len {α : Type u} (l : ℤ) (x : α) (h : 0 ≤ l) : @@ -191,13 +179,7 @@ theorem ireplicate_len {α : Type u} (l : ℤ) (x : α) (h : 0 ≤ l) : have hr := ireplicate_len (l - 1) x (by int_tac) simp [*] termination_by ireplicate_len l x h => l.toNat -decreasing_by - simp_wf - -- TODO: simplify this kind of proofs - simp at * - have : 0 ≤ l := by linarith - have : 1 ≤ l := by linarith - simp [Int.toNat_sub_of_le, *] +decreasing_by int_decr_tac theorem len_eq_length (ls : List α) : ls.len = ls.length := by induction ls -- cgit v1.3.1 From 61368028027a7c160c33b05ec605c26833212667 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 17 Oct 2023 10:36:15 +0200 Subject: Refold the scalar types when applying progress --- backends/lean/Base/Arith/Int.lean | 4 +- backends/lean/Base/Arith/Scalar.lean | 2 +- backends/lean/Base/Progress/Progress.lean | 26 ++++++++++- backends/lean/Base/Utils.lean | 75 ++++++++++++++++++++++++++----- 4 files changed, 91 insertions(+), 16 deletions(-) (limited to 'backends') diff --git a/backends/lean/Base/Arith/Int.lean b/backends/lean/Base/Arith/Int.lean index 2959e245..a57f8bb1 100644 --- a/backends/lean/Base/Arith/Int.lean +++ b/backends/lean/Base/Arith/Int.lean @@ -162,7 +162,7 @@ def introInstances (declToUnfold : Name) (lookup : Expr → MetaM (Option Expr)) -- Add a declaration let nval ← Utils.addDeclTac name e type (asLet := false) -- Simplify to unfold the declaration to unfold (i.e., the projector) - Utils.simpAt [declToUnfold] [] [] (Tactic.Location.targets #[mkIdent name] false) + Utils.simpAt true [declToUnfold] [] [] (Location.targets #[mkIdent name] false) -- Return the new value pure nval @@ -240,7 +240,7 @@ def intTac (splitGoalConjs : Bool) (extraPreprocess : Tactic.TacticM Unit) : Ta -- the goal. I think before leads to a smaller proof term? Tactic.allGoals (intTacPreprocess extraPreprocess) -- More preprocessing - Tactic.allGoals (Utils.tryTac (Utils.simpAt [] [``nat_zero_eq_int_zero] [] .wildcard)) + Tactic.allGoals (Utils.tryTac (Utils.simpAt true [] [``nat_zero_eq_int_zero] [] .wildcard)) -- Split the conjunctions in the goal if splitGoalConjs then Tactic.allGoals (Utils.repeatTac Utils.splitConjTarget) -- Call linarith diff --git a/backends/lean/Base/Arith/Scalar.lean b/backends/lean/Base/Arith/Scalar.lean index 66c31129..2342cce6 100644 --- a/backends/lean/Base/Arith/Scalar.lean +++ b/backends/lean/Base/Arith/Scalar.lean @@ -17,7 +17,7 @@ def scalarTacExtraPreprocess : Tactic.TacticM Unit := do add (← mkAppM ``Scalar.cMax_bound #[.const ``ScalarTy.Usize []]) add (← mkAppM ``Scalar.cMax_bound #[.const ``ScalarTy.Isize []]) -- Reveal the concrete bounds, simplify calls to [ofInt] - Utils.simpAt [``Scalar.min, ``Scalar.max, ``Scalar.cMin, ``Scalar.cMax, + Utils.simpAt true [``Scalar.min, ``Scalar.max, ``Scalar.cMin, ``Scalar.cMax, ``I8.min, ``I16.min, ``I32.min, ``I64.min, ``I128.min, ``I8.max, ``I16.max, ``I32.max, ``I64.max, ``I128.max, ``U8.min, ``U16.min, ``U32.min, ``U64.min, ``U128.min, diff --git a/backends/lean/Base/Progress/Progress.lean b/backends/lean/Base/Progress/Progress.lean index 8b0759c5..ecf05dab 100644 --- a/backends/lean/Base/Progress/Progress.lean +++ b/backends/lean/Base/Progress/Progress.lean @@ -8,6 +8,27 @@ namespace Progress open Lean Elab Term Meta Tactic open Utils +-- TODO: the scalar types annoyingly often get reduced when we use the progress +-- tactic. We should find a way of controling reduction. For now we use rewriting +-- lemmas to make sure the goal remains clean, but this complexifies proof terms. +-- It seems there used to be a `fold` tactic. +theorem scalar_isize_eq : Primitives.Scalar .Isize = Primitives.Isize := by rfl +theorem scalar_i8_eq : Primitives.Scalar .I8 = Primitives.I8 := by rfl +theorem scalar_i16_eq : Primitives.Scalar .I16 = Primitives.I16 := by rfl +theorem scalar_i32_eq : Primitives.Scalar .I32 = Primitives.I32 := by rfl +theorem scalar_i64_eq : Primitives.Scalar .I64 = Primitives.I64 := by rfl +theorem scalar_i128_eq : Primitives.Scalar .I128 = Primitives.I128 := by rfl +theorem scalar_usize_eq : Primitives.Scalar .Usize = Primitives.Usize := by rfl +theorem scalar_u8_eq : Primitives.Scalar .U8 = Primitives.U8 := by rfl +theorem scalar_u16_eq : Primitives.Scalar .U16 = Primitives.U16 := by rfl +theorem scalar_u32_eq : Primitives.Scalar .U32 = Primitives.U32 := by rfl +theorem scalar_u64_eq : Primitives.Scalar .U64 = Primitives.U64 := by rfl +theorem scalar_u128_eq : Primitives.Scalar .U128 = Primitives.U128 := by rfl +def scalar_eqs := [ + ``scalar_isize_eq, ``scalar_i8_eq, ``scalar_i16_eq, ``scalar_i32_eq, ``scalar_i64_eq, ``scalar_i128_eq, + ``scalar_usize_eq, ``scalar_u8_eq, ``scalar_u16_eq, ``scalar_u32_eq, ``scalar_u64_eq, ``scalar_u128_eq +] + inductive TheoremOrLocal where | Theorem (thName : Name) | Local (asm : LocalDecl) @@ -111,8 +132,11 @@ def progressWith (fExpr : Expr) (th : TheoremOrLocal) splitEqAndPost fun hEq hPost ids => do trace[Progress] "eq and post:\n{hEq} : {← inferType hEq}\n{hPost}" tryTac ( - simpAt [] [``Primitives.bind_tc_ret, ``Primitives.bind_tc_fail, ``Primitives.bind_tc_div] + simpAt true [] + [``Primitives.bind_tc_ret, ``Primitives.bind_tc_fail, ``Primitives.bind_tc_div] [hEq.fvarId!] (.targets #[] true)) + -- TODO: remove this (some types get unfolded too much: we "fold" them back) + tryTac (simpAt true [] scalar_eqs [] .wildcard_dep) -- Clear the equality, unless the user requests not to do so let mgoal ← do if keep.isSome then getMainGoal diff --git a/backends/lean/Base/Utils.lean b/backends/lean/Base/Utils.lean index 5224e1c3..b917a789 100644 --- a/backends/lean/Base/Utils.lean +++ b/backends/lean/Base/Utils.lean @@ -604,16 +604,12 @@ example (h : ∃ x y z, x + y + z ≥ 0) : ∃ x, x ≥ 0 := by rename_i x y z exists x + y + z -/- Call the simp tactic. - The initialization of the context is adapted from Tactic.elabSimpArgs. - Something very annoying is that there is no function which allows to - initialize a simp context without doing an elaboration - as a consequence - we write our own here. -/ -def simpAt (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) - (loc : Tactic.Location) : - Tactic.TacticM Unit := do - -- Initialize with the builtin simp theorems - let simpThms ← Tactic.simpOnlyBuiltins.foldlM (·.addConst ·) ({} : SimpTheorems) +def mkSimpCtx (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) : + Tactic.TacticM Simp.Context := do + -- Initialize either with the builtin simp theorems or with all the simp theorems + let simpThms ← + if simpOnly then Tactic.simpOnlyBuiltins.foldlM (·.addConst ·) ({} : SimpTheorems) + else getSimpTheorems -- Add the equational theorem for the declarations to unfold let simpThms ← declsToUnfold.foldlM (fun thms decl => thms.addDeclToUnfold decl) simpThms @@ -637,8 +633,63 @@ def simpAt (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVar throwError "Not a proposition: {thmName}" ) simpThms let congrTheorems ← getSimpCongrTheorems - let ctx : Simp.Context := { simpTheorems := #[simpThms], congrTheorems } + pure { simpTheorems := #[simpThms], congrTheorems } + + +inductive Location where + /-- Apply the tactic everywhere. Same as `Tactic.Location.wildcard` -/ + | wildcard + /-- Apply the tactic everywhere, including in the variable types (i.e., in + assumptions which are not propositions). --/ + | wildcard_dep + /-- Same as Tactic.Location -/ + | targets (hypotheses : Array Syntax) (type : Bool) + +-- Comes from Tactic.simpLocation +def customSimpLocation (ctx : Simp.Context) (discharge? : Option Simp.Discharge := none) + (loc : Location) : TacticM Simp.UsedSimps := do + match loc with + | Location.targets hyps simplifyTarget => + withMainContext do + let fvarIds ← Lean.Elab.Tactic.getFVarIds hyps + go fvarIds simplifyTarget + | Location.wildcard => + withMainContext do + go (← (← getMainGoal).getNondepPropHyps) (simplifyTarget := true) + | Location.wildcard_dep => + withMainContext do + let ctx ← Lean.MonadLCtx.getLCtx + let decls ← ctx.getDecls + let tgts := (decls.map (fun d => d.fvarId)).toArray + go tgts (simplifyTarget := true) +where + go (fvarIdsToSimp : Array FVarId) (simplifyTarget : Bool) : TacticM Simp.UsedSimps := do + let mvarId ← getMainGoal + let (result?, usedSimps) ← simpGoal mvarId ctx (simplifyTarget := simplifyTarget) (discharge? := discharge?) (fvarIdsToSimp := fvarIdsToSimp) + match result? with + | none => replaceMainGoal [] + | some (_, mvarId) => replaceMainGoal [mvarId] + return usedSimps + +/- Call the simp tactic. + The initialization of the context is adapted from Tactic.elabSimpArgs. + Something very annoying is that there is no function which allows to + initialize a simp context without doing an elaboration - as a consequence + we write our own here. -/ +def simpAt (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) + (loc : Location) : + Tactic.TacticM Unit := do + -- Initialize the simp context + let ctx ← mkSimpCtx simpOnly declsToUnfold thms hypsToUse + -- Apply the simplifier + let _ ← customSimpLocation ctx (discharge? := .none) loc + +-- Call the simpAll tactic +def simpAll (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) : + Tactic.TacticM Unit := do + -- Initialize the simp context + let ctx ← mkSimpCtx false declsToUnfold thms hypsToUse -- Apply the simplifier - let _ ← Tactic.simpLocation ctx (discharge? := .none) loc + let _ ← Lean.Meta.simpAll (← getMainGoal) ctx end Utils -- cgit v1.3.1 From c27c3052ec3f9a093b06a41f56b3a361cb65e950 Mon Sep 17 00:00:00 2001 From: Jonathan Protzenko Date: Sun, 22 Oct 2023 16:34:46 -0700 Subject: Add more support for numeric operations, xor, rotate --- backends/fstar/Primitives.fst | 23 ++++++++++++++++++++++- compiler/Extract.ml | 11 +++++++---- compiler/FunsAnalysis.ml | 24 +++++++++++++++++++++--- 3 files changed, 50 insertions(+), 8 deletions(-) (limited to 'backends') diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index e9391834..7d0845ed 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -100,6 +100,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function +| Isize | I8 | I16 | I32 | I64 | I128 -> false +| Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +167,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +272,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,6 +300,13 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + (*** Range *) type range (a : Type0) = { start : a; diff --git a/compiler/Extract.ml b/compiler/Extract.ml index ac81d6f3..b842aea1 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -3,7 +3,6 @@ the formatter everywhere... *) -open Utils open Pure open PureUtils open TranslateCore @@ -61,6 +60,11 @@ let named_binop_name (binop : E.binop) (int_ty : integer_type) : string = | Le -> "le" | Ge -> "ge" | Gt -> "gt" + | BitXor -> "xor" + | BitAnd -> "and" + | BitOr -> "or" + | Shl -> "lsl" + | Shr -> "asr" (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *) | _ -> raise (Failure "Unreachable") in (* Remark: the Lean case is actually not used *) @@ -498,14 +502,13 @@ let extract_binop (extract_expr : bool -> texpression -> unit) F.pp_print_string fmt binop; F.pp_print_space fmt (); extract_expr false arg1 - | _, (Lt | Le | Ge | Gt | Div | Rem | Add | Sub | Mul) -> + | _ -> let binop = named_binop_name binop int_ty in F.pp_print_string fmt binop; F.pp_print_space fmt (); extract_expr true arg0; F.pp_print_space fmt (); - extract_expr true arg1 - | _, (BitXor | BitAnd | BitOr | Shl | Shr) -> raise Unimplemented); + extract_expr true arg1); if inside then F.pp_print_string fmt ")" let type_decl_kind_to_qualif (kind : decl_kind) diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml index f4406653..f8aa06dc 100644 --- a/compiler/FunsAnalysis.ml +++ b/compiler/FunsAnalysis.ml @@ -58,6 +58,24 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) let can_diverge = ref false in let is_rec = 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 } + in + + (* JP: Why not use a reduce visitor here with a tuple of the values to be + computed? *) let visit_fun (f : fun_decl) : unit = let obj = object (self) @@ -108,9 +126,9 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) assert ((not f.is_global_decl_body) || not !stateful); match f.body with | None -> - (* Opaque function: we consider they fail by default *) - obj#may_fail true; - stateful := (not f.is_global_decl_body) && use_state + let info = opaque_info f in + obj#may_fail info.fallible; + stateful := (not f.is_global_decl_body) && use_state && info.stateful | Some body -> obj#visit_statement () body.body in List.iter visit_fun d; -- cgit v1.3.1 From f35aba375757db99d2dc6ac2b11b9eb1e437b420 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 24 Oct 2023 11:58:35 +0200 Subject: Add definitions in for the Lean Primitives library --- backends/lean/Base/Primitives.lean | 2 ++ backends/lean/Base/Primitives/Alloc.lean | 37 +++++++++++++++++++++++++ backends/lean/Base/Primitives/CoreOpsDeref.lean | 18 ++++++++++++ 3 files changed, 57 insertions(+) create mode 100644 backends/lean/Base/Primitives/Alloc.lean create mode 100644 backends/lean/Base/Primitives/CoreOpsDeref.lean (limited to 'backends') diff --git a/backends/lean/Base/Primitives.lean b/backends/lean/Base/Primitives.lean index 6b7b0792..22378af7 100644 --- a/backends/lean/Base/Primitives.lean +++ b/backends/lean/Base/Primitives.lean @@ -2,3 +2,5 @@ import Base.Primitives.Base import Base.Primitives.Scalar import Base.Primitives.Array import Base.Primitives.Vec +import Base.Primitives.Alloc +import Base.Primitives.CoreOpsDeref diff --git a/backends/lean/Base/Primitives/Alloc.lean b/backends/lean/Base/Primitives/Alloc.lean new file mode 100644 index 00000000..0580421f --- /dev/null +++ b/backends/lean/Base/Primitives/Alloc.lean @@ -0,0 +1,37 @@ +import Lean +import Base.Primitives.Base +import Base.Primitives.CoreOpsDeref + +open Primitives +open Result + +namespace alloc + +namespace boxed -- alloc.boxed + +namespace Box -- alloc.boxed.Box + +def deref (T : Type) (x : T) : Result T := ret x +def deref_mut (T : Type) (x : T) : Result T := ret x +def deref_mut_back (T : Type) (_ : T) (x : T) : Result T := ret x + +/-- Trait instance -/ +def coreOpsDerefInst (Self : Type) : + core.ops.deref.Deref Self := { + Target := Self + deref := deref Self +} + +/-- Trait instance -/ +def coreOpsDerefMutInst (Self : Type) : + core.ops.deref.DerefMut Self := { + derefInst := coreOpsDerefInst Self + deref_mut := deref_mut Self + deref_mut_back := deref_mut_back Self +} + +end Box -- alloc.boxed.Box + +end boxed -- alloc.boxed + +end alloc diff --git a/backends/lean/Base/Primitives/CoreOpsDeref.lean b/backends/lean/Base/Primitives/CoreOpsDeref.lean new file mode 100644 index 00000000..2b540012 --- /dev/null +++ b/backends/lean/Base/Primitives/CoreOpsDeref.lean @@ -0,0 +1,18 @@ +import Lean +import Base.Primitives.Base + +open Primitives +open Result + +namespace core.ops.deref + +structure Deref (Self : Type) where + Target : Type + deref : Self → Result Target + +structure DerefMut (Self : Type) where + derefInst : Deref Self + deref_mut : Self → Result derefInst.Target + deref_mut_back : Self → derefInst.Target → Result Self + +end core.ops.deref -- cgit v1.3.1 From fb4fe9ec2c00f15a745ee12357e4a8f929a4dfc0 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 24 Oct 2023 16:43:00 +0200 Subject: Fix minor issues --- backends/lean/Base/Primitives/Base.lean | 4 ++-- compiler/ExtractBuiltin.ml | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) (limited to 'backends') diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean index 7c0fa3bb..2bd081c0 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 mem.replace (a : Type) (x : a) (_ : a) : a := x -@[simp] def mem.replace_back (a : Type) (_ : a) (y : a) : a := y +@[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 /-- Aeneas-translated function -- useful to reduce non-recursive definitions. Use with `simp [ aeneas ]` -/ diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 65c18efd..2e46b120 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -211,15 +211,15 @@ let builtin_funs () : rg = None; extract_name = (match !backend with - | FStar | Coq | HOL4 -> "mem_replace_fwd" - | Lean -> "mem.replace"); + | FStar | Coq | HOL4 -> "core_mem_replace_fwd" + | Lean -> "core.mem.replace"); }; { rg = rg0; extract_name = (match !backend with - | FStar | Coq | HOL4 -> "mem_replace_back" - | Lean -> "mem.replace_back"); + | FStar | Coq | HOL4 -> "core_mem_replace_back" + | Lean -> "core.mem.replace_back"); }; ] ); ( [ "alloc"; "vec"; "Vec"; "new" ], -- 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 'backends') 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 e3cb3646bbe3d50240aa0bf4763f8e816fb9a706 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 25 Oct 2023 15:36:06 +0200 Subject: Fix some issues at extraction and add builtins --- backends/lean/Base/Primitives.lean | 4 +- backends/lean/Base/Primitives/Alloc.lean | 2 +- backends/lean/Base/Primitives/Array.lean | 403 ----------------- backends/lean/Base/Primitives/ArraySlice.lean | 560 ++++++++++++++++++++++++ backends/lean/Base/Primitives/Base.lean | 7 + backends/lean/Base/Primitives/CoreOps.lean | 37 ++ backends/lean/Base/Primitives/CoreOpsDeref.lean | 18 - backends/lean/Base/Primitives/Vec.lean | 2 +- compiler/Extract.ml | 45 +- compiler/ExtractBuiltin.ml | 304 ++++++++++++- compiler/LlbcAstUtils.ml | 19 +- compiler/Translate.ml | 10 +- 12 files changed, 948 insertions(+), 463 deletions(-) delete mode 100644 backends/lean/Base/Primitives/Array.lean create mode 100644 backends/lean/Base/Primitives/ArraySlice.lean create mode 100644 backends/lean/Base/Primitives/CoreOps.lean delete mode 100644 backends/lean/Base/Primitives/CoreOpsDeref.lean (limited to 'backends') diff --git a/backends/lean/Base/Primitives.lean b/backends/lean/Base/Primitives.lean index 22378af7..613b6076 100644 --- a/backends/lean/Base/Primitives.lean +++ b/backends/lean/Base/Primitives.lean @@ -1,6 +1,6 @@ import Base.Primitives.Base import Base.Primitives.Scalar -import Base.Primitives.Array +import Base.Primitives.ArraySlice import Base.Primitives.Vec import Base.Primitives.Alloc -import Base.Primitives.CoreOpsDeref +import Base.Primitives.CoreOps diff --git a/backends/lean/Base/Primitives/Alloc.lean b/backends/lean/Base/Primitives/Alloc.lean index 0580421f..34590499 100644 --- a/backends/lean/Base/Primitives/Alloc.lean +++ b/backends/lean/Base/Primitives/Alloc.lean @@ -1,6 +1,6 @@ import Lean import Base.Primitives.Base -import Base.Primitives.CoreOpsDeref +import Base.Primitives.CoreOps open Primitives open Result diff --git a/backends/lean/Base/Primitives/Array.lean b/backends/lean/Base/Primitives/Array.lean deleted file mode 100644 index 49c84bee..00000000 --- a/backends/lean/Base/Primitives/Array.lean +++ /dev/null @@ -1,403 +0,0 @@ -/- Arrays/slices -/ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd -import Mathlib.Tactic.Linarith -import Base.IList -import Base.Primitives.Scalar -import Base.Primitives.Range -import Base.Arith -import Base.Progress.Base - -namespace Primitives - -open Result Error - -def Array (α : Type u) (n : Usize) := { l : List α // l.length = n.val } - -instance (a : Type u) (n : Usize) : Arith.HasIntProp (Array a n) where - prop_ty := λ v => v.val.len = n.val - prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *] - -instance {α : Type u} {n : Usize} (p : Array α n → Prop) : Arith.HasIntProp (Subtype p) where - prop_ty := λ x => p x - prop := λ x => x.property - -@[simp] -abbrev Array.length {α : Type u} {n : Usize} (v : Array α n) : Int := v.val.len - -@[simp] -abbrev Array.v {α : Type u} {n : Usize} (v : Array α n) : List α := v.val - -example {α: Type u} {n : Usize} (v : Array α n) : v.length ≤ Scalar.max ScalarTy.Usize := by - scalar_tac - -def Array.make (α : Type u) (n : Usize) (init : List α) (hl : init.len = n.val := by decide) : - Array α n := ⟨ init, by simp [← List.len_eq_length]; apply hl ⟩ - -example : Array Int (Usize.ofInt 2) := Array.make Int (Usize.ofInt 2) [0, 1] - -@[simp] -abbrev Array.index {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α := - v.val.index i - -@[simp] -abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i j : Int) : List α := - v.val.slice i j - -def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - --- For initialization -def Array.repeat (α : Type u) (n : Usize) (x : α) : Array α n := - ⟨ List.ireplicate n.val x, by have h := n.hmin; simp_all [Scalar.min] ⟩ - -@[pspec] -theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) : - ∃ a, Array.repeat α n x = a ∧ a.val = List.ireplicate n.val x := by - simp [Array.repeat] - -/- In the theorems below: we don't always need the `∃ ..`, but we use one - so that `progress` introduces an opaque variable and an equality. This - helps control the context. - -/ - -@[pspec] -theorem Array.index_shared_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_shared α n i = ret x ∧ x = v.val.index i.val := by - simp only [index_shared] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - --- This shouldn't be used -def Array.index_shared_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (_: α) : Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def Array.index_mut (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - -@[pspec] -theorem Array.index_mut_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_mut α n i = ret x ∧ x = v.val.index i.val := by - simp only [index_mut] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - -def Array.index_mut_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some _ => - .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ - -@[pspec] -theorem Array.index_mut_back_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α) - (hbound : i.val < v.length) : - ∃ nv, v.index_mut_back α n i x = ret nv ∧ - nv.val = v.val.update i.val x - := by - simp only [index_mut_back] - have h := List.indexOpt_bounds v.val i.val - split - . simp_all [length]; cases h <;> scalar_tac - . simp_all - -def Slice (α : Type u) := { l : List α // l.length ≤ Usize.max } - -instance (a : Type u) : Arith.HasIntProp (Slice a) where - prop_ty := λ v => 0 ≤ v.val.len ∧ v.val.len ≤ Scalar.max ScalarTy.Usize - prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *] - -instance {α : Type u} (p : Slice α → Prop) : Arith.HasIntProp (Subtype p) where - prop_ty := λ x => p x - prop := λ x => x.property - -@[simp] -abbrev Slice.length {α : Type u} (v : Slice α) : Int := v.val.len - -@[simp] -abbrev Slice.v {α : Type u} (v : Slice α) : List α := v.val - -example {a: Type u} (v : Slice a) : v.length ≤ Scalar.max ScalarTy.Usize := by - scalar_tac - -def Slice.new (α : Type u): Slice α := ⟨ [], by apply Scalar.cMax_suffices .Usize; simp ⟩ - --- TODO: very annoying that the α is an explicit parameter -def Slice.len (α : Type u) (v : Slice α) : Usize := - Usize.ofIntCore v.val.len (by scalar_tac) (by scalar_tac) - -@[simp] -theorem Slice.len_val {α : Type u} (v : Slice α) : (Slice.len α v).val = v.length := - by rfl - -@[simp] -abbrev Slice.index {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α := - v.val.index i - -@[simp] -abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : List α := - s.val.slice i j - -def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - -/- In the theorems below: we don't always need the `∃ ..`, but we use one - so that `progress` introduces an opaque variable and an equality. This - helps control the context. - -/ - -@[pspec] -theorem Slice.index_shared_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by - simp only [index_shared] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - --- This shouldn't be used -def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def Slice.index_mut (α : Type u) (v: Slice α) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - -@[pspec] -theorem Slice.index_mut_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by - simp only [index_mut] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - -def Slice.index_mut_back (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some _ => - .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ - -@[pspec] -theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) - (hbound : i.val < v.length) : - ∃ nv, v.index_mut_back α i x = ret nv ∧ - nv.val = v.val.update i.val x - := by - simp only [index_mut_back] - have h := List.indexOpt_bounds v.val i.val - split - . simp_all [length]; cases h <;> scalar_tac - . simp_all - -/- Array to slice/subslices -/ - -/- We could make this function not use the `Result` type. By making it monadic, we - push the user to use the `Array.to_slice_shared_spec` spec theorem below (through the - `progress` tactic), meaning `Array.to_slice_shared` should be considered as opaque. - All what the spec theorem reveals is that the "representative" lists are the same. -/ -def Array.to_slice_shared (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := - ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩ - -@[pspec] -theorem Array.to_slice_shared_spec {α : Type u} {n : Usize} (v : Array α n) : - ∃ s, to_slice_shared α n v = ret s ∧ v.val = s.val := by simp [to_slice_shared] - -def Array.to_slice_mut (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := - to_slice_shared α n v - -@[pspec] -theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) : - ∃ s, Array.to_slice_shared α n v = ret s ∧ v.val = s.val := to_slice_shared_spec v - -def Array.to_slice_mut_back (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) := - if h: s.val.len = n.val then - ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩ - else fail panic - -@[pspec] -theorem Array.to_slice_mut_back_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) : - ∃ na, to_slice_mut_back α n a ns = ret na ∧ na.val = ns.val - := by simp [to_slice_mut_back, *] - -def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := - -- TODO: not completely sure here - if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then - ret ⟨ a.val.slice r.start.val r.end_.val, - by - simp [← List.len_eq_length] - have := a.val.slice_len_le r.start.val r.end_.val - scalar_tac ⟩ - else - fail panic - -@[pspec] -theorem Array.subslice_shared_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) - (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : - ∃ s, subslice_shared α n a r = ret s ∧ - s.val = a.val.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) - := by - simp [subslice_shared, *] - intro i _ _ - have := List.index_slice r.start.val r.end_.val i a.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac) - simp [*] - -def Array.subslice_mut (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := - Array.subslice_shared α n a r - -@[pspec] -theorem Array.subslice_mut_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) - (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : - ∃ s, subslice_mut α n a r = ret s ∧ - s.val = a.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) - := subslice_shared_spec a r h0 h1 - -def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) := - -- TODO: not completely sure here - if h: r.start.val < r.end_.val ∧ r.end_.val ≤ a.length ∧ s.val.len = r.end_.val - r.start.val then - let s_beg := a.val.itake r.start.val - let s_end := a.val.idrop r.end_.val - have : s_beg.len = r.start.val := by - apply List.itake_len - . simp_all; scalar_tac - . scalar_tac - have : s_end.len = a.val.len - r.end_.val := by - apply List.idrop_len - . scalar_tac - . scalar_tac - let na := s_beg.append (s.val.append s_end) - have : na.len = a.val.len := by simp [*] - ret ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩ - else - fail panic - --- TODO: it is annoying to write `.val` everywhere. We could leverage coercions, --- but: some symbols like `+` are already overloaded to be notations for monadic --- operations/ --- We should introduce special symbols for the monadic arithmetic operations --- (the use will never write those symbols directly). -@[pspec] -theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α) - (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) : - ∃ na, subslice_mut_back α n a r s = ret na ∧ - (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧ - (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = s.index (i - r.start.val)) ∧ - (∀ i, r.end_.val ≤ i → i < n.val → na.index i = a.index i) := by - simp [subslice_mut_back, *] - have h := List.replace_slice_index r.start.val r.end_.val a.val s.val - (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac) - simp [List.replace_slice] at h - have ⟨ h0, h1, h2 ⟩ := h - clear h - split_conjs - . intro i _ _ - have := h0 i (by int_tac) (by int_tac) - simp [*] - . intro i _ _ - have := h1 i (by int_tac) (by int_tac) - simp [*] - . intro i _ _ - have := h2 i (by int_tac) (by int_tac) - simp [*] - -def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := - -- TODO: not completely sure here - if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then - ret ⟨ s.val.slice r.start.val r.end_.val, - by - simp [← List.len_eq_length] - have := s.val.slice_len_le r.start.val r.end_.val - scalar_tac ⟩ - else - fail panic - -@[pspec] -theorem Slice.subslice_shared_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) - (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : - ∃ ns, subslice_shared α s r = ret ns ∧ - ns.val = s.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i)) - := by - simp [subslice_shared, *] - intro i _ _ - have := List.index_slice r.start.val r.end_.val i s.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac) - simp [*] - -def Slice.subslice_mut (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := - Slice.subslice_shared α s r - -@[pspec] -theorem Slice.subslice_mut_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) - (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : - ∃ ns, subslice_mut α s r = ret ns ∧ - ns.val = s.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i)) - := subslice_shared_spec s r h0 h1 - -attribute [pp_dot] List.len List.length List.index -- use the dot notation when printing -set_option pp.coercions false -- do not print coercions with ↑ (this doesn't parse) - -def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) := - -- TODO: not completely sure here - if h: r.start.val < r.end_.val ∧ r.end_.val ≤ s.length ∧ ss.val.len = r.end_.val - r.start.val then - let s_beg := s.val.itake r.start.val - let s_end := s.val.idrop r.end_.val - have : s_beg.len = r.start.val := by - apply List.itake_len - . simp_all; scalar_tac - . scalar_tac - have : s_end.len = s.val.len - r.end_.val := by - apply List.idrop_len - . scalar_tac - . scalar_tac - let ns := s_beg.append (ss.val.append s_end) - have : ns.len = s.val.len := by simp [*] - ret ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩ - else - fail panic - -@[pspec] -theorem Slice.subslice_mut_back_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α) - (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) : - ∃ na, subslice_mut_back α a r ss = ret na ∧ - (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧ - (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = ss.index (i - r.start.val)) ∧ - (∀ i, r.end_.val ≤ i → i < a.length → na.index i = a.index i) := by - simp [subslice_mut_back, *] - have h := List.replace_slice_index r.start.val r.end_.val a.val ss.val - (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac) - simp [List.replace_slice, *] at h - have ⟨ h0, h1, h2 ⟩ := h - clear h - split_conjs - . intro i _ _ - have := h0 i (by int_tac) (by int_tac) - simp [*] - . intro i _ _ - have := h1 i (by int_tac) (by int_tac) - simp [*] - . intro i _ _ - have := h2 i (by int_tac) (by int_tac) - simp [*] - -end Primitives diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean new file mode 100644 index 00000000..47807a0d --- /dev/null +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -0,0 +1,560 @@ +/- Arrays/Slices -/ +import Lean +import Lean.Meta.Tactic.Simp +import Init.Data.List.Basic +import Mathlib.Tactic.RunCmd +import Mathlib.Tactic.Linarith +import Base.IList +import Base.Primitives.Scalar +import Base.Primitives.Range +import Base.Primitives.CoreOps +import Base.Arith +import Base.Progress.Base + +namespace Primitives + +open Result Error + +def Array (α : Type u) (n : Usize) := { l : List α // l.length = n.val } + +instance (a : Type u) (n : Usize) : Arith.HasIntProp (Array a n) where + prop_ty := λ v => v.val.len = n.val + prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *] + +instance {α : Type u} {n : Usize} (p : Array α n → Prop) : Arith.HasIntProp (Subtype p) where + prop_ty := λ x => p x + prop := λ x => x.property + +@[simp] +abbrev Array.length {α : Type u} {n : Usize} (v : Array α n) : Int := v.val.len + +@[simp] +abbrev Array.v {α : Type u} {n : Usize} (v : Array α n) : List α := v.val + +example {α: Type u} {n : Usize} (v : Array α n) : v.length ≤ Scalar.max ScalarTy.Usize := by + scalar_tac + +def Array.make (α : Type u) (n : Usize) (init : List α) (hl : init.len = n.val := by decide) : + Array α n := ⟨ init, by simp [← List.len_eq_length]; apply hl ⟩ + +example : Array Int (Usize.ofInt 2) := Array.make Int (Usize.ofInt 2) [0, 1] + +@[simp] +abbrev Array.index {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α := + v.val.index i + +@[simp] +abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i j : Int) : List α := + v.val.slice i j + +def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := + match v.val.indexOpt i.val with + | none => fail .arrayOutOfBounds + | some x => ret x + +-- For initialization +def Array.repeat (α : Type u) (n : Usize) (x : α) : Array α n := + ⟨ List.ireplicate n.val x, by have h := n.hmin; simp_all [Scalar.min] ⟩ + +@[pspec] +theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) : + ∃ a, Array.repeat α n x = a ∧ a.val = List.ireplicate n.val x := by + simp [Array.repeat] + +/- In the theorems below: we don't always need the `∃ ..`, but we use one + so that `progress` introduces an opaque variable and an equality. This + helps control the context. + -/ + +@[pspec] +theorem Array.index_shared_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) + (hbound : i.val < v.length) : + ∃ x, v.index_shared α n i = ret x ∧ x = v.val.index i.val := by + simp only [index_shared] + -- TODO: dependent rewrite + have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) + simp [*] + +-- This shouldn't be used +def Array.index_shared_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (_: α) : Result Unit := + if i.val < List.length v.val then + .ret () + else + .fail arrayOutOfBounds + +def Array.index_mut (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := + match v.val.indexOpt i.val with + | none => fail .arrayOutOfBounds + | some x => ret x + +@[pspec] +theorem Array.index_mut_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) + (hbound : i.val < v.length) : + ∃ x, v.index_mut α n i = ret x ∧ x = v.val.index i.val := by + simp only [index_mut] + -- TODO: dependent rewrite + have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) + simp [*] + +def Array.index_mut_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) := + match v.val.indexOpt i.val with + | none => fail .arrayOutOfBounds + | some _ => + .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ + +@[pspec] +theorem Array.index_mut_back_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α) + (hbound : i.val < v.length) : + ∃ nv, v.index_mut_back α n i x = ret nv ∧ + nv.val = v.val.update i.val x + := by + simp only [index_mut_back] + have h := List.indexOpt_bounds v.val i.val + split + . simp_all [length]; cases h <;> scalar_tac + . simp_all + +def Slice (α : Type u) := { l : List α // l.length ≤ Usize.max } + +instance (a : Type u) : Arith.HasIntProp (Slice a) where + prop_ty := λ v => 0 ≤ v.val.len ∧ v.val.len ≤ Scalar.max ScalarTy.Usize + prop := λ ⟨ _, l ⟩ => by simp[Scalar.max, List.len_eq_length, *] + +instance {α : Type u} (p : Slice α → Prop) : Arith.HasIntProp (Subtype p) where + prop_ty := λ x => p x + prop := λ x => x.property + +@[simp] +abbrev Slice.length {α : Type u} (v : Slice α) : Int := v.val.len + +@[simp] +abbrev Slice.v {α : Type u} (v : Slice α) : List α := v.val + +example {a: Type u} (v : Slice a) : v.length ≤ Scalar.max ScalarTy.Usize := by + scalar_tac + +def Slice.new (α : Type u): Slice α := ⟨ [], by apply Scalar.cMax_suffices .Usize; simp ⟩ + +-- TODO: very annoying that the α is an explicit parameter +def Slice.len (α : Type u) (v : Slice α) : Usize := + Usize.ofIntCore v.val.len (by scalar_tac) (by scalar_tac) + +@[simp] +theorem Slice.len_val {α : Type u} (v : Slice α) : (Slice.len α v).val = v.length := + by rfl + +@[simp] +abbrev Slice.index {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α := + v.val.index i + +@[simp] +abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : List α := + s.val.slice i j + +def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α := + match v.val.indexOpt i.val with + | none => fail .arrayOutOfBounds + | some x => ret x + +/- In the theorems below: we don't always need the `∃ ..`, but we use one + so that `progress` introduces an opaque variable and an equality. This + helps control the context. + -/ + +@[pspec] +theorem Slice.index_shared_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) + (hbound : i.val < v.length) : + ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by + simp only [index_shared] + -- TODO: dependent rewrite + have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) + simp [*] + +-- This shouldn't be used +def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Result Unit := + if i.val < List.length v.val then + .ret () + else + .fail arrayOutOfBounds + +def Slice.index_mut (α : Type u) (v: Slice α) (i: Usize) : Result α := + match v.val.indexOpt i.val with + | none => fail .arrayOutOfBounds + | some x => ret x + +@[pspec] +theorem Slice.index_mut_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) + (hbound : i.val < v.length) : + ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by + simp only [index_mut] + -- TODO: dependent rewrite + have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) + simp [*] + +def Slice.index_mut_back (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) := + match v.val.indexOpt i.val with + | none => fail .arrayOutOfBounds + | some _ => + .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ + +@[pspec] +theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) + (hbound : i.val < v.length) : + ∃ nv, v.index_mut_back α i x = ret nv ∧ + nv.val = v.val.update i.val x + := by + simp only [index_mut_back] + have h := List.indexOpt_bounds v.val i.val + split + . simp_all [length]; cases h <;> scalar_tac + . simp_all + +/- Array to slice/subslices -/ + +/- We could make this function not use the `Result` type. By making it monadic, we + push the user to use the `Array.to_slice_shared_spec` spec theorem below (through the + `progress` tactic), meaning `Array.to_slice_shared` should be considered as opaque. + All what the spec theorem reveals is that the "representative" lists are the same. -/ +def Array.to_slice_shared (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := + ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩ + +@[pspec] +theorem Array.to_slice_shared_spec {α : Type u} {n : Usize} (v : Array α n) : + ∃ s, to_slice_shared α n v = ret s ∧ v.val = s.val := by simp [to_slice_shared] + +def Array.to_slice_mut (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := + to_slice_shared α n v + +@[pspec] +theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) : + ∃ s, Array.to_slice_shared α n v = ret s ∧ v.val = s.val := to_slice_shared_spec v + +def Array.to_slice_mut_back (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) := + if h: s.val.len = n.val then + ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩ + else fail panic + +@[pspec] +theorem Array.to_slice_mut_back_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) : + ∃ na, to_slice_mut_back α n a ns = ret na ∧ na.val = ns.val + := by simp [to_slice_mut_back, *] + +def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := + -- TODO: not completely sure here + if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then + ret ⟨ a.val.slice r.start.val r.end_.val, + by + simp [← List.len_eq_length] + have := a.val.slice_len_le r.start.val r.end_.val + scalar_tac ⟩ + else + fail panic + +@[pspec] +theorem Array.subslice_shared_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) + (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : + ∃ s, subslice_shared α n a r = ret s ∧ + s.val = a.val.slice r.start.val r.end_.val ∧ + (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) + := by + simp [subslice_shared, *] + intro i _ _ + have := List.index_slice r.start.val r.end_.val i a.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac) + simp [*] + +def Array.subslice_mut (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := + Array.subslice_shared α n a r + +@[pspec] +theorem Array.subslice_mut_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) + (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : + ∃ s, subslice_mut α n a r = ret s ∧ + s.val = a.slice r.start.val r.end_.val ∧ + (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) + := subslice_shared_spec a r h0 h1 + +def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) := + -- TODO: not completely sure here + if h: r.start.val < r.end_.val ∧ r.end_.val ≤ a.length ∧ s.val.len = r.end_.val - r.start.val then + let s_beg := a.val.itake r.start.val + let s_end := a.val.idrop r.end_.val + have : s_beg.len = r.start.val := by + apply List.itake_len + . simp_all; scalar_tac + . scalar_tac + have : s_end.len = a.val.len - r.end_.val := by + apply List.idrop_len + . scalar_tac + . scalar_tac + let na := s_beg.append (s.val.append s_end) + have : na.len = a.val.len := by simp [*] + ret ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩ + else + fail panic + +-- TODO: it is annoying to write `.val` everywhere. We could leverage coercions, +-- but: some symbols like `+` are already overloaded to be notations for monadic +-- operations/ +-- We should introduce special symbols for the monadic arithmetic operations +-- (the use will never write those symbols directly). +@[pspec] +theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α) + (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) : + ∃ na, subslice_mut_back α n a r s = ret na ∧ + (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧ + (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = s.index (i - r.start.val)) ∧ + (∀ i, r.end_.val ≤ i → i < n.val → na.index i = a.index i) := by + simp [subslice_mut_back, *] + have h := List.replace_slice_index r.start.val r.end_.val a.val s.val + (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac) + simp [List.replace_slice] at h + have ⟨ h0, h1, h2 ⟩ := h + clear h + split_conjs + . intro i _ _ + have := h0 i (by int_tac) (by int_tac) + simp [*] + . intro i _ _ + have := h1 i (by int_tac) (by int_tac) + simp [*] + . intro i _ _ + have := h2 i (by int_tac) (by int_tac) + simp [*] + +def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := + -- TODO: not completely sure here + if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then + ret ⟨ s.val.slice r.start.val r.end_.val, + by + simp [← List.len_eq_length] + have := s.val.slice_len_le r.start.val r.end_.val + scalar_tac ⟩ + else + fail panic + +@[pspec] +theorem Slice.subslice_shared_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) + (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : + ∃ ns, subslice_shared α s r = ret ns ∧ + ns.val = s.slice r.start.val r.end_.val ∧ + (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i)) + := by + simp [subslice_shared, *] + intro i _ _ + have := List.index_slice r.start.val r.end_.val i s.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac) + simp [*] + +def Slice.subslice_mut (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := + Slice.subslice_shared α s r + +@[pspec] +theorem Slice.subslice_mut_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) + (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : + ∃ ns, subslice_mut α s r = ret ns ∧ + ns.val = s.slice r.start.val r.end_.val ∧ + (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i)) + := subslice_shared_spec s r h0 h1 + +attribute [pp_dot] List.len List.length List.index -- use the dot notation when printing +set_option pp.coercions false -- do not print coercions with ↑ (this doesn't parse) + +def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) := + -- TODO: not completely sure here + if h: r.start.val < r.end_.val ∧ r.end_.val ≤ s.length ∧ ss.val.len = r.end_.val - r.start.val then + let s_beg := s.val.itake r.start.val + let s_end := s.val.idrop r.end_.val + have : s_beg.len = r.start.val := by + apply List.itake_len + . simp_all; scalar_tac + . scalar_tac + have : s_end.len = s.val.len - r.end_.val := by + apply List.idrop_len + . scalar_tac + . scalar_tac + let ns := s_beg.append (ss.val.append s_end) + have : ns.len = s.val.len := by simp [*] + ret ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩ + else + fail panic + +@[pspec] +theorem Slice.subslice_mut_back_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α) + (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) : + ∃ na, subslice_mut_back α a r ss = ret na ∧ + (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧ + (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = ss.index (i - r.start.val)) ∧ + (∀ i, r.end_.val ≤ i → i < a.length → na.index i = a.index i) := by + simp [subslice_mut_back, *] + have h := List.replace_slice_index r.start.val r.end_.val a.val ss.val + (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac) + simp [List.replace_slice, *] at h + have ⟨ h0, h1, h2 ⟩ := h + clear h + split_conjs + . intro i _ _ + have := h0 i (by int_tac) (by int_tac) + simp [*] + . intro i _ _ + have := h1 i (by int_tac) (by int_tac) + simp [*] + . intro i _ _ + have := h2 i (by int_tac) (by int_tac) + simp [*] + +/- Trait declaration: [core::slice::index::private_slice_index::Sealed] -/ +structure core.slice.index.private_slice_index.Sealed (Self : Type) where + +/- Trait declaration: [core::slice::index::SliceIndex] -/ +structure core.slice.index.SliceIndex (Self T0 : Type) where + sealedInst :core.slice.index.private_slice_index.Sealed Self + Output : Type + get : Self → T0 → Result (Option Output) + get_mut : Self → T0 → Result (Option Output) + get_mut_back : Self → T0 → Option Output → Result T0 + get_unchecked : Self → ConstRawPtr T0 → Result (ConstRawPtr Output) + get_unchecked_mut : Self → MutRawPtr T0 → Result (MutRawPtr Output) + index : Self → T0 → Result Output + index_mut : Self → T0 → Result Output + index_mut_back : Self → T0 → Output → Result T0 + +/- [core::slice::index::[T]::index]: forward function -/ +def core.slice.index.Slice.index + (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) + (slice : Slice T0) (i : I) : Result inst.Output := do + let x ← inst.get i slice + match x with + | none => fail panic + | some x => ret x + +/- [core::slice::index::Range:::get]: forward function -/ +def core.slice.index.Range.get (T0 : Type) (i : Range Usize) (slice : Slice T0) : + Result (Option (Slice T0)) := + sorry -- TODO + +/- [core::slice::index::Range::get_mut]: forward function -/ +def core.slice.index.Range.get_mut + (T0 : Type) : Range Usize → Slice T0 → Result (Option (Slice T0)) := + sorry -- TODO + +/- [core::slice::index::Range::get_mut]: backward function 0 -/ +def core.slice.index.Range.get_mut_back + (T0 : Type) : + Range Usize → Slice T0 → Option (Slice T0) → Result (Slice T0) := + sorry -- TODO + +/- [core::slice::index::Range::get_unchecked]: forward function -/ +def core.slice.index.Range.get_unchecked + (T0 : Type) : + Range Usize → ConstRawPtr (Slice T0) → Result (ConstRawPtr (Slice T0)) := + -- Don't know what the model should be - for now we always fail to make + -- sure code which uses it fails + fun _ _ => fail panic + +/- [core::slice::index::Range::get_unchecked_mut]: forward function -/ +def core.slice.index.Range.get_unchecked_mut + (T0 : Type) : + Range Usize → MutRawPtr (Slice T0) → Result (MutRawPtr (Slice T0)) := + -- Don't know what the model should be - for now we always fail to make + -- sure code which uses it fails + fun _ _ => fail panic + +/- [core::slice::index::Range::index]: forward function -/ +def core.slice.index.Range.index + (T0 : Type) : Range Usize → Slice T0 → Result (Slice T0) := + sorry -- TODO + +/- [core::slice::index::Range::index_mut]: forward function -/ +def core.slice.index.Range.index_mut + (T0 : Type) : Range Usize → Slice T0 → Result (Slice T0) := + sorry -- TODO + +/- [core::slice::index::Range::index_mut]: backward function 0 -/ +def core.slice.index.Range.index_mut_back + (T0 : Type) : Range Usize → Slice T0 → Slice T0 → Result (Slice T0) := + sorry -- TODO + +/- [core::slice::index::[T]::index_mut]: forward function -/ +def core.slice.index.Slice.index_mut + (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) : + Slice T0 → I → Result inst.Output := + sorry -- TODO + +/- [core::slice::index::[T]::index_mut]: backward function 0 -/ +def core.slice.index.Slice.index_mut_back + (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) : + Slice T0 → I → inst.Output → Result (Slice T0) := + sorry -- TODO + +/- [core::array::[T; N]::index]: forward function -/ +def core.array.Array.index + (T0 I : Type) (N : Usize) (inst : core.ops.index.Index (Slice T0) I) : + Array T0 N → I → Result inst.Output := + sorry -- TODO + +/- [core::array::[T; N]::index_mut]: forward function -/ +def core.array.Array.index_mut + (T0 I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T0) I) : + Array T0 N → I → Result inst.indexInst.Output := + sorry -- TODO + +/- [core::array::[T; N]::index_mut]: backward function 0 -/ +def core.array.Array.index_mut_back + (T0 I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T0) I) : + Array T0 N → I → inst.indexInst.Output → Result (Array T0 N) := + sorry -- TODO + +/- Trait implementation: [core::slice::index::[T]] -/ +def core.slice.index.Slice.coreopsindexIndexInst (T0 I : Type) + (inst : core.slice.index.SliceIndex I (Slice T0)) : + core.ops.index.Index (Slice T0) I := { + Output := inst.Output + index := core.slice.index.Slice.index T0 I inst +} + +/- Trait implementation: [core::slice::index::private_slice_index::Range] -/ +def core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst + : core.slice.index.private_slice_index.Sealed (Range Usize) := {} + +/- Trait implementation: [core::slice::index::Range] -/ +def core.slice.index.Range.coresliceindexSliceIndexInst (T0 : Type) : + core.slice.index.SliceIndex (Range Usize) (Slice T0) := { + sealedInst := + core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst + Output := Slice T0 + get := core.slice.index.Range.get T0 + get_mut := core.slice.index.Range.get_mut T0 + get_mut_back := core.slice.index.Range.get_mut_back T0 + get_unchecked := core.slice.index.Range.get_unchecked T0 + get_unchecked_mut := core.slice.index.Range.get_unchecked_mut T0 + index := core.slice.index.Range.index T0 + index_mut := core.slice.index.Range.index_mut T0 + index_mut_back := core.slice.index.Range.index_mut_back T0 +} + +/- Trait implementation: [core::slice::index::[T]] -/ +def core.slice.index.Slice.coreopsindexIndexMutInst (T0 I : Type) + (inst : core.slice.index.SliceIndex I (Slice T0)) : + core.ops.index.IndexMut (Slice T0) I := { + indexInst := core.slice.index.Slice.coreopsindexIndexInst T0 I inst + index_mut := core.slice.index.Slice.index_mut T0 I inst + index_mut_back := core.slice.index.Slice.index_mut_back T0 I inst +} + +/- Trait implementation: [core::array::[T; N]] -/ +def core.array.Array.coreopsindexIndexInst (T0 I : Type) (N : Usize) + (inst : core.ops.index.Index (Slice T0) I) : + core.ops.index.Index (Array T0 N) I := { + Output := inst.Output + index := core.array.Array.index T0 I N inst +} + +/- Trait implementation: [core::array::[T; N]] -/ +def core.array.Array.coreopsindexIndexMutInst (T0 I : Type) (N : Usize) + (inst : core.ops.index.IndexMut (Slice T0) I) : + core.ops.index.IndexMut (Array T0 N) I := { + indexInst := core.array.Array.coreopsindexIndexInst T0 I N inst.indexInst + index_mut := core.array.Array.index_mut T0 I N inst + index_mut_back := core.array.Array.index_mut_back T0 I N inst +} + +end Primitives diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean index 10af8f67..7fc33251 100644 --- a/backends/lean/Base/Primitives/Base.lean +++ b/backends/lean/Base/Primitives/Base.lean @@ -127,4 +127,11 @@ def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := Use with `simp [ aeneas ]` -/ register_simp_attr aeneas +-- We don't really use raw pointers for now +structure MutRawPtr (T : Type) where + v : T + +structure ConstRawPtr (T : Type) where + v : T + end Primitives diff --git a/backends/lean/Base/Primitives/CoreOps.lean b/backends/lean/Base/Primitives/CoreOps.lean new file mode 100644 index 00000000..da458f66 --- /dev/null +++ b/backends/lean/Base/Primitives/CoreOps.lean @@ -0,0 +1,37 @@ +import Lean +import Base.Primitives.Base + +open Primitives +open Result + +namespace core.ops + +namespace index -- core.ops.index + +/- Trait declaration: [core::ops::index::Index] -/ +structure Index (Self Idx : Type) where + Output : Type + index : Self → Idx → Result Output + +/- Trait declaration: [core::ops::index::IndexMut] -/ +structure IndexMut (Self Idx : Type) where + indexInst : Index Self Idx + index_mut : Self → Idx → Result indexInst.Output + index_mut_back : Self → Idx → indexInst.Output → Result Self + +end index -- core.ops.index + +namespace deref -- core.ops.deref + +structure Deref (Self : Type) where + Target : Type + deref : Self → Result Target + +structure DerefMut (Self : Type) where + derefInst : Deref Self + deref_mut : Self → Result derefInst.Target + deref_mut_back : Self → derefInst.Target → Result Self + +end deref -- core.ops.deref + +end core.ops diff --git a/backends/lean/Base/Primitives/CoreOpsDeref.lean b/backends/lean/Base/Primitives/CoreOpsDeref.lean deleted file mode 100644 index 2b540012..00000000 --- a/backends/lean/Base/Primitives/CoreOpsDeref.lean +++ /dev/null @@ -1,18 +0,0 @@ -import Lean -import Base.Primitives.Base - -open Primitives -open Result - -namespace core.ops.deref - -structure Deref (Self : Type) where - Target : Type - deref : Self → Result Target - -structure DerefMut (Self : Type) where - derefInst : Deref Self - deref_mut : Self → Result derefInst.Target - deref_mut_back : Self → derefInst.Target → Result Self - -end core.ops.deref diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index c4c4d9f2..99fcedc6 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -6,7 +6,7 @@ import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith import Base.IList import Base.Primitives.Scalar -import Base.Primitives.Array +import Base.Primitives.ArraySlice import Base.Arith import Base.Progress.Base diff --git a/compiler/Extract.ml b/compiler/Extract.ml index afd722e5..6b6a2686 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -234,26 +234,20 @@ let assumed_adts () : (assumed_ty * string) list = (Array, "Array"); (Slice, "Slice"); (Str, "Str"); + (RawPtr Mut, "MutRawPtr"); + (RawPtr Const, "ConstRawPtr"); ] - | Coq | FStar -> + | Coq | FStar | HOL4 -> [ (State, "state"); (Result, "result"); (Error, "error"); - (Fuel, "nat"); - (Array, "array"); - (Slice, "slice"); - (Str, "str"); - ] - | HOL4 -> - [ - (State, "state"); - (Result, "result"); - (Error, "error"); - (Fuel, "num"); + (Fuel, if !backend = HOL4 then "num" else "nat"); (Array, "array"); (Slice, "slice"); (Str, "str"); + (RawPtr Mut, "mut_raw_ptr"); + (RawPtr Const, "const_raw_ptr"); ] let assumed_struct_constructors () : (assumed_ty * string) list = @@ -1378,7 +1372,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : let def_name = match info with | None -> ctx.fmt.type_name def.name - | Some info -> String.concat "." info.rust_name + | Some info -> info.extract_name in let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in (* Compute and register: @@ -4281,16 +4275,9 @@ let extract_trait_decl_method_names (ctx : extraction_ctx) string * (RegionGroupId.id option * string) list = let compute_fun_name (f : fun_decl) : RegionGroupId.id option * string = - (* We do something special: we use the base name but remove everything - but the crate (because [get_name] removes it) and the last ident. - This allows us to reuse the [ctx_compute_fun_decl] function. - *) - let basename : name = - match (f.basename : name) with - | Ident crate :: name -> - Ident crate :: [ Collections.List.last name ] - | _ -> raise (Failure "Unexpected") - in + (* We do something special to reuse the [ctx_compute_fun_decl] + function. TODO: make it cleaner. *) + let basename : name = [ Ident item_name ] in let f = { f with basename } in let trans = A.FunDeclId.Map.find f.def_id ctx.trans_funs in let name = ctx_compute_fun_name trans f ctx in @@ -4503,6 +4490,17 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) extract_generic_params ctx fmt TypeDeclId.Set.empty generics type_params cg_params trait_clauses; + (* Add the parent clauses as local clauses, so that we can refer to them *) + let ctx = + List.fold_left + (fun ctx clause -> + let item_name = + ctx_get_trait_parent_clause decl.def_id clause.clause_id ctx + in + ctx_add (LocalTraitClauseId clause.clause_id) item_name ctx) + ctx decl.generics.trait_clauses + in + F.pp_print_space fmt (); (match !backend with | Lean -> F.pp_print_string fmt "where" @@ -4522,6 +4520,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) ctx_get_trait_parent_clause decl.def_id 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/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 4c6fe014..c781463e 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -121,7 +121,7 @@ let builtin_types () : builtin_type_info list = rust_name = [ "alloc"; "alloc"; "Global" ]; extract_name = (match !backend with - | Lean -> "AllocGlobal" + | Lean -> "alloc.alloc.Global" | Coq | FStar | HOL4 -> "alloc_global"); keep_params = None; body_info = None; @@ -335,7 +335,7 @@ let builtin_funs () : rg = None; extract_name = (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_box_deref" + | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref" | Lean -> "alloc.boxed.Box.deref"); }; (* The backward function shouldn't be used *) @@ -343,7 +343,7 @@ let builtin_funs () : rg = rg0; extract_name = (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_back" + | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_back" | Lean -> "alloc.boxed.Box.deref_back"); }; ] ); @@ -354,7 +354,7 @@ let builtin_funs () : rg = None; extract_name = (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_mut" + | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_mut" | Lean -> "alloc.boxed.Box.deref_mut"); }; { @@ -365,6 +365,179 @@ let builtin_funs () : | Lean -> "alloc.boxed.Box.deref_mut_back"); }; ] ); + (* TODO: fix the same like "[T]" below *) + ( [ "core"; "slice"; "index"; "[T]"; "index" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Slice_index" + | Lean -> "core.slice.index.Slice.index"); + }; + (* The backward function shouldn't be used *) + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_back" + | Lean -> "core.slice.index.Slice.index_back"); + }; + ] ); + ( [ "core"; "slice"; "index"; "[T]"; "index_mut" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut" + | Lean -> "core.slice.index.Slice.index_mut"); + }; + (* The backward function shouldn't be used *) + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut_back" + | Lean -> "core.slice.index.Slice.index_mut_back"); + }; + ] ); + ( [ "core"; "array"; "[T; N]"; "index" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_array_Array_index" + | Lean -> "core.array.Array.index"); + }; + (* The backward function shouldn't be used *) + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_array_Array_index_back" + | Lean -> "core.array.Array.index_back"); + }; + ] ); + ( [ "core"; "array"; "[T; N]"; "index_mut" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_array_Array_index_mut" + | Lean -> "core.array.Array.index_mut"); + }; + (* The backward function shouldn't be used *) + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_array_Array_index_mut_back" + | Lean -> "core.array.Array.index_mut_back"); + }; + ] ); + ( [ "core"; "slice"; "index"; "Range"; "get" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_get" + | Lean -> "core.slice.index.Range.get"); + }; + (* The backward function shouldn't be used *) + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_get_back" + | Lean -> "core.slice.index.Range.get_back"); + }; + ] ); + ( [ "core"; "slice"; "index"; "Range"; "get_mut" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut" + | Lean -> "core.slice.index.Range.get_mut"); + }; + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut_back" + | Lean -> "core.slice.index.Range.get_mut_back"); + }; + ] ); + ( [ "core"; "slice"; "index"; "Range"; "index" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_index" + | Lean -> "core.slice.index.Range.index"); + }; + (* The backward function shouldn't be used *) + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_index_back" + | Lean -> "core.slice.index.Range.index_back"); + }; + ] ); + ( [ "core"; "slice"; "index"; "Range"; "index_mut" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut" + | Lean -> "core.slice.index.Range.index_mut"); + }; + { + rg = rg0; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut_back" + | Lean -> "core.slice.index.Range.index_mut_back"); + }; + ] ); + ( [ "core"; "slice"; "index"; "Range"; "get_unchecked" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked" + | Lean -> "core.slice.index.Range.get_unchecked"); + }; + ] ); + ( [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ], + None, + [ + { + rg = None; + extract_name = + (match !backend with + | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked_mut" + | Lean -> "core.slice.index.Range.get_unchecked_mut"); + }; + ] ); ] let mk_builtin_funs_map () = @@ -528,7 +701,7 @@ let builtin_trait_decls_info () = [ (match !backend with | Coq | FStar | HOL4 -> "index_inst" - | Lean -> "IndexInst"); + | Lean -> "indexInst"); ]; consts = []; types = []; @@ -547,6 +720,104 @@ let builtin_trait_decls_info () = ] ); ]; }; + { + (* Sealed *) + rust_name = "core::slice::index::private_slice_index::Sealed"; + extract_name = + (match !backend with + | Coq | FStar | HOL4 -> "core_slice_index_sealed" + | Lean -> "core.slice.index.private_slice_index.Sealed"); + parent_clauses = []; + consts = []; + types = []; + funs = []; + }; + { + (* SliceIndex *) + rust_name = "core::slice::index::SliceIndex"; + extract_name = + (match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex" + | Lean -> "core.slice.index.SliceIndex"); + parent_clauses = + [ + (match !backend with + | Coq | FStar | HOL4 -> "sealed_inst" + | Lean -> "sealedInst"); + ]; + consts = []; + types = + [ + ( "Output", + ( (match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_Output" + | Lean -> "Output"), + [] ) ); + ]; + funs = + [ + ( "get", + [ + ( None, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_get" + | Lean -> "get" ); + (* The backward function shouldn't be used *) + ( rg0, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_get_back" + | Lean -> "get_back" ); + ] ); + ( "get_mut", + [ + ( None, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_get_mut" + | Lean -> "get_mut" ); + ( rg0, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_get_mut_back" + | Lean -> "get_mut_back" ); + ] ); + ( "get_unchecked", + [ + ( None, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_get_unchecked" + | Lean -> "get_unchecked" ); + ] ); + ( "get_unchecked_mut", + [ + ( None, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_get_unchecked_mut" + | Lean -> "get_unchecked_mut" ); + ] ); + ( "index", + [ + ( None, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_index" + | Lean -> "index" ); + (* The backward function shouldn't be used *) + ( rg0, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_index_back" + | Lean -> "index_back" ); + ] ); + ( "index_mut", + [ + ( None, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_index_mut" + | Lean -> "index_mut" ); + ( rg0, + match !backend with + | Coq | FStar | HOL4 -> "core_SliceIndex_index_mut_back" + | Lean -> "index_mut_back" ); + ] ); + ]; + }; ] let mk_builtin_trait_decls_map () = @@ -577,6 +848,7 @@ end module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd) let builtin_trait_impls_info () : ((string list * string list) * string) list = + (* TODO: fix the names like "[T]" below *) [ (* core::ops::Deref> *) ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "Deref" ]), @@ -584,6 +856,28 @@ let builtin_trait_impls_info () : ((string list * string list) * string) list = (* core::ops::DerefMut> *) ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "DerefMut" ]), "alloc.boxed.Box.coreOpsDerefMutInst" ); + (* core::ops::index::Index<[T], I> *) + ( ([ "core"; "slice"; "index"; "[T]" ], [ "core"; "ops"; "index"; "Index" ]), + "core.slice.index.Slice.coreopsindexIndexInst" ); + (* core::slice::index::private_slice_index::Sealed> *) + ( ( [ "core"; "slice"; "index"; "private_slice_index"; "Range" ], + [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ), + "core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst" + ); + (* core::slice::index::SliceIndex, [T]> *) + ( ( [ "core"; "slice"; "index"; "Range" ], + [ "core"; "slice"; "index"; "SliceIndex" ] ), + "core.slice.index.Range.coresliceindexSliceIndexInst" ); + (* core::ops::index::IndexMut<[T], I> *) + ( ( [ "core"; "slice"; "index"; "[T]" ], + [ "core"; "ops"; "index"; "IndexMut" ] ), + "core.slice.index.Slice.coreopsindexIndexMutInst" ); + (* core::ops::index::Index<[T; N], I> *) + ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "Index" ]), + "core.array.Array.coreopsindexIndexInst" ); + (* core::ops::index::IndexMut<[T; N], I> *) + ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "IndexMut" ]), + "core.array.Array.coreopsindexIndexMutInst" ); ] let mk_builtin_trait_impls_map () = diff --git a/compiler/LlbcAstUtils.ml b/compiler/LlbcAstUtils.ml index 2553127a..0ab4ed94 100644 --- a/compiler/LlbcAstUtils.ml +++ b/compiler/LlbcAstUtils.ml @@ -13,14 +13,14 @@ let lookup_fun_name (fun_id : fun_id) (fun_decls : fun_decl FunDeclId.Map.t) : | Regular id -> (FunDeclId.Map.find id fun_decls).name | Assumed aid -> Assumed.get_assumed_fun_name aid -(** Return the opaque declarations found in the crate. +(** Return the opaque declarations found in the crate, which are also *not builtin*. [filter_assumed]: if [true], do not consider as opaque the external definitions that we will map to definitions from the standard library. Remark: the list of functions also contains the list of opaque global bodies. *) -let crate_get_opaque_decls (k : crate) (filter_assumed : bool) : +let crate_get_opaque_non_builtin_decls (k : crate) (filter_assumed : bool) : T.type_decl list * fun_decl list = let open ExtractBuiltin in let is_opaque_fun (d : fun_decl) : bool = @@ -30,14 +30,21 @@ let crate_get_opaque_decls (k : crate) (filter_assumed : bool) : (which don't have a body but must not be considered as opaque) *) && (match d.kind with TraitMethodDecl _ -> false | _ -> true) && ((not filter_assumed) - || not (SimpleNameMap.mem sname builtin_globals_map)) + || (not (SimpleNameMap.mem sname builtin_globals_map)) + && not (SimpleNameMap.mem sname (builtin_funs_map ()))) + in + let is_opaque_type (d : T.type_decl) : bool = + let sname = name_to_simple_name d.name in + d.kind = T.Opaque + && ((not filter_assumed) + || not (SimpleNameMap.mem sname (builtin_types_map ()))) in - let is_opaque_type (d : T.type_decl) : bool = d.kind = T.Opaque in (* Note that by checking the function bodies we also the globals *) ( List.filter is_opaque_type (T.TypeDeclId.Map.values k.types), List.filter is_opaque_fun (FunDeclId.Map.values k.functions) ) (** Return true if the crate contains opaque declarations, ignoring the assumed definitions. *) -let crate_has_opaque_decls (k : crate) (filter_assumed : bool) : bool = - crate_get_opaque_decls k filter_assumed <> ([], []) +let crate_has_opaque_non_builtin_decls (k : crate) (filter_assumed : bool) : + bool = + crate_get_opaque_non_builtin_decls k filter_assumed <> ([], []) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 35dff9e6..019a5c35 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -390,10 +390,10 @@ type gen_config = { [filter_assumed]: if [true], do not consider as opaque the external definitions that we will map to definitions from the standard library. *) -let crate_has_opaque_decls (ctx : gen_ctx) (filter_assumed : bool) : bool * bool - = +let crate_has_opaque_non_builtin_decls (ctx : gen_ctx) (filter_assumed : bool) : + bool * bool = let types, funs = - LlbcAstUtils.crate_get_opaque_decls ctx.crate filter_assumed + LlbcAstUtils.crate_get_opaque_non_builtin_decls ctx.crate filter_assumed in log#ldebug (lazy @@ -1257,7 +1257,9 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : (* Check if there are opaque types and functions - in which case we need * to split *) - let has_opaque_types, has_opaque_funs = crate_has_opaque_decls ctx true in + let has_opaque_types, has_opaque_funs = + crate_has_opaque_non_builtin_decls ctx true + in let has_opaque_types = has_opaque_types || !Config.use_state in (* Extract the types *) -- cgit v1.3.1 From 81b7a7d706bc1a0f2f57bc254a8af158039a10cf Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 25 Oct 2023 18:44:28 +0200 Subject: Make the hashmap files typecheck again in Lean --- Makefile | 6 +- backends/lean/Base/Primitives/ArraySlice.lean | 61 +- backends/lean/Base/Primitives/Range.lean | 2 +- backends/lean/Base/Primitives/Vec.lean | 74 +- backends/lean/Base/Progress/Progress.lean | 3 +- compiler/Extract.ml | 2500 ++----------------------- compiler/ExtractBase.ml | 2 + compiler/ExtractBuiltin.ml | 509 ++--- compiler/ExtractTypes.ml | 2390 +++++++++++++++++++++++ compiler/Pure.ml | 4 +- compiler/Translate.ml | 1 + compiler/dune | 1 + 12 files changed, 2778 insertions(+), 2775 deletions(-) create mode 100644 compiler/ExtractTypes.ml (limited to 'backends') diff --git a/Makefile b/Makefile index 2c996345..958ae8d7 100644 --- a/Makefile +++ b/Makefile @@ -142,7 +142,8 @@ tcoq-loops: OPTIONS += -use-fuel -no-split-files tlean-loops: SUBDIR := thol4-loops: SUBDIR := misc-loops -trans-hashmap: OPTIONS += -no-state -test-trans-units +# TODO: reactivate -test-trans-units +trans-hashmap: OPTIONS += -no-state trans-hashmap: SUBDIR := hashmap tfstar-hashmap: OPTIONS += -decreases-clauses -template-clauses tcoq-hashmap: OPTIONS += -use-fuel @@ -150,7 +151,8 @@ tlean-hashmap: SUBDIR := tlean-hashmap: OPTIONS += -no-gen-lib-entry # We add a custom import in the Hashmap.lean file: we do not want to overwrite it thol4-hashmap: OPTIONS += -trans-hashmap_main: OPTIONS += -test-trans-units +# TODO: reactivate -test-trans-units +trans-hashmap_main: OPTIONS += trans-hashmap_main: SUBDIR := hashmap_on_disk tfstar-hashmap_main: OPTIONS += -decreases-clauses -template-clauses tcoq-hashmap_main: OPTIONS += -use-fuel diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index 47807a0d..615e0783 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -13,7 +13,7 @@ import Base.Progress.Base namespace Primitives -open Result Error +open Result Error core.ops.range def Array (α : Type u) (n : Usize) := { l : List α // l.length = n.val } @@ -406,7 +406,7 @@ structure core.slice.index.private_slice_index.Sealed (Self : Type) where /- Trait declaration: [core::slice::index::SliceIndex] -/ structure core.slice.index.SliceIndex (Self T0 : Type) where - sealedInst :core.slice.index.private_slice_index.Sealed Self + sealedInst : core.slice.index.private_slice_index.Sealed Self Output : Type get : Self → T0 → Result (Option Output) get_mut : Self → T0 → Result (Option Output) @@ -557,4 +557,61 @@ def core.array.Array.coreopsindexIndexMutInst (T0 I : Type) (N : Usize) index_mut_back := core.array.Array.index_mut_back T0 I N inst } +/- [core::slice::index::usize::get]: forward function -/ +def core.slice.index.Usize.get + (T : Type) : Usize → Slice T → Result (Option T) := + sorry -- TODO + +/- [core::slice::index::usize::get_mut]: forward function -/ +def core.slice.index.Usize.get_mut + (T : Type) : Usize → Slice T → Result (Option T) := + sorry -- TODO + +/- [core::slice::index::usize::get_mut]: backward function 0 -/ +def core.slice.index.Usize.get_mut_back + (T : Type) : Usize → Slice T → Option T → Result (Slice T) := + sorry -- TODO + +/- [core::slice::index::usize::get_unchecked]: forward function -/ +def core.slice.index.Usize.get_unchecked + (T : Type) : Usize → ConstRawPtr (Slice T) → Result (ConstRawPtr T) := + sorry -- TODO + +/- [core::slice::index::usize::get_unchecked_mut]: forward function -/ +def core.slice.index.Usize.get_unchecked_mut + (T : Type) : Usize → MutRawPtr (Slice T) → Result (MutRawPtr T) := + sorry -- TODO + +/- [core::slice::index::usize::index]: forward function -/ +def core.slice.index.Usize.index (T : Type) : Usize → Slice T → Result T := + sorry -- TODO + +/- [core::slice::index::usize::index_mut]: forward function -/ +def core.slice.index.Usize.index_mut (T : Type) : Usize → Slice T → Result T := + sorry -- TODO + +/- [core::slice::index::usize::index_mut]: backward function 0 -/ +def core.slice.index.Usize.index_mut_back + (T : Type) : Usize → Slice T → T → Result (Slice T) := + sorry -- TODO + +/- Trait implementation: [core::slice::index::private_slice_index::usize] -/ +def core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst + : core.slice.index.private_slice_index.Sealed Usize := {} + +/- Trait implementation: [core::slice::index::usize] -/ +def core.slice.index.usize.coresliceindexSliceIndexInst (T : Type) : + core.slice.index.SliceIndex Usize (Slice T) := { + sealedInst := core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst + Output := T + get := core.slice.index.Usize.get T + get_mut := core.slice.index.Usize.get_mut T + get_mut_back := core.slice.index.Usize.get_mut_back T + get_unchecked := core.slice.index.Usize.get_unchecked T + get_unchecked_mut := core.slice.index.Usize.get_unchecked_mut T + index := core.slice.index.Usize.index T + index_mut := core.slice.index.Usize.index_mut T + index_mut_back := core.slice.index.Usize.index_mut_back T +} + end Primitives diff --git a/backends/lean/Base/Primitives/Range.lean b/backends/lean/Base/Primitives/Range.lean index 26cbee42..a268bcba 100644 --- a/backends/lean/Base/Primitives/Range.lean +++ b/backends/lean/Base/Primitives/Range.lean @@ -11,7 +11,7 @@ import Base.Progress.Base namespace Primitives -structure Range (α : Type u) where +structure core.ops.range.Range (α : Type u) where mk :: start: α end_: α diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index 99fcedc6..e1b7e87b 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -14,6 +14,8 @@ namespace Primitives open Result Error +namespace alloc.vec + def Vec (α : Type u) := { l : List α // l.length ≤ Usize.max } instance (a : Type u) : Arith.HasIntProp (Vec a) where @@ -79,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_shared (α : 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 @@ -90,51 +92,65 @@ def Vec.index_shared (α : Type u) (v: Vec α) (i: Usize) : Result α := -/ @[pspec] -theorem Vec.index_shared_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) +theorem Vec.index_usize_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by - simp only [index_shared] + ∃ 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 [*] --- This shouldn't be used -def Vec.index_back (α : Type u) (v: Vec α) (i: Usize) (_: α) : Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def Vec.index_mut (α : Type u) (v: Vec α) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - -@[pspec] -theorem Vec.index_mut_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by - simp only [index_mut] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - -def Vec.index_mut_back (α : 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 _ => .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ @[pspec] -theorem Vec.index_mut_back_spec {α : Type u} (v: Vec α) (i: Usize) (x : α) +theorem Vec.update_usize_spec {α : Type u} (v: Vec α) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.index_mut_back α i x = ret nv ∧ + ∃ nv, v.update_usize α i x = ret nv ∧ nv.val = v.val.update i.val x := by - simp only [index_mut_back] + simp only [update_usize] have h := List.indexOpt_bounds v.val i.val split . simp_all [length]; cases h <;> scalar_tac . simp_all +/- [alloc::vec::Vec::index]: forward function -/ +def Vec.index (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) + (self : Vec T) (i : I) : Result inst.Output := + sorry -- TODO + +/- [alloc::vec::Vec::index_mut]: forward function -/ +def Vec.index_mut (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) + (self : Vec T) (i : I) : Result inst.Output := + sorry -- TODO + +/- [alloc::vec::Vec::index_mut]: backward function 0 -/ +def Vec.index_mut_back + (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) + (self : Vec T) (i : I) (x : inst.Output) : Result (alloc.vec.Vec T) := + sorry -- TODO + +/- Trait implementation: [alloc::vec::Vec] -/ +def Vec.coreopsindexIndexInst (T I : Type) + (inst : core.slice.index.SliceIndex I (Slice T)) : + core.ops.index.Index (alloc.vec.Vec T) I := { + Output := inst.Output + index := Vec.index T I inst +} + +/- Trait implementation: [alloc::vec::Vec] -/ +def Vec.coreopsindexIndexMutInst (T I : Type) + (inst : core.slice.index.SliceIndex I (Slice T)) : + core.ops.index.IndexMut (alloc.vec.Vec T) I := { + indexInst := Vec.coreopsindexIndexInst T I inst + index_mut := Vec.index_mut T I inst + index_mut_back := Vec.index_mut_back T I inst +} + +end alloc.vec + end Primitives diff --git a/backends/lean/Base/Progress/Progress.lean b/backends/lean/Base/Progress/Progress.lean index ecf05dab..24c6f912 100644 --- a/backends/lean/Base/Progress/Progress.lean +++ b/backends/lean/Base/Progress/Progress.lean @@ -383,6 +383,7 @@ namespace Test -- #eval showStoredPSpec -- #eval showStoredPSpecClass -- #eval showStoredPSpecExprClass + open alloc.vec example {ty} {x y : Scalar ty} (hmin : Scalar.min ty ≤ x.val + y.val) @@ -408,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.index_mut_back α 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/compiler/Extract.ml b/compiler/Extract.ml index 6b6a2686..caa4835f 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -7,2370 +7,8 @@ open Pure open PureUtils open TranslateCore open ExtractBase -open StringUtils open Config -module F = Format - -(** Small helper to compute the name of an int type *) -let int_name (int_ty : integer_type) = - let isize, usize, i_format, u_format = - match !backend with - | FStar | Coq | HOL4 -> - ("isize", "usize", format_of_string "i%d", format_of_string "u%d") - | Lean -> ("Isize", "Usize", format_of_string "I%d", format_of_string "U%d") - in - match int_ty with - | Isize -> isize - | I8 -> Printf.sprintf i_format 8 - | I16 -> Printf.sprintf i_format 16 - | I32 -> Printf.sprintf i_format 32 - | I64 -> Printf.sprintf i_format 64 - | I128 -> Printf.sprintf i_format 128 - | Usize -> usize - | U8 -> Printf.sprintf u_format 8 - | U16 -> Printf.sprintf u_format 16 - | U32 -> Printf.sprintf u_format 32 - | U64 -> Printf.sprintf u_format 64 - | U128 -> Printf.sprintf u_format 128 - -(** Small helper to compute the name of a unary operation *) -let unop_name (unop : unop) : string = - match unop with - | Not -> ( - match !backend with FStar | Lean -> "not" | Coq -> "negb" | HOL4 -> "~") - | Neg (int_ty : integer_type) -> ( - match !backend with Lean -> "-" | _ -> int_name int_ty ^ "_neg") - | Cast _ -> - (* We never directly use the unop name in this case *) - raise (Failure "Unsupported") - -(** Small helper to compute the name of a binary operation (note that many - binary operations like "less than" are extracted to primitive operations, - like [<]). - *) -let named_binop_name (binop : E.binop) (int_ty : integer_type) : string = - let binop = - match binop with - | Div -> "div" - | Rem -> "rem" - | Add -> "add" - | Sub -> "sub" - | Mul -> "mul" - | Lt -> "lt" - | Le -> "le" - | Ge -> "ge" - | Gt -> "gt" - | BitXor -> "xor" - | BitAnd -> "and" - | BitOr -> "or" - | Shl -> "lsl" - | Shr -> - "asr" - (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *) - | _ -> raise (Failure "Unreachable") - in - (* Remark: the Lean case is actually not used *) - match !backend with - | Lean -> int_name int_ty ^ "." ^ binop - | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop - -(** A list of keywords/identifiers used by the backend and with which we - want to check collision. - - Remark: this is useful mostly to look for collisions when generating - names for *variables*. - *) -let keywords () = - let named_unops = - unop_name Not - :: List.map (fun it -> unop_name (Neg it)) T.all_signed_int_types - in - let named_binops = [ E.Div; Rem; Add; Sub; Mul ] in - let named_binops = - List.concat_map - (fun bn -> List.map (fun it -> named_binop_name bn it) T.all_int_types) - named_binops - in - let misc = - match !backend with - | FStar -> - [ - "assert"; - "assert_norm"; - "assume"; - "else"; - "fun"; - "fn"; - "FStar"; - "FStar.Mul"; - "if"; - "in"; - "include"; - "int"; - "let"; - "list"; - "match"; - "not"; - "open"; - "rec"; - "scalar_cast"; - "then"; - "type"; - "Type0"; - "Type"; - "unit"; - "val"; - "with"; - ] - | Coq -> - [ - "assert"; - "Arguments"; - "Axiom"; - "char_of_byte"; - "Check"; - "Declare"; - "Definition"; - "else"; - "End"; - "fun"; - "Fixpoint"; - "if"; - "in"; - "int"; - "Inductive"; - "Import"; - "let"; - "Lemma"; - "match"; - "Module"; - "not"; - "Notation"; - "Proof"; - "Qed"; - "rec"; - "Record"; - "Require"; - "Scope"; - "Search"; - "SearchPattern"; - "Set"; - "then"; - (* [tt] is unit *) - "tt"; - "type"; - "Type"; - "unit"; - "with"; - ] - | Lean -> - [ - "by"; - "class"; - "decreasing_by"; - "def"; - "deriving"; - "do"; - "else"; - "end"; - "for"; - "have"; - "if"; - "inductive"; - "instance"; - "import"; - "let"; - "macro"; - "match"; - "namespace"; - "opaque"; - "open"; - "run_cmd"; - "set_option"; - "simp"; - "structure"; - "syntax"; - "termination_by"; - "then"; - "Type"; - "unsafe"; - "where"; - "with"; - "opaque_defs"; - ] - | HOL4 -> - [ - "Axiom"; - "case"; - "Definition"; - "else"; - "End"; - "fix"; - "fix_exec"; - "fn"; - "fun"; - "if"; - "in"; - "int"; - "Inductive"; - "let"; - "of"; - "Proof"; - "QED"; - "then"; - "Theorem"; - ] - in - List.concat [ named_unops; named_binops; misc ] - -let assumed_adts () : (assumed_ty * string) list = - match !backend with - | Lean -> - [ - (State, "State"); - (Result, "Result"); - (Error, "Error"); - (Fuel, "Nat"); - (Array, "Array"); - (Slice, "Slice"); - (Str, "Str"); - (RawPtr Mut, "MutRawPtr"); - (RawPtr Const, "ConstRawPtr"); - ] - | Coq | FStar | HOL4 -> - [ - (State, "state"); - (Result, "result"); - (Error, "error"); - (Fuel, if !backend = HOL4 then "num" else "nat"); - (Array, "array"); - (Slice, "slice"); - (Str, "str"); - (RawPtr Mut, "mut_raw_ptr"); - (RawPtr Const, "const_raw_ptr"); - ] - -let assumed_struct_constructors () : (assumed_ty * string) list = - match !backend with - | Lean -> [ (Array, "Array.make") ] - | Coq -> [ (Array, "mk_array") ] - | FStar -> [ (Array, "mk_array") ] - | HOL4 -> [ (Array, "mk_array") ] - -let assumed_variants () : (assumed_ty * VariantId.id * string) list = - match !backend with - | FStar -> - [ - (Result, result_return_id, "Return"); - (Result, result_fail_id, "Fail"); - (Error, error_failure_id, "Failure"); - (Error, error_out_of_fuel_id, "OutOfFuel"); - (* No Fuel::Zero on purpose *) - (* No Fuel::Succ on purpose *) - ] - | Coq -> - [ - (Result, result_return_id, "Return"); - (Result, result_fail_id, "Fail_"); - (Error, error_failure_id, "Failure"); - (Error, error_out_of_fuel_id, "OutOfFuel"); - (Fuel, fuel_zero_id, "O"); - (Fuel, fuel_succ_id, "S"); - ] - | Lean -> - [ - (Result, result_return_id, "ret"); - (Result, result_fail_id, "fail"); - (Error, error_failure_id, "panic"); - (* No Fuel::Zero on purpose *) - (* No Fuel::Succ on purpose *) - ] - | HOL4 -> - [ - (Result, result_return_id, "Return"); - (Result, result_fail_id, "Fail"); - (Error, error_failure_id, "Failure"); - (* No Fuel::Zero on purpose *) - (* No Fuel::Succ on purpose *) - ] - -let assumed_llbc_functions () : - (A.assumed_fun_id * T.RegionGroupId.id option * string) list = - let rg0 = Some T.RegionGroupId.zero in - match !backend with - | FStar | Coq | HOL4 -> - [ - (ArrayIndexShared, None, "array_index_shared"); - (ArrayIndexMut, None, "array_index_mut_fwd"); - (ArrayIndexMut, rg0, "array_index_mut_back"); - (ArrayToSliceShared, None, "array_to_slice_shared"); - (ArrayToSliceMut, None, "array_to_slice_mut_fwd"); - (ArrayToSliceMut, rg0, "array_to_slice_mut_back"); - (ArrayRepeat, None, "array_repeat"); - (SliceIndexShared, None, "slice_index_shared"); - (SliceIndexMut, None, "slice_index_mut_fwd"); - (SliceIndexMut, rg0, "slice_index_mut_back"); - (SliceLen, None, "slice_len"); - ] - | Lean -> - [ - (ArrayIndexShared, None, "Array.index_shared"); - (ArrayIndexMut, None, "Array.index_mut"); - (ArrayIndexMut, rg0, "Array.index_mut_back"); - (ArrayToSliceShared, None, "Array.to_slice_shared"); - (ArrayToSliceMut, None, "Array.to_slice_mut"); - (ArrayToSliceMut, rg0, "Array.to_slice_mut_back"); - (ArrayRepeat, None, "Array.repeat"); - (SliceIndexShared, None, "Slice.index_shared"); - (SliceIndexMut, None, "Slice.index_mut"); - (SliceIndexMut, rg0, "Slice.index_mut_back"); - (SliceLen, None, "Slice.len"); - ] - -let assumed_pure_functions () : (pure_assumed_fun_id * string) list = - match !backend with - | FStar -> - [ - (Return, "return"); - (Fail, "fail"); - (Assert, "massert"); - (FuelDecrease, "decrease"); - (FuelEqZero, "is_zero"); - ] - | Coq -> - (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *) - [ (Return, "return_"); (Fail, "fail_"); (Assert, "massert") ] - | Lean -> - (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *) - [ (Return, "return"); (Fail, "fail_"); (Assert, "massert") ] - | HOL4 -> - (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *) - [ (Return, "return"); (Fail, "fail"); (Assert, "massert") ] - -let names_map_init () : names_map_init = - { - keywords = keywords (); - assumed_adts = assumed_adts (); - assumed_structs = assumed_struct_constructors (); - assumed_variants = assumed_variants (); - assumed_llbc_functions = assumed_llbc_functions (); - assumed_pure_functions = assumed_pure_functions (); - } - -let extract_unop (extract_expr : bool -> texpression -> unit) - (fmt : F.formatter) (inside : bool) (unop : unop) (arg : texpression) : unit - = - match unop with - | Not | Neg _ -> - let unop = unop_name unop in - if inside then F.pp_print_string fmt "("; - F.pp_print_string fmt unop; - F.pp_print_space fmt (); - extract_expr true arg; - if inside then F.pp_print_string fmt ")" - | Cast (src, tgt) -> ( - (* HOL4 has a special treatment: because it doesn't support dependent - types, we don't have a specific operator for the cast *) - match !backend with - | HOL4 -> - (* Casting, say, an u32 to an i32 would be done as follows: - {[ - mk_i32 (u32_to_int x) - ]} - *) - if inside then F.pp_print_string fmt "("; - F.pp_print_string fmt ("mk_" ^ int_name tgt); - F.pp_print_space fmt (); - F.pp_print_string fmt "("; - F.pp_print_string fmt (int_name src ^ "_to_int"); - F.pp_print_space fmt (); - extract_expr true arg; - F.pp_print_string fmt ")"; - if inside then F.pp_print_string fmt ")" - | FStar | Coq | Lean -> - (* Rem.: the source type is an implicit parameter *) - if inside then F.pp_print_string fmt "("; - let cast_str = - match !backend with - | Coq | FStar -> "scalar_cast" - | Lean -> (* TODO: I8.cast, I16.cast, etc.*) "Scalar.cast" - | HOL4 -> raise (Failure "Unreachable") - in - F.pp_print_string fmt cast_str; - F.pp_print_space fmt (); - if !backend <> Lean then ( - F.pp_print_string fmt - (StringUtils.capitalize_first_letter - (PrintPure.integer_type_to_string src)); - F.pp_print_space fmt ()); - if !backend = Lean then F.pp_print_string fmt ("." ^ int_name tgt) - else - F.pp_print_string fmt - (StringUtils.capitalize_first_letter - (PrintPure.integer_type_to_string tgt)); - F.pp_print_space fmt (); - extract_expr true arg; - if inside then F.pp_print_string fmt ")") - -(** [extract_expr] : the boolean argument is [inside] *) -let extract_binop (extract_expr : bool -> texpression -> unit) - (fmt : F.formatter) (inside : bool) (binop : E.binop) - (int_ty : integer_type) (arg0 : texpression) (arg1 : texpression) : unit = - if inside then F.pp_print_string fmt "("; - (* Some binary operations have a special notation depending on the backend *) - (match (!backend, binop) with - | HOL4, (Eq | Ne) - | (FStar | Coq | Lean), (Eq | Lt | Le | Ne | Ge | Gt) - | Lean, (Div | Rem | Add | Sub | Mul) -> - let binop = - match binop with - | Eq -> "=" - | Lt -> "<" - | Le -> "<=" - | Ne -> if !backend = Lean then "!=" else "<>" - | Ge -> ">=" - | Gt -> ">" - | Div -> "/" - | Rem -> "%" - | Add -> "+" - | Sub -> "-" - | Mul -> "*" - | _ -> raise (Failure "Unreachable") - in - let binop = - match !backend with FStar | Lean | HOL4 -> binop | Coq -> "s" ^ binop - in - extract_expr false arg0; - F.pp_print_space fmt (); - F.pp_print_string fmt binop; - F.pp_print_space fmt (); - extract_expr false arg1 - | _ -> - let binop = named_binop_name binop int_ty in - F.pp_print_string fmt binop; - F.pp_print_space fmt (); - extract_expr true arg0; - F.pp_print_space fmt (); - extract_expr true arg1); - if inside then F.pp_print_string fmt ")" - -let type_decl_kind_to_qualif (kind : decl_kind) - (type_kind : type_decl_kind option) : string option = - match !backend with - | FStar -> ( - match kind with - | SingleNonRec -> Some "type" - | SingleRec -> Some "type" - | MutRecFirst -> Some "type" - | MutRecInner -> Some "and" - | MutRecLast -> Some "and" - | Assumed -> Some "assume type" - | Declared -> Some "val") - | Coq -> ( - match (kind, type_kind) with - | SingleNonRec, Some Enum -> Some "Inductive" - | SingleNonRec, Some Struct -> Some "Record" - | (SingleRec | MutRecFirst), Some _ -> Some "Inductive" - | (MutRecInner | MutRecLast), Some _ -> - (* Coq doesn't support groups of mutually recursive definitions which mix - * records and inducties: we convert everything to records if this happens - *) - Some "with" - | (Assumed | Declared), None -> Some "Axiom" - | SingleNonRec, None -> - (* This is for traits *) - Some "Record" - | _ -> - raise - (Failure - ("Unexpected: (" ^ show_decl_kind kind ^ ", " - ^ Print.option_to_string show_type_decl_kind type_kind - ^ ")"))) - | Lean -> ( - match kind with - | SingleNonRec -> - if type_kind = Some Struct then Some "structure" else Some "inductive" - | SingleRec -> Some "inductive" - | MutRecFirst -> Some "inductive" - | MutRecInner -> Some "inductive" - | MutRecLast -> Some "inductive" - | Assumed -> Some "axiom" - | Declared -> Some "axiom") - | HOL4 -> None - -let fun_decl_kind_to_qualif (kind : decl_kind) : string option = - match !backend with - | FStar -> ( - match kind with - | SingleNonRec -> Some "let" - | SingleRec -> Some "let rec" - | MutRecFirst -> Some "let rec" - | MutRecInner -> Some "and" - | MutRecLast -> Some "and" - | Assumed -> Some "assume val" - | Declared -> Some "val") - | Coq -> ( - match kind with - | SingleNonRec -> Some "Definition" - | SingleRec -> Some "Fixpoint" - | MutRecFirst -> Some "Fixpoint" - | MutRecInner -> Some "with" - | MutRecLast -> Some "with" - | Assumed -> Some "Axiom" - | Declared -> Some "Axiom") - | Lean -> ( - match kind with - | SingleNonRec -> Some "def" - | SingleRec -> Some "divergent def" - | MutRecFirst -> Some "mutual divergent def" - | MutRecInner -> Some "divergent def" - | MutRecLast -> Some "divergent def" - | Assumed -> Some "axiom" - | Declared -> Some "axiom") - | HOL4 -> None - -(** The type of types. - - TODO: move inside the formatter? - *) -let type_keyword () = - match !backend with - | FStar -> "Type0" - | Coq | Lean -> "Type" - | HOL4 -> raise (Failure "Unexpected") - -(** - [ctx]: we use the context to lookup type definitions, to retrieve type names. - This is used to compute variable names, when they have no basenames: in this - case we use the first letter of the type name. - - [variant_concatenate_type_name]: if true, add the type name as a prefix - to the variant names. - Ex.: - In Rust: - {[ - enum List = { - Cons(u32, Box),x - Nil, - } - ]} - - F*, if option activated: - {[ - type list = - | ListCons : u32 -> list -> list - | ListNil : list - ]} - - F*, if option not activated: - {[ - type list = - | Cons : u32 -> list -> list - | Nil : list - ]} - - Rk.: this should be true by default, because in Rust all the variant names - are actively uniquely identifier by the type name [List::Cons(...)], while - in other languages it is not necessarily the case, and thus clashes can mess - up type checking. Note that some languages actually forbids the name clashes - (it is the case of F* ). - *) -let mk_formatter (ctx : trans_ctx) (crate_name : string) - (variant_concatenate_type_name : bool) : formatter = - let int_name = int_name in - - (* Prepare a name. - * The first id elem is always the crate: if it is the local crate, - * we remove it. - * We also remove all the disambiguators, then convert everything to strings. - * **Rmk:** because we remove the disambiguators, there may be name collisions - * (which is ok, because we check for name collisions and fail if there is any). - *) - let get_name (name : name) : string list = - (* Rmk.: initially we only filtered the disambiguators equal to 0 *) - let name = Names.filter_disambiguators name in - match name with - | Ident crate :: name -> - let name = if crate = crate_name then name else Ident crate :: name in - let name = - List.map - (function - | Names.Ident s -> s - | Disambiguator d -> Names.Disambiguator.to_string d) - name - in - name - | _ -> - raise (Failure ("Unexpected name shape: " ^ Print.name_to_string name)) - in - let flatten_name (name : string list) : string = - match !backend with - | FStar | Coq | HOL4 -> String.concat "_" name - | Lean -> String.concat "." name - in - let get_type_name = get_name in - let type_name_to_camel_case name = - let name = get_type_name name in - let name = List.map to_camel_case name in - String.concat "" name - in - let type_name_to_snake_case name = - let name = get_type_name name in - let name = List.map to_snake_case name in - let name = String.concat "_" name in - match !backend with - | FStar | Lean | HOL4 -> name - | Coq -> capitalize_first_letter name - in - let type_name name = - match !backend with - | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_t" - | Lean -> String.concat "." (get_type_name name) - in - let field_name (def_name : name) (field_id : FieldId.id) - (field_name : string option) : string = - let field_name_s = - match field_name with - | Some field_name -> field_name - | None -> - (* TODO: extract structs with no field names to tuples *) - FieldId.to_string field_id - in - if !Config.record_fields_short_names then - if field_name = None then (* TODO: this is a bit ugly *) - "_" ^ field_name_s - else field_name_s - else - let def_name = type_name_to_snake_case def_name ^ "_" in - def_name ^ field_name_s - in - let variant_name (def_name : name) (variant : string) : string = - match !backend with - | FStar | Coq | HOL4 -> - let variant = to_camel_case variant in - if variant_concatenate_type_name then - type_name_to_camel_case def_name ^ variant - else variant - | Lean -> variant - in - let struct_constructor (basename : name) : string = - let tname = type_name basename in - let prefix = - match !backend with FStar -> "Mk" | Coq | HOL4 -> "mk" | Lean -> "" - in - let suffix = - match !backend with FStar | Coq | HOL4 -> "" | Lean -> ".mk" - in - prefix ^ tname ^ suffix - in - let get_fun_name fname = - let fname = get_name fname in - (* TODO: don't convert to snake case for Coq, HOL4, F* *) - flatten_name fname - in - let global_name (name : global_name) : string = - (* Converting to snake case also lowercases the letters (in Rust, global - * names are written in capital letters). *) - let parts = List.map to_snake_case (get_name name) in - String.concat "_" parts - in - let fun_name (fname : fun_name) (num_loops : int) (loop_id : LoopId.id option) - (num_rgs : int) (rg : region_group_info option) (filter_info : bool * int) - : string = - let fname = get_fun_name fname in - (* Compute the suffix *) - let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in - (* Concatenate *) - fname ^ suffix - in - - let trait_decl_name (trait_decl : trait_decl) : string = - type_name trait_decl.name - in - - let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) : - string = - (* TODO: provisional: we concatenate the trait impl name (which is its type) - with the trait decl name *) - let trait_decl = - let name = trait_decl.name in - match !backend with - | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_inst" - | Lean -> String.concat "" (get_type_name name) ^ "Inst" - in - flatten_name (get_type_name trait_impl.name @ [ trait_decl ]) - in - - let trait_parent_clause_name (trait_decl : trait_decl) (clause : trait_clause) - : string = - (* TODO: improve - it would be better to not use indices *) - let clause = "parent_clause_" ^ TraitClauseId.to_string clause.clause_id in - if !Config.record_fields_short_names then clause - else trait_decl_name trait_decl ^ "_" ^ clause - in - let trait_type_name (trait_decl : trait_decl) (item : string) : string = - if !Config.record_fields_short_names then item - else trait_decl_name trait_decl ^ "_" ^ item - in - let trait_const_name (trait_decl : trait_decl) (item : string) : string = - if !Config.record_fields_short_names then item - else trait_decl_name trait_decl ^ "_" ^ item - in - let trait_method_name (trait_decl : trait_decl) (item : string) : string = - if !Config.record_fields_short_names then item - else trait_decl_name trait_decl ^ "_" ^ item - in - let trait_type_clause_name (trait_decl : trait_decl) (item : string) - (clause : trait_clause) : string = - (* TODO: improve - it would be better to not use indices *) - trait_type_name trait_decl item - ^ "_clause_" - ^ TraitClauseId.to_string clause.clause_id - in - - let termination_measure_name (_fid : A.FunDeclId.id) (fname : fun_name) - (num_loops : int) (loop_id : LoopId.id option) : string = - let fname = get_fun_name fname in - let lp_suffix = default_fun_loop_suffix num_loops loop_id in - (* Compute the suffix *) - let suffix = - match !Config.backend with - | FStar -> "_decreases" - | Lean -> "_terminates" - | Coq | HOL4 -> raise (Failure "Unexpected") - in - (* Concatenate *) - fname ^ lp_suffix ^ suffix - in - - let decreases_proof_name (_fid : A.FunDeclId.id) (fname : fun_name) - (num_loops : int) (loop_id : LoopId.id option) : string = - let fname = get_fun_name fname in - let lp_suffix = default_fun_loop_suffix num_loops loop_id in - (* Compute the suffix *) - let suffix = - match !Config.backend with - | Lean -> "_decreases" - | FStar | Coq | HOL4 -> raise (Failure "Unexpected") - in - (* Concatenate *) - fname ^ lp_suffix ^ suffix - in - - let var_basename (_varset : StringSet.t) (basename : string option) (ty : ty) - : string = - (* Small helper to derive var names from ADT type names. - - We do the following: - - convert the type name to snake case - - take the first letter of every "letter group" - Ex.: "HashMap" -> "hash_map" -> "hm" - *) - let name_from_type_ident (name : string) : string = - let cl = to_snake_case name in - let cl = String.split_on_char '_' cl in - let cl = List.filter (fun s -> String.length s > 0) cl in - assert (List.length cl > 0); - let cl = List.map (fun s -> s.[0]) cl in - StringUtils.string_of_chars cl - in - (* If there is a basename, we use it *) - match basename with - | Some basename -> - (* This should be a no-op *) - to_snake_case basename - | None -> ( - (* No basename: we use the first letter of the type *) - match ty with - | Adt (type_id, generics) -> ( - match type_id with - | Tuple -> - (* The "pair" case is frequent enough to have its special treatment *) - if List.length generics.types = 2 then "p" else "t" - | Assumed Result -> "r" - | Assumed Error -> ConstStrings.error_basename - | Assumed Fuel -> ConstStrings.fuel_basename - | Assumed Array -> "a" - | Assumed Slice -> "s" - | Assumed Str -> "s" - | Assumed State -> ConstStrings.state_basename - | Assumed (RawPtr _) -> "p" - | AdtId adt_id -> - let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in - (* Derive the var name from the last ident of the type name - * Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm" - *) - (* The name shouldn't be empty, and its last element should - * be an ident *) - let cl = List.nth def.name (List.length def.name - 1) in - name_from_type_ident (Names.as_ident cl)) - | TypeVar _ -> ( - (* TODO: use "t" also for F* *) - match !backend with - | FStar -> "x" (* lacking inspiration here... *) - | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *)) - | Literal lty -> ( - match lty with Bool -> "b" | Char -> "c" | Integer _ -> "i") - | Arrow _ -> "f" - | TraitType (_, _, name) -> name_from_type_ident name) - in - let type_var_basename (_varset : StringSet.t) (basename : string) : string = - (* Rust type variables are snake-case and start with a capital letter *) - match !backend with - | FStar -> - (* This is *not* a no-op: this removes the capital letter *) - to_snake_case basename - | HOL4 -> - (* In HOL4, type variable names must start with "'" *) - "'" ^ to_snake_case basename - | Coq | Lean -> basename - in - let const_generic_var_basename (_varset : StringSet.t) (basename : string) : - string = - (* Rust type variables are snake-case and start with a capital letter *) - match !backend with - | FStar | HOL4 -> - (* This is *not* a no-op: this removes the capital letter *) - to_snake_case basename - | Coq | Lean -> basename - in - let trait_clause_basename (_varset : StringSet.t) (_clause : trait_clause) : - string = - (* TODO: actually use the clause to derive the name *) - "inst" - in - let trait_self_clause_basename = "self_clause" in - let append_index (basename : string) (i : int) : string = - basename ^ string_of_int i - in - - let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit - = - match cv with - | Scalar sv -> ( - match !backend with - | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value) - | Coq | HOL4 | Lean -> - let print_brackets = inside && !backend = HOL4 in - if print_brackets then F.pp_print_string fmt "("; - (match !backend with - | Coq | Lean -> () - | HOL4 -> - F.pp_print_string fmt ("int_to_" ^ int_name sv.PV.int_ty); - F.pp_print_space fmt () - | _ -> raise (Failure "Unreachable")); - (* We need to add parentheses if the value is negative *) - if sv.PV.value >= Z.of_int 0 then - F.pp_print_string fmt (Z.to_string sv.PV.value) - else if !backend = Lean then - (* TODO: parsing issues with Lean because there are ambiguous - interpretations between int values and nat values *) - F.pp_print_string fmt - ("(-(" ^ Z.to_string (Z.neg sv.PV.value) ^ ":Int))") - else F.pp_print_string fmt ("(" ^ Z.to_string sv.PV.value ^ ")"); - (match !backend with - | Coq -> - let iname = int_name sv.PV.int_ty in - F.pp_print_string fmt ("%" ^ iname) - | Lean -> - let iname = String.lowercase_ascii (int_name sv.PV.int_ty) in - F.pp_print_string fmt ("#" ^ iname) - | HOL4 -> () - | _ -> raise (Failure "Unreachable")); - if print_brackets then F.pp_print_string fmt ")") - | Bool b -> - let b = - match !backend with - | HOL4 -> if b then "T" else "F" - | Coq | FStar | Lean -> if b then "true" else "false" - in - F.pp_print_string fmt b - | Char c -> ( - match !backend with - | HOL4 -> - (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *) - F.pp_print_string fmt ("#\"" ^ String.make 1 c ^ "\"") - | FStar | Lean -> F.pp_print_string fmt ("'" ^ String.make 1 c ^ "'") - | Coq -> - if inside then F.pp_print_string fmt "("; - F.pp_print_string fmt "char_of_byte"; - F.pp_print_space fmt (); - (* Convert the the char to ascii *) - let c = - let i = Char.code c in - let x0 = i / 16 in - let x1 = i mod 16 in - "Coq.Init.Byte.x" ^ string_of_int x0 ^ string_of_int x1 - in - F.pp_print_string fmt c; - if inside then F.pp_print_string fmt ")") - in - let bool_name = if !backend = Lean then "Bool" else "bool" in - let char_name = if !backend = Lean then "Char" else "char" in - let str_name = if !backend = Lean then "String" else "string" in - { - bool_name; - char_name; - int_name; - str_name; - type_decl_kind_to_qualif; - fun_decl_kind_to_qualif; - field_name; - variant_name; - struct_constructor; - type_name; - global_name; - fun_name; - termination_measure_name; - decreases_proof_name; - trait_decl_name; - trait_impl_name; - trait_parent_clause_name; - trait_const_name; - trait_type_name; - trait_method_name; - trait_type_clause_name; - var_basename; - type_var_basename; - const_generic_var_basename; - trait_self_clause_basename; - trait_clause_basename; - append_index; - extract_literal; - extract_unop; - extract_binop; - } - -let mk_formatter_and_names_map (ctx : trans_ctx) (crate_name : string) - (variant_concatenate_type_name : bool) : formatter * names_map = - let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in - let names_map = initialize_names_map fmt (names_map_init ()) in - (fmt, names_map) - -let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool = - match dg with [ d ] -> d.body = None | _ -> false - -let is_single_opaque_type_decl_group (dg : Pure.type_decl list) : bool = - match dg with [ d ] -> d.kind = Opaque | _ -> false - -let is_empty_record_type_decl (d : Pure.type_decl) : bool = d.kind = Struct [] - -let is_empty_record_type_decl_group (dg : Pure.type_decl list) : bool = - match dg with [ d ] -> is_empty_record_type_decl d | _ -> false - -(** In some provers, groups of definitions must be delimited. - - - in Coq, *every* group (including singletons) must end with "." - - in Lean, groups of mutually recursive definitions must end with "end" - - in HOL4 (in most situations) the whole group must be within a `Define` command - - Calls to {!extract_fun_decl} should be inserted between calls to - {!start_fun_decl_group} and {!end_fun_decl_group}. - - TODO: maybe those [{start/end}_decl_group] functions are not that much a good - idea and we should merge them with the corresponding [extract_decl] functions. - *) -let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter) - (is_rec : bool) (dg : Pure.fun_decl list) = - match !backend with - | FStar | Coq | Lean -> () - | HOL4 -> - (* In HOL4, opaque functions have a special treatment *) - if is_single_opaque_fun_decl_group dg then () - else - let compute_fun_def_name (def : Pure.fun_decl) : string = - ctx_get_local_function def.def_id def.loop_id def.back_id ctx ^ "_def" - in - let names = List.map compute_fun_def_name dg in - (* Add a break before *) - F.pp_print_break fmt 0 0; - (* Open the box for the delimiters *) - F.pp_open_vbox fmt 0; - (* Open the box for the definitions themselves *) - F.pp_open_vbox fmt ctx.indent_incr; - (* Print the delimiters *) - if is_rec then - F.pp_print_string fmt - ("val [" ^ String.concat ", " names ^ "] = DefineDiv ‘") - else ( - assert (List.length names = 1); - let name = List.hd names in - F.pp_print_string fmt ("val " ^ name ^ " = Define ‘")); - F.pp_print_cut fmt () - -(** See {!start_fun_decl_group}. *) -let end_fun_decl_group (fmt : F.formatter) (is_rec : bool) - (dg : Pure.fun_decl list) = - match !backend with - | FStar -> () - | Coq -> - (* For aesthetic reasons, we print the Coq end group delimiter directly - in {!extract_fun_decl}. *) - () - | Lean -> - (* We must add the "end" keyword to groups of mutually recursive functions *) - if is_rec && List.length dg > 1 then ( - F.pp_print_cut fmt (); - F.pp_print_string fmt "end"; - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0) - else () - | HOL4 -> - (* In HOL4, opaque functions have a special treatment *) - if is_single_opaque_fun_decl_group dg then () - else ( - (* Close the box for the definitions *) - F.pp_close_box fmt (); - (* Print the end delimiter *) - F.pp_print_cut fmt (); - F.pp_print_string fmt "’"; - (* Close the box for the delimiters *) - F.pp_close_box fmt (); - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0) - -(** See {!start_fun_decl_group}: similar usage, but for the type declarations. *) -let start_type_decl_group (ctx : extraction_ctx) (fmt : F.formatter) - (is_rec : bool) (dg : Pure.type_decl list) = - match !backend with - | FStar | Coq -> () - | Lean -> - if is_rec && List.length dg > 1 then ( - F.pp_print_space fmt (); - F.pp_print_string fmt "mutual"; - F.pp_print_space fmt ()) - | HOL4 -> - (* In HOL4, opaque types and empty records have a special treatment *) - if - is_single_opaque_type_decl_group dg - || is_empty_record_type_decl_group dg - then () - else ( - (* Add a break before *) - F.pp_print_break fmt 0 0; - (* Open the box for the delimiters *) - F.pp_open_vbox fmt 0; - (* Open the box for the definitions themselves *) - F.pp_open_vbox fmt ctx.indent_incr; - (* Print the delimiters *) - F.pp_print_string fmt "Datatype:"; - F.pp_print_cut fmt ()) - -(** See {!start_fun_decl_group}. *) -let end_type_decl_group (fmt : F.formatter) (is_rec : bool) - (dg : Pure.type_decl list) = - match !backend with - | FStar -> () - | Coq -> - (* For aesthetic reasons, we print the Coq end group delimiter directly - in {!extract_fun_decl}. *) - () - | Lean -> - (* We must add the "end" keyword to groups of mutually recursive functions *) - if is_rec && List.length dg > 1 then ( - F.pp_print_cut fmt (); - F.pp_print_string fmt "end"; - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0) - else () - | HOL4 -> - (* In HOL4, opaque types and empty records have a special treatment *) - if - is_single_opaque_type_decl_group dg - || is_empty_record_type_decl_group dg - then () - else ( - (* Close the box for the definitions *) - F.pp_close_box fmt (); - (* Print the end delimiter *) - F.pp_print_cut fmt (); - F.pp_print_string fmt "End"; - (* Close the box for the delimiters *) - F.pp_close_box fmt (); - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0) - -let unit_name () = - match !backend with Lean -> "Unit" | Coq | FStar | HOL4 -> "unit" - -(** Small helper *) -let extract_arrow (fmt : F.formatter) () : unit = - if !Config.backend = Lean then F.pp_print_string fmt "→" - else F.pp_print_string fmt "->" - -let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter) - (inside : bool) (cg : const_generic) : unit = - match cg with - | ConstGenericGlobal id -> - let s = ctx_get_global id ctx in - F.pp_print_string fmt s - | ConstGenericValue v -> ctx.fmt.extract_literal fmt inside v - | ConstGenericVar id -> - let s = ctx_get_const_generic_var id ctx in - F.pp_print_string fmt s - -let extract_literal_type (ctx : extraction_ctx) (fmt : F.formatter) - (ty : literal_type) : unit = - match ty with - | Bool -> F.pp_print_string fmt ctx.fmt.bool_name - | Char -> F.pp_print_string fmt ctx.fmt.char_name - | Integer int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty) - -(** [inside] constrols whether we should add parentheses or not around type - applications (if [true] we add parentheses). - - [no_params_tys]: for all the types inside this set, do not print the type parameters. - This is used for HOL4. As polymorphism is uniform in HOL4, printing the - type parameters in the recursive definitions is useless (and actually - forbidden). - - For instance, where in F* we would write: - {[ - type list a = | Nil : list a | Cons : a -> list a -> list a - ]} - - In HOL4 we would simply write: - {[ - Datatype: - list = Nil 'a | Cons 'a list - End - ]} - *) -let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit = - let extract_rec = extract_ty ctx fmt no_params_tys in - match ty with - | Adt (type_id, generics) -> ( - let has_params = generics <> empty_generic_args in - match type_id with - | Tuple -> - (* This is a bit annoying, but in F*/Coq/HOL4 [()] is not the unit type: - * we have to write [unit]... *) - if generics.types = [] then F.pp_print_string fmt (unit_name ()) - else ( - F.pp_print_string fmt "("; - Collections.List.iter_link - (fun () -> - F.pp_print_space fmt (); - let product = - match !backend with - | FStar -> "&" - | Coq -> "*" - | Lean -> "×" - | HOL4 -> "#" - in - F.pp_print_string fmt product; - F.pp_print_space fmt ()) - (extract_rec true) generics.types; - F.pp_print_string fmt ")") - | AdtId _ | Assumed _ -> ( - (* HOL4 behaves differently. Where in Coq/FStar/Lean we would write: - `tree a b` - - In HOL4 we would write: - `('a, 'b) tree` - *) - match !backend with - | FStar | Coq | Lean -> - let print_paren = inside && has_params in - if print_paren then F.pp_print_string fmt "("; - (* TODO: for now, only the opaque *functions* are extracted in the - opaque module. The opaque *types* are assumed. *) - F.pp_print_string fmt (ctx_get_type type_id ctx); - (* We might need to filter the type arguments, if the type - is builtin (for instance, we filter the global allocator type - argument for `Vec`). *) - let generics = - match type_id with - | AdtId id -> ( - match - TypeDeclId.Map.find_opt id ctx.types_filter_type_args_map - with - | None -> generics - | Some filter -> - let types = List.combine filter generics.types in - let types = - List.filter_map - (fun (b, ty) -> if b then Some ty else None) - types - in - { generics with types }) - | _ -> generics - in - extract_generic_args ctx fmt no_params_tys generics; - if print_paren then F.pp_print_string fmt ")" - | HOL4 -> - let { types; const_generics; trait_refs } = generics in - (* Const generics are not supported in HOL4 *) - assert (const_generics = []); - let print_tys = - match type_id with - | AdtId id -> not (TypeDeclId.Set.mem id no_params_tys) - | Assumed _ -> true - | _ -> raise (Failure "Unreachable") - in - if types <> [] && print_tys then ( - let print_paren = List.length types > 1 in - if print_paren then F.pp_print_string fmt "("; - Collections.List.iter_link - (fun () -> - F.pp_print_string fmt ","; - F.pp_print_space fmt ()) - (extract_rec true) types; - if print_paren then F.pp_print_string fmt ")"; - F.pp_print_space fmt ()); - F.pp_print_string fmt (ctx_get_type type_id ctx); - if trait_refs <> [] then ( - F.pp_print_space fmt (); - Collections.List.iter_link (F.pp_print_space fmt) - (extract_trait_ref ctx fmt no_params_tys true) - trait_refs))) - | TypeVar vid -> F.pp_print_string fmt (ctx_get_type_var vid ctx) - | Literal lty -> extract_literal_type ctx fmt lty - | Arrow (arg_ty, ret_ty) -> - if inside then F.pp_print_string fmt "("; - extract_rec false arg_ty; - F.pp_print_space fmt (); - extract_arrow fmt (); - F.pp_print_space fmt (); - extract_rec false ret_ty; - if inside then F.pp_print_string fmt ")" - | TraitType (trait_ref, generics, type_name) -> - if !parameterize_trait_types then raise (Failure "Unimplemented") - else if trait_ref.trait_id <> Self then ( - (* HOL4 doesn't have 1st class types *) - assert (!backend <> HOL4); - let use_brackets = generics <> empty_generic_args in - if use_brackets then F.pp_print_string fmt "("; - extract_trait_ref ctx fmt no_params_tys false trait_ref; - extract_generic_args ctx fmt no_params_tys generics; - let name = - ctx_get_trait_type trait_ref.trait_decl_ref.trait_decl_id type_name - ctx - in - if use_brackets then F.pp_print_string fmt ")"; - F.pp_print_string fmt ("." ^ name)) - else - (* There are two situations: - - we are extracting a declared item (typically a function signature) - for a trait declaration. We directly refer to the item (we extract - trait declarations as structures, so we can refer to their fields) - - we are extracting a provided method for a trait declaration. We - refer to the item in the self trait clause (see {!SelfTraitClauseId}). - - Remark: we can't get there for trait *implementations* because then the - types should have been normalized. - *) - let trait_decl_id = Option.get ctx.trait_decl_id in - let item_name = ctx_get_trait_type trait_decl_id type_name ctx in - assert (generics = empty_generic_args); - if ctx.is_provided_method then - (* Provided method: use the trait self clause *) - let self_clause = ctx_get_trait_self_clause ctx in - F.pp_print_string fmt (self_clause ^ "." ^ item_name) - else - (* Declaration: directly refer to the item *) - F.pp_print_string fmt item_name - -and extract_trait_ref (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit = - let use_brackets = tr.generics <> empty_generic_args && inside in - if use_brackets then F.pp_print_string fmt "("; - extract_trait_instance_id ctx fmt no_params_tys inside tr.trait_id; - extract_generic_args ctx fmt no_params_tys tr.generics; - if use_brackets then F.pp_print_string fmt ")" - -and extract_trait_decl_ref (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_decl_ref) : - unit = - let use_brackets = tr.decl_generics <> empty_generic_args && inside in - let name = ctx_get_trait_decl tr.trait_decl_id ctx in - if use_brackets then F.pp_print_string fmt "("; - F.pp_print_string fmt name; - (* There is something subtle here: the trait obligations for the implemented - trait are put inside the parent clauses, so we must ignore them here *) - let generics = { tr.decl_generics with trait_refs = [] } in - extract_generic_args ctx fmt no_params_tys generics; - if use_brackets then F.pp_print_string fmt ")" - -and extract_generic_args (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) (generics : generic_args) : unit = - let { types; const_generics; trait_refs } = generics in - if !backend <> HOL4 then ( - if types <> [] then ( - F.pp_print_space fmt (); - Collections.List.iter_link (F.pp_print_space fmt) - (extract_ty ctx fmt no_params_tys true) - types); - if const_generics <> [] then ( - assert (!backend <> HOL4); - F.pp_print_space fmt (); - Collections.List.iter_link (F.pp_print_space fmt) - (extract_const_generic ctx fmt true) - const_generics)); - if trait_refs <> [] then ( - F.pp_print_space fmt (); - Collections.List.iter_link (F.pp_print_space fmt) - (extract_trait_ref ctx fmt no_params_tys true) - trait_refs) - -and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id) - : unit = - match id with - | Self -> - (* This has specific treatment depending on the item we're extracting - (associated type, etc.). We should have caught this elsewhere. *) - raise (Failure "Unexpected") - | TraitImpl id -> - let name = ctx_get_trait_impl id ctx in - F.pp_print_string fmt name - | Clause id -> - let name = ctx_get_local_trait_clause id ctx in - F.pp_print_string fmt name - | ParentClause (inst_id, decl_id, clause_id) -> - (* Use the trait decl id to lookup the name *) - let name = ctx_get_trait_parent_clause decl_id clause_id ctx in - extract_trait_instance_id ctx fmt no_params_tys true inst_id; - F.pp_print_string fmt ("." ^ name) - | ItemClause (inst_id, decl_id, item_name, clause_id) -> - (* Use the trait decl id to lookup the name *) - let name = ctx_get_trait_item_clause decl_id item_name clause_id ctx in - extract_trait_instance_id ctx fmt no_params_tys true inst_id; - F.pp_print_string fmt ("." ^ name) - | TraitRef trait_ref -> - extract_trait_ref ctx fmt no_params_tys inside trait_ref - | UnknownTrait _ -> - (* This is an error case *) - raise (Failure "Unexpected") - -(** Compute the names for all the top-level identifiers used in a type - definition (type name, variant names, field names, etc. but not type - parameters). - - We need to do this preemptively, beforce extracting any definition, - because of recursive definitions. - *) -let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : - extraction_ctx = - (* Lookup the builtin information, if there is *) - let open ExtractBuiltin in - let sname = name_to_simple_name def.name in - let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in - (* Register the filtering information, if there is *) - let ctx = - match info with - | Some { keep_params = Some keep; _ } -> - { - ctx with - types_filter_type_args_map = - TypeDeclId.Map.add def.def_id keep ctx.types_filter_type_args_map; - } - | _ -> ctx - in - (* Compute and register the type def name *) - let def_name = - match info with - | None -> ctx.fmt.type_name def.name - | Some info -> info.extract_name - in - let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in - (* Compute and register: - * - the variant names, if this is an enumeration - * - the field names, if this is a structure - *) - let ctx = - match def.kind with - | Struct fields -> - (* Compute the names *) - let field_names, cons_name = - match info with - | None | Some { body_info = None; _ } -> - let field_names = - FieldId.mapi - (fun fid (field : field) -> - (fid, ctx.fmt.field_name def.name fid field.field_name)) - fields - in - let cons_name = ctx.fmt.struct_constructor def.name in - (field_names, cons_name) - | Some { body_info = Some (Struct (cons_name, field_names)); _ } -> - let field_names = - FieldId.mapi - (fun fid (_, name) -> (fid, name)) - (List.combine fields field_names) - in - (field_names, cons_name) - | Some info -> - raise - (Failure - ("Invalid builtin information: " - ^ show_builtin_type_info info)) - in - (* Add the fields *) - let ctx = - List.fold_left - (fun ctx (fid, name) -> - ctx_add (FieldId (AdtId def.def_id, fid)) name ctx) - ctx field_names - in - (* Add the constructor name *) - ctx_add (StructId (AdtId def.def_id)) cons_name ctx - | Enum variants -> - let variant_names = - match info with - | None -> - VariantId.mapi - (fun variant_id (variant : variant) -> - let name = - ctx.fmt.variant_name def.name variant.variant_name - in - (* Add the type name prefix for Lean *) - let name = - if !Config.backend = Lean then - let type_name = ctx.fmt.type_name def.name in - type_name ^ "." ^ name - else name - in - (variant_id, name)) - variants - | Some { body_info = Some (Enum variant_infos); _ } -> - (* We need to compute the map from variant to variant *) - let variant_map = - StringMap.of_list - (List.map - (fun (info : builtin_enum_variant_info) -> - (info.rust_variant_name, info.extract_variant_name)) - variant_infos) - in - VariantId.mapi - (fun variant_id (variant : variant) -> - (variant_id, StringMap.find variant.variant_name variant_map)) - variants - | _ -> raise (Failure "Invalid builtin information") - in - List.fold_left - (fun ctx (vid, vname) -> - ctx_add (VariantId (AdtId def.def_id, vid)) vname ctx) - ctx variant_names - | Opaque -> - (* Nothing to do *) - ctx - in - (* Return *) - ctx - -(** Print the variants *) -let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter) - (type_decl_group : TypeDeclId.Set.t) (type_name : string) - (type_params : string list) (cg_params : string list) (cons_name : string) - (fields : field list) : unit = - F.pp_print_space fmt (); - (* variant box *) - F.pp_open_hvbox fmt ctx.indent_incr; - (* [| Cons :] - * Note that we really don't want any break above so we print everything - * at once. *) - let opt_colon = if !backend <> HOL4 then " :" else "" in - F.pp_print_string fmt ("| " ^ cons_name ^ opt_colon); - let print_field (fid : FieldId.id) (f : field) (ctx : extraction_ctx) : - extraction_ctx = - F.pp_print_space fmt (); - (* Open the field box *) - F.pp_open_box fmt ctx.indent_incr; - (* Print the field names, if the backend accepts it. - * [ x :] - * Note that when printing fields, we register the field names as - * *variables*: they don't need to be unique at the top level. *) - let ctx = - match !backend with - | FStar -> ( - match f.field_name with - | None -> ctx - | Some field_name -> - let var_id = VarId.of_int (FieldId.to_int fid) in - let field_name = - ctx.fmt.var_basename ctx.names_map.names_set (Some field_name) - f.field_ty - in - let ctx, field_name = ctx_add_var field_name var_id ctx in - F.pp_print_string fmt (field_name ^ " :"); - F.pp_print_space fmt (); - ctx) - | Coq | Lean | HOL4 -> ctx - in - (* Print the field type *) - let inside = !backend = HOL4 in - extract_ty ctx fmt type_decl_group inside f.field_ty; - (* Print the arrow [->] *) - if !backend <> HOL4 then ( - F.pp_print_space fmt (); - extract_arrow fmt ()); - (* Close the field box *) - F.pp_close_box fmt (); - (* Return *) - ctx - in - (* Print the fields *) - let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in - let _ = - List.fold_left (fun ctx (fid, f) -> print_field fid f ctx) ctx fields - in - (* Sanity check: HOL4 doesn't support const generics *) - assert (cg_params = [] || !backend <> HOL4); - (* Print the final type *) - if !backend <> HOL4 then ( - F.pp_print_space fmt (); - F.pp_open_hovbox fmt 0; - F.pp_print_string fmt type_name; - List.iter - (fun p -> - F.pp_print_space fmt (); - F.pp_print_string fmt p) - (List.append type_params cg_params); - F.pp_close_box fmt ()); - (* Close the variant box *) - F.pp_close_box fmt () - -(* TODO: we don' need the [def_name] paramter: it can be retrieved from the context *) -let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter) - (type_decl_group : TypeDeclId.Set.t) (def : type_decl) (def_name : string) - (type_params : string list) (cg_params : string list) - (variants : variant list) : unit = - (* We want to generate a definition which looks like this (taking F* as example): - {[ - type list a = | Cons : a -> list a -> list a | Nil : list a - ]} - - If there isn't enough space on one line: - {[ - type s = - | Cons : a -> list a -> list a - | Nil : list a - ]} - - And if we need to write the type of a variant on several lines: - {[ - type s = - | Cons : - a -> - list a -> - list a - | Nil : list a - ]} - - Finally, it is possible to give names to the variant fields in Rust. - In this situation, we generate a definition like this: - {[ - type s = - | Cons : hd:a -> tl:list a -> list a - | Nil : list a - ]} - - Note that we already printed: [type s =] - *) - let print_variant _variant_id (v : variant) = - (* We don't lookup the name, because it may have a prefix for the type - id (in the case of Lean) *) - let cons_name = ctx.fmt.variant_name def.name v.variant_name in - let fields = v.fields in - extract_type_decl_variant ctx fmt type_decl_group def_name type_params - cg_params cons_name fields - in - (* Print the variants *) - let variants = VariantId.mapi (fun vid v -> (vid, v)) variants in - List.iter (fun (vid, v) -> print_variant vid v) variants - -let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) - (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) - (type_params : string list) (cg_params : string list) (fields : field list) - : unit = - (* We want to generate a definition which looks like this (taking F* as example): - {[ - type t = { x : int; y : bool; } - ]} - - If there isn't enough space on one line: - {[ - type t = - { - x : int; y : bool; - } - ]} - - And if there is even less space: - {[ - type t = - { - x : int; - y : bool; - } - ]} - - Also, in case there are no fields, we need to define the type as [unit] - ([type t = {}] doesn't work in F* ). - - Coq: - ==== - We need to define the constructor name upon defining the struct (record, in Coq). - The syntex is: - {[ - Record Foo = mkFoo { x : int; y : bool; }. - }] - - Also, Coq doesn't support groups of mutually recursive inductives and records. - This is fine, because we can then define records as inductives, and leverage - the fact that when record fields are accessed, the records are symbolically - expanded which introduces let bindings of the form: [let RecordCons ... = x in ...]. - As a consequence, we never use the record projectors (unless we reconstruct - them in the micro passes of course). - - HOL4: - ===== - Type definitions are written as follows: - {[ - Datatype: - tree = - TLeaf 'a - | TNode node ; - - node = - Node (tree list) - End - ]} - *) - (* Note that we already printed: [type t =] *) - let is_rec = decl_is_from_rec_group kind in - let _ = - if !backend = FStar && fields = [] then ( - F.pp_print_space fmt (); - F.pp_print_string fmt (unit_name ())) - else if !backend = Lean && fields = [] then () - (* If the definition is recursive, we may need to extract it as an inductive - (instead of a record). We start with the "normal" case: we extract it - as a record. *) - else if (not is_rec) || (!backend <> Coq && !backend <> Lean) then ( - if !backend <> Lean then F.pp_print_space fmt (); - (* If Coq: print the constructor name *) - (* TODO: remove superfluous test not is_rec below *) - if !backend = Coq && not is_rec then ( - F.pp_print_string fmt (ctx_get_struct (AdtId def.def_id) ctx); - F.pp_print_string fmt " "); - (match !backend with - | Lean -> () - | FStar | Coq -> F.pp_print_string fmt "{" - | HOL4 -> F.pp_print_string fmt "<|"); - F.pp_print_break fmt 1 ctx.indent_incr; - (* The body itself *) - (* Open a box for the body *) - (match !backend with - | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0 - | Lean -> F.pp_open_vbox fmt 0); - (* Print the fields *) - let print_field (field_id : FieldId.id) (f : field) : unit = - let field_name = ctx_get_field (AdtId def.def_id) field_id ctx in - (* Open a box for the field *) - F.pp_open_box fmt ctx.indent_incr; - F.pp_print_string fmt field_name; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - extract_ty ctx fmt type_decl_group false f.field_ty; - if !backend <> Lean then F.pp_print_string fmt ";"; - (* Close the box for the field *) - F.pp_close_box fmt () - in - let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in - Collections.List.iter_link (F.pp_print_space fmt) - (fun (fid, f) -> print_field fid f) - fields; - (* Close the box for the body *) - F.pp_close_box fmt (); - match !backend with - | Lean -> () - | FStar | Coq -> - F.pp_print_space fmt (); - F.pp_print_string fmt "}" - | HOL4 -> - F.pp_print_space fmt (); - F.pp_print_string fmt "|>") - else ( - (* We extract for Coq or Lean, and we have a recursive record, or a record in - a group of mutually recursive types: we extract it as an inductive type *) - assert (is_rec && (!backend = Coq || !backend = Lean)); - (* Small trick: in Lean we use namespaces, meaning we don't need to prefix - the constructor name with the name of the type at definition site, - i.e., instead of generating `inductive Foo := | MkFoo ...` like in Coq - we generate `inductive Foo := | mk ... *) - let cons_name = - if !backend = Lean then "mk" else ctx_get_struct (AdtId def.def_id) ctx - in - let def_name = ctx_get_local_type def.def_id ctx in - extract_type_decl_variant ctx fmt type_decl_group def_name type_params - cg_params cons_name fields) - in - () - -(** Extract a nestable, muti-line comment *) -let extract_comment (fmt : F.formatter) (sl : string list) : unit = - (* Delimiters, space after we break a line *) - let ld, space, rd = - match !backend with - | Coq | FStar | HOL4 -> ("(** ", 4, " *)") - | Lean -> ("/- ", 3, " -/") - in - F.pp_open_vbox fmt space; - F.pp_print_string fmt ld; - (match sl with - | [] -> () - | s :: sl -> - F.pp_print_string fmt s; - List.iter - (fun s -> - F.pp_print_space fmt (); - F.pp_print_string fmt s) - sl); - F.pp_print_string fmt rd; - F.pp_close_box fmt () - -let extract_trait_clause_type (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) (clause : trait_clause) : unit = - let trait_name = ctx_get_trait_decl clause.trait_id ctx in - F.pp_print_string fmt trait_name; - extract_generic_args ctx fmt no_params_tys clause.generics - -(** Insert a space, if necessary *) -let insert_req_space (fmt : F.formatter) (space : bool ref) : unit = - if !space then space := false else F.pp_print_space fmt () - -(** Extract the trait self clause. - - We add the trait self clause for provided methods (see {!TraitSelfClauseId}). - *) -let extract_trait_self_clause (insert_req_space : unit -> unit) - (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : trait_decl) - (params : string list) : unit = - insert_req_space (); - F.pp_print_string fmt "("; - let self_clause = ctx_get_trait_self_clause ctx in - F.pp_print_string fmt self_clause; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - let trait_id = ctx_get_trait_decl trait_decl.def_id ctx in - F.pp_print_string fmt trait_id; - List.iter - (fun p -> - F.pp_print_space fmt (); - F.pp_print_string fmt p) - params; - F.pp_print_string fmt ")" - -(** - - [trait_decl]: if [Some], it means we are extracting the generics for a provided - method and need to insert a trait self clause (see {!TraitSelfClauseId}). - *) -let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter) - (no_params_tys : TypeDeclId.Set.t) ?(use_forall = false) - ?(use_forall_use_sep = true) ?(as_implicits : bool = false) - ?(space : bool ref option = None) ?(trait_decl : trait_decl option = None) - (generics : generic_params) (type_params : string list) - (cg_params : string list) (trait_clauses : string list) : unit = - let all_params = List.concat [ type_params; cg_params; trait_clauses ] in - (* HOL4 doesn't support const generics *) - assert (cg_params = [] || !backend <> HOL4); - let left_bracket (implicit : bool) = - if implicit then F.pp_print_string fmt "{" else F.pp_print_string fmt "(" - in - let right_bracket (implicit : bool) = - if implicit then F.pp_print_string fmt "}" else F.pp_print_string fmt ")" - in - let insert_req_space () = - match space with - | None -> F.pp_print_space fmt () - | Some space -> insert_req_space fmt space - in - (* Print the type/const generic parameters *) - if all_params <> [] then ( - if use_forall then ( - if use_forall_use_sep then ( - insert_req_space (); - F.pp_print_string fmt ":"); - insert_req_space (); - F.pp_print_string fmt "forall"); - (* Small helper - we may need to split the parameters *) - let print_generics (as_implicits : bool) (type_params : string list) - (const_generics : const_generic_var list) - (trait_clauses : trait_clause list) : unit = - (* Note that in HOL4 we don't print the type parameters. *) - if !backend <> HOL4 then ( - (* Print the type parameters *) - if type_params <> [] then ( - insert_req_space (); - (* ( *) - left_bracket as_implicits; - List.iter - (fun s -> - F.pp_print_string fmt s; - F.pp_print_space fmt ()) - type_params; - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword ()); - (* ) *) - right_bracket as_implicits); - (* Print the const generic parameters *) - List.iter - (fun (var : const_generic_var) -> - insert_req_space (); - (* ( *) - left_bracket as_implicits; - let n = ctx_get_const_generic_var var.index ctx in - F.pp_print_string fmt n; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - extract_literal_type ctx fmt var.ty; - (* ) *) - right_bracket as_implicits) - const_generics); - (* Print the trait clauses *) - List.iter - (fun (clause : trait_clause) -> - insert_req_space (); - (* ( *) - left_bracket as_implicits; - let n = ctx_get_local_trait_clause clause.clause_id ctx in - F.pp_print_string fmt n; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - extract_trait_clause_type ctx fmt no_params_tys clause; - (* ) *) - right_bracket as_implicits) - trait_clauses - in - (* If we extract the generics for a provided method for a trait declaration - (indicated by the trait decl given as input), we need to split the generics: - - we print the generics for the trait decl - - we print the trait self clause - - we print the generics for the trait method - *) - match trait_decl with - | None -> - print_generics as_implicits type_params generics.const_generics - generics.trait_clauses - | Some trait_decl -> - (* Split the generics between the generics specific to the trait decl - and those specific to the trait method *) - let open Collections.List in - let dtype_params, mtype_params = - split_at type_params (length trait_decl.generics.types) - in - let dcgs, mcgs = - split_at generics.const_generics - (length trait_decl.generics.const_generics) - in - let dtrait_clauses, mtrait_clauses = - split_at generics.trait_clauses - (length trait_decl.generics.trait_clauses) - in - (* Extract the trait decl generics - note that we can always deduce - those parameters from the trait self clause: for this reason - they are always implicit *) - print_generics true dtype_params dcgs dtrait_clauses; - (* Extract the trait self clause *) - let params = - concat - [ - dtype_params; - map - (fun (cg : const_generic_var) -> - ctx_get_const_generic_var cg.index ctx) - dcgs; - map - (fun c -> ctx_get_local_trait_clause c.clause_id ctx) - dtrait_clauses; - ] - in - extract_trait_self_clause insert_req_space ctx fmt trait_decl params; - (* Extract the method generics *) - print_generics as_implicits mtype_params mcgs mtrait_clauses) - -(** Extract a type declaration. - - This function is for all type declarations and all backends **at the exception** - of opaque (assumed/declared) types format4 HOL4. - - See {!extract_type_decl}. - *) -let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) - (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) - (extract_body : bool) : unit = - (* Sanity check *) - assert (extract_body || !backend <> HOL4); - let type_kind = - if extract_body then - match def.kind with - | Struct _ -> Some Struct - | Enum _ -> Some Enum - | Opaque -> None - else None - in - (* If in Coq and the declaration is opaque, it must have the shape: - [Axiom Ident : forall (T0 ... Tn : Type) (N0 : ...) ... (Nn : ...), ... -> ... -> ...]. - - The boolean [is_opaque_coq] is used to detect this case. - *) - let is_opaque = type_kind = None in - let is_opaque_coq = !backend = Coq && is_opaque in - let use_forall = is_opaque_coq && def.generics <> empty_generic_params in - (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.def_id ctx in - (* Add the type and const generic params - note that we need those bindings only for the - * body translation (they are not top-level) *) - let ctx_body, type_params, cg_params, trait_clauses = - ctx_add_generic_params def.generics ctx - in - (* Add a break before *) - if !backend <> HOL4 || not (decl_is_first_from_group kind) then - F.pp_print_break fmt 0 0; - (* Print a comment to link the extracted type to its original rust definition *) - extract_comment fmt [ "[" ^ Print.name_to_string def.name ^ "]" ]; - F.pp_print_break fmt 0 0; - (* Open a box for the definition, so that whenever possible it gets printed on - * one line. Note however that in the case of Lean line breaks are important - * for parsing: we thus use a hovbox. *) - (match !backend with - | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0 - | Lean -> F.pp_open_vbox fmt 0); - (* Open a box for "type TYPE_NAME (TYPE_PARAMS CONST_GEN_PARAMS) =" *) - F.pp_open_hovbox fmt ctx.indent_incr; - (* > "type TYPE_NAME" *) - let qualif = ctx.fmt.type_decl_kind_to_qualif kind type_kind in - (match qualif with - | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name) - | None -> F.pp_print_string fmt def_name); - (* HOL4 doesn't support const generics, and type definitions in HOL4 don't - support trait clauses *) - assert ((cg_params = [] && trait_clauses = []) || !backend <> HOL4); - (* Print the generic parameters *) - extract_generic_params ctx_body fmt type_decl_group ~use_forall def.generics - type_params cg_params trait_clauses; - (* Print the "=" if we extract the body*) - if extract_body then ( - F.pp_print_space fmt (); - let eq = - match !backend with - | FStar -> "=" - | Coq -> ":=" - | Lean -> - if type_kind = Some Struct && kind = SingleNonRec then "where" - else ":=" - | HOL4 -> "=" - in - F.pp_print_string fmt eq) - else ( - (* Otherwise print ": Type", unless it is the HOL4 backend (in - which case we declare the type with `new_type`) *) - if use_forall then F.pp_print_string fmt "," - else ( - F.pp_print_space fmt (); - F.pp_print_string fmt ":"); - F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword ())); - (* Close the box for "type TYPE_NAME (TYPE_PARAMS) =" *) - F.pp_close_box fmt (); - (if extract_body then - match def.kind with - | Struct fields -> - extract_type_decl_struct_body ctx_body fmt type_decl_group kind def - type_params cg_params fields - | Enum variants -> - extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name - type_params cg_params variants - | Opaque -> raise (Failure "Unreachable")); - (* Add the definition end delimiter *) - if !backend = HOL4 && decl_is_not_last_from_group kind then ( - F.pp_print_space fmt (); - F.pp_print_string fmt ";") - else if !backend = Coq && decl_is_last_from_group kind then ( - (* This is actually an end of group delimiter. For aesthetic reasons - we print it here instead of in {!end_type_decl_group}. *) - F.pp_print_cut fmt (); - F.pp_print_string fmt "."); - (* Close the box for the definition *) - F.pp_close_box fmt (); - (* Add breaks to insert new lines between definitions *) - if !backend <> HOL4 || decl_is_not_last_from_group kind then - F.pp_print_break fmt 0 0 - -(** Extract an opaque type declaration to HOL4. - - Remark (SH): having to treat this specific case separately is very annoying, - but I could not find a better way. - *) -let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) - (def : type_decl) : unit = - (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.def_id ctx in - (* Generic parameters are unsupported *) - assert (def.generics.const_generics = []); - (* Trait clauses on type definitions are unsupported *) - assert (def.generics.trait_clauses = []); - (* Types *) - (* Count the number of parameters *) - let num_params = List.length def.generics.types in - (* Generate the declaration *) - F.pp_print_space fmt (); - F.pp_print_string fmt - ("val _ = new_type (\"" ^ def_name ^ "\", " ^ string_of_int num_params ^ ")"); - F.pp_print_space fmt () - -(** Extract an empty record type declaration to HOL4. - - Empty records are not supported in HOL4, so we extract them as type - abbreviations to the unit type. - - Remark (SH): having to treat this specific case separately is very annoying, - but I could not find a better way. - *) -let extract_type_decl_hol4_empty_record (ctx : extraction_ctx) - (fmt : F.formatter) (def : type_decl) : unit = - (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.def_id ctx in - (* Sanity check *) - assert (def.generics = empty_generic_params); - (* Generate the declaration *) - F.pp_print_space fmt (); - F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”"); - F.pp_print_space fmt () - -(** Extract a type declaration. - - Note that all the names used for extraction should already have been - registered. - - This function should be inserted between calls to {!start_type_decl_group} - and {!end_type_decl_group}. - *) -let extract_type_decl (ctx : extraction_ctx) (fmt : F.formatter) - (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) : - unit = - let extract_body = - match kind with - | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast -> true - | Assumed | Declared -> false - in - if extract_body then - if !backend = HOL4 && is_empty_record_type_decl def then - extract_type_decl_hol4_empty_record ctx fmt def - else extract_type_decl_gen ctx fmt type_decl_group kind def extract_body - else - match !backend with - | FStar | Coq | Lean -> - extract_type_decl_gen ctx fmt type_decl_group kind def extract_body - | HOL4 -> extract_type_decl_hol4_opaque ctx fmt def - -(** Auxiliary function. - - Generate [Arguments] instructions in Coq. - *) -let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) - (kind : decl_kind) (decl : type_decl) : unit = - assert (!backend = Coq); - (* Generating the [Arguments] instructions is useful only if there are type parameters *) - if decl.generics.types = [] && decl.generics.const_generics = [] then () - else - (* Add the type params - note that we need those bindings only for the - * body translation (they are not top-level) *) - let _ctx_body, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.generics ctx - in - (* Auxiliary function to extract an [Arguments Cons {T} _ _.] instruction *) - let extract_arguments_info (cons_name : string) (fields : 'a list) : unit = - (* Add a break before *) - F.pp_print_break fmt 0 0; - (* Open a box *) - F.pp_open_hovbox fmt ctx.indent_incr; - F.pp_print_break fmt 0 0; - F.pp_print_string fmt "Arguments"; - F.pp_print_space fmt (); - F.pp_print_string fmt cons_name; - (* Print the type/const params and the trait clauses (`{T}`) *) - List.iter - (fun (var : string) -> - F.pp_print_space fmt (); - F.pp_print_string fmt ("{" ^ var ^ "}")) - (List.concat [ type_params; cg_params; trait_clauses ]); - (* Print the fields (`_`) *) - List.iter - (fun _ -> - F.pp_print_space fmt (); - F.pp_print_string fmt "_") - fields; - F.pp_print_string fmt "."; - - (* Close the box *) - F.pp_close_box fmt () - in - - (* Generate the [Arguments] instruction *) - match decl.kind with - | Opaque -> () - | Struct fields -> - let adt_id = AdtId decl.def_id in - (* Generate the instruction for the record constructor *) - let cons_name = ctx_get_struct adt_id ctx in - extract_arguments_info cons_name fields; - (* Generate the instruction for the record projectors, if there are *) - let is_rec = decl_is_from_rec_group kind in - if not is_rec then - FieldId.iteri - (fun fid _ -> - let cons_name = ctx_get_field adt_id fid ctx in - extract_arguments_info cons_name []) - fields; - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0 - | Enum variants -> - (* Generate the instructions *) - VariantId.iteri - (fun vid (v : variant) -> - let cons_name = ctx_get_variant (AdtId decl.def_id) vid ctx in - extract_arguments_info cons_name v.fields) - variants; - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0 - -(** Auxiliary function. - - Generate field projectors in Coq. - - Sometimes we extract records as inductives in Coq: when this happens we - have to define the field projectors afterwards. - *) -let extract_type_decl_record_field_projectors (ctx : extraction_ctx) - (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = - assert (!backend = Coq); - match decl.kind with - | Opaque | Enum _ -> () - | Struct fields -> - (* Records are extracted as inductives only if they are recursive *) - let is_rec = decl_is_from_rec_group kind in - if is_rec then - (* Add the type params *) - let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.generics ctx - in - let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in - let ctx, field_var = ctx_add_var "x" (VarId.of_int 1) ctx in - let def_name = ctx_get_local_type decl.def_id ctx in - let cons_name = ctx_get_struct (AdtId decl.def_id) ctx in - let extract_field_proj (field_id : FieldId.id) (_ : field) : unit = - F.pp_print_space fmt (); - (* Outer box for the projector definition *) - F.pp_open_hvbox fmt 0; - (* Inner box for the projector definition *) - F.pp_open_hvbox fmt ctx.indent_incr; - (* Open a box for the [Definition PROJ ... :=] *) - F.pp_open_hovbox fmt ctx.indent_incr; - F.pp_print_string fmt "Definition"; - F.pp_print_space fmt (); - let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in - F.pp_print_string fmt field_name; - (* Print the generics *) - let as_implicits = true in - extract_generic_params ctx fmt TypeDeclId.Set.empty ~as_implicits - decl.generics type_params cg_params trait_clauses; - (* Print the record parameter *) - F.pp_print_space fmt (); - F.pp_print_string fmt "("; - F.pp_print_string fmt record_var; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - F.pp_print_string fmt def_name; - List.iter - (fun p -> - F.pp_print_space fmt (); - F.pp_print_string fmt p) - type_params; - F.pp_print_string fmt ")"; - (* *) - F.pp_print_space fmt (); - F.pp_print_string fmt ":="; - (* Close the box for the [Definition PROJ ... :=] *) - F.pp_close_box fmt (); - F.pp_print_space fmt (); - (* Open a box for the whole match *) - F.pp_open_hvbox fmt 0; - (* Open a box for the [match ... with] *) - F.pp_open_hovbox fmt ctx.indent_incr; - F.pp_print_string fmt "match"; - F.pp_print_space fmt (); - F.pp_print_string fmt record_var; - F.pp_print_space fmt (); - F.pp_print_string fmt "with"; - (* Close the box for the [match ... with] *) - F.pp_close_box fmt (); - - (* Open a box for the branch *) - F.pp_open_hovbox fmt ctx.indent_incr; - (* Print the match branch *) - F.pp_print_space fmt (); - F.pp_print_string fmt "|"; - F.pp_print_space fmt (); - F.pp_print_string fmt cons_name; - FieldId.iteri - (fun id _ -> - F.pp_print_space fmt (); - if field_id = id then F.pp_print_string fmt field_var - else F.pp_print_string fmt "_") - fields; - F.pp_print_space fmt (); - F.pp_print_string fmt "=>"; - F.pp_print_space fmt (); - F.pp_print_string fmt field_var; - (* Close the box for the branch *) - F.pp_close_box fmt (); - (* Print the [end] *) - F.pp_print_space fmt (); - F.pp_print_string fmt "end"; - (* Close the box for the whole match *) - F.pp_close_box fmt (); - (* Close the inner box projector *) - F.pp_close_box fmt (); - (* If Coq: end the definition with a "." *) - if !backend = Coq then ( - F.pp_print_cut fmt (); - F.pp_print_string fmt "."); - (* Close the outer box projector *) - F.pp_close_box fmt (); - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0 - in - - let extract_proj_notation (field_id : FieldId.id) (_ : field) : unit = - F.pp_print_space fmt (); - (* Outer box for the projector definition *) - F.pp_open_hvbox fmt 0; - (* Inner box for the projector definition *) - F.pp_open_hovbox fmt ctx.indent_incr; - let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in - F.pp_print_string fmt "Notation"; - F.pp_print_space fmt (); - let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in - F.pp_print_string fmt ("\"" ^ record_var ^ " .(" ^ field_name ^ ")\""); - F.pp_print_space fmt (); - F.pp_print_string fmt ":="; - F.pp_print_space fmt (); - F.pp_print_string fmt "("; - F.pp_print_string fmt field_name; - F.pp_print_space fmt (); - F.pp_print_string fmt record_var; - F.pp_print_string fmt ")"; - F.pp_print_space fmt (); - F.pp_print_string fmt "(at level 9)"; - (* Close the inner box projector *) - F.pp_close_box fmt (); - (* If Coq: end the definition with a "." *) - if !backend = Coq then ( - F.pp_print_cut fmt (); - F.pp_print_string fmt "."); - (* Close the outer box projector *) - F.pp_close_box fmt (); - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0 - in - - let extract_field_proj_and_notation (field_id : FieldId.id) - (field : field) : unit = - extract_field_proj field_id field; - extract_proj_notation field_id field - in - - FieldId.iteri extract_field_proj_and_notation fields - -(** Extract extra information for a type (e.g., [Arguments] instructions in Coq). - - Note that all the names used for extraction should already have been - registered. - *) -let extract_type_decl_extra_info (ctx : extraction_ctx) (fmt : F.formatter) - (kind : decl_kind) (decl : type_decl) : unit = - match !backend with - | FStar | Lean | HOL4 -> () - | Coq -> - extract_type_decl_coq_arguments ctx fmt kind decl; - extract_type_decl_record_field_projectors ctx fmt kind decl - -(** Extract the state type declaration. *) -let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx) - (kind : decl_kind) : unit = - (* Add a break before *) - F.pp_print_break fmt 0 0; - (* Print a comment *) - extract_comment fmt [ "The state type used in the state-error monad" ]; - F.pp_print_break fmt 0 0; - (* Open a box for the definition, so that whenever possible it gets printed on - * one line *) - F.pp_open_hvbox fmt 0; - (* Retrieve the name *) - let state_name = ctx_get_assumed_type State ctx in - (* The syntax for Lean and Coq is almost identical. *) - let print_axiom () = - let axiom = - match !backend with - | Coq -> "Axiom" - | Lean -> "axiom" - | FStar | HOL4 -> raise (Failure "Unexpected") - in - F.pp_print_string fmt axiom; - F.pp_print_space fmt (); - F.pp_print_string fmt state_name; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - F.pp_print_string fmt "Type"; - if !backend = Coq then F.pp_print_string fmt "." - in - (* The kind should be [Assumed] or [Declared] *) - (match kind with - | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast -> - raise (Failure "Unexpected") - | Assumed -> ( - match !backend with - | FStar -> - F.pp_print_string fmt "assume"; - F.pp_print_space fmt (); - F.pp_print_string fmt "type"; - F.pp_print_space fmt (); - F.pp_print_string fmt state_name; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - F.pp_print_string fmt "Type0" - | HOL4 -> - F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)") - | Coq | Lean -> print_axiom ()) - | Declared -> ( - match !backend with - | FStar -> - F.pp_print_string fmt "val"; - F.pp_print_space fmt (); - F.pp_print_string fmt state_name; - F.pp_print_space fmt (); - F.pp_print_string fmt ":"; - F.pp_print_space fmt (); - F.pp_print_string fmt "Type0" - | HOL4 -> - F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)") - | Coq | Lean -> print_axiom ())); - (* Close the box for the definition *) - F.pp_close_box fmt (); - (* Add breaks to insert new lines between definitions *) - F.pp_print_break fmt 0 0 +include ExtractTypes (** Compute the names for all the pure functions generated from a rust function (forward function and backward functions). @@ -2415,13 +53,23 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) let fun_id = (Pure.FunId (Regular f.def_id), f.loop_id, f.back_id) in - let fun_name = - (List.find - (fun (x : builtin_fun_info) -> x.rg = f.back_id) - info) - .extract_name + let fun_info = + List.find_opt + (fun (x : builtin_fun_info) -> x.rg = f.back_id) + info in - ctx_add (FunId (FromLlbc fun_id)) fun_name ctx) + match fun_info with + | Some fun_info -> + ctx_add (FunId (FromLlbc fun_id)) fun_info.extract_name ctx + | None -> + raise + (Failure + ("Not found: " + ^ Names.name_to_string f.basename + ^ ", " + ^ Print.option_to_string Pure.show_loop_id f.loop_id + ^ Print.option_to_string Pure.show_region_group_id + f.back_id))) ctx funs | None -> let fwd = def.fwd in @@ -2554,6 +202,32 @@ let extract_global (ctx : extraction_ctx) (fmt : F.formatter) (id : A.GlobalDeclId.id) : unit = F.pp_print_string fmt (ctx_get_global id ctx) +(* Filter the generics of a function if it is builtin *) +let fun_builtin_filter_types (id : FunDeclId.id) (types : 'a list) + (ctx : extraction_ctx) : ('a list, 'a list * string) Result.result = + match FunDeclId.Map.find_opt id ctx.funs_filter_type_args_map with + | None -> Result.Ok types + | Some filter -> + if List.length filter <> List.length types then ( + let decl = FunDeclId.Map.find id ctx.trans_funs in + let err = + "Ill-formed builtin information for function " + ^ Names.name_to_string decl.fwd.f.basename + ^ ": " + ^ string_of_int (List.length filter) + ^ " filtering arguments provided for " + ^ string_of_int (List.length types) + ^ " type arguments" + in + log#serror err; + Result.Error (types, err)) + else + let types = List.combine filter types in + let types = + List.filter_map (fun (b, ty) -> if b then Some ty else None) types + in + Result.Ok types + (** [inside]: see {!extract_ty}. As a pattern can introduce new variables, we return an extraction context @@ -2785,22 +459,24 @@ and extract_function_call (ctx : extraction_ctx) (fmt : F.formatter) is builtin (for instance, we filter the global allocator type argument for `Vec::new`). *) - let generics = + let types = match fun_id with - | FromLlbc (FunId (Regular id), _, _) -> ( - match FunDeclId.Map.find_opt id ctx.funs_filter_type_args_map with - | None -> generics - | Some filter -> - let types = List.combine filter generics.types in - let types = - List.filter_map - (fun (b, ty) -> if b then Some ty else None) - types - in - { generics with types }) - | _ -> generics + | FromLlbc (FunId (Regular id), _, _) -> + fun_builtin_filter_types id generics.types ctx + | _ -> Result.Ok generics.types in - extract_generic_args ctx fmt TypeDeclId.Set.empty generics; + (match types with + | Ok types -> + extract_generic_args ctx fmt TypeDeclId.Set.empty + { generics with types } + | Error (types, err) -> + extract_generic_args ctx fmt TypeDeclId.Set.empty + { generics with types }; + if !Config.extract_fail_hard then raise (Failure err) + else + F.pp_print_string fmt + "(\"ERROR: ill-formed builtin: invalid number of filtering \ + arguments\")"); (* Print the arguments *) List.iter (fun ve -> @@ -4353,10 +2029,8 @@ let extract_trait_decl_register_names (ctx : extraction_ctx) (** Similar to {!extract_type_decl_register_names} *) let extract_trait_impl_register_names (ctx : extraction_ctx) (trait_impl : trait_impl) : extraction_ctx = - let trait_decl = - TraitDeclId.Map.find trait_impl.impl_trait.trait_decl_id - ctx.trans_trait_decls - in + let decl_id = trait_impl.impl_trait.trait_decl_id in + let trait_decl = TraitDeclId.Map.find decl_id ctx.trans_trait_decls in (* Check if the trait implementation is builtin *) let builtin_info = let open ExtractBuiltin in @@ -4365,6 +2039,24 @@ let extract_trait_impl_register_names (ctx : extraction_ctx) SimpleNamePairMap.find_opt (type_sname, trait_sname) (builtin_trait_impls_map ()) in + (* Register some builtin information (if necessary) *) + let ctx, builtin_info = + match builtin_info with + | None -> (ctx, None) + | Some (filter, info) -> + let ctx = + match filter with + | None -> ctx + | Some filter -> + { + ctx with + trait_impls_filter_type_args_map = + TraitImplId.Map.add trait_impl.def_id filter + ctx.trait_impls_filter_type_args_map; + } + in + (ctx, Some info) + in (* For now we do not support overriding provided methods *) assert (trait_impl.provided_methods = []); @@ -4596,12 +2288,36 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let f = f.f in let fun_name = ctx_get_trait_method trait_decl_id item_name f.back_id ctx in let ty () = + (* Filter the generics if the method is a builtin *) + let i_tys, _, _ = impl_generics in + let impl_types, i_tys, f_tys = + match FunDeclId.Map.find_opt f.def_id ctx.funs_filter_type_args_map with + | None -> (impl.generics.types, i_tys, f.signature.generics.types) + | Some filter -> + let filter_list filter ls = + let ls = List.combine filter ls in + List.filter_map (fun (b, ty) -> if b then Some ty else None) ls + in + let impl_types = impl.generics.types in + let impl_filter = + Collections.List.prefix (List.length impl_types) filter + in + let i_tys = i_tys in + let i_filter = Collections.List.prefix (List.length i_tys) filter in + ( filter_list impl_filter impl_types, + filter_list i_filter i_tys, + filter_list filter f.signature.generics.types ) + in + let f_generics = { f.signature.generics with types = f_tys } in (* Extract the generics - we need to quantify over the generics which are specific to the method, and call it will all the generics (trait impl + method generics) *) let f_generics = - generic_params_drop_prefix impl.generics f.signature.generics + generic_params_drop_prefix + { impl.generics with types = impl_types } + f_generics in + (* Register and print the quantified generics *) let ctx, f_tys, f_cgs, f_tcs = ctx_add_generic_params f_generics ctx in let use_forall = f_generics <> empty_generic_params in extract_generic_params ctx fmt TypeDeclId.Set.empty ~use_forall f_generics @@ -4609,12 +2325,14 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) if use_forall then F.pp_print_string fmt ","; (* Extract the function call *) F.pp_print_space fmt (); - let id = ctx_get_local_function f.def_id None f.back_id ctx in - F.pp_print_string fmt id; + let fun_name = ctx_get_local_function f.def_id None f.back_id ctx in + F.pp_print_string fmt fun_name; let all_generics = - let i_tys, i_cgs, i_tcs = impl_generics in + let _, i_cgs, i_tcs = impl_generics in List.concat [ i_tys; f_tys; i_cgs; f_cgs; i_tcs; f_tcs ] in + + (* Filter the generics if the function is builtin *) List.iter (fun p -> F.pp_print_space fmt (); diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 3eef6b3b..7e8e4ffc 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -653,6 +653,8 @@ type extraction_ctx = { *) funs_filter_type_args_map : bool list FunDeclId.Map.t; (** Same as {!types_filter_type_args_map}, but for functions *) + trait_impls_filter_type_args_map : bool list TraitImplId.Map.t; + (** Same as {!types_filter_type_args_map}, but for trait implementations *) } (** Debugging function, used when communicating name collisions to the user, diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index c781463e..fa873c6a 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -122,7 +122,7 @@ let builtin_types () : builtin_type_info list = extract_name = (match !backend with | Lean -> "alloc.alloc.Global" - | Coq | FStar | HOL4 -> "alloc_global"); + | Coq | FStar | HOL4 -> "alloc_alloc_Global"); keep_params = None; body_info = None; }; @@ -130,7 +130,9 @@ let builtin_types () : builtin_type_info list = { rust_name = [ "alloc"; "vec"; "Vec" ]; extract_name = - (match !backend with Lean -> "Vec" | Coq | FStar | HOL4 -> "vec"); + (match !backend with + | Lean -> "alloc.vec.Vec" + | Coq | FStar | HOL4 -> "alloc_vec_Vec"); keep_params = Some [ true; false ]; body_info = None; }; @@ -170,15 +172,17 @@ let builtin_types () : builtin_type_info list = { rust_name = [ "core"; "ops"; "range"; "Range" ]; extract_name = - (match !backend with Lean -> "Range" | Coq | FStar | HOL4 -> "range"); + (match !backend with + | Lean -> "core.ops.range.Range" + | Coq | FStar | HOL4 -> "core_ops_range_Range"); keep_params = None; body_info = Some (Struct ( (match !backend with - | Lean -> "Range.mk" - | Coq | HOL4 -> "mk_range" - | FStar -> "Mkrange"), + | Lean -> "core.ops.range.Range.mk" + | Coq | HOL4 -> "mk_core_ops_range_Range" + | FStar -> "Mkcore_ops_range_Range"), [ "start"; "end_" ] )); }; ] @@ -204,340 +208,118 @@ type builtin_fun_info = { let builtin_funs () : (string list * bool list option * builtin_fun_info list) list = let rg0 = Some Types.RegionGroupId.zero in + (* Small utility *) + let mk_fun (name : string list) (extract_name : string list option) + (filter : bool list option) (with_back : bool) (back_no_suffix : bool) : + string list * bool list option * builtin_fun_info list = + let extract_name = + match extract_name with None -> name | Some name -> name + in + let fwd_name = + match !backend with + | FStar | Coq | HOL4 -> String.concat "_" extract_name + | Lean -> String.concat "." extract_name + in + let fwd_suffix = if with_back && back_no_suffix then "_fwd" else "" in + let fwd = [ { rg = None; extract_name = fwd_name ^ fwd_suffix } ] in + let back_suffix = if with_back && back_no_suffix then "" else "_back" in + let back = + if with_back then [ { rg = rg0; extract_name = fwd_name ^ back_suffix } ] + else [] + in + (name, filter, fwd @ back) + in [ - ( [ "core"; "mem"; "replace" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_mem_replace_fwd" - | Lean -> "core.mem.replace"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_mem_replace_back" - | Lean -> "core.mem.replace_back"); - }; - ] ); - ( [ "alloc"; "vec"; "Vec"; "new" ], - Some [ true; false ], - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_new" - | Lean -> "Vec.new"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_new_back" - | Lean -> "Vec.new_back"); - }; - ] ); - ( [ "alloc"; "vec"; "Vec"; "push" ], - Some [ true; false ], - [ - (* The forward function shouldn't be used *) - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_push_fwd" - | Lean -> "Vec.push_fwd"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_push_back" - | Lean -> "Vec.push"); - }; - ] ); - ( [ "alloc"; "vec"; "Vec"; "insert" ], - Some [ true; false ], - [ - (* The forward function shouldn't be used *) - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_insert_fwd" - | Lean -> "Vec.insert_fwd"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_insert_back" - | Lean -> "Vec.insert"); - }; - ] ); - ( [ "alloc"; "vec"; "Vec"; "len" ], - Some [ true; false ], - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_len" - | Lean -> "Vec.len"); - }; - ] ); - ( [ "alloc"; "vec"; "Vec"; "index" ], - Some [ true; false ], - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_index_fwd" - | Lean -> "Vec.index_shared"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_index_back" - | Lean -> "Vec.index_shared_back"); - }; - ] ); - ( [ "alloc"; "vec"; "Vec"; "index_mut" ], - Some [ true; false ], - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_index_mut_fwd" - | Lean -> "Vec.index_mut"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "vec_index_mut_back" - | Lean -> "Vec.index_mut_back"); - }; - ] ); - ( [ "alloc"; "boxed"; "Box"; "deref" ], - Some [ true; false ], - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref" - | Lean -> "alloc.boxed.Box.deref"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_back" - | Lean -> "alloc.boxed.Box.deref_back"); - }; - ] ); - ( [ "alloc"; "boxed"; "Box"; "deref_mut" ], - Some [ true; false ], - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_Box_deref_mut" - | Lean -> "alloc.boxed.Box.deref_mut"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "alloc_boxed_box_deref_mut_back" - | Lean -> "alloc.boxed.Box.deref_mut_back"); - }; - ] ); + mk_fun [ "core"; "mem"; "replace" ] None None true false; + mk_fun [ "alloc"; "vec"; "Vec"; "new" ] None None false false; + mk_fun + [ "alloc"; "vec"; "Vec"; "push" ] + None + (Some [ true; false ]) + true true; + mk_fun + [ "alloc"; "vec"; "Vec"; "insert" ] + None + (Some [ true; false ]) + true true; + mk_fun + [ "alloc"; "vec"; "Vec"; "len" ] + None + (Some [ true; false ]) + true false; + mk_fun + [ "alloc"; "vec"; "Vec"; "index" ] + None + (Some [ true; true; false ]) + true false; + mk_fun + [ "alloc"; "vec"; "Vec"; "index_mut" ] + None + (Some [ true; true; false ]) + true false; + mk_fun + [ "alloc"; "boxed"; "Box"; "deref" ] + None + (Some [ true; false ]) + true false; + mk_fun + [ "alloc"; "boxed"; "Box"; "deref_mut" ] + None + (Some [ true; false ]) + true false; (* TODO: fix the same like "[T]" below *) - ( [ "core"; "slice"; "index"; "[T]"; "index" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Slice_index" - | Lean -> "core.slice.index.Slice.index"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_back" - | Lean -> "core.slice.index.Slice.index_back"); - }; - ] ); - ( [ "core"; "slice"; "index"; "[T]"; "index_mut" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut" - | Lean -> "core.slice.index.Slice.index_mut"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Slice_index_mut_back" - | Lean -> "core.slice.index.Slice.index_mut_back"); - }; - ] ); - ( [ "core"; "array"; "[T; N]"; "index" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_array_Array_index" - | Lean -> "core.array.Array.index"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_array_Array_index_back" - | Lean -> "core.array.Array.index_back"); - }; - ] ); - ( [ "core"; "array"; "[T; N]"; "index_mut" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_array_Array_index_mut" - | Lean -> "core.array.Array.index_mut"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_array_Array_index_mut_back" - | Lean -> "core.array.Array.index_mut_back"); - }; - ] ); - ( [ "core"; "slice"; "index"; "Range"; "get" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_get" - | Lean -> "core.slice.index.Range.get"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_get_back" - | Lean -> "core.slice.index.Range.get_back"); - }; - ] ); - ( [ "core"; "slice"; "index"; "Range"; "get_mut" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut" - | Lean -> "core.slice.index.Range.get_mut"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_get_mut_back" - | Lean -> "core.slice.index.Range.get_mut_back"); - }; - ] ); - ( [ "core"; "slice"; "index"; "Range"; "index" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_index" - | Lean -> "core.slice.index.Range.index"); - }; - (* The backward function shouldn't be used *) - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_index_back" - | Lean -> "core.slice.index.Range.index_back"); - }; - ] ); - ( [ "core"; "slice"; "index"; "Range"; "index_mut" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut" - | Lean -> "core.slice.index.Range.index_mut"); - }; - { - rg = rg0; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_index_mut_back" - | Lean -> "core.slice.index.Range.index_mut_back"); - }; - ] ); - ( [ "core"; "slice"; "index"; "Range"; "get_unchecked" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked" - | Lean -> "core.slice.index.Range.get_unchecked"); - }; - ] ); - ( [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ], - None, - [ - { - rg = None; - extract_name = - (match !backend with - | FStar | Coq | HOL4 -> "core_slice_index_Range_get_unchecked_mut" - | Lean -> "core.slice.index.Range.get_unchecked_mut"); - }; - ] ); + mk_fun + [ "core"; "slice"; "index"; "[T]"; "index" ] + (Some [ "core"; "slice"; "index"; "Slice"; "index" ]) + None true false; + mk_fun + [ "core"; "slice"; "index"; "[T]"; "index_mut" ] + (Some [ "core"; "slice"; "index"; "Slice"; "index_mut" ]) + None true false; + mk_fun + [ "core"; "array"; "[T; N]"; "index" ] + (Some [ "core"; "array"; "Array"; "index" ]) + None true false; + mk_fun + [ "core"; "array"; "[T; N]"; "index_mut" ] + (Some [ "core"; "array"; "Array"; "index_mut" ]) + None true false; + mk_fun [ "core"; "slice"; "index"; "Range"; "get" ] None None true false; + mk_fun [ "core"; "slice"; "index"; "Range"; "get_mut" ] None None true false; + mk_fun [ "core"; "slice"; "index"; "Range"; "index" ] None None true false; + mk_fun + [ "core"; "slice"; "index"; "Range"; "index_mut" ] + None None true false; + mk_fun + [ "core"; "slice"; "index"; "Range"; "get_unchecked" ] + None None false false; + mk_fun + [ "core"; "slice"; "index"; "Range"; "get_unchecked_mut" ] + None None false false; + mk_fun + [ "core"; "slice"; "index"; "usize"; "get" ] + (Some [ "core"; "slice"; "index"; "Usize"; "get" ]) + None true false; + mk_fun + [ "core"; "slice"; "index"; "usize"; "get_mut" ] + (Some [ "core"; "slice"; "index"; "Usize"; "get_mut" ]) + None true false; + mk_fun + [ "core"; "slice"; "index"; "usize"; "get_unchecked" ] + (Some [ "core"; "slice"; "index"; "Usize"; "get_unchecked" ]) + None false false; + mk_fun + [ "core"; "slice"; "index"; "usize"; "get_unchecked_mut" ] + (Some [ "core"; "slice"; "index"; "Usize"; "get_unchecked_mut" ]) + None false false; + mk_fun + [ "core"; "slice"; "index"; "usize"; "index" ] + (Some [ "core"; "slice"; "index"; "Usize"; "index" ]) + None true false; + mk_fun + [ "core"; "slice"; "index"; "usize"; "index_mut" ] + (Some [ "core"; "slice"; "index"; "Usize"; "index_mut" ]) + None true false; ] let mk_builtin_funs_map () = @@ -576,6 +358,8 @@ let builtin_non_fallible_funs = in let int_funs = List.concat int_funs in [ + "alloc::vec::Vec::new"; + "alloc::vec::Vec::len"; "alloc::boxed::Box::deref"; "alloc::boxed::Box::deref_mut"; "core::mem::replace"; @@ -847,37 +631,68 @@ end module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd) -let builtin_trait_impls_info () : ((string list * string list) * string) list = +let builtin_trait_impls_info () : + ((string list * string list) * (bool list option * string)) list = + let fmt ?(filter : bool list option = None) (name : string) : + bool list option * string = + let name = + match !backend with + | Lean -> name + | FStar | Coq | HOL4 -> + let name = String.split_on_char '.' name in + String.concat "_" name + in + (filter, name) + in (* TODO: fix the names like "[T]" below *) [ (* core::ops::Deref> *) ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "Deref" ]), - "alloc.boxed.Box.coreOpsDerefInst" ); + fmt "alloc.boxed.Box.coreOpsDerefInst" ); (* core::ops::DerefMut> *) ( ([ "alloc"; "boxed"; "Box" ], [ "core"; "ops"; "deref"; "DerefMut" ]), - "alloc.boxed.Box.coreOpsDerefMutInst" ); + fmt "alloc.boxed.Box.coreOpsDerefMutInst" ); (* core::ops::index::Index<[T], I> *) ( ([ "core"; "slice"; "index"; "[T]" ], [ "core"; "ops"; "index"; "Index" ]), - "core.slice.index.Slice.coreopsindexIndexInst" ); + fmt "core.slice.index.Slice.coreopsindexIndexInst" ); (* core::slice::index::private_slice_index::Sealed> *) ( ( [ "core"; "slice"; "index"; "private_slice_index"; "Range" ], [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ), - "core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst" + fmt + "core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst" ); (* core::slice::index::SliceIndex, [T]> *) ( ( [ "core"; "slice"; "index"; "Range" ], [ "core"; "slice"; "index"; "SliceIndex" ] ), - "core.slice.index.Range.coresliceindexSliceIndexInst" ); + fmt "core.slice.index.Range.coresliceindexSliceIndexInst" ); (* core::ops::index::IndexMut<[T], I> *) ( ( [ "core"; "slice"; "index"; "[T]" ], [ "core"; "ops"; "index"; "IndexMut" ] ), - "core.slice.index.Slice.coreopsindexIndexMutInst" ); + fmt "core.slice.index.Slice.coreopsindexIndexMutInst" ); (* core::ops::index::Index<[T; N], I> *) ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "Index" ]), - "core.array.Array.coreopsindexIndexInst" ); + fmt "core.array.Array.coreopsindexIndexInst" ); (* core::ops::index::IndexMut<[T; N], I> *) ( ([ "core"; "array"; "[T; N]" ], [ "core"; "ops"; "index"; "IndexMut" ]), - "core.array.Array.coreopsindexIndexMutInst" ); + fmt "core.array.Array.coreopsindexIndexMutInst" ); + (* core::slice::index::private_slice_index::Sealed *) + ( ( [ "core"; "slice"; "index"; "private_slice_index"; "usize" ], + [ "core"; "slice"; "index"; "private_slice_index"; "Sealed" ] ), + fmt + "core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst" + ); + (* core::slice::index::SliceIndex *) + ( ( [ "core"; "slice"; "index"; "usize" ], + [ "core"; "slice"; "index"; "SliceIndex" ] ), + fmt "core.slice.index.usize.coresliceindexSliceIndexInst" ); + (* core::ops::index::Index, T> *) + ( ([ "alloc"; "vec"; "Vec" ], [ "core"; "ops"; "index"; "Index" ]), + let filter = Some [ true; true; false ] in + fmt ~filter "alloc.vec.Vec.coreopsindexIndexInst" ); + (* core::ops::index::IndexMut, T> *) + ( ([ "alloc"; "vec"; "Vec" ], [ "core"; "ops"; "index"; "IndexMut" ]), + let filter = Some [ true; true; false ] in + fmt ~filter "alloc.vec.Vec.coreopsindexIndexMutInst" ); ] let mk_builtin_trait_impls_map () = diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml new file mode 100644 index 00000000..219f273f --- /dev/null +++ b/compiler/ExtractTypes.ml @@ -0,0 +1,2390 @@ +(** The generic extraction *) +(* Turn the whole module into a functor: it is very annoying to carry the + the formatter everywhere... +*) + +open Pure +open PureUtils +open TranslateCore +open ExtractBase +open StringUtils +open Config +module F = Format + +(** Small helper to compute the name of an int type *) +let int_name (int_ty : integer_type) = + let isize, usize, i_format, u_format = + match !backend with + | FStar | Coq | HOL4 -> + ("isize", "usize", format_of_string "i%d", format_of_string "u%d") + | Lean -> ("Isize", "Usize", format_of_string "I%d", format_of_string "U%d") + in + match int_ty with + | Isize -> isize + | I8 -> Printf.sprintf i_format 8 + | I16 -> Printf.sprintf i_format 16 + | I32 -> Printf.sprintf i_format 32 + | I64 -> Printf.sprintf i_format 64 + | I128 -> Printf.sprintf i_format 128 + | Usize -> usize + | U8 -> Printf.sprintf u_format 8 + | U16 -> Printf.sprintf u_format 16 + | U32 -> Printf.sprintf u_format 32 + | U64 -> Printf.sprintf u_format 64 + | U128 -> Printf.sprintf u_format 128 + +(** Small helper to compute the name of a unary operation *) +let unop_name (unop : unop) : string = + match unop with + | Not -> ( + match !backend with FStar | Lean -> "not" | Coq -> "negb" | HOL4 -> "~") + | Neg (int_ty : integer_type) -> ( + match !backend with Lean -> "-" | _ -> int_name int_ty ^ "_neg") + | Cast _ -> + (* We never directly use the unop name in this case *) + raise (Failure "Unsupported") + +(** Small helper to compute the name of a binary operation (note that many + binary operations like "less than" are extracted to primitive operations, + like [<]). + *) +let named_binop_name (binop : E.binop) (int_ty : integer_type) : string = + let binop = + match binop with + | Div -> "div" + | Rem -> "rem" + | Add -> "add" + | Sub -> "sub" + | Mul -> "mul" + | Lt -> "lt" + | Le -> "le" + | Ge -> "ge" + | Gt -> "gt" + | BitXor -> "xor" + | BitAnd -> "and" + | BitOr -> "or" + | Shl -> "lsl" + | Shr -> + "asr" + (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *) + | _ -> raise (Failure "Unreachable") + in + (* Remark: the Lean case is actually not used *) + match !backend with + | Lean -> int_name int_ty ^ "." ^ binop + | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop + +(** A list of keywords/identifiers used by the backend and with which we + want to check collision. + + Remark: this is useful mostly to look for collisions when generating + names for *variables*. + *) +let keywords () = + let named_unops = + unop_name Not + :: List.map (fun it -> unop_name (Neg it)) T.all_signed_int_types + in + let named_binops = [ E.Div; Rem; Add; Sub; Mul ] in + let named_binops = + List.concat_map + (fun bn -> List.map (fun it -> named_binop_name bn it) T.all_int_types) + named_binops + in + let misc = + match !backend with + | FStar -> + [ + "assert"; + "assert_norm"; + "assume"; + "else"; + "fun"; + "fn"; + "FStar"; + "FStar.Mul"; + "if"; + "in"; + "include"; + "int"; + "let"; + "list"; + "match"; + "not"; + "open"; + "rec"; + "scalar_cast"; + "then"; + "type"; + "Type0"; + "Type"; + "unit"; + "val"; + "with"; + ] + | Coq -> + [ + "assert"; + "Arguments"; + "Axiom"; + "char_of_byte"; + "Check"; + "Declare"; + "Definition"; + "else"; + "End"; + "fun"; + "Fixpoint"; + "if"; + "in"; + "int"; + "Inductive"; + "Import"; + "let"; + "Lemma"; + "match"; + "Module"; + "not"; + "Notation"; + "Proof"; + "Qed"; + "rec"; + "Record"; + "Require"; + "Scope"; + "Search"; + "SearchPattern"; + "Set"; + "then"; + (* [tt] is unit *) + "tt"; + "type"; + "Type"; + "unit"; + "with"; + ] + | Lean -> + [ + "by"; + "class"; + "decreasing_by"; + "def"; + "deriving"; + "do"; + "else"; + "end"; + "for"; + "have"; + "if"; + "inductive"; + "instance"; + "import"; + "let"; + "macro"; + "match"; + "namespace"; + "opaque"; + "open"; + "run_cmd"; + "set_option"; + "simp"; + "structure"; + "syntax"; + "termination_by"; + "then"; + "Type"; + "unsafe"; + "where"; + "with"; + "opaque_defs"; + ] + | HOL4 -> + [ + "Axiom"; + "case"; + "Definition"; + "else"; + "End"; + "fix"; + "fix_exec"; + "fn"; + "fun"; + "if"; + "in"; + "int"; + "Inductive"; + "let"; + "of"; + "Proof"; + "QED"; + "then"; + "Theorem"; + ] + in + List.concat [ named_unops; named_binops; misc ] + +let assumed_adts () : (assumed_ty * string) list = + match !backend with + | Lean -> + [ + (State, "State"); + (Result, "Result"); + (Error, "Error"); + (Fuel, "Nat"); + (Array, "Array"); + (Slice, "Slice"); + (Str, "Str"); + (RawPtr Mut, "MutRawPtr"); + (RawPtr Const, "ConstRawPtr"); + ] + | Coq | FStar | HOL4 -> + [ + (State, "state"); + (Result, "result"); + (Error, "error"); + (Fuel, if !backend = HOL4 then "num" else "nat"); + (Array, "array"); + (Slice, "slice"); + (Str, "str"); + (RawPtr Mut, "mut_raw_ptr"); + (RawPtr Const, "const_raw_ptr"); + ] + +let assumed_struct_constructors () : (assumed_ty * string) list = + match !backend with + | Lean -> [ (Array, "Array.make") ] + | Coq -> [ (Array, "mk_array") ] + | FStar -> [ (Array, "mk_array") ] + | HOL4 -> [ (Array, "mk_array") ] + +let assumed_variants () : (assumed_ty * VariantId.id * string) list = + match !backend with + | FStar -> + [ + (Result, result_return_id, "Return"); + (Result, result_fail_id, "Fail"); + (Error, error_failure_id, "Failure"); + (Error, error_out_of_fuel_id, "OutOfFuel"); + (* No Fuel::Zero on purpose *) + (* No Fuel::Succ on purpose *) + ] + | Coq -> + [ + (Result, result_return_id, "Return"); + (Result, result_fail_id, "Fail_"); + (Error, error_failure_id, "Failure"); + (Error, error_out_of_fuel_id, "OutOfFuel"); + (Fuel, fuel_zero_id, "O"); + (Fuel, fuel_succ_id, "S"); + ] + | Lean -> + [ + (Result, result_return_id, "ret"); + (Result, result_fail_id, "fail"); + (Error, error_failure_id, "panic"); + (* No Fuel::Zero on purpose *) + (* No Fuel::Succ on purpose *) + ] + | HOL4 -> + [ + (Result, result_return_id, "Return"); + (Result, result_fail_id, "Fail"); + (Error, error_failure_id, "Failure"); + (* No Fuel::Zero on purpose *) + (* No Fuel::Succ on purpose *) + ] + +let assumed_llbc_functions () : + (A.assumed_fun_id * T.RegionGroupId.id option * string) list = + let rg0 = Some T.RegionGroupId.zero in + match !backend with + | FStar | Coq | HOL4 -> + [ + (ArrayIndexShared, None, "array_index_shared"); + (ArrayIndexMut, None, "array_index_mut_fwd"); + (ArrayIndexMut, rg0, "array_index_mut_back"); + (ArrayToSliceShared, None, "array_to_slice_shared"); + (ArrayToSliceMut, None, "array_to_slice_mut_fwd"); + (ArrayToSliceMut, rg0, "array_to_slice_mut_back"); + (ArrayRepeat, None, "array_repeat"); + (SliceIndexShared, None, "slice_index_shared"); + (SliceIndexMut, None, "slice_index_mut_fwd"); + (SliceIndexMut, rg0, "slice_index_mut_back"); + (SliceLen, None, "slice_len"); + ] + | Lean -> + [ + (ArrayIndexShared, None, "Array.index_shared"); + (ArrayIndexMut, None, "Array.index_mut"); + (ArrayIndexMut, rg0, "Array.index_mut_back"); + (ArrayToSliceShared, None, "Array.to_slice_shared"); + (ArrayToSliceMut, None, "Array.to_slice_mut"); + (ArrayToSliceMut, rg0, "Array.to_slice_mut_back"); + (ArrayRepeat, None, "Array.repeat"); + (SliceIndexShared, None, "Slice.index_shared"); + (SliceIndexMut, None, "Slice.index_mut"); + (SliceIndexMut, rg0, "Slice.index_mut_back"); + (SliceLen, None, "Slice.len"); + ] + +let assumed_pure_functions () : (pure_assumed_fun_id * string) list = + match !backend with + | FStar -> + [ + (Return, "return"); + (Fail, "fail"); + (Assert, "massert"); + (FuelDecrease, "decrease"); + (FuelEqZero, "is_zero"); + ] + | Coq -> + (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *) + [ (Return, "return_"); (Fail, "fail_"); (Assert, "massert") ] + | Lean -> + (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *) + [ (Return, "return"); (Fail, "fail_"); (Assert, "massert") ] + | HOL4 -> + (* We don't provide [FuelDecrease] and [FuelEqZero] on purpose *) + [ (Return, "return"); (Fail, "fail"); (Assert, "massert") ] + +let names_map_init () : names_map_init = + { + keywords = keywords (); + assumed_adts = assumed_adts (); + assumed_structs = assumed_struct_constructors (); + assumed_variants = assumed_variants (); + assumed_llbc_functions = assumed_llbc_functions (); + assumed_pure_functions = assumed_pure_functions (); + } + +let extract_unop (extract_expr : bool -> texpression -> unit) + (fmt : F.formatter) (inside : bool) (unop : unop) (arg : texpression) : unit + = + match unop with + | Not | Neg _ -> + let unop = unop_name unop in + if inside then F.pp_print_string fmt "("; + F.pp_print_string fmt unop; + F.pp_print_space fmt (); + extract_expr true arg; + if inside then F.pp_print_string fmt ")" + | Cast (src, tgt) -> ( + (* HOL4 has a special treatment: because it doesn't support dependent + types, we don't have a specific operator for the cast *) + match !backend with + | HOL4 -> + (* Casting, say, an u32 to an i32 would be done as follows: + {[ + mk_i32 (u32_to_int x) + ]} + *) + if inside then F.pp_print_string fmt "("; + F.pp_print_string fmt ("mk_" ^ int_name tgt); + F.pp_print_space fmt (); + F.pp_print_string fmt "("; + F.pp_print_string fmt (int_name src ^ "_to_int"); + F.pp_print_space fmt (); + extract_expr true arg; + F.pp_print_string fmt ")"; + if inside then F.pp_print_string fmt ")" + | FStar | Coq | Lean -> + (* Rem.: the source type is an implicit parameter *) + if inside then F.pp_print_string fmt "("; + let cast_str = + match !backend with + | Coq | FStar -> "scalar_cast" + | Lean -> (* TODO: I8.cast, I16.cast, etc.*) "Scalar.cast" + | HOL4 -> raise (Failure "Unreachable") + in + F.pp_print_string fmt cast_str; + F.pp_print_space fmt (); + if !backend <> Lean then ( + F.pp_print_string fmt + (StringUtils.capitalize_first_letter + (PrintPure.integer_type_to_string src)); + F.pp_print_space fmt ()); + if !backend = Lean then F.pp_print_string fmt ("." ^ int_name tgt) + else + F.pp_print_string fmt + (StringUtils.capitalize_first_letter + (PrintPure.integer_type_to_string tgt)); + F.pp_print_space fmt (); + extract_expr true arg; + if inside then F.pp_print_string fmt ")") + +(** [extract_expr] : the boolean argument is [inside] *) +let extract_binop (extract_expr : bool -> texpression -> unit) + (fmt : F.formatter) (inside : bool) (binop : E.binop) + (int_ty : integer_type) (arg0 : texpression) (arg1 : texpression) : unit = + if inside then F.pp_print_string fmt "("; + (* Some binary operations have a special notation depending on the backend *) + (match (!backend, binop) with + | HOL4, (Eq | Ne) + | (FStar | Coq | Lean), (Eq | Lt | Le | Ne | Ge | Gt) + | Lean, (Div | Rem | Add | Sub | Mul) -> + let binop = + match binop with + | Eq -> "=" + | Lt -> "<" + | Le -> "<=" + | Ne -> if !backend = Lean then "!=" else "<>" + | Ge -> ">=" + | Gt -> ">" + | Div -> "/" + | Rem -> "%" + | Add -> "+" + | Sub -> "-" + | Mul -> "*" + | _ -> raise (Failure "Unreachable") + in + let binop = + match !backend with FStar | Lean | HOL4 -> binop | Coq -> "s" ^ binop + in + extract_expr false arg0; + F.pp_print_space fmt (); + F.pp_print_string fmt binop; + F.pp_print_space fmt (); + extract_expr false arg1 + | _ -> + let binop = named_binop_name binop int_ty in + F.pp_print_string fmt binop; + F.pp_print_space fmt (); + extract_expr true arg0; + F.pp_print_space fmt (); + extract_expr true arg1); + if inside then F.pp_print_string fmt ")" + +let type_decl_kind_to_qualif (kind : decl_kind) + (type_kind : type_decl_kind option) : string option = + match !backend with + | FStar -> ( + match kind with + | SingleNonRec -> Some "type" + | SingleRec -> Some "type" + | MutRecFirst -> Some "type" + | MutRecInner -> Some "and" + | MutRecLast -> Some "and" + | Assumed -> Some "assume type" + | Declared -> Some "val") + | Coq -> ( + match (kind, type_kind) with + | SingleNonRec, Some Enum -> Some "Inductive" + | SingleNonRec, Some Struct -> Some "Record" + | (SingleRec | MutRecFirst), Some _ -> Some "Inductive" + | (MutRecInner | MutRecLast), Some _ -> + (* Coq doesn't support groups of mutually recursive definitions which mix + * records and inducties: we convert everything to records if this happens + *) + Some "with" + | (Assumed | Declared), None -> Some "Axiom" + | SingleNonRec, None -> + (* This is for traits *) + Some "Record" + | _ -> + raise + (Failure + ("Unexpected: (" ^ show_decl_kind kind ^ ", " + ^ Print.option_to_string show_type_decl_kind type_kind + ^ ")"))) + | Lean -> ( + match kind with + | SingleNonRec -> + if type_kind = Some Struct then Some "structure" else Some "inductive" + | SingleRec -> Some "inductive" + | MutRecFirst -> Some "inductive" + | MutRecInner -> Some "inductive" + | MutRecLast -> Some "inductive" + | Assumed -> Some "axiom" + | Declared -> Some "axiom") + | HOL4 -> None + +let fun_decl_kind_to_qualif (kind : decl_kind) : string option = + match !backend with + | FStar -> ( + match kind with + | SingleNonRec -> Some "let" + | SingleRec -> Some "let rec" + | MutRecFirst -> Some "let rec" + | MutRecInner -> Some "and" + | MutRecLast -> Some "and" + | Assumed -> Some "assume val" + | Declared -> Some "val") + | Coq -> ( + match kind with + | SingleNonRec -> Some "Definition" + | SingleRec -> Some "Fixpoint" + | MutRecFirst -> Some "Fixpoint" + | MutRecInner -> Some "with" + | MutRecLast -> Some "with" + | Assumed -> Some "Axiom" + | Declared -> Some "Axiom") + | Lean -> ( + match kind with + | SingleNonRec -> Some "def" + | SingleRec -> Some "divergent def" + | MutRecFirst -> Some "mutual divergent def" + | MutRecInner -> Some "divergent def" + | MutRecLast -> Some "divergent def" + | Assumed -> Some "axiom" + | Declared -> Some "axiom") + | HOL4 -> None + +(** The type of types. + + TODO: move inside the formatter? + *) +let type_keyword () = + match !backend with + | FStar -> "Type0" + | Coq | Lean -> "Type" + | HOL4 -> raise (Failure "Unexpected") + +(** + [ctx]: we use the context to lookup type definitions, to retrieve type names. + This is used to compute variable names, when they have no basenames: in this + case we use the first letter of the type name. + + [variant_concatenate_type_name]: if true, add the type name as a prefix + to the variant names. + Ex.: + In Rust: + {[ + enum List = { + Cons(u32, Box),x + Nil, + } + ]} + + F*, if option activated: + {[ + type list = + | ListCons : u32 -> list -> list + | ListNil : list + ]} + + F*, if option not activated: + {[ + type list = + | Cons : u32 -> list -> list + | Nil : list + ]} + + Rk.: this should be true by default, because in Rust all the variant names + are actively uniquely identifier by the type name [List::Cons(...)], while + in other languages it is not necessarily the case, and thus clashes can mess + up type checking. Note that some languages actually forbids the name clashes + (it is the case of F* ). + *) +let mk_formatter (ctx : trans_ctx) (crate_name : string) + (variant_concatenate_type_name : bool) : formatter = + let int_name = int_name in + + (* Prepare a name. + * The first id elem is always the crate: if it is the local crate, + * we remove it. + * We also remove all the disambiguators, then convert everything to strings. + * **Rmk:** because we remove the disambiguators, there may be name collisions + * (which is ok, because we check for name collisions and fail if there is any). + *) + let get_name (name : name) : string list = + (* Rmk.: initially we only filtered the disambiguators equal to 0 *) + let name = Names.filter_disambiguators name in + match name with + | Ident crate :: name -> + let name = if crate = crate_name then name else Ident crate :: name in + let name = + List.map + (function + | Names.Ident s -> s + | Disambiguator d -> Names.Disambiguator.to_string d) + name + in + name + | _ -> + raise (Failure ("Unexpected name shape: " ^ Print.name_to_string name)) + in + let flatten_name (name : string list) : string = + match !backend with + | FStar | Coq | HOL4 -> String.concat "_" name + | Lean -> String.concat "." name + in + let get_type_name = get_name in + let type_name_to_camel_case name = + let name = get_type_name name in + let name = List.map to_camel_case name in + String.concat "" name + in + let type_name_to_snake_case name = + let name = get_type_name name in + let name = List.map to_snake_case name in + let name = String.concat "_" name in + match !backend with + | FStar | Lean | HOL4 -> name + | Coq -> capitalize_first_letter name + in + let type_name name = + match !backend with + | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_t" + | Lean -> String.concat "." (get_type_name name) + in + let field_name (def_name : name) (field_id : FieldId.id) + (field_name : string option) : string = + let field_name_s = + match field_name with + | Some field_name -> field_name + | None -> + (* TODO: extract structs with no field names to tuples *) + FieldId.to_string field_id + in + if !Config.record_fields_short_names then + if field_name = None then (* TODO: this is a bit ugly *) + "_" ^ field_name_s + else field_name_s + else + let def_name = type_name_to_snake_case def_name ^ "_" in + def_name ^ field_name_s + in + let variant_name (def_name : name) (variant : string) : string = + match !backend with + | FStar | Coq | HOL4 -> + let variant = to_camel_case variant in + if variant_concatenate_type_name then + type_name_to_camel_case def_name ^ variant + else variant + | Lean -> variant + in + let struct_constructor (basename : name) : string = + let tname = type_name basename in + let prefix = + match !backend with FStar -> "Mk" | Coq | HOL4 -> "mk" | Lean -> "" + in + let suffix = + match !backend with FStar | Coq | HOL4 -> "" | Lean -> ".mk" + in + prefix ^ tname ^ suffix + in + let get_fun_name fname = + let fname = get_name fname in + (* TODO: don't convert to snake case for Coq, HOL4, F* *) + flatten_name fname + in + let global_name (name : global_name) : string = + (* Converting to snake case also lowercases the letters (in Rust, global + * names are written in capital letters). *) + let parts = List.map to_snake_case (get_name name) in + String.concat "_" parts + in + let fun_name (fname : fun_name) (num_loops : int) (loop_id : LoopId.id option) + (num_rgs : int) (rg : region_group_info option) (filter_info : bool * int) + : string = + let fname = get_fun_name fname in + (* Compute the suffix *) + let suffix = default_fun_suffix num_loops loop_id num_rgs rg filter_info in + (* Concatenate *) + fname ^ suffix + in + + let trait_decl_name (trait_decl : trait_decl) : string = + type_name trait_decl.name + in + + let trait_impl_name (trait_decl : trait_decl) (trait_impl : trait_impl) : + string = + (* TODO: provisional: we concatenate the trait impl name (which is its type) + with the trait decl name *) + let trait_decl = + let name = trait_decl.name in + match !backend with + | FStar | Coq | HOL4 -> type_name_to_snake_case name ^ "_inst" + | Lean -> String.concat "" (get_type_name name) ^ "Inst" + in + flatten_name (get_type_name trait_impl.name @ [ trait_decl ]) + in + + let trait_parent_clause_name (trait_decl : trait_decl) (clause : trait_clause) + : string = + (* TODO: improve - it would be better to not use indices *) + let clause = "parent_clause_" ^ TraitClauseId.to_string clause.clause_id in + if !Config.record_fields_short_names then clause + else trait_decl_name trait_decl ^ "_" ^ clause + in + let trait_type_name (trait_decl : trait_decl) (item : string) : string = + if !Config.record_fields_short_names then item + else trait_decl_name trait_decl ^ "_" ^ item + in + let trait_const_name (trait_decl : trait_decl) (item : string) : string = + if !Config.record_fields_short_names then item + else trait_decl_name trait_decl ^ "_" ^ item + in + let trait_method_name (trait_decl : trait_decl) (item : string) : string = + if !Config.record_fields_short_names then item + else trait_decl_name trait_decl ^ "_" ^ item + in + let trait_type_clause_name (trait_decl : trait_decl) (item : string) + (clause : trait_clause) : string = + (* TODO: improve - it would be better to not use indices *) + trait_type_name trait_decl item + ^ "_clause_" + ^ TraitClauseId.to_string clause.clause_id + in + + let termination_measure_name (_fid : A.FunDeclId.id) (fname : fun_name) + (num_loops : int) (loop_id : LoopId.id option) : string = + let fname = get_fun_name fname in + let lp_suffix = default_fun_loop_suffix num_loops loop_id in + (* Compute the suffix *) + let suffix = + match !Config.backend with + | FStar -> "_decreases" + | Lean -> "_terminates" + | Coq | HOL4 -> raise (Failure "Unexpected") + in + (* Concatenate *) + fname ^ lp_suffix ^ suffix + in + + let decreases_proof_name (_fid : A.FunDeclId.id) (fname : fun_name) + (num_loops : int) (loop_id : LoopId.id option) : string = + let fname = get_fun_name fname in + let lp_suffix = default_fun_loop_suffix num_loops loop_id in + (* Compute the suffix *) + let suffix = + match !Config.backend with + | Lean -> "_decreases" + | FStar | Coq | HOL4 -> raise (Failure "Unexpected") + in + (* Concatenate *) + fname ^ lp_suffix ^ suffix + in + + let var_basename (_varset : StringSet.t) (basename : string option) (ty : ty) + : string = + (* Small helper to derive var names from ADT type names. + + We do the following: + - convert the type name to snake case + - take the first letter of every "letter group" + Ex.: "HashMap" -> "hash_map" -> "hm" + *) + let name_from_type_ident (name : string) : string = + let cl = to_snake_case name in + let cl = String.split_on_char '_' cl in + let cl = List.filter (fun s -> String.length s > 0) cl in + assert (List.length cl > 0); + let cl = List.map (fun s -> s.[0]) cl in + StringUtils.string_of_chars cl + in + (* If there is a basename, we use it *) + match basename with + | Some basename -> + (* This should be a no-op *) + to_snake_case basename + | None -> ( + (* No basename: we use the first letter of the type *) + match ty with + | Adt (type_id, generics) -> ( + match type_id with + | Tuple -> + (* The "pair" case is frequent enough to have its special treatment *) + if List.length generics.types = 2 then "p" else "t" + | Assumed Result -> "r" + | Assumed Error -> ConstStrings.error_basename + | Assumed Fuel -> ConstStrings.fuel_basename + | Assumed Array -> "a" + | Assumed Slice -> "s" + | Assumed Str -> "s" + | Assumed State -> ConstStrings.state_basename + | Assumed (RawPtr _) -> "p" + | AdtId adt_id -> + let def = TypeDeclId.Map.find adt_id ctx.type_ctx.type_decls in + (* Derive the var name from the last ident of the type name + * Ex.: ["hashmap"; "HashMap"] ~~> "HashMap" -> "hash_map" -> "hm" + *) + (* The name shouldn't be empty, and its last element should + * be an ident *) + let cl = List.nth def.name (List.length def.name - 1) in + name_from_type_ident (Names.as_ident cl)) + | TypeVar _ -> ( + (* TODO: use "t" also for F* *) + match !backend with + | FStar -> "x" (* lacking inspiration here... *) + | Coq | Lean | HOL4 -> "t" (* lacking inspiration here... *)) + | Literal lty -> ( + match lty with Bool -> "b" | Char -> "c" | Integer _ -> "i") + | Arrow _ -> "f" + | TraitType (_, _, name) -> name_from_type_ident name) + in + let type_var_basename (_varset : StringSet.t) (basename : string) : string = + (* Rust type variables are snake-case and start with a capital letter *) + match !backend with + | FStar -> + (* This is *not* a no-op: this removes the capital letter *) + to_snake_case basename + | HOL4 -> + (* In HOL4, type variable names must start with "'" *) + "'" ^ to_snake_case basename + | Coq | Lean -> basename + in + let const_generic_var_basename (_varset : StringSet.t) (basename : string) : + string = + (* Rust type variables are snake-case and start with a capital letter *) + match !backend with + | FStar | HOL4 -> + (* This is *not* a no-op: this removes the capital letter *) + to_snake_case basename + | Coq | Lean -> basename + in + let trait_clause_basename (_varset : StringSet.t) (_clause : trait_clause) : + string = + (* TODO: actually use the clause to derive the name *) + "inst" + in + let trait_self_clause_basename = "self_clause" in + let append_index (basename : string) (i : int) : string = + basename ^ string_of_int i + in + + let extract_literal (fmt : F.formatter) (inside : bool) (cv : literal) : unit + = + match cv with + | Scalar sv -> ( + match !backend with + | FStar -> F.pp_print_string fmt (Z.to_string sv.PV.value) + | Coq | HOL4 | Lean -> + let print_brackets = inside && !backend = HOL4 in + if print_brackets then F.pp_print_string fmt "("; + (match !backend with + | Coq | Lean -> () + | HOL4 -> + F.pp_print_string fmt ("int_to_" ^ int_name sv.PV.int_ty); + F.pp_print_space fmt () + | _ -> raise (Failure "Unreachable")); + (* We need to add parentheses if the value is negative *) + if sv.PV.value >= Z.of_int 0 then + F.pp_print_string fmt (Z.to_string sv.PV.value) + else if !backend = Lean then + (* TODO: parsing issues with Lean because there are ambiguous + interpretations between int values and nat values *) + F.pp_print_string fmt + ("(-(" ^ Z.to_string (Z.neg sv.PV.value) ^ ":Int))") + else F.pp_print_string fmt ("(" ^ Z.to_string sv.PV.value ^ ")"); + (match !backend with + | Coq -> + let iname = int_name sv.PV.int_ty in + F.pp_print_string fmt ("%" ^ iname) + | Lean -> + let iname = String.lowercase_ascii (int_name sv.PV.int_ty) in + F.pp_print_string fmt ("#" ^ iname) + | HOL4 -> () + | _ -> raise (Failure "Unreachable")); + if print_brackets then F.pp_print_string fmt ")") + | Bool b -> + let b = + match !backend with + | HOL4 -> if b then "T" else "F" + | Coq | FStar | Lean -> if b then "true" else "false" + in + F.pp_print_string fmt b + | Char c -> ( + match !backend with + | HOL4 -> + (* [#"a"] is a notation for [CHR 97] (97 is the ASCII code for 'a') *) + F.pp_print_string fmt ("#\"" ^ String.make 1 c ^ "\"") + | FStar | Lean -> F.pp_print_string fmt ("'" ^ String.make 1 c ^ "'") + | Coq -> + if inside then F.pp_print_string fmt "("; + F.pp_print_string fmt "char_of_byte"; + F.pp_print_space fmt (); + (* Convert the the char to ascii *) + let c = + let i = Char.code c in + let x0 = i / 16 in + let x1 = i mod 16 in + "Coq.Init.Byte.x" ^ string_of_int x0 ^ string_of_int x1 + in + F.pp_print_string fmt c; + if inside then F.pp_print_string fmt ")") + in + let bool_name = if !backend = Lean then "Bool" else "bool" in + let char_name = if !backend = Lean then "Char" else "char" in + let str_name = if !backend = Lean then "String" else "string" in + { + bool_name; + char_name; + int_name; + str_name; + type_decl_kind_to_qualif; + fun_decl_kind_to_qualif; + field_name; + variant_name; + struct_constructor; + type_name; + global_name; + fun_name; + termination_measure_name; + decreases_proof_name; + trait_decl_name; + trait_impl_name; + trait_parent_clause_name; + trait_const_name; + trait_type_name; + trait_method_name; + trait_type_clause_name; + var_basename; + type_var_basename; + const_generic_var_basename; + trait_self_clause_basename; + trait_clause_basename; + append_index; + extract_literal; + extract_unop; + extract_binop; + } + +let mk_formatter_and_names_map (ctx : trans_ctx) (crate_name : string) + (variant_concatenate_type_name : bool) : formatter * names_map = + let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in + let names_map = initialize_names_map fmt (names_map_init ()) in + (fmt, names_map) + +let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool = + match dg with [ d ] -> d.body = None | _ -> false + +let is_single_opaque_type_decl_group (dg : Pure.type_decl list) : bool = + match dg with [ d ] -> d.kind = Opaque | _ -> false + +let is_empty_record_type_decl (d : Pure.type_decl) : bool = d.kind = Struct [] + +let is_empty_record_type_decl_group (dg : Pure.type_decl list) : bool = + match dg with [ d ] -> is_empty_record_type_decl d | _ -> false + +(** In some provers, groups of definitions must be delimited. + + - in Coq, *every* group (including singletons) must end with "." + - in Lean, groups of mutually recursive definitions must end with "end" + - in HOL4 (in most situations) the whole group must be within a `Define` command + + Calls to {!extract_fun_decl} should be inserted between calls to + {!start_fun_decl_group} and {!end_fun_decl_group}. + + TODO: maybe those [{start/end}_decl_group] functions are not that much a good + idea and we should merge them with the corresponding [extract_decl] functions. + *) +let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter) + (is_rec : bool) (dg : Pure.fun_decl list) = + match !backend with + | FStar | Coq | Lean -> () + | HOL4 -> + (* In HOL4, opaque functions have a special treatment *) + if is_single_opaque_fun_decl_group dg then () + else + let compute_fun_def_name (def : Pure.fun_decl) : string = + ctx_get_local_function def.def_id def.loop_id def.back_id ctx ^ "_def" + in + let names = List.map compute_fun_def_name dg in + (* Add a break before *) + F.pp_print_break fmt 0 0; + (* Open the box for the delimiters *) + F.pp_open_vbox fmt 0; + (* Open the box for the definitions themselves *) + F.pp_open_vbox fmt ctx.indent_incr; + (* Print the delimiters *) + if is_rec then + F.pp_print_string fmt + ("val [" ^ String.concat ", " names ^ "] = DefineDiv ‘") + else ( + assert (List.length names = 1); + let name = List.hd names in + F.pp_print_string fmt ("val " ^ name ^ " = Define ‘")); + F.pp_print_cut fmt () + +(** See {!start_fun_decl_group}. *) +let end_fun_decl_group (fmt : F.formatter) (is_rec : bool) + (dg : Pure.fun_decl list) = + match !backend with + | FStar -> () + | Coq -> + (* For aesthetic reasons, we print the Coq end group delimiter directly + in {!extract_fun_decl}. *) + () + | Lean -> + (* We must add the "end" keyword to groups of mutually recursive functions *) + if is_rec && List.length dg > 1 then ( + F.pp_print_cut fmt (); + F.pp_print_string fmt "end"; + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0) + else () + | HOL4 -> + (* In HOL4, opaque functions have a special treatment *) + if is_single_opaque_fun_decl_group dg then () + else ( + (* Close the box for the definitions *) + F.pp_close_box fmt (); + (* Print the end delimiter *) + F.pp_print_cut fmt (); + F.pp_print_string fmt "’"; + (* Close the box for the delimiters *) + F.pp_close_box fmt (); + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0) + +(** See {!start_fun_decl_group}: similar usage, but for the type declarations. *) +let start_type_decl_group (ctx : extraction_ctx) (fmt : F.formatter) + (is_rec : bool) (dg : Pure.type_decl list) = + match !backend with + | FStar | Coq -> () + | Lean -> + if is_rec && List.length dg > 1 then ( + F.pp_print_space fmt (); + F.pp_print_string fmt "mutual"; + F.pp_print_space fmt ()) + | HOL4 -> + (* In HOL4, opaque types and empty records have a special treatment *) + if + is_single_opaque_type_decl_group dg + || is_empty_record_type_decl_group dg + then () + else ( + (* Add a break before *) + F.pp_print_break fmt 0 0; + (* Open the box for the delimiters *) + F.pp_open_vbox fmt 0; + (* Open the box for the definitions themselves *) + F.pp_open_vbox fmt ctx.indent_incr; + (* Print the delimiters *) + F.pp_print_string fmt "Datatype:"; + F.pp_print_cut fmt ()) + +(** See {!start_fun_decl_group}. *) +let end_type_decl_group (fmt : F.formatter) (is_rec : bool) + (dg : Pure.type_decl list) = + match !backend with + | FStar -> () + | Coq -> + (* For aesthetic reasons, we print the Coq end group delimiter directly + in {!extract_fun_decl}. *) + () + | Lean -> + (* We must add the "end" keyword to groups of mutually recursive functions *) + if is_rec && List.length dg > 1 then ( + F.pp_print_cut fmt (); + F.pp_print_string fmt "end"; + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0) + else () + | HOL4 -> + (* In HOL4, opaque types and empty records have a special treatment *) + if + is_single_opaque_type_decl_group dg + || is_empty_record_type_decl_group dg + then () + else ( + (* Close the box for the definitions *) + F.pp_close_box fmt (); + (* Print the end delimiter *) + F.pp_print_cut fmt (); + F.pp_print_string fmt "End"; + (* Close the box for the delimiters *) + F.pp_close_box fmt (); + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0) + +let unit_name () = + match !backend with Lean -> "Unit" | Coq | FStar | HOL4 -> "unit" + +(** Small helper *) +let extract_arrow (fmt : F.formatter) () : unit = + if !Config.backend = Lean then F.pp_print_string fmt "→" + else F.pp_print_string fmt "->" + +let extract_const_generic (ctx : extraction_ctx) (fmt : F.formatter) + (inside : bool) (cg : const_generic) : unit = + match cg with + | ConstGenericGlobal id -> + let s = ctx_get_global id ctx in + F.pp_print_string fmt s + | ConstGenericValue v -> ctx.fmt.extract_literal fmt inside v + | ConstGenericVar id -> + let s = ctx_get_const_generic_var id ctx in + F.pp_print_string fmt s + +let extract_literal_type (ctx : extraction_ctx) (fmt : F.formatter) + (ty : literal_type) : unit = + match ty with + | Bool -> F.pp_print_string fmt ctx.fmt.bool_name + | Char -> F.pp_print_string fmt ctx.fmt.char_name + | Integer int_ty -> F.pp_print_string fmt (ctx.fmt.int_name int_ty) + +(** [inside] constrols whether we should add parentheses or not around type + applications (if [true] we add parentheses). + + [no_params_tys]: for all the types inside this set, do not print the type parameters. + This is used for HOL4. As polymorphism is uniform in HOL4, printing the + type parameters in the recursive definitions is useless (and actually + forbidden). + + For instance, where in F* we would write: + {[ + type list a = | Nil : list a | Cons : a -> list a -> list a + ]} + + In HOL4 we would simply write: + {[ + Datatype: + list = Nil 'a | Cons 'a list + End + ]} + *) +let rec extract_ty (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit = + let extract_rec = extract_ty ctx fmt no_params_tys in + match ty with + | Adt (type_id, generics) -> ( + let has_params = generics <> empty_generic_args in + match type_id with + | Tuple -> + (* This is a bit annoying, but in F*/Coq/HOL4 [()] is not the unit type: + * we have to write [unit]... *) + if generics.types = [] then F.pp_print_string fmt (unit_name ()) + else ( + F.pp_print_string fmt "("; + Collections.List.iter_link + (fun () -> + F.pp_print_space fmt (); + let product = + match !backend with + | FStar -> "&" + | Coq -> "*" + | Lean -> "×" + | HOL4 -> "#" + in + F.pp_print_string fmt product; + F.pp_print_space fmt ()) + (extract_rec true) generics.types; + F.pp_print_string fmt ")") + | AdtId _ | Assumed _ -> ( + (* HOL4 behaves differently. Where in Coq/FStar/Lean we would write: + `tree a b` + + In HOL4 we would write: + `('a, 'b) tree` + *) + match !backend with + | FStar | Coq | Lean -> + let print_paren = inside && has_params in + if print_paren then F.pp_print_string fmt "("; + (* TODO: for now, only the opaque *functions* are extracted in the + opaque module. The opaque *types* are assumed. *) + F.pp_print_string fmt (ctx_get_type type_id ctx); + (* We might need to filter the type arguments, if the type + is builtin (for instance, we filter the global allocator type + argument for `Vec`). *) + let generics = + match type_id with + | AdtId id -> ( + match + TypeDeclId.Map.find_opt id ctx.types_filter_type_args_map + with + | None -> generics + | Some filter -> + let types = List.combine filter generics.types in + let types = + List.filter_map + (fun (b, ty) -> if b then Some ty else None) + types + in + { generics with types }) + | _ -> generics + in + extract_generic_args ctx fmt no_params_tys generics; + if print_paren then F.pp_print_string fmt ")" + | HOL4 -> + let { types; const_generics; trait_refs } = generics in + (* Const generics are not supported in HOL4 *) + assert (const_generics = []); + let print_tys = + match type_id with + | AdtId id -> not (TypeDeclId.Set.mem id no_params_tys) + | Assumed _ -> true + | _ -> raise (Failure "Unreachable") + in + if types <> [] && print_tys then ( + let print_paren = List.length types > 1 in + if print_paren then F.pp_print_string fmt "("; + Collections.List.iter_link + (fun () -> + F.pp_print_string fmt ","; + F.pp_print_space fmt ()) + (extract_rec true) types; + if print_paren then F.pp_print_string fmt ")"; + F.pp_print_space fmt ()); + F.pp_print_string fmt (ctx_get_type type_id ctx); + if trait_refs <> [] then ( + F.pp_print_space fmt (); + Collections.List.iter_link (F.pp_print_space fmt) + (extract_trait_ref ctx fmt no_params_tys true) + trait_refs))) + | TypeVar vid -> F.pp_print_string fmt (ctx_get_type_var vid ctx) + | Literal lty -> extract_literal_type ctx fmt lty + | Arrow (arg_ty, ret_ty) -> + if inside then F.pp_print_string fmt "("; + extract_rec false arg_ty; + F.pp_print_space fmt (); + extract_arrow fmt (); + F.pp_print_space fmt (); + extract_rec false ret_ty; + if inside then F.pp_print_string fmt ")" + | TraitType (trait_ref, generics, type_name) -> + if !parameterize_trait_types then raise (Failure "Unimplemented") + else if trait_ref.trait_id <> Self then ( + (* HOL4 doesn't have 1st class types *) + assert (!backend <> HOL4); + let use_brackets = generics <> empty_generic_args in + if use_brackets then F.pp_print_string fmt "("; + extract_trait_ref ctx fmt no_params_tys false trait_ref; + extract_generic_args ctx fmt no_params_tys generics; + let name = + ctx_get_trait_type trait_ref.trait_decl_ref.trait_decl_id type_name + ctx + in + if use_brackets then F.pp_print_string fmt ")"; + F.pp_print_string fmt ("." ^ name)) + else + (* There are two situations: + - we are extracting a declared item (typically a function signature) + for a trait declaration. We directly refer to the item (we extract + trait declarations as structures, so we can refer to their fields) + - we are extracting a provided method for a trait declaration. We + refer to the item in the self trait clause (see {!SelfTraitClauseId}). + + Remark: we can't get there for trait *implementations* because then the + types should have been normalized. + *) + let trait_decl_id = Option.get ctx.trait_decl_id in + let item_name = ctx_get_trait_type trait_decl_id type_name ctx in + assert (generics = empty_generic_args); + if ctx.is_provided_method then + (* Provided method: use the trait self clause *) + let self_clause = ctx_get_trait_self_clause ctx in + F.pp_print_string fmt (self_clause ^ "." ^ item_name) + else + (* Declaration: directly refer to the item *) + F.pp_print_string fmt item_name + +and extract_trait_ref (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit = + let use_brackets = tr.generics <> empty_generic_args && inside in + if use_brackets then F.pp_print_string fmt "("; + (* We may need to filter the parameters if the trait is builtin *) + let generics = + match tr.trait_id with + | TraitImpl id -> ( + match + TraitImplId.Map.find_opt id ctx.trait_impls_filter_type_args_map + with + | None -> tr.generics + | Some filter -> + let types = + List.filter_map + (fun (b, x) -> if b then Some x else None) + (List.combine filter tr.generics.types) + in + { tr.generics with types }) + | _ -> tr.generics + in + extract_trait_instance_id ctx fmt no_params_tys inside tr.trait_id; + extract_generic_args ctx fmt no_params_tys generics; + if use_brackets then F.pp_print_string fmt ")" + +and extract_trait_decl_ref (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_decl_ref) : + unit = + let use_brackets = tr.decl_generics <> empty_generic_args && inside in + let name = ctx_get_trait_decl tr.trait_decl_id ctx in + if use_brackets then F.pp_print_string fmt "("; + F.pp_print_string fmt name; + (* There is something subtle here: the trait obligations for the implemented + trait are put inside the parent clauses, so we must ignore them here *) + let generics = { tr.decl_generics with trait_refs = [] } in + extract_generic_args ctx fmt no_params_tys generics; + if use_brackets then F.pp_print_string fmt ")" + +and extract_generic_args (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) (generics : generic_args) : unit = + let { types; const_generics; trait_refs } = generics in + if !backend <> HOL4 then ( + if types <> [] then ( + F.pp_print_space fmt (); + Collections.List.iter_link (F.pp_print_space fmt) + (extract_ty ctx fmt no_params_tys true) + types); + if const_generics <> [] then ( + assert (!backend <> HOL4); + F.pp_print_space fmt (); + Collections.List.iter_link (F.pp_print_space fmt) + (extract_const_generic ctx fmt true) + const_generics)); + if trait_refs <> [] then ( + F.pp_print_space fmt (); + Collections.List.iter_link (F.pp_print_space fmt) + (extract_trait_ref ctx fmt no_params_tys true) + trait_refs) + +and extract_trait_instance_id (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id) + : unit = + match id with + | Self -> + (* This has specific treatment depending on the item we're extracting + (associated type, etc.). We should have caught this elsewhere. *) + raise (Failure "Unexpected") + | TraitImpl id -> + let name = ctx_get_trait_impl id ctx in + F.pp_print_string fmt name + | Clause id -> + let name = ctx_get_local_trait_clause id ctx in + F.pp_print_string fmt name + | ParentClause (inst_id, decl_id, clause_id) -> + (* Use the trait decl id to lookup the name *) + let name = ctx_get_trait_parent_clause decl_id clause_id ctx in + extract_trait_instance_id ctx fmt no_params_tys true inst_id; + F.pp_print_string fmt ("." ^ name) + | ItemClause (inst_id, decl_id, item_name, clause_id) -> + (* Use the trait decl id to lookup the name *) + let name = ctx_get_trait_item_clause decl_id item_name clause_id ctx in + extract_trait_instance_id ctx fmt no_params_tys true inst_id; + F.pp_print_string fmt ("." ^ name) + | TraitRef trait_ref -> + extract_trait_ref ctx fmt no_params_tys inside trait_ref + | UnknownTrait _ -> + (* This is an error case *) + raise (Failure "Unexpected") + +(** Compute the names for all the top-level identifiers used in a type + definition (type name, variant names, field names, etc. but not type + parameters). + + We need to do this preemptively, beforce extracting any definition, + because of recursive definitions. + *) +let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : + extraction_ctx = + (* Lookup the builtin information, if there is *) + let open ExtractBuiltin in + let sname = name_to_simple_name def.name in + let info = SimpleNameMap.find_opt sname (builtin_types_map ()) in + (* Register the filtering information, if there is *) + let ctx = + match info with + | Some { keep_params = Some keep; _ } -> + { + ctx with + types_filter_type_args_map = + TypeDeclId.Map.add def.def_id keep ctx.types_filter_type_args_map; + } + | _ -> ctx + in + (* Compute and register the type def name *) + let def_name = + match info with + | None -> ctx.fmt.type_name def.name + | Some info -> info.extract_name + in + let ctx = ctx_add (TypeId (AdtId def.def_id)) def_name ctx in + (* Compute and register: + * - the variant names, if this is an enumeration + * - the field names, if this is a structure + *) + let ctx = + match def.kind with + | Struct fields -> + (* Compute the names *) + let field_names, cons_name = + match info with + | None | Some { body_info = None; _ } -> + let field_names = + FieldId.mapi + (fun fid (field : field) -> + (fid, ctx.fmt.field_name def.name fid field.field_name)) + fields + in + let cons_name = ctx.fmt.struct_constructor def.name in + (field_names, cons_name) + | Some { body_info = Some (Struct (cons_name, field_names)); _ } -> + let field_names = + FieldId.mapi + (fun fid (_, name) -> (fid, name)) + (List.combine fields field_names) + in + (field_names, cons_name) + | Some info -> + raise + (Failure + ("Invalid builtin information: " + ^ show_builtin_type_info info)) + in + (* Add the fields *) + let ctx = + List.fold_left + (fun ctx (fid, name) -> + ctx_add (FieldId (AdtId def.def_id, fid)) name ctx) + ctx field_names + in + (* Add the constructor name *) + ctx_add (StructId (AdtId def.def_id)) cons_name ctx + | Enum variants -> + let variant_names = + match info with + | None -> + VariantId.mapi + (fun variant_id (variant : variant) -> + let name = + ctx.fmt.variant_name def.name variant.variant_name + in + (* Add the type name prefix for Lean *) + let name = + if !Config.backend = Lean then + let type_name = ctx.fmt.type_name def.name in + type_name ^ "." ^ name + else name + in + (variant_id, name)) + variants + | Some { body_info = Some (Enum variant_infos); _ } -> + (* We need to compute the map from variant to variant *) + let variant_map = + StringMap.of_list + (List.map + (fun (info : builtin_enum_variant_info) -> + (info.rust_variant_name, info.extract_variant_name)) + variant_infos) + in + VariantId.mapi + (fun variant_id (variant : variant) -> + (variant_id, StringMap.find variant.variant_name variant_map)) + variants + | _ -> raise (Failure "Invalid builtin information") + in + List.fold_left + (fun ctx (vid, vname) -> + ctx_add (VariantId (AdtId def.def_id, vid)) vname ctx) + ctx variant_names + | Opaque -> + (* Nothing to do *) + ctx + in + (* Return *) + ctx + +(** Print the variants *) +let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter) + (type_decl_group : TypeDeclId.Set.t) (type_name : string) + (type_params : string list) (cg_params : string list) (cons_name : string) + (fields : field list) : unit = + F.pp_print_space fmt (); + (* variant box *) + F.pp_open_hvbox fmt ctx.indent_incr; + (* [| Cons :] + * Note that we really don't want any break above so we print everything + * at once. *) + let opt_colon = if !backend <> HOL4 then " :" else "" in + F.pp_print_string fmt ("| " ^ cons_name ^ opt_colon); + let print_field (fid : FieldId.id) (f : field) (ctx : extraction_ctx) : + extraction_ctx = + F.pp_print_space fmt (); + (* Open the field box *) + F.pp_open_box fmt ctx.indent_incr; + (* Print the field names, if the backend accepts it. + * [ x :] + * Note that when printing fields, we register the field names as + * *variables*: they don't need to be unique at the top level. *) + let ctx = + match !backend with + | FStar -> ( + match f.field_name with + | None -> ctx + | Some field_name -> + let var_id = VarId.of_int (FieldId.to_int fid) in + let field_name = + ctx.fmt.var_basename ctx.names_map.names_set (Some field_name) + f.field_ty + in + let ctx, field_name = ctx_add_var field_name var_id ctx in + F.pp_print_string fmt (field_name ^ " :"); + F.pp_print_space fmt (); + ctx) + | Coq | Lean | HOL4 -> ctx + in + (* Print the field type *) + let inside = !backend = HOL4 in + extract_ty ctx fmt type_decl_group inside f.field_ty; + (* Print the arrow [->] *) + if !backend <> HOL4 then ( + F.pp_print_space fmt (); + extract_arrow fmt ()); + (* Close the field box *) + F.pp_close_box fmt (); + (* Return *) + ctx + in + (* Print the fields *) + let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in + let _ = + List.fold_left (fun ctx (fid, f) -> print_field fid f ctx) ctx fields + in + (* Sanity check: HOL4 doesn't support const generics *) + assert (cg_params = [] || !backend <> HOL4); + (* Print the final type *) + if !backend <> HOL4 then ( + F.pp_print_space fmt (); + F.pp_open_hovbox fmt 0; + F.pp_print_string fmt type_name; + List.iter + (fun p -> + F.pp_print_space fmt (); + F.pp_print_string fmt p) + (List.append type_params cg_params); + F.pp_close_box fmt ()); + (* Close the variant box *) + F.pp_close_box fmt () + +(* TODO: we don' need the [def_name] paramter: it can be retrieved from the context *) +let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter) + (type_decl_group : TypeDeclId.Set.t) (def : type_decl) (def_name : string) + (type_params : string list) (cg_params : string list) + (variants : variant list) : unit = + (* We want to generate a definition which looks like this (taking F* as example): + {[ + type list a = | Cons : a -> list a -> list a | Nil : list a + ]} + + If there isn't enough space on one line: + {[ + type s = + | Cons : a -> list a -> list a + | Nil : list a + ]} + + And if we need to write the type of a variant on several lines: + {[ + type s = + | Cons : + a -> + list a -> + list a + | Nil : list a + ]} + + Finally, it is possible to give names to the variant fields in Rust. + In this situation, we generate a definition like this: + {[ + type s = + | Cons : hd:a -> tl:list a -> list a + | Nil : list a + ]} + + Note that we already printed: [type s =] + *) + let print_variant _variant_id (v : variant) = + (* We don't lookup the name, because it may have a prefix for the type + id (in the case of Lean) *) + let cons_name = ctx.fmt.variant_name def.name v.variant_name in + let fields = v.fields in + extract_type_decl_variant ctx fmt type_decl_group def_name type_params + cg_params cons_name fields + in + (* Print the variants *) + let variants = VariantId.mapi (fun vid v -> (vid, v)) variants in + List.iter (fun (vid, v) -> print_variant vid v) variants + +let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) + (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) + (type_params : string list) (cg_params : string list) (fields : field list) + : unit = + (* We want to generate a definition which looks like this (taking F* as example): + {[ + type t = { x : int; y : bool; } + ]} + + If there isn't enough space on one line: + {[ + type t = + { + x : int; y : bool; + } + ]} + + And if there is even less space: + {[ + type t = + { + x : int; + y : bool; + } + ]} + + Also, in case there are no fields, we need to define the type as [unit] + ([type t = {}] doesn't work in F* ). + + Coq: + ==== + We need to define the constructor name upon defining the struct (record, in Coq). + The syntex is: + {[ + Record Foo = mkFoo { x : int; y : bool; }. + }] + + Also, Coq doesn't support groups of mutually recursive inductives and records. + This is fine, because we can then define records as inductives, and leverage + the fact that when record fields are accessed, the records are symbolically + expanded which introduces let bindings of the form: [let RecordCons ... = x in ...]. + As a consequence, we never use the record projectors (unless we reconstruct + them in the micro passes of course). + + HOL4: + ===== + Type definitions are written as follows: + {[ + Datatype: + tree = + TLeaf 'a + | TNode node ; + + node = + Node (tree list) + End + ]} + *) + (* Note that we already printed: [type t =] *) + let is_rec = decl_is_from_rec_group kind in + let _ = + if !backend = FStar && fields = [] then ( + F.pp_print_space fmt (); + F.pp_print_string fmt (unit_name ())) + else if !backend = Lean && fields = [] then () + (* If the definition is recursive, we may need to extract it as an inductive + (instead of a record). We start with the "normal" case: we extract it + as a record. *) + else if (not is_rec) || (!backend <> Coq && !backend <> Lean) then ( + if !backend <> Lean then F.pp_print_space fmt (); + (* If Coq: print the constructor name *) + (* TODO: remove superfluous test not is_rec below *) + if !backend = Coq && not is_rec then ( + F.pp_print_string fmt (ctx_get_struct (AdtId def.def_id) ctx); + F.pp_print_string fmt " "); + (match !backend with + | Lean -> () + | FStar | Coq -> F.pp_print_string fmt "{" + | HOL4 -> F.pp_print_string fmt "<|"); + F.pp_print_break fmt 1 ctx.indent_incr; + (* The body itself *) + (* Open a box for the body *) + (match !backend with + | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0 + | Lean -> F.pp_open_vbox fmt 0); + (* Print the fields *) + let print_field (field_id : FieldId.id) (f : field) : unit = + let field_name = ctx_get_field (AdtId def.def_id) field_id ctx in + (* Open a box for the field *) + F.pp_open_box fmt ctx.indent_incr; + F.pp_print_string fmt field_name; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + extract_ty ctx fmt type_decl_group false f.field_ty; + if !backend <> Lean then F.pp_print_string fmt ";"; + (* Close the box for the field *) + F.pp_close_box fmt () + in + let fields = FieldId.mapi (fun fid f -> (fid, f)) fields in + Collections.List.iter_link (F.pp_print_space fmt) + (fun (fid, f) -> print_field fid f) + fields; + (* Close the box for the body *) + F.pp_close_box fmt (); + match !backend with + | Lean -> () + | FStar | Coq -> + F.pp_print_space fmt (); + F.pp_print_string fmt "}" + | HOL4 -> + F.pp_print_space fmt (); + F.pp_print_string fmt "|>") + else ( + (* We extract for Coq or Lean, and we have a recursive record, or a record in + a group of mutually recursive types: we extract it as an inductive type *) + assert (is_rec && (!backend = Coq || !backend = Lean)); + (* Small trick: in Lean we use namespaces, meaning we don't need to prefix + the constructor name with the name of the type at definition site, + i.e., instead of generating `inductive Foo := | MkFoo ...` like in Coq + we generate `inductive Foo := | mk ... *) + let cons_name = + if !backend = Lean then "mk" else ctx_get_struct (AdtId def.def_id) ctx + in + let def_name = ctx_get_local_type def.def_id ctx in + extract_type_decl_variant ctx fmt type_decl_group def_name type_params + cg_params cons_name fields) + in + () + +(** Extract a nestable, muti-line comment *) +let extract_comment (fmt : F.formatter) (sl : string list) : unit = + (* Delimiters, space after we break a line *) + let ld, space, rd = + match !backend with + | Coq | FStar | HOL4 -> ("(** ", 4, " *)") + | Lean -> ("/- ", 3, " -/") + in + F.pp_open_vbox fmt space; + F.pp_print_string fmt ld; + (match sl with + | [] -> () + | s :: sl -> + F.pp_print_string fmt s; + List.iter + (fun s -> + F.pp_print_space fmt (); + F.pp_print_string fmt s) + sl); + F.pp_print_string fmt rd; + F.pp_close_box fmt () + +let extract_trait_clause_type (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) (clause : trait_clause) : unit = + let trait_name = ctx_get_trait_decl clause.trait_id ctx in + F.pp_print_string fmt trait_name; + extract_generic_args ctx fmt no_params_tys clause.generics + +(** Insert a space, if necessary *) +let insert_req_space (fmt : F.formatter) (space : bool ref) : unit = + if !space then space := false else F.pp_print_space fmt () + +(** Extract the trait self clause. + + We add the trait self clause for provided methods (see {!TraitSelfClauseId}). + *) +let extract_trait_self_clause (insert_req_space : unit -> unit) + (ctx : extraction_ctx) (fmt : F.formatter) (trait_decl : trait_decl) + (params : string list) : unit = + insert_req_space (); + F.pp_print_string fmt "("; + let self_clause = ctx_get_trait_self_clause ctx in + F.pp_print_string fmt self_clause; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + let trait_id = ctx_get_trait_decl trait_decl.def_id ctx in + F.pp_print_string fmt trait_id; + List.iter + (fun p -> + F.pp_print_space fmt (); + F.pp_print_string fmt p) + params; + F.pp_print_string fmt ")" + +(** + - [trait_decl]: if [Some], it means we are extracting the generics for a provided + method and need to insert a trait self clause (see {!TraitSelfClauseId}). + *) +let extract_generic_params (ctx : extraction_ctx) (fmt : F.formatter) + (no_params_tys : TypeDeclId.Set.t) ?(use_forall = false) + ?(use_forall_use_sep = true) ?(as_implicits : bool = false) + ?(space : bool ref option = None) ?(trait_decl : trait_decl option = None) + (generics : generic_params) (type_params : string list) + (cg_params : string list) (trait_clauses : string list) : unit = + let all_params = List.concat [ type_params; cg_params; trait_clauses ] in + (* HOL4 doesn't support const generics *) + assert (cg_params = [] || !backend <> HOL4); + let left_bracket (implicit : bool) = + if implicit then F.pp_print_string fmt "{" else F.pp_print_string fmt "(" + in + let right_bracket (implicit : bool) = + if implicit then F.pp_print_string fmt "}" else F.pp_print_string fmt ")" + in + let insert_req_space () = + match space with + | None -> F.pp_print_space fmt () + | Some space -> insert_req_space fmt space + in + (* Print the type/const generic parameters *) + if all_params <> [] then ( + if use_forall then ( + if use_forall_use_sep then ( + insert_req_space (); + F.pp_print_string fmt ":"); + insert_req_space (); + F.pp_print_string fmt "forall"); + (* Small helper - we may need to split the parameters *) + let print_generics (as_implicits : bool) (type_params : string list) + (const_generics : const_generic_var list) + (trait_clauses : trait_clause list) : unit = + (* Note that in HOL4 we don't print the type parameters. *) + if !backend <> HOL4 then ( + (* Print the type parameters *) + if type_params <> [] then ( + insert_req_space (); + (* ( *) + left_bracket as_implicits; + List.iter + (fun s -> + F.pp_print_string fmt s; + F.pp_print_space fmt ()) + type_params; + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + F.pp_print_string fmt (type_keyword ()); + (* ) *) + right_bracket as_implicits); + (* Print the const generic parameters *) + List.iter + (fun (var : const_generic_var) -> + insert_req_space (); + (* ( *) + left_bracket as_implicits; + let n = ctx_get_const_generic_var var.index ctx in + F.pp_print_string fmt n; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + extract_literal_type ctx fmt var.ty; + (* ) *) + right_bracket as_implicits) + const_generics); + (* Print the trait clauses *) + List.iter + (fun (clause : trait_clause) -> + insert_req_space (); + (* ( *) + left_bracket as_implicits; + let n = ctx_get_local_trait_clause clause.clause_id ctx in + F.pp_print_string fmt n; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + extract_trait_clause_type ctx fmt no_params_tys clause; + (* ) *) + right_bracket as_implicits) + trait_clauses + in + (* If we extract the generics for a provided method for a trait declaration + (indicated by the trait decl given as input), we need to split the generics: + - we print the generics for the trait decl + - we print the trait self clause + - we print the generics for the trait method + *) + match trait_decl with + | None -> + print_generics as_implicits type_params generics.const_generics + generics.trait_clauses + | Some trait_decl -> + (* Split the generics between the generics specific to the trait decl + and those specific to the trait method *) + let open Collections.List in + let dtype_params, mtype_params = + split_at type_params (length trait_decl.generics.types) + in + let dcgs, mcgs = + split_at generics.const_generics + (length trait_decl.generics.const_generics) + in + let dtrait_clauses, mtrait_clauses = + split_at generics.trait_clauses + (length trait_decl.generics.trait_clauses) + in + (* Extract the trait decl generics - note that we can always deduce + those parameters from the trait self clause: for this reason + they are always implicit *) + print_generics true dtype_params dcgs dtrait_clauses; + (* Extract the trait self clause *) + let params = + concat + [ + dtype_params; + map + (fun (cg : const_generic_var) -> + ctx_get_const_generic_var cg.index ctx) + dcgs; + map + (fun c -> ctx_get_local_trait_clause c.clause_id ctx) + dtrait_clauses; + ] + in + extract_trait_self_clause insert_req_space ctx fmt trait_decl params; + (* Extract the method generics *) + print_generics as_implicits mtype_params mcgs mtrait_clauses) + +(** Extract a type declaration. + + This function is for all type declarations and all backends **at the exception** + of opaque (assumed/declared) types format4 HOL4. + + See {!extract_type_decl}. + *) +let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) + (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) + (extract_body : bool) : unit = + (* Sanity check *) + assert (extract_body || !backend <> HOL4); + let type_kind = + if extract_body then + match def.kind with + | Struct _ -> Some Struct + | Enum _ -> Some Enum + | Opaque -> None + else None + in + (* If in Coq and the declaration is opaque, it must have the shape: + [Axiom Ident : forall (T0 ... Tn : Type) (N0 : ...) ... (Nn : ...), ... -> ... -> ...]. + + The boolean [is_opaque_coq] is used to detect this case. + *) + let is_opaque = type_kind = None in + let is_opaque_coq = !backend = Coq && is_opaque in + let use_forall = is_opaque_coq && def.generics <> empty_generic_params in + (* Retrieve the definition name *) + let def_name = ctx_get_local_type def.def_id ctx in + (* Add the type and const generic params - note that we need those bindings only for the + * body translation (they are not top-level) *) + let ctx_body, type_params, cg_params, trait_clauses = + ctx_add_generic_params def.generics ctx + in + (* Add a break before *) + if !backend <> HOL4 || not (decl_is_first_from_group kind) then + F.pp_print_break fmt 0 0; + (* Print a comment to link the extracted type to its original rust definition *) + extract_comment fmt [ "[" ^ Print.name_to_string def.name ^ "]" ]; + F.pp_print_break fmt 0 0; + (* Open a box for the definition, so that whenever possible it gets printed on + * one line. Note however that in the case of Lean line breaks are important + * for parsing: we thus use a hovbox. *) + (match !backend with + | Coq | FStar | HOL4 -> F.pp_open_hvbox fmt 0 + | Lean -> F.pp_open_vbox fmt 0); + (* Open a box for "type TYPE_NAME (TYPE_PARAMS CONST_GEN_PARAMS) =" *) + F.pp_open_hovbox fmt ctx.indent_incr; + (* > "type TYPE_NAME" *) + let qualif = ctx.fmt.type_decl_kind_to_qualif kind type_kind in + (match qualif with + | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name) + | None -> F.pp_print_string fmt def_name); + (* HOL4 doesn't support const generics, and type definitions in HOL4 don't + support trait clauses *) + assert ((cg_params = [] && trait_clauses = []) || !backend <> HOL4); + (* Print the generic parameters *) + extract_generic_params ctx_body fmt type_decl_group ~use_forall def.generics + type_params cg_params trait_clauses; + (* Print the "=" if we extract the body*) + if extract_body then ( + F.pp_print_space fmt (); + let eq = + match !backend with + | FStar -> "=" + | Coq -> ":=" + | Lean -> + if type_kind = Some Struct && kind = SingleNonRec then "where" + else ":=" + | HOL4 -> "=" + in + F.pp_print_string fmt eq) + else ( + (* Otherwise print ": Type", unless it is the HOL4 backend (in + which case we declare the type with `new_type`) *) + if use_forall then F.pp_print_string fmt "," + else ( + F.pp_print_space fmt (); + F.pp_print_string fmt ":"); + F.pp_print_space fmt (); + F.pp_print_string fmt (type_keyword ())); + (* Close the box for "type TYPE_NAME (TYPE_PARAMS) =" *) + F.pp_close_box fmt (); + (if extract_body then + match def.kind with + | Struct fields -> + extract_type_decl_struct_body ctx_body fmt type_decl_group kind def + type_params cg_params fields + | Enum variants -> + extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name + type_params cg_params variants + | Opaque -> raise (Failure "Unreachable")); + (* Add the definition end delimiter *) + if !backend = HOL4 && decl_is_not_last_from_group kind then ( + F.pp_print_space fmt (); + F.pp_print_string fmt ";") + else if !backend = Coq && decl_is_last_from_group kind then ( + (* This is actually an end of group delimiter. For aesthetic reasons + we print it here instead of in {!end_type_decl_group}. *) + F.pp_print_cut fmt (); + F.pp_print_string fmt "."); + (* Close the box for the definition *) + F.pp_close_box fmt (); + (* Add breaks to insert new lines between definitions *) + if !backend <> HOL4 || decl_is_not_last_from_group kind then + F.pp_print_break fmt 0 0 + +(** Extract an opaque type declaration to HOL4. + + Remark (SH): having to treat this specific case separately is very annoying, + but I could not find a better way. + *) +let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) + (def : type_decl) : unit = + (* Retrieve the definition name *) + let def_name = ctx_get_local_type def.def_id ctx in + (* Generic parameters are unsupported *) + assert (def.generics.const_generics = []); + (* Trait clauses on type definitions are unsupported *) + assert (def.generics.trait_clauses = []); + (* Types *) + (* Count the number of parameters *) + let num_params = List.length def.generics.types in + (* Generate the declaration *) + F.pp_print_space fmt (); + F.pp_print_string fmt + ("val _ = new_type (\"" ^ def_name ^ "\", " ^ string_of_int num_params ^ ")"); + F.pp_print_space fmt () + +(** Extract an empty record type declaration to HOL4. + + Empty records are not supported in HOL4, so we extract them as type + abbreviations to the unit type. + + Remark (SH): having to treat this specific case separately is very annoying, + but I could not find a better way. + *) +let extract_type_decl_hol4_empty_record (ctx : extraction_ctx) + (fmt : F.formatter) (def : type_decl) : unit = + (* Retrieve the definition name *) + let def_name = ctx_get_local_type def.def_id ctx in + (* Sanity check *) + assert (def.generics = empty_generic_params); + (* Generate the declaration *) + F.pp_print_space fmt (); + F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”"); + F.pp_print_space fmt () + +(** Extract a type declaration. + + Note that all the names used for extraction should already have been + registered. + + This function should be inserted between calls to {!start_type_decl_group} + and {!end_type_decl_group}. + *) +let extract_type_decl (ctx : extraction_ctx) (fmt : F.formatter) + (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) : + unit = + let extract_body = + match kind with + | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast -> true + | Assumed | Declared -> false + in + if extract_body then + if !backend = HOL4 && is_empty_record_type_decl def then + extract_type_decl_hol4_empty_record ctx fmt def + else extract_type_decl_gen ctx fmt type_decl_group kind def extract_body + else + match !backend with + | FStar | Coq | Lean -> + extract_type_decl_gen ctx fmt type_decl_group kind def extract_body + | HOL4 -> extract_type_decl_hol4_opaque ctx fmt def + +(** Auxiliary function. + + Generate [Arguments] instructions in Coq. + *) +let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) + (kind : decl_kind) (decl : type_decl) : unit = + assert (!backend = Coq); + (* Generating the [Arguments] instructions is useful only if there are type parameters *) + if decl.generics.types = [] && decl.generics.const_generics = [] then () + else + (* Add the type params - note that we need those bindings only for the + * body translation (they are not top-level) *) + let _ctx_body, type_params, cg_params, trait_clauses = + ctx_add_generic_params decl.generics ctx + in + (* Auxiliary function to extract an [Arguments Cons {T} _ _.] instruction *) + let extract_arguments_info (cons_name : string) (fields : 'a list) : unit = + (* Add a break before *) + F.pp_print_break fmt 0 0; + (* Open a box *) + F.pp_open_hovbox fmt ctx.indent_incr; + F.pp_print_break fmt 0 0; + F.pp_print_string fmt "Arguments"; + F.pp_print_space fmt (); + F.pp_print_string fmt cons_name; + (* Print the type/const params and the trait clauses (`{T}`) *) + List.iter + (fun (var : string) -> + F.pp_print_space fmt (); + F.pp_print_string fmt ("{" ^ var ^ "}")) + (List.concat [ type_params; cg_params; trait_clauses ]); + (* Print the fields (`_`) *) + List.iter + (fun _ -> + F.pp_print_space fmt (); + F.pp_print_string fmt "_") + fields; + F.pp_print_string fmt "."; + + (* Close the box *) + F.pp_close_box fmt () + in + + (* Generate the [Arguments] instruction *) + match decl.kind with + | Opaque -> () + | Struct fields -> + let adt_id = AdtId decl.def_id in + (* Generate the instruction for the record constructor *) + let cons_name = ctx_get_struct adt_id ctx in + extract_arguments_info cons_name fields; + (* Generate the instruction for the record projectors, if there are *) + let is_rec = decl_is_from_rec_group kind in + if not is_rec then + FieldId.iteri + (fun fid _ -> + let cons_name = ctx_get_field adt_id fid ctx in + extract_arguments_info cons_name []) + fields; + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0 + | Enum variants -> + (* Generate the instructions *) + VariantId.iteri + (fun vid (v : variant) -> + let cons_name = ctx_get_variant (AdtId decl.def_id) vid ctx in + extract_arguments_info cons_name v.fields) + variants; + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0 + +(** Auxiliary function. + + Generate field projectors in Coq. + + Sometimes we extract records as inductives in Coq: when this happens we + have to define the field projectors afterwards. + *) +let extract_type_decl_record_field_projectors (ctx : extraction_ctx) + (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = + assert (!backend = Coq); + match decl.kind with + | Opaque | Enum _ -> () + | Struct fields -> + (* Records are extracted as inductives only if they are recursive *) + let is_rec = decl_is_from_rec_group kind in + if is_rec then + (* Add the type params *) + let ctx, type_params, cg_params, trait_clauses = + ctx_add_generic_params decl.generics ctx + in + let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in + let ctx, field_var = ctx_add_var "x" (VarId.of_int 1) ctx in + let def_name = ctx_get_local_type decl.def_id ctx in + let cons_name = ctx_get_struct (AdtId decl.def_id) ctx in + let extract_field_proj (field_id : FieldId.id) (_ : field) : unit = + F.pp_print_space fmt (); + (* Outer box for the projector definition *) + F.pp_open_hvbox fmt 0; + (* Inner box for the projector definition *) + F.pp_open_hvbox fmt ctx.indent_incr; + (* Open a box for the [Definition PROJ ... :=] *) + F.pp_open_hovbox fmt ctx.indent_incr; + F.pp_print_string fmt "Definition"; + F.pp_print_space fmt (); + let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in + F.pp_print_string fmt field_name; + (* Print the generics *) + let as_implicits = true in + extract_generic_params ctx fmt TypeDeclId.Set.empty ~as_implicits + decl.generics type_params cg_params trait_clauses; + (* Print the record parameter *) + F.pp_print_space fmt (); + F.pp_print_string fmt "("; + F.pp_print_string fmt record_var; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + F.pp_print_string fmt def_name; + List.iter + (fun p -> + F.pp_print_space fmt (); + F.pp_print_string fmt p) + type_params; + F.pp_print_string fmt ")"; + (* *) + F.pp_print_space fmt (); + F.pp_print_string fmt ":="; + (* Close the box for the [Definition PROJ ... :=] *) + F.pp_close_box fmt (); + F.pp_print_space fmt (); + (* Open a box for the whole match *) + F.pp_open_hvbox fmt 0; + (* Open a box for the [match ... with] *) + F.pp_open_hovbox fmt ctx.indent_incr; + F.pp_print_string fmt "match"; + F.pp_print_space fmt (); + F.pp_print_string fmt record_var; + F.pp_print_space fmt (); + F.pp_print_string fmt "with"; + (* Close the box for the [match ... with] *) + F.pp_close_box fmt (); + + (* Open a box for the branch *) + F.pp_open_hovbox fmt ctx.indent_incr; + (* Print the match branch *) + F.pp_print_space fmt (); + F.pp_print_string fmt "|"; + F.pp_print_space fmt (); + F.pp_print_string fmt cons_name; + FieldId.iteri + (fun id _ -> + F.pp_print_space fmt (); + if field_id = id then F.pp_print_string fmt field_var + else F.pp_print_string fmt "_") + fields; + F.pp_print_space fmt (); + F.pp_print_string fmt "=>"; + F.pp_print_space fmt (); + F.pp_print_string fmt field_var; + (* Close the box for the branch *) + F.pp_close_box fmt (); + (* Print the [end] *) + F.pp_print_space fmt (); + F.pp_print_string fmt "end"; + (* Close the box for the whole match *) + F.pp_close_box fmt (); + (* Close the inner box projector *) + F.pp_close_box fmt (); + (* If Coq: end the definition with a "." *) + if !backend = Coq then ( + F.pp_print_cut fmt (); + F.pp_print_string fmt "."); + (* Close the outer box projector *) + F.pp_close_box fmt (); + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0 + in + + let extract_proj_notation (field_id : FieldId.id) (_ : field) : unit = + F.pp_print_space fmt (); + (* Outer box for the projector definition *) + F.pp_open_hvbox fmt 0; + (* Inner box for the projector definition *) + F.pp_open_hovbox fmt ctx.indent_incr; + let ctx, record_var = ctx_add_var "x" (VarId.of_int 0) ctx in + F.pp_print_string fmt "Notation"; + F.pp_print_space fmt (); + let field_name = ctx_get_field (AdtId decl.def_id) field_id ctx in + F.pp_print_string fmt ("\"" ^ record_var ^ " .(" ^ field_name ^ ")\""); + F.pp_print_space fmt (); + F.pp_print_string fmt ":="; + F.pp_print_space fmt (); + F.pp_print_string fmt "("; + F.pp_print_string fmt field_name; + F.pp_print_space fmt (); + F.pp_print_string fmt record_var; + F.pp_print_string fmt ")"; + F.pp_print_space fmt (); + F.pp_print_string fmt "(at level 9)"; + (* Close the inner box projector *) + F.pp_close_box fmt (); + (* If Coq: end the definition with a "." *) + if !backend = Coq then ( + F.pp_print_cut fmt (); + F.pp_print_string fmt "."); + (* Close the outer box projector *) + F.pp_close_box fmt (); + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0 + in + + let extract_field_proj_and_notation (field_id : FieldId.id) + (field : field) : unit = + extract_field_proj field_id field; + extract_proj_notation field_id field + in + + FieldId.iteri extract_field_proj_and_notation fields + +(** Extract extra information for a type (e.g., [Arguments] instructions in Coq). + + Note that all the names used for extraction should already have been + registered. + *) +let extract_type_decl_extra_info (ctx : extraction_ctx) (fmt : F.formatter) + (kind : decl_kind) (decl : type_decl) : unit = + match !backend with + | FStar | Lean | HOL4 -> () + | Coq -> + extract_type_decl_coq_arguments ctx fmt kind decl; + extract_type_decl_record_field_projectors ctx fmt kind decl + +(** Extract the state type declaration. *) +let extract_state_type (fmt : F.formatter) (ctx : extraction_ctx) + (kind : decl_kind) : unit = + (* Add a break before *) + F.pp_print_break fmt 0 0; + (* Print a comment *) + extract_comment fmt [ "The state type used in the state-error monad" ]; + F.pp_print_break fmt 0 0; + (* Open a box for the definition, so that whenever possible it gets printed on + * one line *) + F.pp_open_hvbox fmt 0; + (* Retrieve the name *) + let state_name = ctx_get_assumed_type State ctx in + (* The syntax for Lean and Coq is almost identical. *) + let print_axiom () = + let axiom = + match !backend with + | Coq -> "Axiom" + | Lean -> "axiom" + | FStar | HOL4 -> raise (Failure "Unexpected") + in + F.pp_print_string fmt axiom; + F.pp_print_space fmt (); + F.pp_print_string fmt state_name; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + F.pp_print_string fmt "Type"; + if !backend = Coq then F.pp_print_string fmt "." + in + (* The kind should be [Assumed] or [Declared] *) + (match kind with + | SingleNonRec | SingleRec | MutRecFirst | MutRecInner | MutRecLast -> + raise (Failure "Unexpected") + | Assumed -> ( + match !backend with + | FStar -> + F.pp_print_string fmt "assume"; + F.pp_print_space fmt (); + F.pp_print_string fmt "type"; + F.pp_print_space fmt (); + F.pp_print_string fmt state_name; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + F.pp_print_string fmt "Type0" + | HOL4 -> + F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)") + | Coq | Lean -> print_axiom ()) + | Declared -> ( + match !backend with + | FStar -> + F.pp_print_string fmt "val"; + F.pp_print_space fmt (); + F.pp_print_string fmt state_name; + F.pp_print_space fmt (); + F.pp_print_string fmt ":"; + F.pp_print_space fmt (); + F.pp_print_string fmt "Type0" + | HOL4 -> + F.pp_print_string fmt ("val _ = new_type (\"" ^ state_name ^ "\", 0)") + | Coq | Lean -> print_axiom ())); + (* Close the box for the definition *) + F.pp_close_box fmt (); + (* Add breaks to insert new lines between definitions *) + F.pp_print_break fmt 0 0 diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 9a3654b8..a5aa0edd 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -24,8 +24,6 @@ module TraitClauseId = T.TraitClauseId module LoopId = IdGen () -type loop_id = LoopId.id [@@deriving show, ord] - (** We give an identifier to every phase of the synthesis (forward, backward for group of regions 0, etc.) *) module SynthPhaseId = @@ -47,6 +45,8 @@ type trait_clause_id = T.trait_clause_id [@@deriving show, ord] type trait_item_name = T.trait_item_name [@@deriving show, ord] type global_decl_id = T.global_decl_id [@@deriving show, ord] type fun_decl_id = A.fun_decl_id [@@deriving show, ord] +type loop_id = LoopId.id [@@deriving show, ord] +type region_group_id = T.region_group_id [@@deriving show, ord] type mutability = Mut | Const [@@deriving show, ord] (** The assumed types for the pure AST. diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 019a5c35..c5ac4e96 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -1076,6 +1076,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : functions_with_decreases_clause = rec_functions; types_filter_type_args_map = Pure.TypeDeclId.Map.empty; funs_filter_type_args_map = Pure.FunDeclId.Map.empty; + trait_impls_filter_type_args_map = Pure.TraitImplId.Map.empty; } in diff --git a/compiler/dune b/compiler/dune index a4b09df4..648c7325 100644 --- a/compiler/dune +++ b/compiler/dune @@ -24,6 +24,7 @@ Extract ExtractBase ExtractBuiltin + ExtractTypes FunsAnalysis Identifiers InterpreterBorrowsCore -- cgit v1.3.1 From ca24c351f97a3f8989a6866de0868ef54241b194 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 12:07:50 +0200 Subject: Make progress on fixing the extraction for Lean --- backends/lean/Base/Primitives/ArraySlice.lean | 164 ++++++++----------------- compiler/Extract.ml | 2 +- compiler/ExtractBase.ml | 165 ++++++++++++++++---------- compiler/ExtractTypes.ml | 48 ++++---- compiler/Translate.ml | 21 +--- 5 files changed, 180 insertions(+), 220 deletions(-) (limited to 'backends') diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index 615e0783..2a080ca6 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -40,14 +40,14 @@ def Array.make (α : Type u) (n : Usize) (init : List α) (hl : init.len = n.val example : Array Int (Usize.ofInt 2) := Array.make Int (Usize.ofInt 2) [0, 1] @[simp] -abbrev Array.index {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α := +abbrev Array.index_s {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i : Int) : α := v.val.index i @[simp] abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i j : Int) : List α := v.val.slice i j -def Array.index_shared (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := +def Array.index_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some x => ret x @@ -67,48 +67,27 @@ theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) : -/ @[pspec] -theorem Array.index_shared_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) +theorem Array.index_usize_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_shared α n i = ret x ∧ x = v.val.index i.val := by - simp only [index_shared] + ∃ x, v.index_usize α n 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 [*] --- This shouldn't be used -def Array.index_shared_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (_: α) : Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def Array.index_mut (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - -@[pspec] -theorem Array.index_mut_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_mut α n i = ret x ∧ x = v.val.index i.val := by - simp only [index_mut] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - -def Array.index_mut_back (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) := +def Array.update_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: α) : Result (Array α n) := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some _ => .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ @[pspec] -theorem Array.index_mut_back_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α) +theorem Array.update_usize_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.index_mut_back α n i x = ret nv ∧ + ∃ nv, v.update_usize α n i x = ret nv ∧ nv.val = v.val.update i.val x := by - simp only [index_mut_back] + simp only [update_usize] have h := List.indexOpt_bounds v.val i.val split . simp_all [length]; cases h <;> scalar_tac @@ -144,14 +123,14 @@ theorem Slice.len_val {α : Type u} (v : Slice α) : (Slice.len α v).val = v.le by rfl @[simp] -abbrev Slice.index {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α := +abbrev Slice.index_s {α : Type u} [Inhabited α] (v: Slice α) (i: Int) : α := v.val.index i @[simp] abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : List α := s.val.slice i j -def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α := +def Slice.index_usize (α : Type u) (v: Slice α) (i: Usize) : Result α := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some x => ret x @@ -162,10 +141,10 @@ def Slice.index_shared (α : Type u) (v: Slice α) (i: Usize) : Result α := -/ @[pspec] -theorem Slice.index_shared_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) +theorem Slice.index_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_shared α i = ret x ∧ x = v.val.index i.val := by - simp only [index_shared] + ∃ 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 [*] @@ -177,33 +156,19 @@ def Slice.index_shared_back (α : Type u) (v: Slice α) (i: Usize) (_: α) : Res else .fail arrayOutOfBounds -def Slice.index_mut (α : Type u) (v: Slice α) (i: Usize) : Result α := - match v.val.indexOpt i.val with - | none => fail .arrayOutOfBounds - | some x => ret x - -@[pspec] -theorem Slice.index_mut_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) - (hbound : i.val < v.length) : - ∃ x, v.index_mut α i = ret x ∧ x = v.val.index i.val := by - simp only [index_mut] - -- TODO: dependent rewrite - have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) - simp [*] - -def Slice.index_mut_back (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) := +def Slice.update_usize (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result (Slice α) := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some _ => .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ @[pspec] -theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) +theorem Slice.update_usize_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.index_mut_back α i x = ret nv ∧ + ∃ nv, v.update_usize α i x = ret nv ∧ nv.val = v.val.update i.val x := by - simp only [index_mut_back] + simp only [update_usize] have h := List.indexOpt_bounds v.val i.val split . simp_all [length]; cases h <;> scalar_tac @@ -212,34 +177,27 @@ theorem Slice.index_mut_back_spec {α : Type u} (v: Slice α) (i: Usize) (x : α /- Array to slice/subslices -/ /- We could make this function not use the `Result` type. By making it monadic, we - push the user to use the `Array.to_slice_shared_spec` spec theorem below (through the - `progress` tactic), meaning `Array.to_slice_shared` should be considered as opaque. + push the user to use the `Array.to_slice_spec` spec theorem below (through the + `progress` tactic), meaning `Array.to_slice` should be considered as opaque. All what the spec theorem reveals is that the "representative" lists are the same. -/ -def Array.to_slice_shared (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := +def Array.to_slice (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩ @[pspec] -theorem Array.to_slice_shared_spec {α : Type u} {n : Usize} (v : Array α n) : - ∃ s, to_slice_shared α n v = ret s ∧ v.val = s.val := by simp [to_slice_shared] - -def Array.to_slice_mut (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := - to_slice_shared α n v +theorem Array.to_slice_spec {α : Type u} {n : Usize} (v : Array α n) : + ∃ s, to_slice α n v = ret s ∧ v.val = s.val := by simp [to_slice] -@[pspec] -theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) : - ∃ s, Array.to_slice_shared α n v = ret s ∧ v.val = s.val := to_slice_shared_spec v - -def Array.to_slice_mut_back (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) := +def Array.from_slice (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) := if h: s.val.len = n.val then ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩ else fail panic @[pspec] -theorem Array.to_slice_mut_back_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) : - ∃ na, to_slice_mut_back α n a ns = ret na ∧ na.val = ns.val - := by simp [to_slice_mut_back, *] +theorem Array.from_slice_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) : + ∃ na, from_slice α n a ns = ret na ∧ na.val = ns.val + := by simp [from_slice, *] -def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := +def Array.subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := -- TODO: not completely sure here if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then ret ⟨ a.val.slice r.start.val r.end_.val, @@ -251,29 +209,18 @@ def Array.subslice_shared (α : Type u) (n : Usize) (a : Array α n) (r : Range fail panic @[pspec] -theorem Array.subslice_shared_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) +theorem Array.subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : - ∃ s, subslice_shared α n a r = ret s ∧ + ∃ s, subslice α n a r = ret s ∧ s.val = a.val.slice r.start.val r.end_.val ∧ (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) := by - simp [subslice_shared, *] + simp [subslice, *] intro i _ _ have := List.index_slice r.start.val r.end_.val i a.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac) simp [*] -def Array.subslice_mut (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := - Array.subslice_shared α n a r - -@[pspec] -theorem Array.subslice_mut_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) - (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : - ∃ s, subslice_mut α n a r = ret s ∧ - s.val = a.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) - := subslice_shared_spec a r h0 h1 - -def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) := +def Array.update_subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) (s : Slice α) : Result (Array α n) := -- TODO: not completely sure here if h: r.start.val < r.end_.val ∧ r.end_.val ≤ a.length ∧ s.val.len = r.end_.val - r.start.val then let s_beg := a.val.itake r.start.val @@ -298,13 +245,13 @@ def Array.subslice_mut_back (α : Type u) (n : Usize) (a : Array α n) (r : Rang -- We should introduce special symbols for the monadic arithmetic operations -- (the use will never write those symbols directly). @[pspec] -theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α) +theorem Array.update_subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α) (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) : - ∃ na, subslice_mut_back α n a r s = ret na ∧ - (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧ - (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = s.index (i - r.start.val)) ∧ - (∀ i, r.end_.val ≤ i → i < n.val → na.index i = a.index i) := by - simp [subslice_mut_back, *] + ∃ na, update_subslice α n a r s = ret na ∧ + (∀ i, 0 ≤ i → i < r.start.val → na.index_s i = a.index_s i) ∧ + (∀ i, r.start.val ≤ i → i < r.end_.val → na.index_s i = s.index_s (i - r.start.val)) ∧ + (∀ i, r.end_.val ≤ i → i < n.val → na.index_s i = a.index_s i) := by + simp [update_subslice, *] have h := List.replace_slice_index r.start.val r.end_.val a.val s.val (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac) simp [List.replace_slice] at h @@ -321,7 +268,7 @@ theorem Array.subslice_mut_back_spec {α : Type u} {n : Usize} [Inhabited α] (a have := h2 i (by int_tac) (by int_tac) simp [*] -def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := +def Slice.subslice (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := -- TODO: not completely sure here if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then ret ⟨ s.val.slice r.start.val r.end_.val, @@ -333,32 +280,21 @@ def Slice.subslice_shared (α : Type u) (s : Slice α) (r : Range Usize) : Resul fail panic @[pspec] -theorem Slice.subslice_shared_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) +theorem Slice.subslice_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : - ∃ ns, subslice_shared α s r = ret ns ∧ + ∃ ns, subslice α s r = ret ns ∧ ns.val = s.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i)) + (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index_s i = s.index_s (r.start.val + i)) := by - simp [subslice_shared, *] + simp [subslice, *] intro i _ _ have := List.index_slice r.start.val r.end_.val i s.val (by scalar_tac) (by scalar_tac) (by trivial) (by scalar_tac) simp [*] -def Slice.subslice_mut (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := - Slice.subslice_shared α s r - -@[pspec] -theorem Slice.subslice_mut_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) - (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : - ∃ ns, subslice_mut α s r = ret ns ∧ - ns.val = s.slice r.start.val r.end_.val ∧ - (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index i = s.index (r.start.val + i)) - := subslice_shared_spec s r h0 h1 - attribute [pp_dot] List.len List.length List.index -- use the dot notation when printing set_option pp.coercions false -- do not print coercions with ↑ (this doesn't parse) -def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) := +def Slice.update_subslice (α : Type u) (s : Slice α) (r : Range Usize) (ss : Slice α) : Result (Slice α) := -- TODO: not completely sure here if h: r.start.val < r.end_.val ∧ r.end_.val ≤ s.length ∧ ss.val.len = r.end_.val - r.start.val then let s_beg := s.val.itake r.start.val @@ -378,13 +314,13 @@ def Slice.subslice_mut_back (α : Type u) (s : Slice α) (r : Range Usize) (ss : fail panic @[pspec] -theorem Slice.subslice_mut_back_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α) +theorem Slice.update_subslice_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α) (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) : - ∃ na, subslice_mut_back α a r ss = ret na ∧ - (∀ i, 0 ≤ i → i < r.start.val → na.index i = a.index i) ∧ - (∀ i, r.start.val ≤ i → i < r.end_.val → na.index i = ss.index (i - r.start.val)) ∧ - (∀ i, r.end_.val ≤ i → i < a.length → na.index i = a.index i) := by - simp [subslice_mut_back, *] + ∃ na, update_subslice α a r ss = ret na ∧ + (∀ i, 0 ≤ i → i < r.start.val → na.index_s i = a.index_s i) ∧ + (∀ i, r.start.val ≤ i → i < r.end_.val → na.index_s i = ss.index_s (i - r.start.val)) ∧ + (∀ i, r.end_.val ≤ i → i < a.length → na.index_s i = a.index_s i) := by + simp [update_subslice, *] have h := List.replace_slice_index r.start.val r.end_.val a.val ss.val (by scalar_tac) (by scalar_tac) (by scalar_tac) (by scalar_tac) simp [List.replace_slice, *] at h diff --git a/compiler/Extract.ml b/compiler/Extract.ml index fdcd82d9..574602c7 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -241,7 +241,7 @@ let rec extract_typed_pattern (ctx : extraction_ctx) (fmt : F.formatter) ctx | PatVar (v, _) -> let vname = - ctx.fmt.var_basename ctx.names_map.names_set v.basename v.ty + ctx.fmt.var_basename ctx.names_maps.names_map.names_set v.basename v.ty in let ctx, vname = ctx_add_var vname v.id ctx in F.pp_print_string fmt vname; diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 7e8e4ffc..8f71116c 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -520,23 +520,6 @@ let names_map_add (id_to_string : id -> string) (id : id) (name : string) let names_set = StringSet.add name nm.names_set in { id_to_name; name_to_id; names_set } -let names_map_add_assumed_type (id_to_string : id -> string) (id : assumed_ty) - (name : string) (nm : names_map) : names_map = - names_map_add id_to_string (TypeId (Assumed id)) name nm - -let names_map_add_assumed_struct (id_to_string : id -> string) (id : assumed_ty) - (name : string) (nm : names_map) : names_map = - names_map_add id_to_string (StructId (Assumed id)) name nm - -let names_map_add_assumed_variant (id_to_string : id -> string) - (id : assumed_ty) (variant_id : VariantId.id) (name : string) - (nm : names_map) : names_map = - names_map_add id_to_string (VariantId (Assumed id, variant_id)) name nm - -let names_map_add_function (id_to_string : id -> string) (fid : fun_id) - (name : string) (nm : names_map) : names_map = - names_map_add id_to_string (FunId fid) name nm - (** The unsafe names map stores mappings from identifiers to names which might collide. For some backends and some names, it might be acceptable to have collisions. For instance, in Lean, different records can have fields with @@ -547,6 +530,8 @@ let names_map_add_function (id_to_string : id -> string) (fid : fun_id) *) type unsafe_names_map = { id_to_name : string IdMap.t } +let empty_unsafe_names_map = { id_to_name = IdMap.empty } + let unsafe_names_map_add (id : id) (name : string) (nm : unsafe_names_map) : unsafe_names_map = { id_to_name = IdMap.add id name nm.id_to_name } @@ -585,16 +570,7 @@ let basename_to_unique (names_set : StringSet.t) type fun_name_info = { keep_fwd : bool; num_backs : int } -(** Extraction context. - - Note that the extraction context contains information coming from the - LLBC AST (not only the pure AST). This is useful for naming, for instance: - we use the region information to generate the names of the backward - functions, etc. - *) -type extraction_ctx = { - crate : A.crate; - trans_ctx : trans_ctx; +type names_maps = { names_map : names_map; (** The map for id to names, where we forbid name collisions (ex.: we always forbid function name collisions). *) @@ -610,6 +586,19 @@ type extraction_ctx = { the name "u32", and another field of the same record refers to "u32" (for instance in its type). *) +} + +(** Extraction context. + + Note that the extraction context contains information coming from the + LLBC AST (not only the pure AST). This is useful for naming, for instance: + we use the region information to generate the names of the backward + functions, etc. + *) +type extraction_ctx = { + crate : A.crate; + trans_ctx : trans_ctx; + names_maps : names_maps; fmt : formatter; indent_incr : int; (** The indent increment we insert whenever we need to indent more *) @@ -836,12 +825,15 @@ let allow_collisions (id : id) : bool = | FieldId _ | TraitItemClauseId _ | TraitParentClauseId _ | TraitItemId _ | TraitMethodId _ -> !Config.record_fields_short_names + | FunId (Pure _ | FromLlbc (FunId (Assumed _), _, _)) -> + (* We map several assumed functions to the same id *) + true | _ -> false -let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = - (* The id_to_string function to print nice debugging messages if there are - * collisions *) - let id_to_string (id : id) : string = id_to_string id ctx in +(** The [id_to_string] function to print nice debugging messages if there are + collisions *) +let names_maps_add (id_to_string : id -> string) (id : id) (name : string) + (nm : names_maps) : names_maps = (* We do not use the same name map if we allow/disallow collisions. We notably use it for field names: some backends like Lean can use the type information to disambiguate field projections. @@ -856,59 +848,90 @@ let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = *) if allow_collisions id then ( (* Check with the ids which are considered to be strict on collisions *) - names_map_check_collision id_to_string id name ctx.strict_names_map; + names_map_check_collision id_to_string id name nm.strict_names_map; { - ctx with - unsafe_names_map = unsafe_names_map_add id name ctx.unsafe_names_map; + nm with + unsafe_names_map = unsafe_names_map_add id name nm.unsafe_names_map; }) else (* Remark: if we are strict on collisions: - we add the id to the strict collisions map - we check that the id doesn't collide with the unsafe map + TODO: we might not check that: + - a user defined function doesn't collide with an assumed function + - two trait decl items don't collide with each other *) let strict_names_map = if strict_collisions id then - names_map_add id_to_string id name ctx.strict_names_map - else ctx.strict_names_map + names_map_add id_to_string id name nm.strict_names_map + else nm.strict_names_map in - let names_map = names_map_add id_to_string id name ctx.names_map in - { ctx with strict_names_map; names_map } + let names_map = names_map_add id_to_string id name nm.names_map in + { nm with strict_names_map; names_map } -let ctx_get (id : id) (ctx : extraction_ctx) : string = +let ctx_add (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = + let id_to_string (id : id) : string = id_to_string id ctx in + let names_maps = names_maps_add id_to_string id name ctx.names_maps in + { ctx with names_maps } + +(** The [id_to_string] function to print nice debugging messages if there are + collisions *) +let names_maps_get (id_to_string : id -> string) (id : id) (nm : names_maps) : + string = (* We do not use the same name map if we allow/disallow collisions *) let map_to_string (m : string IdMap.t) : string = "[\n" ^ String.concat "," (List.map - (fun (id, n) -> "\n " ^ id_to_string id ctx ^ " -> " ^ n) + (fun (id, n) -> "\n " ^ id_to_string id ^ " -> " ^ n) (IdMap.bindings m)) ^ "\n]" in if allow_collisions id then ( - let m = ctx.unsafe_names_map.id_to_name in + let m = nm.unsafe_names_map.id_to_name in match IdMap.find_opt id m with | Some s -> s | None -> let err = - "Could not find: " ^ id_to_string id ctx ^ "\nNames map:\n" + "Could not find: " ^ id_to_string id ^ "\nNames map:\n" ^ map_to_string m in log#serror err; if !Config.extract_fail_hard then raise (Failure err) - else - "(%%%ERROR: unknown identifier\": " ^ id_to_string id ctx ^ "\"%%%)") + else "(%%%ERROR: unknown identifier\": " ^ id_to_string id ^ "\"%%%)") else - let m = ctx.names_map.id_to_name in + let m = nm.names_map.id_to_name in match IdMap.find_opt id m with | Some s -> s | None -> let err = - "Could not find: " ^ id_to_string id ctx ^ "\nNames map:\n" + "Could not find: " ^ id_to_string id ^ "\nNames map:\n" ^ map_to_string m in log#serror err; if !Config.extract_fail_hard then raise (Failure err) - else "(ERROR: \"" ^ id_to_string id ctx ^ "\")" + else "(ERROR: \"" ^ id_to_string id ^ "\")" + +let ctx_get (id : id) (ctx : extraction_ctx) : string = + let id_to_string (id : id) : string = id_to_string id ctx in + names_maps_get id_to_string id ctx.names_maps + +let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty) + (name : string) (nm : names_maps) : names_maps = + names_maps_add id_to_string (TypeId (Assumed id)) name nm + +let names_maps_add_assumed_struct (id_to_string : id -> string) + (id : assumed_ty) (name : string) (nm : names_maps) : names_maps = + names_maps_add id_to_string (StructId (Assumed id)) name nm + +let names_maps_add_assumed_variant (id_to_string : id -> string) + (id : assumed_ty) (variant_id : VariantId.id) (name : string) + (nm : names_maps) : names_maps = + names_maps_add id_to_string (VariantId (Assumed id, variant_id)) name nm + +let names_maps_add_function (id_to_string : id -> string) (fid : fun_id) + (name : string) (nm : names_maps) : names_maps = + names_maps_add id_to_string (FunId fid) name nm let ctx_get_global (id : A.GlobalDeclId.id) (ctx : extraction_ctx) : string = ctx_get (GlobalId id) ctx @@ -999,9 +1022,12 @@ let ctx_get_termination_measure (def_id : A.FunDeclId.id) (** Generate a unique type variable name and add it to the context *) let ctx_add_type_var (basename : string) (id : TypeVarId.id) (ctx : extraction_ctx) : extraction_ctx * string = - let name = ctx.fmt.type_var_basename ctx.names_map.names_set basename in let name = - basename_to_unique ctx.names_map.names_set ctx.fmt.append_index name + ctx.fmt.type_var_basename ctx.names_maps.names_map.names_set basename + in + let name = + basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index + name in let ctx = ctx_add (TypeVarId id) name ctx in (ctx, name) @@ -1010,10 +1036,12 @@ let ctx_add_type_var (basename : string) (id : TypeVarId.id) let ctx_add_const_generic_var (basename : string) (id : ConstGenericVarId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = - ctx.fmt.const_generic_var_basename ctx.names_map.names_set basename + ctx.fmt.const_generic_var_basename ctx.names_maps.names_map.names_set + basename in let name = - basename_to_unique ctx.names_map.names_set ctx.fmt.append_index name + basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index + name in let ctx = ctx_add (ConstGenericVarId id) name ctx in (ctx, name) @@ -1029,7 +1057,8 @@ let ctx_add_type_vars (vars : (string * TypeVarId.id) list) let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = - basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename + basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index + basename in let ctx = ctx_add (VarId id) name ctx in (ctx, name) @@ -1038,7 +1067,8 @@ let ctx_add_var (basename : string) (id : VarId.id) (ctx : extraction_ctx) : let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string = let basename = ctx.fmt.trait_self_clause_basename in let name = - basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename + basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index + basename in let ctx = ctx_add TraitSelfClauseId name ctx in (ctx, name) @@ -1047,7 +1077,8 @@ let ctx_add_trait_self_clause (ctx : extraction_ctx) : extraction_ctx * string = let ctx_add_local_trait_clause (basename : string) (id : TraitClauseId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = - basename_to_unique ctx.names_map.names_set ctx.fmt.append_index basename + basename_to_unique ctx.names_maps.names_map.names_set ctx.fmt.append_index + basename in let ctx = ctx_add (LocalTraitClauseId id) name ctx in (ctx, name) @@ -1057,7 +1088,9 @@ let ctx_add_vars (vars : var list) (ctx : extraction_ctx) : extraction_ctx * string list = List.fold_left_map (fun ctx (v : var) -> - let name = ctx.fmt.var_basename ctx.names_map.names_set v.basename v.ty in + let name = + ctx.fmt.var_basename ctx.names_maps.names_map.names_set v.basename v.ty + in ctx_add_var name v.id ctx) ctx vars @@ -1078,7 +1111,9 @@ let ctx_add_local_trait_clauses (clauses : trait_clause list) (ctx : extraction_ctx) : extraction_ctx * string list = List.fold_left_map (fun ctx (c : trait_clause) -> - let basename = ctx.fmt.trait_clause_basename ctx.names_map.names_set c in + let basename = + ctx.fmt.trait_clause_basename ctx.names_maps.names_map.names_set c + in ctx_add_local_trait_clause basename c.clause_id ctx) ctx clauses @@ -1189,9 +1224,10 @@ type names_map_init = { assumed_pure_functions : (pure_assumed_fun_id * string) list; } -(** Initialize a names map with a proper set of keywords/names coming from the +(** Initialize names maps with a proper set of keywords/names coming from the target language/prover. *) -let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map = +let initialize_names_maps (fmt : formatter) (init : names_map_init) : names_maps + = let int_names = List.map fmt.int_name T.all_int_types in let keywords = List.concat @@ -1207,7 +1243,10 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map = * Also note that we don't need this mapping for keywords: we insert keywords only * to check collisions. *) let id_to_name = IdMap.empty in - let nm = { id_to_name; name_to_id; names_set } in + let names_map = { id_to_name; name_to_id; names_set } in + let unsafe_names_map = empty_unsafe_names_map in + let strict_names_map = empty_names_map in + let nm = { names_map; unsafe_names_map; strict_names_map } in (* For debugging - we are creating bindings for assumed types and functions, so * it is ok if we simply use the "show" function (those aren't simply identified * by numbers) *) @@ -1221,19 +1260,19 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map = let nm = List.fold_left (fun nm (type_id, name) -> - names_map_add_assumed_type id_to_string type_id name nm) + names_maps_add_assumed_type id_to_string type_id name nm) nm init.assumed_adts in let nm = List.fold_left (fun nm (type_id, name) -> - names_map_add_assumed_struct id_to_string type_id name nm) + names_maps_add_assumed_struct id_to_string type_id name nm) nm init.assumed_structs in let nm = List.fold_left (fun nm (type_id, variant_id, name) -> - names_map_add_assumed_variant id_to_string type_id variant_id name nm) + names_maps_add_assumed_variant id_to_string type_id variant_id name nm) nm init.assumed_variants in let assumed_functions = @@ -1245,7 +1284,7 @@ let initialize_names_map (fmt : formatter) (init : names_map_init) : names_map = in let nm = List.fold_left - (fun nm (fid, name) -> names_map_add_function id_to_string fid name nm) + (fun nm (fid, name) -> names_maps_add_function id_to_string fid name nm) nm assumed_functions in (* Return *) diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index 219f273f..fd3baf0d 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -300,30 +300,30 @@ let assumed_llbc_functions () : match !backend with | FStar | Coq | HOL4 -> [ - (ArrayIndexShared, None, "array_index_shared"); - (ArrayIndexMut, None, "array_index_mut_fwd"); - (ArrayIndexMut, rg0, "array_index_mut_back"); - (ArrayToSliceShared, None, "array_to_slice_shared"); - (ArrayToSliceMut, None, "array_to_slice_mut_fwd"); - (ArrayToSliceMut, rg0, "array_to_slice_mut_back"); + (ArrayIndexShared, None, "array_index_usize"); + (ArrayIndexMut, None, "array_index_usize"); + (ArrayIndexMut, rg0, "array_update_usize"); + (ArrayToSliceShared, None, "array_to_slice"); + (ArrayToSliceMut, None, "array_to_slice"); + (ArrayToSliceMut, rg0, "array_from_slice"); (ArrayRepeat, None, "array_repeat"); - (SliceIndexShared, None, "slice_index_shared"); - (SliceIndexMut, None, "slice_index_mut_fwd"); - (SliceIndexMut, rg0, "slice_index_mut_back"); + (SliceIndexShared, None, "slice_index_usize"); + (SliceIndexMut, None, "slice_index_usize"); + (SliceIndexMut, rg0, "slice_update_usize"); (SliceLen, None, "slice_len"); ] | Lean -> [ - (ArrayIndexShared, None, "Array.index_shared"); - (ArrayIndexMut, None, "Array.index_mut"); - (ArrayIndexMut, rg0, "Array.index_mut_back"); - (ArrayToSliceShared, None, "Array.to_slice_shared"); - (ArrayToSliceMut, None, "Array.to_slice_mut"); - (ArrayToSliceMut, rg0, "Array.to_slice_mut_back"); + (ArrayIndexShared, None, "Array.index_usize"); + (ArrayIndexMut, None, "Array.index_usize"); + (ArrayIndexMut, rg0, "Array.update_usize"); + (ArrayToSliceShared, None, "Array.to_slice"); + (ArrayToSliceMut, None, "Array.to_slice"); + (ArrayToSliceMut, rg0, "Array.from_slice"); (ArrayRepeat, None, "Array.repeat"); - (SliceIndexShared, None, "Slice.index_shared"); - (SliceIndexMut, None, "Slice.index_mut"); - (SliceIndexMut, rg0, "Slice.index_mut_back"); + (SliceIndexShared, None, "Slice.index_usize"); + (SliceIndexMut, None, "Slice.index_usize"); + (SliceIndexMut, rg0, "Slice.update_usize"); (SliceLen, None, "Slice.len"); ] @@ -941,11 +941,11 @@ let mk_formatter (ctx : trans_ctx) (crate_name : string) extract_binop; } -let mk_formatter_and_names_map (ctx : trans_ctx) (crate_name : string) - (variant_concatenate_type_name : bool) : formatter * names_map = +let mk_formatter_and_names_maps (ctx : trans_ctx) (crate_name : string) + (variant_concatenate_type_name : bool) : formatter * names_maps = let fmt = mk_formatter ctx crate_name variant_concatenate_type_name in - let names_map = initialize_names_map fmt (names_map_init ()) in - (fmt, names_map) + let names_maps = initialize_names_maps fmt (names_map_init ()) in + (fmt, names_maps) let is_single_opaque_fun_decl_group (dg : Pure.fun_decl list) : bool = match dg with [ d ] -> d.body = None | _ -> false @@ -1507,8 +1507,8 @@ let extract_type_decl_variant (ctx : extraction_ctx) (fmt : F.formatter) | Some field_name -> let var_id = VarId.of_int (FieldId.to_int fid) in let field_name = - ctx.fmt.var_basename ctx.names_map.names_set (Some field_name) - f.field_ty + ctx.fmt.var_basename ctx.names_maps.names_map.names_set + (Some field_name) f.field_ty in let ctx, field_name = ctx_add_var field_name var_id ctx in F.pp_print_string fmt (field_name ^ " :"); diff --git a/compiler/Translate.ml b/compiler/Translate.ml index c5ac4e96..cb23198a 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -990,23 +990,10 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : in (* Initialize the names map (we insert the names of the "primitives" declarations, and insert the names of the local declarations later) *) - let mk_formatter_and_names_map = Extract.mk_formatter_and_names_map in - let fmt, names_map = - mk_formatter_and_names_map trans_ctx crate.name + let fmt, names_maps = + Extract.mk_formatter_and_names_maps trans_ctx crate.name variant_concatenate_type_name in - let strict_names_map = - let open ExtractBase in - let ids = - List.filter - (fun (id, _) -> strict_collisions id) - (IdMap.bindings names_map.id_to_name) - in - List.fold_left - (* id_to_string: we shouldn't need to use it *) - (fun m (id, n) -> names_map_add show_id id n m) - empty_names_map ids - in (* We need to compute which functions are recursive, in order to know * whether we should generate a decrease clause or not. *) @@ -1060,9 +1047,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : { ExtractBase.crate; trans_ctx; - names_map; - unsafe_names_map = { id_to_name = ExtractBase.IdMap.empty }; - strict_names_map; + names_maps; fmt; indent_incr = 2; use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses; -- cgit v1.3.1 From 442f0aede5da127b4828a90bcbade73a345340e3 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 14:10:57 +0200 Subject: Make progress on fixing the extraction --- backends/lean/Base/Primitives/ArraySlice.lean | 128 +++++++++++++------------- compiler/ExtractBuiltin.ml | 32 +++++-- 2 files changed, 88 insertions(+), 72 deletions(-) (limited to 'backends') diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index 2a080ca6..cfc9a6b2 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -341,110 +341,110 @@ theorem Slice.update_subslice_spec {α : Type u} [Inhabited α] (a : Slice α) ( structure core.slice.index.private_slice_index.Sealed (Self : Type) where /- Trait declaration: [core::slice::index::SliceIndex] -/ -structure core.slice.index.SliceIndex (Self T0 : Type) where +structure core.slice.index.SliceIndex (Self T : Type) where sealedInst : core.slice.index.private_slice_index.Sealed Self Output : Type - get : Self → T0 → Result (Option Output) - get_mut : Self → T0 → Result (Option Output) - get_mut_back : Self → T0 → Option Output → Result T0 - get_unchecked : Self → ConstRawPtr T0 → Result (ConstRawPtr Output) - get_unchecked_mut : Self → MutRawPtr T0 → Result (MutRawPtr Output) - index : Self → T0 → Result Output - index_mut : Self → T0 → Result Output - index_mut_back : Self → T0 → Output → Result T0 + get : Self → T → Result (Option Output) + get_mut : Self → T → Result (Option Output) + get_mut_back : Self → T → Option Output → Result T + get_unchecked : Self → ConstRawPtr T → Result (ConstRawPtr Output) + get_unchecked_mut : Self → MutRawPtr T → Result (MutRawPtr Output) + index : Self → T → Result Output + index_mut : Self → T → Result Output + index_mut_back : Self → T → Output → Result T /- [core::slice::index::[T]::index]: forward function -/ def core.slice.index.Slice.index - (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) - (slice : Slice T0) (i : I) : Result inst.Output := do + (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) + (slice : Slice T) (i : I) : Result inst.Output := do let x ← inst.get i slice match x with | none => fail panic | some x => ret x /- [core::slice::index::Range:::get]: forward function -/ -def core.slice.index.Range.get (T0 : Type) (i : Range Usize) (slice : Slice T0) : - Result (Option (Slice T0)) := +def core.slice.index.Range.get (T : Type) (i : Range Usize) (slice : Slice T) : + Result (Option (Slice T)) := sorry -- TODO /- [core::slice::index::Range::get_mut]: forward function -/ def core.slice.index.Range.get_mut - (T0 : Type) : Range Usize → Slice T0 → Result (Option (Slice T0)) := + (T : Type) : Range Usize → Slice T → Result (Option (Slice T)) := sorry -- TODO /- [core::slice::index::Range::get_mut]: backward function 0 -/ def core.slice.index.Range.get_mut_back - (T0 : Type) : - Range Usize → Slice T0 → Option (Slice T0) → Result (Slice T0) := + (T : Type) : + Range Usize → Slice T → Option (Slice T) → Result (Slice T) := sorry -- TODO /- [core::slice::index::Range::get_unchecked]: forward function -/ def core.slice.index.Range.get_unchecked - (T0 : Type) : - Range Usize → ConstRawPtr (Slice T0) → Result (ConstRawPtr (Slice T0)) := + (T : Type) : + Range Usize → ConstRawPtr (Slice T) → Result (ConstRawPtr (Slice T)) := -- Don't know what the model should be - for now we always fail to make -- sure code which uses it fails fun _ _ => fail panic /- [core::slice::index::Range::get_unchecked_mut]: forward function -/ def core.slice.index.Range.get_unchecked_mut - (T0 : Type) : - Range Usize → MutRawPtr (Slice T0) → Result (MutRawPtr (Slice T0)) := + (T : Type) : + Range Usize → MutRawPtr (Slice T) → Result (MutRawPtr (Slice T)) := -- Don't know what the model should be - for now we always fail to make -- sure code which uses it fails fun _ _ => fail panic /- [core::slice::index::Range::index]: forward function -/ def core.slice.index.Range.index - (T0 : Type) : Range Usize → Slice T0 → Result (Slice T0) := + (T : Type) : Range Usize → Slice T → Result (Slice T) := sorry -- TODO /- [core::slice::index::Range::index_mut]: forward function -/ def core.slice.index.Range.index_mut - (T0 : Type) : Range Usize → Slice T0 → Result (Slice T0) := + (T : Type) : Range Usize → Slice T → Result (Slice T) := sorry -- TODO /- [core::slice::index::Range::index_mut]: backward function 0 -/ def core.slice.index.Range.index_mut_back - (T0 : Type) : Range Usize → Slice T0 → Slice T0 → Result (Slice T0) := + (T : Type) : Range Usize → Slice T → Slice T → Result (Slice T) := sorry -- TODO /- [core::slice::index::[T]::index_mut]: forward function -/ def core.slice.index.Slice.index_mut - (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) : - Slice T0 → I → Result inst.Output := + (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) : + Slice T → I → Result inst.Output := sorry -- TODO /- [core::slice::index::[T]::index_mut]: backward function 0 -/ def core.slice.index.Slice.index_mut_back - (T0 I : Type) (inst : core.slice.index.SliceIndex I (Slice T0)) : - Slice T0 → I → inst.Output → Result (Slice T0) := + (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) : + Slice T → I → inst.Output → Result (Slice T) := sorry -- TODO /- [core::array::[T; N]::index]: forward function -/ def core.array.Array.index - (T0 I : Type) (N : Usize) (inst : core.ops.index.Index (Slice T0) I) : - Array T0 N → I → Result inst.Output := + (T I : Type) (N : Usize) (inst : core.ops.index.Index (Slice T) I) + (a : Array T N) (i : I) : Result inst.Output := sorry -- TODO /- [core::array::[T; N]::index_mut]: forward function -/ def core.array.Array.index_mut - (T0 I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T0) I) : - Array T0 N → I → Result inst.indexInst.Output := + (T I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T) I) + (a : Array T N) (i : I) : Result inst.indexInst.Output := sorry -- TODO /- [core::array::[T; N]::index_mut]: backward function 0 -/ def core.array.Array.index_mut_back - (T0 I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T0) I) : - Array T0 N → I → inst.indexInst.Output → Result (Array T0 N) := + (T I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T) I) + (a : Array T N) (i : I) (x : inst.indexInst.Output) : Result (Array T N) := sorry -- TODO /- Trait implementation: [core::slice::index::[T]] -/ -def core.slice.index.Slice.coreopsindexIndexInst (T0 I : Type) - (inst : core.slice.index.SliceIndex I (Slice T0)) : - core.ops.index.Index (Slice T0) I := { +def core.slice.index.Slice.coreopsindexIndexInst (T I : Type) + (inst : core.slice.index.SliceIndex I (Slice T)) : + core.ops.index.Index (Slice T) I := { Output := inst.Output - index := core.slice.index.Slice.index T0 I inst + index := core.slice.index.Slice.index T I inst } /- Trait implementation: [core::slice::index::private_slice_index::Range] -/ @@ -452,45 +452,45 @@ def core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_index : core.slice.index.private_slice_index.Sealed (Range Usize) := {} /- Trait implementation: [core::slice::index::Range] -/ -def core.slice.index.Range.coresliceindexSliceIndexInst (T0 : Type) : - core.slice.index.SliceIndex (Range Usize) (Slice T0) := { +def core.slice.index.Range.coresliceindexSliceIndexInst (T : Type) : + core.slice.index.SliceIndex (Range Usize) (Slice T) := { sealedInst := core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst - Output := Slice T0 - get := core.slice.index.Range.get T0 - get_mut := core.slice.index.Range.get_mut T0 - get_mut_back := core.slice.index.Range.get_mut_back T0 - get_unchecked := core.slice.index.Range.get_unchecked T0 - get_unchecked_mut := core.slice.index.Range.get_unchecked_mut T0 - index := core.slice.index.Range.index T0 - index_mut := core.slice.index.Range.index_mut T0 - index_mut_back := core.slice.index.Range.index_mut_back T0 + Output := Slice T + get := core.slice.index.Range.get T + get_mut := core.slice.index.Range.get_mut T + get_mut_back := core.slice.index.Range.get_mut_back T + get_unchecked := core.slice.index.Range.get_unchecked T + get_unchecked_mut := core.slice.index.Range.get_unchecked_mut T + index := core.slice.index.Range.index T + index_mut := core.slice.index.Range.index_mut T + index_mut_back := core.slice.index.Range.index_mut_back T } /- Trait implementation: [core::slice::index::[T]] -/ -def core.slice.index.Slice.coreopsindexIndexMutInst (T0 I : Type) - (inst : core.slice.index.SliceIndex I (Slice T0)) : - core.ops.index.IndexMut (Slice T0) I := { - indexInst := core.slice.index.Slice.coreopsindexIndexInst T0 I inst - index_mut := core.slice.index.Slice.index_mut T0 I inst - index_mut_back := core.slice.index.Slice.index_mut_back T0 I inst +def core.slice.index.Slice.coreopsindexIndexMutInst (T I : Type) + (inst : core.slice.index.SliceIndex I (Slice T)) : + core.ops.index.IndexMut (Slice T) I := { + indexInst := core.slice.index.Slice.coreopsindexIndexInst T I inst + index_mut := core.slice.index.Slice.index_mut T I inst + index_mut_back := core.slice.index.Slice.index_mut_back T I inst } /- Trait implementation: [core::array::[T; N]] -/ -def core.array.Array.coreopsindexIndexInst (T0 I : Type) (N : Usize) - (inst : core.ops.index.Index (Slice T0) I) : - core.ops.index.Index (Array T0 N) I := { +def core.array.Array.coreopsindexIndexInst (T I : Type) (N : Usize) + (inst : core.ops.index.Index (Slice T) I) : + core.ops.index.Index (Array T N) I := { Output := inst.Output - index := core.array.Array.index T0 I N inst + index := core.array.Array.index T I N inst } /- Trait implementation: [core::array::[T; N]] -/ -def core.array.Array.coreopsindexIndexMutInst (T0 I : Type) (N : Usize) - (inst : core.ops.index.IndexMut (Slice T0) I) : - core.ops.index.IndexMut (Array T0 N) I := { - indexInst := core.array.Array.coreopsindexIndexInst T0 I N inst.indexInst - index_mut := core.array.Array.index_mut T0 I N inst - index_mut_back := core.array.Array.index_mut_back T0 I N inst +def core.array.Array.coreopsindexIndexMutInst (T I : Type) (N : Usize) + (inst : core.ops.index.IndexMut (Slice T) I) : + core.ops.index.IndexMut (Array T N) I := { + indexInst := core.array.Array.coreopsindexIndexInst T I N inst.indexInst + index_mut := core.array.Array.index_mut T I N inst + index_mut_back := core.array.Array.index_mut_back T I N inst } /- [core::slice::index::usize::get]: forward function -/ diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index 8fcdea56..afa0dd6f 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -528,12 +528,18 @@ module SimpleNamePairMap = Collections.MakeMap (SimpleNamePairOrd) let builtin_trait_impls_info () : ((string list * string list) * (bool list option * string)) list = - let fmt (type_name : string list) (trait_name : string list) - ?(filter : bool list option = None) () : + let fmt (type_name : string list) + ?(extract_type_name : string list option = None) + (trait_name : string list) ?(filter : bool list option = None) () : (string list * string list) * (bool list option * string) = let name = let trait_name = String.concat "" trait_name ^ "Inst" in let sep = backend_choice "_" "." in + let type_name = + match extract_type_name with + | Some type_name -> type_name + | None -> type_name + in String.concat sep type_name ^ sep ^ trait_name in ((type_name, trait_name), (filter, name)) @@ -547,8 +553,15 @@ let builtin_trait_impls_info () : (* core::ops::index::Index<[T], I> *) fmt [ "core"; "slice"; "index"; "[T]" ] + ~extract_type_name:(Some [ "core"; "slice"; "index"; "Slice" ]) [ "core"; "ops"; "index"; "Index" ] (); + (* core::ops::index::IndexMut<[T], I> *) + fmt + [ "core"; "slice"; "index"; "[T]" ] + ~extract_type_name:(Some [ "core"; "slice"; "index"; "Slice" ]) + [ "core"; "ops"; "index"; "IndexMut" ] + (); (* core::slice::index::private_slice_index::Sealed> *) fmt [ "core"; "slice"; "index"; "private_slice_index"; "Range" ] @@ -559,15 +572,18 @@ let builtin_trait_impls_info () : [ "core"; "slice"; "index"; "Range" ] [ "core"; "slice"; "index"; "SliceIndex" ] (); - (* core::ops::index::IndexMut<[T], I> *) + (* core::ops::index::Index<[T; N], I> *) fmt - [ "core"; "slice"; "index"; "[T]" ] - [ "core"; "ops"; "index"; "IndexMut" ] + [ "core"; "array"; "[T; N]" ] + ~extract_type_name:(Some [ "core"; "array"; "Array" ]) + [ "core"; "ops"; "index"; "Index" ] (); - (* core::ops::index::Index<[T; N], I> *) - fmt [ "core"; "array"; "[T; N]" ] [ "core"; "ops"; "index"; "Index" ] (); (* core::ops::index::IndexMut<[T; N], I> *) - fmt [ "core"; "array"; "[T; N]" ] [ "core"; "ops"; "index"; "IndexMut" ] (); + fmt + [ "core"; "array"; "[T; N]" ] + ~extract_type_name:(Some [ "core"; "array"; "Array" ]) + [ "core"; "ops"; "index"; "IndexMut" ] + (); (* core::slice::index::private_slice_index::Sealed *) fmt [ "core"; "slice"; "index"; "private_slice_index"; "usize" ] -- cgit v1.3.1 From c8c9be9b7d9866f9761a21adbadd923d4a79bb09 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 26 Oct 2023 15:55:12 +0200 Subject: Update Primitives.fst --- backends/fstar/Primitives.fst | 366 ++++++++++++++++++--- tests/fstar/array/Primitives.fst | 384 +++++++++++++++++++--- tests/fstar/betree/Primitives.fst | 384 +++++++++++++++++++--- tests/fstar/betree_back_stateful/Primitives.fst | 384 +++++++++++++++++++--- tests/fstar/demo/Primitives.fst | 405 ++++++++++++++++++++++++ tests/fstar/hashmap/Primitives.fst | 384 +++++++++++++++++++--- tests/fstar/hashmap_on_disk/Primitives.fst | 384 +++++++++++++++++++--- tests/fstar/misc/Primitives.fst | 384 +++++++++++++++++++--- 8 files changed, 2757 insertions(+), 318 deletions(-) create mode 100644 tests/fstar/demo/Primitives.fst (limited to 'backends') diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 7d0845ed..5e154122 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -101,8 +105,8 @@ type scalar_ty = | U128 let is_unsigned = function -| Isize | I8 | I16 | I32 | I64 | I128 -> false -| Usize | U8 | U16 | U32 | U64 | U128 -> true + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true let scalar_min (ty : scalar_ty) : int = @@ -307,12 +311,58 @@ let u32_xor = scalar_lxor #U32 let u64_xor = scalar_lxor #U64 let u128_xor = scalar_lxor #U128 -(*** Range *) -type range (a : Type0) = { +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -326,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -343,58 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = - admit() - -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -409,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} diff --git a/tests/fstar/array/Primitives.fst b/tests/fstar/array/Primitives.fst index cd18cf29..5e154122 100644 --- a/tests/fstar/array/Primitives.fst +++ b/tests/fstar/array/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -100,6 +104,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +171,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +276,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,12 +304,65 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -(*** Range *) -type range (a : Type0) = { +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -305,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -322,55 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -385,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index cd18cf29..5e154122 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -100,6 +104,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +171,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +276,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,12 +304,65 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -(*** Range *) -type range (a : Type0) = { +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -305,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -322,55 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -385,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst index cd18cf29..5e154122 100644 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ b/tests/fstar/betree_back_stateful/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -100,6 +104,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +171,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +276,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,12 +304,65 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -(*** Range *) -type range (a : Type0) = { +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -305,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -322,55 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -385,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} diff --git a/tests/fstar/demo/Primitives.fst b/tests/fstar/demo/Primitives.fst new file mode 100644 index 00000000..e9391834 --- /dev/null +++ b/tests/fstar/demo/Primitives.fst @@ -0,0 +1,405 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Return : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Return x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + result b = + match m with + | Return x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +let massert (b:bool) : result unit = if b then Return () else Fail Failure + +// Normalize and unwrap a successful result (used for globals). +let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x +let mem_replace_back (a : Type0) (x : a) (y : a) : a = y + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} + +let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = + if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +/// 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 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 + + +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 +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Substraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +(*** Range *) +type range (a : Type0) = { + start : a; + end_ : a; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Slice *) +type slice (a : Type0) = s:list a{length s <= usize_max} + +let slice_len (a : Type0) (s : slice a) : usize = length s + +let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = + if i < length x then Return (index x i) + else Fail Failure + +let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = + if i < length x then Return (list_update x i nx) + else Fail Failure + +(*** Subslices *) + +let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = + if length s = n then Return s + else Fail Failure + +// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) +let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = + admit() + +let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = + admit() + +let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = + admit() + +let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = + admit() + +let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type vec (a : Type0) = v:list a{length v <= usize_max} + +let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] +let vec_len (a : Type0) (v : vec a) : usize = length v + +// The **forward** function shouldn't be used +let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () +let vec_push_back (a : Type0) (v : vec a) (x : a) : + Pure (result (vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | Return v' -> length v' = length v + 1)) = + if length v < usize_max then begin + (**) assert_norm(length [x] == 1); + (**) append_length v [x]; + (**) assert(length (append v [x]) = length v + 1); + Return (append v [x]) + end + else Fail Failure + +// The **forward** function shouldn't be used +let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure +let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = + if i < length v then Return (list_update v i x) else Fail Failure + +// The **backward** function shouldn't be used +let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = + if i < length v then Return () else Fail Failure + +let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = + if i < length v then Return (index v i) else Fail Failure +let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = + if i < length v then Return (list_update v i nx) else Fail Failure diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index cd18cf29..5e154122 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -100,6 +104,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +171,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +276,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,12 +304,65 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -(*** Range *) -type range (a : Type0) = { +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -305,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -322,55 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -385,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} diff --git a/tests/fstar/hashmap_on_disk/Primitives.fst b/tests/fstar/hashmap_on_disk/Primitives.fst index cd18cf29..5e154122 100644 --- a/tests/fstar/hashmap_on_disk/Primitives.fst +++ b/tests/fstar/hashmap_on_disk/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -100,6 +104,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +171,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +276,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,12 +304,65 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -(*** Range *) -type range (a : Type0) = { +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -305,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -322,55 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -385,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index cd18cf29..5e154122 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -55,8 +55,12 @@ type string = string let is_zero (n: nat) : bool = n = 0 let decrease (n: nat{n > 0}) : nat = n - 1 -let mem_replace_fwd (a : Type0) (x : a) (y : a) : a = x -let mem_replace_back (a : Type0) (x : a) (y : a) : a = y +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 + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated @@ -100,6 +104,11 @@ type scalar_ty = | U64 | U128 +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + + let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -162,6 +171,15 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) +let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = @@ -258,7 +276,7 @@ let u32_add = scalar_add #U32 let u64_add = scalar_add #U64 let u128_add = scalar_add #U128 -/// Substraction +/// Subtraction let isize_sub = scalar_sub #Isize let i8_sub = scalar_sub #I8 let i16_sub = scalar_sub #I16 @@ -286,12 +304,65 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -(*** Range *) -type range (a : Type0) = { +/// Logical operators, defined for unsigned types only, so far +let u8_xor = scalar_lxor #U8 +let u16_xor = scalar_lxor #U16 +let u32_xor = scalar_lxor #U32 +let u64_xor = scalar_lxor #U64 +let u128_xor = scalar_lxor #U128 + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result indexInst.output; + index_mut_back : self → idx → indexInst.output → result self; +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result derefInst.target; + deref_mut_back : self → derefInst.target → result self; +} + +type core_ops_range_Range (a : Type0) = { start : a; end_ : a; } +(*** [alloc] *) + +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x + +// Trait instance +let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreOpsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; + deref_mut_back = alloc_boxed_Box_deref_mut_back self; +} + (*** Array *) type array (a : Type0) (n : usize) = s:list a{length s = n} @@ -305,15 +376,11 @@ let mk_array (a : Type0) (n : usize) normalize_term_spec (FStar.List.Tot.length l); l -let array_index_shared (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let array_index_mut_fwd (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let array_index_mut_back (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = +let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = if i < length x then Return (list_update x i nx) else Fail Failure @@ -322,55 +389,47 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s -let slice_index_shared (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) - else Fail Failure - -let slice_index_mut_fwd (a : Type0) (x : slice a) (i : usize) : result a = +let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = if i < length x then Return (index x i) else Fail Failure -let slice_index_mut_back (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = +let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = if i < length x then Return (list_update x i nx) else Fail Failure (*** Subslices *) -let array_to_slice_shared (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_fwd (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x -let array_to_slice_mut_back (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = if length s = n then Return s else Fail Failure // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice_shared (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = - admit() - -let array_subslice_mut_fwd (a : Type0) (n : usize) (x : array a n) (r : range usize) : result (slice a) = +let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = admit() -let array_subslice_mut_back (a : Type0) (n : usize) (x : array a n) (r : range usize) (ns : slice a) : result (array a n) = +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = admit() -let slice_subslice_shared (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = admit() -let slice_subslice_mut_fwd (a : Type0) (x : slice a) (r : range usize) : result (slice a) = +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = admit() -let slice_subslice_mut_back (a : Type0) (x : slice a) (r : range usize) (ns : slice a) : result (slice a) = +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = admit() (*** Vector *) -type vec (a : Type0) = v:list a{length v <= usize_max} +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} -let vec_new (a : Type0) : vec a = assert_norm(length #a [] == 0); [] -let vec_len (a : Type0) (v : vec a) : usize = length v +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 // The **forward** function shouldn't be used -let vec_push_fwd (a : Type0) (v : vec a) (x : a) : unit = () -let vec_push_back (a : Type0) (v : vec a) (x : a) : - Pure (result (vec a)) +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) : + Pure (result (alloc_vec_Vec a)) (requires True) (ensures (fun res -> match res with @@ -385,18 +444,253 @@ let vec_push_back (a : Type0) (v : vec a) (x : a) : else Fail Failure // The **forward** function shouldn't be used -let vec_insert_fwd (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = +let alloc_vec_Vec_insert_fwd (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result unit = if i < length v then Return () else Fail Failure -let vec_insert_back (a : Type0) (v : vec a) (i : usize) (x : a) : result (vec a) = +let alloc_vec_Vec_insert (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 **backward** function shouldn't be used -let vec_index_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_back (a : Type0) (v : vec a) (i : usize) (x : a) : result unit = - if i < length v then Return () else Fail Failure +// Trait declaration: [core::slice::index::private_slice_index::Sealed] +type core_slice_index_private_slice_index_Sealed (self : Type0) = unit + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output); + get_mut_back : self → t → option output → result t; + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result output; + index_mut_back : self → t → output → result t; +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | Some x -> Return x + +// [core::slice::index::Range:::get]: forward function +let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_Range_get_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: backward function 0 +let core_slice_index_Range_get_mut_back + (t : Type0) : + core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_Range_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_Range_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_Range_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_Range_index_mut + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: backward function 0 +let core_slice_index_Range_index_mut_back + (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result inst.output = + admit () // + +// [core::slice::index::[T]::index_mut]: backward function 0 +let core_slice_index_Slice_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → inst.output → result (slice t) = + admit () // TODO + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : result inst.indexInst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: backward function 0 +let core_array_Array_index_mut_back + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = + admit () // TODO + +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + output = slice t; + get = core_slice_index_Range_get t; + get_mut = core_slice_index_Range_get_mut t; + get_mut_back = core_slice_index_Range_get_mut_back t; + get_unchecked = core_slice_index_Range_get_unchecked t; + get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; + index = core_slice_index_Range_index t; + index_mut = core_slice_index_Range_index_mut t; + index_mut_back = core_slice_index_Range_index_mut_back t; +} -let vec_index_mut_fwd (a : Type0) (v : vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure -let vec_index_mut_back (a : Type0) (v : vec a) (i : usize) (nx : a) : result (vec a) = - if i < length v then Return (list_update v i nx) else Fail Failure +// Trait implementation: [core::slice::index::[T]] +let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; + index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; + index_mut_back = core_array_Array_index_mut_back t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: backward function 0 +let core_slice_index_usize_get_mut_back + (t : Type0) : usize → slice t → option t → result (slice t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: backward function 0 +let core_slice_index_usize_index_mut_back + (t : Type0) : usize → slice t → t → result (slice t) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_mut_back = core_slice_index_usize_get_mut_back t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; + index_mut_back = core_slice_index_usize_index_mut_back t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: backward function 0 +let alloc_vec_Vec_index_mut_back + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) (x : inst.output) : result (alloc_vec_Vec t) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; + index_mut_back = alloc_vec_Vec_index_mut_back t idx inst; +} -- 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 'backends') 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 1c55079dac0c51e45f7d77c67bfdbdb8c52ed192 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 27 Oct 2023 13:26:08 +0200 Subject: Update Primitives.v --- backends/coq/Primitives.v | 402 +++++++++++++++++++++++++++++++++++++++------- 1 file changed, 342 insertions(+), 60 deletions(-) (limited to 'backends') diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index b92eb967..8e0e973d 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -63,13 +63,15 @@ Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) - Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition mem_replace_fwd (a : Type) (x : a) (y : a) : a := x . -Definition mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . +Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. (*** Scalars *) @@ -408,12 +410,75 @@ 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; - end_: T; +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); + core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. +Arguments core_ops_index_IndexMut_index_mut_back {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; }. -Arguments mk_range {_}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); + core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; +}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. +Arguments core_ops_deref_DerefMut_deref_mut_back {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; + core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; +|}. + (*** Arrays *) Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. @@ -436,51 +501,47 @@ Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. (* For initialization *) Axiom array_repeat : forall {T : Type} (n : usize) (x : T), array T n. -Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. Axiom slice_len : forall (T : Type) (s : slice T), usize. -Axiom slice_index_shared : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_fwd : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_back : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). (*** Subslices *) -Axiom array_to_slice_shared : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_fwd : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_back : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). -Axiom array_subslice_shared: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_fwd: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_back: forall (T : Type) (n : usize) (x : array T n) (r : range usize) (ns : slice T), result (array T n). -Axiom slice_subslice_shared: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_fwd: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_back: forall (T : Type) (x : slice T) (r : range usize) (ns : slice T), result (slice T). +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). (*** Vectors *) -Definition vec T := { l: list T | Z.of_nat (length l) <= usize_max }. +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. -Definition vec_to_list {T: Type} (v: vec T) : list T := proj1_sig v. +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. -Definition vec_length {T: Type} (v: vec T) : Z := Z.of_nat (length (vec_to_list v)). +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). -Definition vec_new (T: Type) : vec T := (exist _ [] le_0_usize_max). +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). -Lemma vec_len_in_usize {T} (v: vec T) : usize_min <= vec_length v <= usize_max. +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. Proof. - unfold vec_length, usize_min. + unfold alloc_vec_Vec_length, usize_min. split. - lia. - apply (proj2_sig v). Qed. -Definition vec_len (T: Type) (v: vec T) : usize := - exist _ (vec_length v) (vec_len_in_usize v). +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). Fixpoint list_update {A} (l: list A) (n: nat) (a: A) : list A := @@ -491,50 +552,271 @@ Fixpoint list_update {A} (l: list A) (n: nat) (a: A) | S m => x :: (list_update t m a) end end. -Definition vec_bind {A B} (v: vec A) (f: list A -> result (list B)) : result (vec B) := - l <- f (vec_to_list v) ; +Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := + l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. (* The **forward** function shouldn't be used *) -Definition vec_push_fwd (T: Type) (v: vec T) (x: T) : unit := tt. +Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. -Definition vec_push_back (T: Type) (v: vec T) (x: T) : result (vec T) := - vec_bind v (fun l => Return (l ++ [x])). +Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). (* The **forward** function shouldn't be used *) -Definition vec_insert_fwd (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i +Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => if to_Z i Return n - | None => Fail_ Failure - end. - -Definition vec_index_back (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i Return n - | None => Fail_ Failure +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. +Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Return x end. -Definition vec_index_mut_back (T: Type) (v: vec T) (i: usize) (x: T) : result (vec T) := - vec_bind v (fun l => - if to_Z i slice T -> result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: backward function 0 *) +Axiom core_slice_index_Range_get_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_Range_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_Range_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_Range_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_Range_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: backward function 0 *) +Axiom core_slice_index_Range_index_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). + +(* [core::slice::index::[T]::index_mut]: backward function 0 *) +Axiom core_slice_index_Slice_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: backward function 0 *) +Axiom core_array_Array_index_mut_back : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_Range_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_Range_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; + core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: backward function 0 *) +Axiom core_slice_index_usize_get_mut_back : + forall (T : Type), usize -> slice T -> option T -> result (slice T). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: backward function 0 *) +Axiom core_slice_index_usize_index_mut_back : + forall (T : Type), usize -> slice T -> T -> result (slice T). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: backward function 0 *) +Axiom alloc_vec_Vec_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + 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. End Primitives. -- cgit v1.3.1 From 49117ba254679f98938223711810191c3f7d788f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 27 Oct 2023 13:34:03 +0200 Subject: Regenerate the Coq test files --- backends/coq/Primitives.v | 2 +- tests/coq/array/Array_Funs.v | 402 +++++---- tests/coq/array/Array_Types.v | 4 +- tests/coq/array/Primitives.v | 405 +++++++-- tests/coq/betree/BetreeMain_Funs.v | 1065 ++++++++++++------------ tests/coq/betree/BetreeMain_Opaque.v | 18 +- tests/coq/betree/BetreeMain_Types.v | 92 +- tests/coq/betree/Primitives.v | 405 +++++++-- tests/coq/hashmap/Hashmap_Funs.v | 514 ++++++------ tests/coq/hashmap/Hashmap_Types.v | 30 +- tests/coq/hashmap/Primitives.v | 405 +++++++-- tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 604 +++++++------- tests/coq/hashmap_on_disk/HashmapMain_Opaque.v | 8 +- tests/coq/hashmap_on_disk/HashmapMain_Types.v | 32 +- tests/coq/hashmap_on_disk/Primitives.v | 405 +++++++-- tests/coq/misc/Constants.v | 56 +- tests/coq/misc/External_Funs.v | 39 +- tests/coq/misc/External_Opaque.v | 8 +- tests/coq/misc/External_Types.v | 2 +- tests/coq/misc/Loops.v | 412 ++++----- tests/coq/misc/NoNestedBorrows.v | 305 ++++--- tests/coq/misc/Paper.v | 67 +- tests/coq/misc/PoloniusList.v | 22 +- tests/coq/misc/Primitives.v | 405 +++++++-- 24 files changed, 3589 insertions(+), 2118 deletions(-) (limited to 'backends') diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 8e0e973d..85e38f01 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -499,7 +499,7 @@ Qed. Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. (* For initialization *) -Axiom array_repeat : forall {T : Type} (n : usize) (x : T), array T n. +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). diff --git a/tests/coq/array/Array_Funs.v b/tests/coq/array/Array_Funs.v index 6ff3066a..9980a6e8 100644 --- a/tests/coq/array/Array_Funs.v +++ b/tests/coq/array/Array_Funs.v @@ -10,16 +10,21 @@ Require Export Array_Types. Import Array_Types. Module Array_Funs. +(** [array::incr]: merged forward/backward function + (there is a single backward function, and the forward function returns ()) *) +Definition incr (x : u32) : result u32 := + u32_add x 1%u32. + (** [array::array_to_shared_slice_]: forward function *) -Definition array_to_shared_slice__fwd +Definition array_to_shared_slice_ (T : Type) (s : array T 32%usize) : result (slice T) := - array_to_slice_shared T 32%usize s + array_to_slice T 32%usize s . (** [array::array_to_mut_slice_]: forward function *) -Definition array_to_mut_slice__fwd +Definition array_to_mut_slice_ (T : Type) (s : array T 32%usize) : result (slice T) := - array_to_slice_mut_fwd T 32%usize s + array_to_slice T 32%usize s . (** [array::array_to_mut_slice_]: backward function 0 *) @@ -27,58 +32,44 @@ Definition array_to_mut_slice__back (T : Type) (s : array T 32%usize) (ret : slice T) : result (array T 32%usize) := - array_to_slice_mut_back T 32%usize s ret + array_from_slice T 32%usize s ret . (** [array::array_len]: forward function *) -Definition array_len_fwd (T : Type) (s : array T 32%usize) : result usize := - s0 <- array_to_slice_shared T 32%usize s; let i := slice_len T s0 in Return i +Definition array_len (T : Type) (s : array T 32%usize) : result usize := + s0 <- array_to_slice T 32%usize s; let i := slice_len T s0 in Return i . (** [array::shared_array_len]: forward function *) -Definition shared_array_len_fwd - (T : Type) (s : array T 32%usize) : result usize := - s0 <- array_to_slice_shared T 32%usize s; let i := slice_len T s0 in Return i +Definition shared_array_len (T : Type) (s : array T 32%usize) : result usize := + s0 <- array_to_slice T 32%usize s; let i := slice_len T s0 in Return i . (** [array::shared_slice_len]: forward function *) -Definition shared_slice_len_fwd (T : Type) (s : slice T) : result usize := +Definition shared_slice_len (T : Type) (s : slice T) : result usize := let i := slice_len T s in Return i . (** [array::index_array_shared]: forward function *) -Definition index_array_shared_fwd +Definition index_array_shared (T : Type) (s : array T 32%usize) (i : usize) : result T := - array_index_shared T 32%usize s i + array_index_usize T 32%usize s i . (** [array::index_array_u32]: forward function *) -Definition index_array_u32_fwd - (s : array u32 32%usize) (i : usize) : result u32 := - array_index_shared u32 32%usize s i -. - -(** [array::index_array_generic]: forward function *) -Definition index_array_generic_fwd - (N : usize) (s : array u32 N) (i : usize) : result u32 := - array_index_shared u32 N s i -. - -(** [array::index_array_generic_call]: forward function *) -Definition index_array_generic_call_fwd - (N : usize) (s : array u32 N) (i : usize) : result u32 := - index_array_generic_fwd N s i +Definition 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 *) -Definition index_array_copy_fwd (x : array u32 32%usize) : result u32 := - array_index_shared u32 32%usize x 0%usize +Definition 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 *) -Definition index_mut_array_fwd +Definition index_mut_array (T : Type) (s : array T 32%usize) (i : usize) : result T := - array_index_mut_fwd T 32%usize s i + array_index_usize T 32%usize s i . (** [array::index_mut_array]: backward function 0 *) @@ -86,298 +77,314 @@ Definition index_mut_array_back (T : Type) (s : array T 32%usize) (i : usize) (ret : T) : result (array T 32%usize) := - array_index_mut_back T 32%usize s i ret + array_update_usize T 32%usize s i ret . (** [array::index_slice]: forward function *) -Definition index_slice_fwd (T : Type) (s : slice T) (i : usize) : result T := - slice_index_shared T s i +Definition index_slice (T : Type) (s : slice T) (i : usize) : result T := + slice_index_usize T s i . (** [array::index_mut_slice]: forward function *) -Definition index_mut_slice_fwd - (T : Type) (s : slice T) (i : usize) : result T := - slice_index_mut_fwd T s i +Definition 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 *) Definition index_mut_slice_back (T : Type) (s : slice T) (i : usize) (ret : T) : result (slice T) := - slice_index_mut_back T s i ret + slice_update_usize T s i ret . (** [array::slice_subslice_shared_]: forward function *) -Definition slice_subslice_shared__fwd - (x : slice u32) (y : usize) (z : usize) : result (slice u32) := - slice_subslice_shared u32 x (mk_range y z) +Definition slice_subslice_shared_ + (n : nat) (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 + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [array::slice_subslice_mut_]: forward function *) -Definition slice_subslice_mut__fwd - (x : slice u32) (y : usize) (z : usize) : result (slice u32) := - slice_subslice_mut_fwd u32 x (mk_range y z) +Definition slice_subslice_mut_ + (n : nat) (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 + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [array::slice_subslice_mut_]: backward function 0 *) Definition slice_subslice_mut__back - (x : slice u32) (y : usize) (z : usize) (ret : slice u32) : + (n : nat) (x : slice u32) (y : usize) (z : usize) (ret : slice u32) : result (slice u32) := - slice_subslice_mut_back u32 x (mk_range y z) ret + core_slice_index_Slice_index_mut_back u32 (core_ops_range_Range usize) + (core_slice_index_Range_coresliceindexSliceIndexInst u32) x + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} ret . (** [array::array_to_slice_shared_]: forward function *) -Definition array_to_slice_shared__fwd +Definition 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 *) -Definition array_to_slice_mut__fwd - (x : array u32 32%usize) : result (slice u32) := - array_to_slice_mut_fwd u32 32%usize x +Definition 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 *) Definition array_to_slice_mut__back (x : array u32 32%usize) (ret : slice u32) : result (array u32 32%usize) := - array_to_slice_mut_back u32 32%usize x ret + array_from_slice u32 32%usize x ret . (** [array::array_subslice_shared_]: forward function *) -Definition array_subslice_shared__fwd - (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := - array_subslice_shared u32 32%usize x (mk_range y z) +Definition array_subslice_shared_ + (n : nat) (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 + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [array::array_subslice_mut_]: forward function *) -Definition array_subslice_mut__fwd - (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := - array_subslice_mut_fwd u32 32%usize x (mk_range y z) +Definition array_subslice_mut_ + (n : nat) (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 + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [array::array_subslice_mut_]: backward function 0 *) Definition array_subslice_mut__back - (x : array u32 32%usize) (y : usize) (z : usize) (ret : slice u32) : + (n : nat) (x : array u32 32%usize) (y : usize) (z : usize) (ret : slice u32) + : result (array u32 32%usize) := - array_subslice_mut_back u32 32%usize x (mk_range y z) ret + 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 + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} ret . (** [array::index_slice_0]: forward function *) -Definition index_slice_0_fwd (T : Type) (s : slice T) : result T := - slice_index_shared T s 0%usize +Definition index_slice_0 (T : Type) (s : slice T) : result T := + slice_index_usize T s 0%usize . (** [array::index_array_0]: forward function *) -Definition index_array_0_fwd (T : Type) (s : array T 32%usize) : result T := - array_index_shared T 32%usize s 0%usize +Definition 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 *) -Definition index_index_array_fwd +Definition index_index_array (s : array (array u32 32%usize) 32%usize) (i : usize) (j : usize) : result u32 := - a <- array_index_shared (array u32 32%usize) 32%usize s i; - array_index_shared u32 32%usize a j + a <- array_index_usize (array u32 32%usize) 32%usize s i; + array_index_usize u32 32%usize a j . -(** [array::const_gen_ret]: forward function *) -Definition const_gen_ret_fwd (N : usize) : result usize := - Return N. - (** [array::update_update_array]: forward function *) -Definition update_update_array_fwd +Definition update_update_array (s : array (array u32 32%usize) 32%usize) (i : usize) (j : usize) : result unit := - a <- array_index_mut_fwd (array u32 32%usize) 32%usize s i; - a0 <- array_index_mut_back u32 32%usize a j 0%u32; - _ <- array_index_mut_back (array u32 32%usize) 32%usize s i a0; + a <- array_index_usize (array u32 32%usize) 32%usize s i; + a0 <- array_update_usize u32 32%usize a j 0%u32; + _ <- array_update_usize (array u32 32%usize) 32%usize s i a0; Return tt . (** [array::array_local_deep_copy]: forward function *) -Definition array_local_deep_copy_fwd (x : array u32 32%usize) : result unit := +Definition array_local_deep_copy (x : array u32 32%usize) : result unit := Return tt . (** [array::take_array]: forward function *) -Definition take_array_fwd (a : array u32 2%usize) : result unit := +Definition take_array (a : array u32 2%usize) : result unit := Return tt. (** [array::take_array_borrow]: forward function *) -Definition take_array_borrow_fwd (a : array u32 2%usize) : result unit := +Definition take_array_borrow (a : array u32 2%usize) : result unit := Return tt . (** [array::take_slice]: forward function *) -Definition take_slice_fwd (s : slice u32) : result unit := +Definition take_slice (s : slice u32) : result unit := Return tt. (** [array::take_mut_slice]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition take_mut_slice_fwd_back (s : slice u32) : result (slice u32) := - Return s -. +Definition take_mut_slice (s : slice u32) : result (slice u32) := + Return s. (** [array::take_all]: forward function *) -Definition take_all_fwd : result unit := - _ <- take_array_fwd (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - _ <- take_array_borrow_fwd (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s <- - array_to_slice_shared u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - _ <- take_slice_fwd s; - s0 <- - array_to_slice_mut_fwd u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s1 <- take_mut_slice_fwd_back s0; - _ <- - array_to_slice_mut_back u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) - s1; +Definition take_all : result unit := + _ <- take_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + _ <- take_array_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + _ <- take_slice s; + s0 <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + s1 <- take_mut_slice s0; + _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s1; Return tt . (** [array::index_array]: forward function *) -Definition index_array_fwd (x : array u32 2%usize) : result u32 := - array_index_shared u32 2%usize x 0%usize +Definition index_array (x : array u32 2%usize) : result u32 := + array_index_usize u32 2%usize x 0%usize . (** [array::index_array_borrow]: forward function *) -Definition index_array_borrow_fwd (x : array u32 2%usize) : result u32 := - array_index_shared u32 2%usize x 0%usize +Definition 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 *) -Definition index_slice_u32_0_fwd (x : slice u32) : result u32 := - slice_index_shared u32 x 0%usize +Definition index_slice_u32_0 (x : slice u32) : result u32 := + slice_index_usize u32 x 0%usize . (** [array::index_mut_slice_u32_0]: forward function *) -Definition index_mut_slice_u32_0_fwd (x : slice u32) : result u32 := - slice_index_shared u32 x 0%usize +Definition 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 *) Definition index_mut_slice_u32_0_back (x : slice u32) : result (slice u32) := - _ <- slice_index_shared u32 x 0%usize; Return x + _ <- slice_index_usize u32 x 0%usize; Return x . (** [array::index_all]: forward function *) -Definition index_all_fwd : result u32 := - i <- index_array_fwd (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i0 <- index_array_fwd (mk_array u32 2%usize [ 0%u32; 0%u32 ]); +Definition index_all : result u32 := + i <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + i0 <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); i1 <- u32_add i i0; - i2 <- index_array_borrow_fwd (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + i2 <- index_array_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); i3 <- u32_add i1 i2; - s <- - array_to_slice_shared u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i4 <- index_slice_u32_0_fwd s; + s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + i4 <- index_slice_u32_0 s; i5 <- u32_add i3 i4; - s0 <- - array_to_slice_mut_fwd u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - i6 <- index_mut_slice_u32_0_fwd s0; + s0 <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + i6 <- index_mut_slice_u32_0 s0; i7 <- u32_add i5 i6; s1 <- index_mut_slice_u32_0_back s0; - _ <- - array_to_slice_mut_back u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) - s1; + _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s1; Return i7 . (** [array::update_array]: forward function *) -Definition update_array_fwd (x : array u32 2%usize) : result unit := - _ <- array_index_mut_back u32 2%usize x 0%usize 1%u32; Return tt +Definition update_array (x : array u32 2%usize) : result unit := + _ <- array_update_usize u32 2%usize x 0%usize 1%u32; Return tt . (** [array::update_array_mut_borrow]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition update_array_mut_borrow_fwd_back +Definition 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 ()) *) -Definition update_mut_slice_fwd_back (x : slice u32) : result (slice u32) := - slice_index_mut_back u32 x 0%usize 1%u32 +Definition update_mut_slice (x : slice u32) : result (slice u32) := + slice_update_usize u32 x 0%usize 1%u32 . (** [array::update_all]: forward function *) -Definition update_all_fwd : result unit := - _ <- update_array_fwd (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - x <- - update_array_mut_borrow_fwd_back (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s <- array_to_slice_mut_fwd u32 2%usize x; - s0 <- update_mut_slice_fwd_back s; - _ <- array_to_slice_mut_back u32 2%usize x s0; +Definition update_all : result unit := + _ <- update_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + x <- update_array_mut_borrow (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + s <- array_to_slice u32 2%usize x; + s0 <- update_mut_slice s; + _ <- array_from_slice u32 2%usize x s0; Return tt . (** [array::range_all]: forward function *) -Definition range_all_fwd : result unit := +Definition range_all (n : nat) : result unit := s <- - array_subslice_mut_fwd u32 4%usize - (mk_array u32 4%usize [ 0%u32; 0%u32; 0%u32; 0%u32 ]) (mk_range 1%usize - 3%usize); - s0 <- update_mut_slice_fwd_back 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)) + (mk_array u32 4%usize [ 0%u32; 0%u32; 0%u32; 0%u32 ]) + {| + core_ops_range_Range_start := 1%usize; + core_ops_range_Range_end_ := 3%usize + |}; + s0 <- update_mut_slice s; _ <- - array_subslice_mut_back u32 4%usize - (mk_array u32 4%usize [ 0%u32; 0%u32; 0%u32; 0%u32 ]) (mk_range 1%usize - 3%usize) s0; + 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)) + (mk_array u32 4%usize [ 0%u32; 0%u32; 0%u32; 0%u32 ]) + {| + core_ops_range_Range_start := 1%usize; + core_ops_range_Range_end_ := 3%usize + |} s0; Return tt . (** [array::deref_array_borrow]: forward function *) -Definition deref_array_borrow_fwd (x : array u32 2%usize) : result u32 := - array_index_shared u32 2%usize x 0%usize +Definition 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 *) -Definition deref_array_mut_borrow_fwd (x : array u32 2%usize) : result u32 := - array_index_shared u32 2%usize x 0%usize +Definition 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 *) Definition deref_array_mut_borrow_back (x : array u32 2%usize) : result (array u32 2%usize) := - _ <- array_index_shared u32 2%usize x 0%usize; Return x + _ <- array_index_usize u32 2%usize x 0%usize; Return x . (** [array::take_array_t]: forward function *) -Definition take_array_t_fwd (a : array T_t 2%usize) : result unit := +Definition take_array_t (a : array AB_t 2%usize) : result unit := Return tt. (** [array::non_copyable_array]: forward function *) -Definition non_copyable_array_fwd : result unit := - _ <- take_array_t_fwd (mk_array T_t 2%usize [ TA; TB ]); Return tt +Definition non_copyable_array : result unit := + _ <- take_array_t (mk_array AB_t 2%usize [ AB_A; AB_B ]); Return tt . (** [array::sum]: loop 0: forward function *) -Fixpoint sum_loop_fwd - (n : nat) (s : slice u32) (sum : u32) (i : usize) : result u32 := +Fixpoint sum_loop + (n : nat) (s : slice u32) (sum0 : u32) (i : usize) : result u32 := match n with | O => Fail_ OutOfFuel | S n0 => let i0 := slice_len u32 s in if i s< i0 then ( - i1 <- slice_index_shared u32 s i; - sum0 <- u32_add sum i1; + i1 <- slice_index_usize u32 s i; + sum1 <- u32_add sum0 i1; i2 <- usize_add i 1%usize; - sum_loop_fwd n0 s sum0 i2) - else Return sum + sum_loop n0 s sum1 i2) + else Return sum0 end . (** [array::sum]: forward function *) -Definition sum_fwd (n : nat) (s : slice u32) : result u32 := - sum_loop_fwd n s 0%u32 0%usize +Definition sum (n : nat) (s : slice u32) : result u32 := + sum_loop n s 0%u32 0%usize . (** [array::sum2]: loop 0: forward function *) -Fixpoint sum2_loop_fwd - (n : nat) (s : slice u32) (s2 : slice u32) (sum : u32) (i : usize) : +Fixpoint sum2_loop + (n : nat) (s : slice u32) (s2 : slice u32) (sum0 : u32) (i : usize) : result u32 := match n with @@ -386,69 +393,64 @@ Fixpoint sum2_loop_fwd let i0 := slice_len u32 s in if i s< i0 then ( - i1 <- slice_index_shared u32 s i; - i2 <- slice_index_shared u32 s2 i; + i1 <- slice_index_usize u32 s i; + i2 <- slice_index_usize u32 s2 i; i3 <- u32_add i1 i2; - sum0 <- u32_add sum i3; + sum1 <- u32_add sum0 i3; i4 <- usize_add i 1%usize; - sum2_loop_fwd n0 s s2 sum0 i4) - else Return sum + sum2_loop n0 s s2 sum1 i4) + else Return sum0 end . (** [array::sum2]: forward function *) -Definition sum2_fwd (n : nat) (s : slice u32) (s2 : slice u32) : result u32 := +Definition sum2 (n : nat) (s : slice u32) (s2 : slice u32) : result u32 := let i := slice_len u32 s in let i0 := slice_len u32 s2 in - if negb (i s= i0) then Fail_ Failure else sum2_loop_fwd n s s2 0%u32 0%usize + if negb (i s= i0) then Fail_ Failure else sum2_loop n s s2 0%u32 0%usize . (** [array::f0]: forward function *) -Definition f0_fwd : result unit := - s <- - array_to_slice_mut_fwd u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); - s0 <- slice_index_mut_back u32 s 0%usize 1%u32; - _ <- - array_to_slice_mut_back u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) - s0; +Definition f0 : result unit := + s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); + s0 <- slice_update_usize u32 s 0%usize 1%u32; + _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) s0; Return tt . (** [array::f1]: forward function *) -Definition f1_fwd : result unit := +Definition f1 : result unit := _ <- - array_index_mut_back u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) + array_update_usize u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) 0%usize 1%u32; Return tt . (** [array::f2]: forward function *) -Definition f2_fwd (i : u32) : result unit := +Definition f2 (i : u32) : result unit := Return tt. (** [array::f4]: forward function *) -Definition f4_fwd - (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := - array_subslice_shared u32 32%usize x (mk_range y z) +Definition f4 + (n : nat) (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 + {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |} . (** [array::f3]: forward function *) -Definition f3_fwd (n : nat) : result u32 := +Definition f3 (n : nat) : result u32 := i <- - array_index_shared u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) + array_index_usize u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) 0%usize; - _ <- f2_fwd i; - s <- - array_to_slice_shared u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); - s0 <- - f4_fwd - (mk_array u32 32%usize [ - 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; - 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; - 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; 0%u32; - 0%u32; 0%u32 - ]) 16%usize 18%usize; - sum2_fwd n s s0 + _ <- f2 i; + let b := array_repeat u32 32%usize 0%u32 in + s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); + s0 <- f4 n b 16%usize 18%usize; + sum2 n s s0 . (** [array::SZ] *) @@ -456,24 +458,18 @@ 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 +Definition f5 (x : array u32 32%usize) : result u32 := + array_index_usize u32 32%usize x 0%usize . (** [array::ite]: forward function *) -Definition ite_fwd : result unit := - s <- - array_to_slice_mut_fwd u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - s0 <- - array_to_slice_mut_fwd u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); +Definition ite : result unit := + s <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); + s0 <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); s1 <- index_mut_slice_u32_0_back s0; - _ <- - array_to_slice_mut_back u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) - s1; + _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s1; s2 <- index_mut_slice_u32_0_back s; - _ <- - array_to_slice_mut_back u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) - s2; + _ <- array_from_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]) s2; Return tt . diff --git a/tests/coq/array/Array_Types.v b/tests/coq/array/Array_Types.v index 7be6dc9b..a13d64e6 100644 --- a/tests/coq/array/Array_Types.v +++ b/tests/coq/array/Array_Types.v @@ -8,7 +8,7 @@ Import ListNotations. Local Open Scope Primitives_scope. Module Array_Types. -(** [array::T] *) -Inductive T_t := | TA : T_t | TB : T_t. +(** [array::AB] *) +Inductive AB_t := | AB_A : AB_t | AB_B : AB_t. End Array_Types . diff --git a/tests/coq/array/Primitives.v b/tests/coq/array/Primitives.v index 8d6c9c8d..85e38f01 100644 --- a/tests/coq/array/Primitives.v +++ b/tests/coq/array/Primitives.v @@ -63,13 +63,15 @@ Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) - Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition mem_replace_fwd (a : Type) (x : a) (y : a) : a := x . -Definition mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . +Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. (*** Scalars *) @@ -408,12 +410,75 @@ 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; - end_: T; +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); + core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. +Arguments core_ops_index_IndexMut_index_mut_back {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; +}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); + core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; }. -Arguments mk_range {_}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. +Arguments core_ops_deref_DerefMut_deref_mut_back {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; + core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; +|}. + (*** Arrays *) Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. @@ -433,51 +498,50 @@ Qed. (* TODO: finish the definitions *) Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. -Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +(* For initialization *) +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. + +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. Axiom slice_len : forall (T : Type) (s : slice T), usize. -Axiom slice_index_shared : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_fwd : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_back : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). (*** Subslices *) -Axiom array_to_slice_shared : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_fwd : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_back : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). -Axiom array_subslice_shared: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_fwd: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_back: forall (T : Type) (n : usize) (x : array T n) (r : range usize) (ns : slice T), result (array T n). -Axiom slice_subslice_shared: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_fwd: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_back: forall (T : Type) (x : slice T) (r : range usize) (ns : slice T), result (slice T). +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). (*** Vectors *) -Definition vec T := { l: list T | Z.of_nat (length l) <= usize_max }. +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. -Definition vec_to_list {T: Type} (v: vec T) : list T := proj1_sig v. +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. -Definition vec_length {T: Type} (v: vec T) : Z := Z.of_nat (length (vec_to_list v)). +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). -Definition vec_new (T: Type) : vec T := (exist _ [] le_0_usize_max). +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). -Lemma vec_len_in_usize {T} (v: vec T) : usize_min <= vec_length v <= usize_max. +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. Proof. - unfold vec_length, usize_min. + unfold alloc_vec_Vec_length, usize_min. split. - lia. - apply (proj2_sig v). Qed. -Definition vec_len (T: Type) (v: vec T) : usize := - exist _ (vec_length v) (vec_len_in_usize v). +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). Fixpoint list_update {A} (l: list A) (n: nat) (a: A) : list A := @@ -488,50 +552,271 @@ Fixpoint list_update {A} (l: list A) (n: nat) (a: A) | S m => x :: (list_update t m a) end end. -Definition vec_bind {A B} (v: vec A) (f: list A -> result (list B)) : result (vec B) := - l <- f (vec_to_list v) ; +Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := + l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. (* The **forward** function shouldn't be used *) -Definition vec_push_fwd (T: Type) (v: vec T) (x: T) : unit := tt. +Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. -Definition vec_push_back (T: Type) (v: vec T) (x: T) : result (vec T) := - vec_bind v (fun l => Return (l ++ [x])). +Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). (* The **forward** function shouldn't be used *) -Definition vec_insert_fwd (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i +Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => if to_Z i Return n - | None => Fail_ Failure - end. - -Definition vec_index_back (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i Return n - | None => Fail_ Failure +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. +Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Return x end. -Definition vec_index_mut_back (T: Type) (v: vec T) (i: usize) (x: T) : result (vec T) := - vec_bind v (fun l => - if to_Z i slice T -> result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: backward function 0 *) +Axiom core_slice_index_Range_get_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_Range_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_Range_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_Range_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_Range_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: backward function 0 *) +Axiom core_slice_index_Range_index_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). + +(* [core::slice::index::[T]::index_mut]: backward function 0 *) +Axiom core_slice_index_Slice_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: backward function 0 *) +Axiom core_array_Array_index_mut_back : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_Range_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_Range_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; + core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: backward function 0 *) +Axiom core_slice_index_usize_get_mut_back : + forall (T : Type), usize -> slice T -> option T -> result (slice T). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: backward function 0 *) +Axiom core_slice_index_usize_index_mut_back : + forall (T : Type), usize -> slice T -> T -> result (slice T). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: backward function 0 *) +Axiom alloc_vec_Vec_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + 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. End Primitives. diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v index cfa1f8fb..261e8270 100644 --- a/tests/coq/betree/BetreeMain_Funs.v +++ b/tests/coq/betree/BetreeMain_Funs.v @@ -13,41 +13,41 @@ Import BetreeMain_Opaque. Module BetreeMain_Funs. (** [betree_main::betree::load_internal_node]: forward function *) -Definition betree_load_internal_node_fwd +Definition betree_load_internal_node (id : u64) (st : state) : - result (state * (Betree_list_t (u64 * Betree_message_t))) + result (state * (betree_List_t (u64 * betree_Message_t))) := - betree_utils_load_internal_node_fwd id st + betree_utils_load_internal_node id st . (** [betree_main::betree::store_internal_node]: forward function *) -Definition betree_store_internal_node_fwd - (id : u64) (content : Betree_list_t (u64 * Betree_message_t)) (st : state) : +Definition betree_store_internal_node + (id : u64) (content : betree_List_t (u64 * betree_Message_t)) (st : state) : result (state * unit) := - p <- betree_utils_store_internal_node_fwd id content st; + p <- betree_utils_store_internal_node id content st; let (st0, _) := p in Return (st0, tt) . (** [betree_main::betree::load_leaf_node]: forward function *) -Definition betree_load_leaf_node_fwd - (id : u64) (st : state) : result (state * (Betree_list_t (u64 * u64))) := - betree_utils_load_leaf_node_fwd id st +Definition betree_load_leaf_node + (id : u64) (st : state) : result (state * (betree_List_t (u64 * u64))) := + betree_utils_load_leaf_node id st . (** [betree_main::betree::store_leaf_node]: forward function *) -Definition betree_store_leaf_node_fwd - (id : u64) (content : Betree_list_t (u64 * u64)) (st : state) : +Definition betree_store_leaf_node + (id : u64) (content : betree_List_t (u64 * u64)) (st : state) : result (state * unit) := - p <- betree_utils_store_leaf_node_fwd id content st; + p <- betree_utils_store_leaf_node id content st; let (st0, _) := p in Return (st0, tt) . (** [betree_main::betree::fresh_node_id]: forward function *) -Definition betree_fresh_node_id_fwd (counter : u64) : result u64 := +Definition betree_fresh_node_id (counter : u64) : result u64 := _ <- u64_add counter 1%u64; Return counter . @@ -57,1136 +57,1121 @@ Definition betree_fresh_node_id_back (counter : u64) : result u64 := . (** [betree_main::betree::NodeIdCounter::{0}::new]: forward function *) -Definition betree_node_id_counter_new_fwd : result Betree_node_id_counter_t := - Return {| Betree_node_id_counter_next_node_id := 0%u64 |} +Definition betree_NodeIdCounter_new : result betree_NodeIdCounter_t := + Return {| betree_NodeIdCounter_next_node_id := 0%u64 |} . (** [betree_main::betree::NodeIdCounter::{0}::fresh_id]: forward function *) -Definition betree_node_id_counter_fresh_id_fwd - (self : Betree_node_id_counter_t) : result u64 := - _ <- u64_add self.(Betree_node_id_counter_next_node_id) 1%u64; - Return self.(Betree_node_id_counter_next_node_id) +Definition betree_NodeIdCounter_fresh_id + (self : betree_NodeIdCounter_t) : result u64 := + _ <- u64_add self.(betree_NodeIdCounter_next_node_id) 1%u64; + Return self.(betree_NodeIdCounter_next_node_id) . (** [betree_main::betree::NodeIdCounter::{0}::fresh_id]: backward function 0 *) -Definition betree_node_id_counter_fresh_id_back - (self : Betree_node_id_counter_t) : result Betree_node_id_counter_t := - i <- u64_add self.(Betree_node_id_counter_next_node_id) 1%u64; - Return {| Betree_node_id_counter_next_node_id := i |} +Definition betree_NodeIdCounter_fresh_id_back + (self : betree_NodeIdCounter_t) : result betree_NodeIdCounter_t := + i <- u64_add self.(betree_NodeIdCounter_next_node_id) 1%u64; + Return {| betree_NodeIdCounter_next_node_id := i |} . (** [betree_main::betree::upsert_update]: forward function *) -Definition betree_upsert_update_fwd - (prev : option u64) (st : Betree_upsert_fun_state_t) : result u64 := +Definition betree_upsert_update + (prev : option u64) (st : betree_UpsertFunState_t) : result u64 := match prev with | None => match st with - | BetreeUpsertFunStateAdd v => Return v - | BetreeUpsertFunStateSub i => Return 0%u64 + | Betree_UpsertFunState_Add v => Return v + | Betree_UpsertFunState_Sub i => Return 0%u64 end | Some prev0 => match st with - | BetreeUpsertFunStateAdd v => + | Betree_UpsertFunState_Add v => margin <- u64_sub core_u64_max prev0; if margin s>= v then u64_add prev0 v else Return core_u64_max - | BetreeUpsertFunStateSub v => + | Betree_UpsertFunState_Sub v => if prev0 s>= v then u64_sub prev0 v else Return 0%u64 end end . (** [betree_main::betree::List::{1}::len]: forward function *) -Fixpoint betree_list_len_fwd - (T : Type) (n : nat) (self : Betree_list_t T) : result u64 := +Fixpoint betree_List_len + (T : Type) (n : nat) (self : betree_List_t T) : result u64 := match n with | O => Fail_ OutOfFuel | S n0 => match self with - | BetreeListCons t tl => i <- betree_list_len_fwd T n0 tl; u64_add 1%u64 i - | BetreeListNil => Return 0%u64 + | Betree_List_Cons t tl => i <- betree_List_len T n0 tl; u64_add 1%u64 i + | Betree_List_Nil => Return 0%u64 end end . (** [betree_main::betree::List::{1}::split_at]: forward function *) -Fixpoint betree_list_split_at_fwd - (T : Type) (n : nat) (self : Betree_list_t T) (n0 : u64) : - result ((Betree_list_t T) * (Betree_list_t T)) +Fixpoint betree_List_split_at + (T : Type) (n : nat) (self : betree_List_t T) (n0 : u64) : + result ((betree_List_t T) * (betree_List_t T)) := match n with | O => Fail_ OutOfFuel | S n1 => if n0 s= 0%u64 - then Return (BetreeListNil, self) + then Return (Betree_List_Nil, self) else match self with - | BetreeListCons hd tl => + | Betree_List_Cons hd tl => i <- u64_sub n0 1%u64; - p <- betree_list_split_at_fwd T n1 tl i; + p <- betree_List_split_at T n1 tl i; let (ls0, ls1) := p in let l := ls0 in - Return (BetreeListCons hd l, ls1) - | BetreeListNil => Fail_ Failure + Return (Betree_List_Cons hd l, ls1) + | Betree_List_Nil => Fail_ Failure end end . (** [betree_main::betree::List::{1}::push_front]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition betree_list_push_front_fwd_back - (T : Type) (self : Betree_list_t T) (x : T) : result (Betree_list_t T) := - let tl := mem_replace_fwd (Betree_list_t T) self BetreeListNil in +Definition betree_List_push_front + (T : Type) (self : betree_List_t T) (x : T) : result (betree_List_t T) := + let tl := core_mem_replace (betree_List_t T) self Betree_List_Nil in let l := tl in - Return (BetreeListCons x l) + Return (Betree_List_Cons x l) . (** [betree_main::betree::List::{1}::pop_front]: forward function *) -Definition betree_list_pop_front_fwd - (T : Type) (self : Betree_list_t T) : result T := - let ls := mem_replace_fwd (Betree_list_t T) self BetreeListNil in +Definition betree_List_pop_front + (T : Type) (self : betree_List_t T) : result T := + let ls := core_mem_replace (betree_List_t T) self Betree_List_Nil in match ls with - | BetreeListCons x tl => Return x - | BetreeListNil => Fail_ Failure + | Betree_List_Cons x tl => Return x + | Betree_List_Nil => Fail_ Failure end . (** [betree_main::betree::List::{1}::pop_front]: backward function 0 *) -Definition betree_list_pop_front_back - (T : Type) (self : Betree_list_t T) : result (Betree_list_t T) := - let ls := mem_replace_fwd (Betree_list_t T) self BetreeListNil in +Definition betree_List_pop_front_back + (T : Type) (self : betree_List_t T) : result (betree_List_t T) := + let ls := core_mem_replace (betree_List_t T) self Betree_List_Nil in match ls with - | BetreeListCons x tl => Return tl - | BetreeListNil => Fail_ Failure + | Betree_List_Cons x tl => Return tl + | Betree_List_Nil => Fail_ Failure end . (** [betree_main::betree::List::{1}::hd]: forward function *) -Definition betree_list_hd_fwd (T : Type) (self : Betree_list_t T) : result T := +Definition betree_List_hd (T : Type) (self : betree_List_t T) : result T := match self with - | BetreeListCons hd l => Return hd - | BetreeListNil => Fail_ Failure + | Betree_List_Cons hd l => Return hd + | Betree_List_Nil => Fail_ Failure end . (** [betree_main::betree::List::{2}::head_has_key]: forward function *) -Definition betree_list_head_has_key_fwd - (T : Type) (self : Betree_list_t (u64 * T)) (key : u64) : result bool := +Definition betree_List_head_has_key + (T : Type) (self : betree_List_t (u64 * T)) (key : u64) : result bool := match self with - | BetreeListCons hd l => let (i, _) := hd in Return (i s= key) - | BetreeListNil => Return false + | Betree_List_Cons hd l => let (i, _) := hd in Return (i s= key) + | Betree_List_Nil => Return false end . (** [betree_main::betree::List::{2}::partition_at_pivot]: forward function *) -Fixpoint betree_list_partition_at_pivot_fwd - (T : Type) (n : nat) (self : Betree_list_t (u64 * T)) (pivot : u64) : - result ((Betree_list_t (u64 * T)) * (Betree_list_t (u64 * T))) +Fixpoint betree_List_partition_at_pivot + (T : Type) (n : nat) (self : betree_List_t (u64 * T)) (pivot : u64) : + result ((betree_List_t (u64 * T)) * (betree_List_t (u64 * T))) := match n with | O => Fail_ OutOfFuel | S n0 => match self with - | BetreeListCons hd tl => + | Betree_List_Cons hd tl => let (i, t) := hd in if i s>= pivot - then Return (BetreeListNil, BetreeListCons (i, t) tl) + then Return (Betree_List_Nil, Betree_List_Cons (i, t) tl) else ( - p <- betree_list_partition_at_pivot_fwd T n0 tl pivot; + p <- betree_List_partition_at_pivot T n0 tl pivot; let (ls0, ls1) := p in let l := ls0 in - Return (BetreeListCons (i, t) l, ls1)) - | BetreeListNil => Return (BetreeListNil, BetreeListNil) + Return (Betree_List_Cons (i, t) l, ls1)) + | Betree_List_Nil => Return (Betree_List_Nil, Betree_List_Nil) end end . (** [betree_main::betree::Leaf::{3}::split]: forward function *) -Definition betree_leaf_split_fwd - (n : nat) (self : Betree_leaf_t) (content : Betree_list_t (u64 * u64)) - (params : Betree_params_t) (node_id_cnt : Betree_node_id_counter_t) +Definition betree_Leaf_split + (n : nat) (self : betree_Leaf_t) (content : betree_List_t (u64 * u64)) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) (st : state) : - result (state * Betree_internal_t) + result (state * betree_Internal_t) := p <- - betree_list_split_at_fwd (u64 * u64) n content - params.(Betree_params_split_size); + betree_List_split_at (u64 * u64) n content + params.(betree_Params_split_size); let (content0, content1) := p in - p0 <- betree_list_hd_fwd (u64 * u64) content1; + p0 <- betree_List_hd (u64 * u64) content1; let (pivot, _) := p0 in - id0 <- betree_node_id_counter_fresh_id_fwd node_id_cnt; - node_id_cnt0 <- betree_node_id_counter_fresh_id_back node_id_cnt; - id1 <- betree_node_id_counter_fresh_id_fwd node_id_cnt0; - p1 <- betree_store_leaf_node_fwd id0 content0 st; + id0 <- betree_NodeIdCounter_fresh_id node_id_cnt; + node_id_cnt0 <- betree_NodeIdCounter_fresh_id_back node_id_cnt; + id1 <- betree_NodeIdCounter_fresh_id node_id_cnt0; + p1 <- betree_store_leaf_node id0 content0 st; let (st0, _) := p1 in - p2 <- betree_store_leaf_node_fwd id1 content1 st0; + p2 <- betree_store_leaf_node id1 content1 st0; let (st1, _) := p2 in - let n0 := BetreeNodeLeaf + let n0 := Betree_Node_Leaf {| - Betree_leaf_id := id0; - Betree_leaf_size := params.(Betree_params_split_size) + betree_Leaf_id := id0; + betree_Leaf_size := params.(betree_Params_split_size) |} in - let n1 := BetreeNodeLeaf + let n1 := Betree_Node_Leaf {| - Betree_leaf_id := id1; - Betree_leaf_size := params.(Betree_params_split_size) + betree_Leaf_id := id1; + betree_Leaf_size := params.(betree_Params_split_size) |} in - Return (st1, mkBetree_internal_t self.(Betree_leaf_id) pivot n0 n1) + Return (st1, mkbetree_Internal_t self.(betree_Leaf_id) pivot n0 n1) . (** [betree_main::betree::Leaf::{3}::split]: backward function 2 *) -Definition betree_leaf_split_back - (n : nat) (self : Betree_leaf_t) (content : Betree_list_t (u64 * u64)) - (params : Betree_params_t) (node_id_cnt : Betree_node_id_counter_t) +Definition betree_Leaf_split_back + (n : nat) (self : betree_Leaf_t) (content : betree_List_t (u64 * u64)) + (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) (st : state) : - result Betree_node_id_counter_t + result betree_NodeIdCounter_t := p <- - betree_list_split_at_fwd (u64 * u64) n content - params.(Betree_params_split_size); + betree_List_split_at (u64 * u64) n content + params.(betree_Params_split_size); let (content0, content1) := p in - _ <- betree_list_hd_fwd (u64 * u64) content1; - id0 <- betree_node_id_counter_fresh_id_fwd node_id_cnt; - node_id_cnt0 <- betree_node_id_counter_fresh_id_back node_id_cnt; - id1 <- betree_node_id_counter_fresh_id_fwd node_id_cnt0; - p0 <- betree_store_leaf_node_fwd id0 content0 st; + _ <- betree_List_hd (u64 * u64) content1; + id0 <- betree_NodeIdCounter_fresh_id node_id_cnt; + node_id_cnt0 <- betree_NodeIdCounter_fresh_id_back node_id_cnt; + id1 <- betree_NodeIdCounter_fresh_id node_id_cnt0; + p0 <- betree_store_leaf_node id0 content0 st; let (st0, _) := p0 in - _ <- betree_store_leaf_node_fwd id1 content1 st0; - betree_node_id_counter_fresh_id_back node_id_cnt0 + _ <- betree_store_leaf_node id1 content1 st0; + betree_NodeIdCounter_fresh_id_back node_id_cnt0 . (** [betree_main::betree::Node::{5}::lookup_first_message_for_key]: forward function *) -Fixpoint betree_node_lookup_first_message_for_key_fwd - (n : nat) (key : u64) (msgs : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * Betree_message_t)) +Fixpoint betree_Node_lookup_first_message_for_key + (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => match msgs with - | BetreeListCons x next_msgs => + | Betree_List_Cons x next_msgs => let (i, m) := x in if i s>= key - then Return (BetreeListCons (i, m) next_msgs) - else betree_node_lookup_first_message_for_key_fwd n0 key next_msgs - | BetreeListNil => Return BetreeListNil + then Return (Betree_List_Cons (i, m) next_msgs) + else betree_Node_lookup_first_message_for_key n0 key next_msgs + | Betree_List_Nil => Return Betree_List_Nil end end . (** [betree_main::betree::Node::{5}::lookup_first_message_for_key]: backward function 0 *) -Fixpoint betree_node_lookup_first_message_for_key_back - (n : nat) (key : u64) (msgs : Betree_list_t (u64 * Betree_message_t)) - (ret : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * Betree_message_t)) +Fixpoint betree_Node_lookup_first_message_for_key_back + (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) + (ret : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => match msgs with - | BetreeListCons x next_msgs => + | Betree_List_Cons x next_msgs => let (i, m) := x in if i s>= key then Return ret else ( next_msgs0 <- - betree_node_lookup_first_message_for_key_back n0 key next_msgs ret; - Return (BetreeListCons (i, m) next_msgs0)) - | BetreeListNil => Return ret + betree_Node_lookup_first_message_for_key_back n0 key next_msgs ret; + Return (Betree_List_Cons (i, m) next_msgs0)) + | Betree_List_Nil => Return ret end end . (** [betree_main::betree::Node::{5}::apply_upserts]: forward function *) -Fixpoint betree_node_apply_upserts_fwd - (n : nat) (msgs : Betree_list_t (u64 * Betree_message_t)) (prev : option u64) +Fixpoint betree_Node_apply_upserts + (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) (prev : option u64) (key : u64) (st : state) : result (state * u64) := match n with | O => Fail_ OutOfFuel | S n0 => - b <- betree_list_head_has_key_fwd Betree_message_t msgs key; + b <- betree_List_head_has_key betree_Message_t msgs key; if b then ( - msg <- betree_list_pop_front_fwd (u64 * Betree_message_t) msgs; + msg <- betree_List_pop_front (u64 * betree_Message_t) msgs; let (_, m) := msg in match m with - | BetreeMessageInsert i => Fail_ Failure - | BetreeMessageDelete => Fail_ Failure - | BetreeMessageUpsert s => - v <- betree_upsert_update_fwd prev s; - msgs0 <- betree_list_pop_front_back (u64 * Betree_message_t) msgs; - betree_node_apply_upserts_fwd n0 msgs0 (Some v) key st + | Betree_Message_Insert i => Fail_ Failure + | Betree_Message_Delete => Fail_ Failure + | Betree_Message_Upsert s => + v <- betree_upsert_update prev s; + msgs0 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs; + betree_Node_apply_upserts n0 msgs0 (Some v) key st end) else ( - p <- core_option_option_unwrap_fwd u64 prev st; + p <- core_option_Option_unwrap u64 prev st; let (st0, v) := p in _ <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs (key, - BetreeMessageInsert v); + betree_List_push_front (u64 * betree_Message_t) msgs (key, + Betree_Message_Insert v); Return (st0, v)) end . (** [betree_main::betree::Node::{5}::apply_upserts]: backward function 0 *) -Fixpoint betree_node_apply_upserts_back - (n : nat) (msgs : Betree_list_t (u64 * Betree_message_t)) (prev : option u64) +Fixpoint betree_Node_apply_upserts_back + (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) (prev : option u64) (key : u64) (st : state) : - result (Betree_list_t (u64 * Betree_message_t)) + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => - b <- betree_list_head_has_key_fwd Betree_message_t msgs key; + b <- betree_List_head_has_key betree_Message_t msgs key; if b then ( - msg <- betree_list_pop_front_fwd (u64 * Betree_message_t) msgs; + msg <- betree_List_pop_front (u64 * betree_Message_t) msgs; let (_, m) := msg in match m with - | BetreeMessageInsert i => Fail_ Failure - | BetreeMessageDelete => Fail_ Failure - | BetreeMessageUpsert s => - v <- betree_upsert_update_fwd prev s; - msgs0 <- betree_list_pop_front_back (u64 * Betree_message_t) msgs; - betree_node_apply_upserts_back n0 msgs0 (Some v) key st + | Betree_Message_Insert i => Fail_ Failure + | Betree_Message_Delete => Fail_ Failure + | Betree_Message_Upsert s => + v <- betree_upsert_update prev s; + msgs0 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs; + betree_Node_apply_upserts_back n0 msgs0 (Some v) key st end) else ( - p <- core_option_option_unwrap_fwd u64 prev st; + p <- core_option_Option_unwrap u64 prev st; let (_, v) := p in - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs (key, - BetreeMessageInsert v)) + betree_List_push_front (u64 * betree_Message_t) msgs (key, + Betree_Message_Insert v)) end . (** [betree_main::betree::Node::{5}::lookup_in_bindings]: forward function *) -Fixpoint betree_node_lookup_in_bindings_fwd - (n : nat) (key : u64) (bindings : Betree_list_t (u64 * u64)) : +Fixpoint betree_Node_lookup_in_bindings + (n : nat) (key : u64) (bindings : betree_List_t (u64 * u64)) : result (option u64) := match n with | O => Fail_ OutOfFuel | S n0 => match bindings with - | BetreeListCons hd tl => + | Betree_List_Cons hd tl => let (i, i0) := hd in if i s= key then Return (Some i0) else if i s> key then Return None - else betree_node_lookup_in_bindings_fwd n0 key tl - | BetreeListNil => Return None + else betree_Node_lookup_in_bindings n0 key tl + | Betree_List_Nil => Return None end end . (** [betree_main::betree::Internal::{4}::lookup_in_children]: forward function *) -Fixpoint betree_internal_lookup_in_children_fwd - (n : nat) (self : Betree_internal_t) (key : u64) (st : state) : +Fixpoint betree_Internal_lookup_in_children + (n : nat) (self : betree_Internal_t) (key : u64) (st : state) : result (state * (option u64)) := match n with | O => Fail_ OutOfFuel | S n0 => - if key s< self.(Betree_internal_pivot) - then betree_node_lookup_fwd n0 self.(Betree_internal_left) key st - else betree_node_lookup_fwd n0 self.(Betree_internal_right) key st + if key s< self.(betree_Internal_pivot) + then betree_Node_lookup n0 self.(betree_Internal_left) key st + else betree_Node_lookup n0 self.(betree_Internal_right) key st end (** [betree_main::betree::Internal::{4}::lookup_in_children]: backward function 0 *) -with betree_internal_lookup_in_children_back - (n : nat) (self : Betree_internal_t) (key : u64) (st : state) : - result Betree_internal_t +with betree_Internal_lookup_in_children_back + (n : nat) (self : betree_Internal_t) (key : u64) (st : state) : + result betree_Internal_t := match n with | O => Fail_ OutOfFuel | S n0 => - if key s< self.(Betree_internal_pivot) + if key s< self.(betree_Internal_pivot) then ( - n1 <- betree_node_lookup_back n0 self.(Betree_internal_left) key st; - Return (mkBetree_internal_t self.(Betree_internal_id) - self.(Betree_internal_pivot) n1 self.(Betree_internal_right))) + n1 <- betree_Node_lookup_back n0 self.(betree_Internal_left) key st; + Return (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) n1 self.(betree_Internal_right))) else ( - n1 <- betree_node_lookup_back n0 self.(Betree_internal_right) key st; - Return (mkBetree_internal_t self.(Betree_internal_id) - self.(Betree_internal_pivot) self.(Betree_internal_left) n1)) + n1 <- betree_Node_lookup_back n0 self.(betree_Internal_right) key st; + Return (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) self.(betree_Internal_left) n1)) end (** [betree_main::betree::Node::{5}::lookup]: forward function *) -with betree_node_lookup_fwd - (n : nat) (self : Betree_node_t) (key : u64) (st : state) : +with betree_Node_lookup + (n : nat) (self : betree_Node_t) (key : u64) (st : state) : result (state * (option u64)) := match n with | O => Fail_ OutOfFuel | S n0 => match self with - | BetreeNodeInternal node => - p <- betree_load_internal_node_fwd node.(Betree_internal_id) st; + | Betree_Node_Internal node => + p <- betree_load_internal_node node.(betree_Internal_id) st; let (st0, msgs) := p in - pending <- betree_node_lookup_first_message_for_key_fwd n0 key msgs; + pending <- betree_Node_lookup_first_message_for_key n0 key msgs; match pending with - | BetreeListCons p0 l => + | Betree_List_Cons p0 l => let (k, msg) := p0 in if k s<> key then ( - p1 <- betree_internal_lookup_in_children_fwd n0 node key st0; - let (st1, opt) := p1 in + p1 <- betree_Internal_lookup_in_children n0 node key st0; + let (st1, o) := p1 in _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - (BetreeListCons (k, msg) l); - Return (st1, opt)) + betree_Node_lookup_first_message_for_key_back n0 key msgs + (Betree_List_Cons (k, msg) l); + Return (st1, o)) else match msg with - | BetreeMessageInsert v => + | Betree_Message_Insert v => _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - (BetreeListCons (k, BetreeMessageInsert v) l); + betree_Node_lookup_first_message_for_key_back n0 key msgs + (Betree_List_Cons (k, Betree_Message_Insert v) l); Return (st0, Some v) - | BetreeMessageDelete => + | Betree_Message_Delete => _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - (BetreeListCons (k, BetreeMessageDelete) l); + betree_Node_lookup_first_message_for_key_back n0 key msgs + (Betree_List_Cons (k, Betree_Message_Delete) l); Return (st0, None) - | BetreeMessageUpsert ufs => - p1 <- betree_internal_lookup_in_children_fwd n0 node key st0; + | Betree_Message_Upsert ufs => + p1 <- betree_Internal_lookup_in_children n0 node key st0; let (st1, v) := p1 in p2 <- - betree_node_apply_upserts_fwd n0 (BetreeListCons (k, - BetreeMessageUpsert ufs) l) v key st1; + betree_Node_apply_upserts n0 (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st1; let (st2, v0) := p2 in - node0 <- betree_internal_lookup_in_children_back n0 node key st0; + node0 <- betree_Internal_lookup_in_children_back n0 node key st0; pending0 <- - betree_node_apply_upserts_back n0 (BetreeListCons (k, - BetreeMessageUpsert ufs) l) v key st1; + betree_Node_apply_upserts_back n0 (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st1; msgs0 <- - betree_node_lookup_first_message_for_key_back n0 key msgs + betree_Node_lookup_first_message_for_key_back n0 key msgs pending0; p3 <- - betree_store_internal_node_fwd node0.(Betree_internal_id) msgs0 - st2; + betree_store_internal_node node0.(betree_Internal_id) msgs0 st2; let (st3, _) := p3 in Return (st3, Some v0) end - | BetreeListNil => - p0 <- betree_internal_lookup_in_children_fwd n0 node key st0; - let (st1, opt) := p0 in + | Betree_List_Nil => + p0 <- betree_Internal_lookup_in_children n0 node key st0; + let (st1, o) := p0 in _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - BetreeListNil; - Return (st1, opt) + betree_Node_lookup_first_message_for_key_back n0 key msgs + Betree_List_Nil; + Return (st1, o) end - | BetreeNodeLeaf node => - p <- betree_load_leaf_node_fwd node.(Betree_leaf_id) st; + | Betree_Node_Leaf node => + p <- betree_load_leaf_node node.(betree_Leaf_id) st; let (st0, bindings) := p in - opt <- betree_node_lookup_in_bindings_fwd n0 key bindings; - Return (st0, opt) + o <- betree_Node_lookup_in_bindings n0 key bindings; + Return (st0, o) end end (** [betree_main::betree::Node::{5}::lookup]: backward function 0 *) -with betree_node_lookup_back - (n : nat) (self : Betree_node_t) (key : u64) (st : state) : - result Betree_node_t +with betree_Node_lookup_back + (n : nat) (self : betree_Node_t) (key : u64) (st : state) : + result betree_Node_t := match n with | O => Fail_ OutOfFuel | S n0 => match self with - | BetreeNodeInternal node => - p <- betree_load_internal_node_fwd node.(Betree_internal_id) st; + | Betree_Node_Internal node => + p <- betree_load_internal_node node.(betree_Internal_id) st; let (st0, msgs) := p in - pending <- betree_node_lookup_first_message_for_key_fwd n0 key msgs; + pending <- betree_Node_lookup_first_message_for_key n0 key msgs; match pending with - | BetreeListCons p0 l => + | Betree_List_Cons p0 l => let (k, msg) := p0 in if k s<> key then ( _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - (BetreeListCons (k, msg) l); - node0 <- betree_internal_lookup_in_children_back n0 node key st0; - Return (BetreeNodeInternal node0)) + betree_Node_lookup_first_message_for_key_back n0 key msgs + (Betree_List_Cons (k, msg) l); + node0 <- betree_Internal_lookup_in_children_back n0 node key st0; + Return (Betree_Node_Internal node0)) else match msg with - | BetreeMessageInsert v => + | Betree_Message_Insert v => _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - (BetreeListCons (k, BetreeMessageInsert v) l); - Return (BetreeNodeInternal node) - | BetreeMessageDelete => + betree_Node_lookup_first_message_for_key_back n0 key msgs + (Betree_List_Cons (k, Betree_Message_Insert v) l); + Return (Betree_Node_Internal node) + | Betree_Message_Delete => _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - (BetreeListCons (k, BetreeMessageDelete) l); - Return (BetreeNodeInternal node) - | BetreeMessageUpsert ufs => - p1 <- betree_internal_lookup_in_children_fwd n0 node key st0; + betree_Node_lookup_first_message_for_key_back n0 key msgs + (Betree_List_Cons (k, Betree_Message_Delete) l); + Return (Betree_Node_Internal node) + | Betree_Message_Upsert ufs => + p1 <- betree_Internal_lookup_in_children n0 node key st0; let (st1, v) := p1 in p2 <- - betree_node_apply_upserts_fwd n0 (BetreeListCons (k, - BetreeMessageUpsert ufs) l) v key st1; + betree_Node_apply_upserts n0 (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st1; let (st2, _) := p2 in - node0 <- betree_internal_lookup_in_children_back n0 node key st0; + node0 <- betree_Internal_lookup_in_children_back n0 node key st0; pending0 <- - betree_node_apply_upserts_back n0 (BetreeListCons (k, - BetreeMessageUpsert ufs) l) v key st1; + betree_Node_apply_upserts_back n0 (Betree_List_Cons (k, + Betree_Message_Upsert ufs) l) v key st1; msgs0 <- - betree_node_lookup_first_message_for_key_back n0 key msgs + betree_Node_lookup_first_message_for_key_back n0 key msgs pending0; _ <- - betree_store_internal_node_fwd node0.(Betree_internal_id) msgs0 - st2; - Return (BetreeNodeInternal node0) + betree_store_internal_node node0.(betree_Internal_id) msgs0 st2; + Return (Betree_Node_Internal node0) end - | BetreeListNil => + | Betree_List_Nil => _ <- - betree_node_lookup_first_message_for_key_back n0 key msgs - BetreeListNil; - node0 <- betree_internal_lookup_in_children_back n0 node key st0; - Return (BetreeNodeInternal node0) + betree_Node_lookup_first_message_for_key_back n0 key msgs + Betree_List_Nil; + node0 <- betree_Internal_lookup_in_children_back n0 node key st0; + Return (Betree_Node_Internal node0) end - | BetreeNodeLeaf node => - p <- betree_load_leaf_node_fwd node.(Betree_leaf_id) st; + | Betree_Node_Leaf node => + p <- betree_load_leaf_node node.(betree_Leaf_id) st; let (_, bindings) := p in - _ <- betree_node_lookup_in_bindings_fwd n0 key bindings; - Return (BetreeNodeLeaf node) + _ <- betree_Node_lookup_in_bindings n0 key bindings; + Return (Betree_Node_Leaf node) end end . (** [betree_main::betree::Node::{5}::filter_messages_for_key]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Fixpoint betree_node_filter_messages_for_key_fwd_back - (n : nat) (key : u64) (msgs : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * Betree_message_t)) +Fixpoint betree_Node_filter_messages_for_key + (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => match msgs with - | BetreeListCons p l => + | Betree_List_Cons p l => let (k, m) := p in if k s= key then ( msgs0 <- - betree_list_pop_front_back (u64 * Betree_message_t) (BetreeListCons + betree_List_pop_front_back (u64 * betree_Message_t) (Betree_List_Cons (k, m) l); - betree_node_filter_messages_for_key_fwd_back n0 key msgs0) - else Return (BetreeListCons (k, m) l) - | BetreeListNil => Return BetreeListNil + betree_Node_filter_messages_for_key n0 key msgs0) + else Return (Betree_List_Cons (k, m) l) + | Betree_List_Nil => Return Betree_List_Nil end end . (** [betree_main::betree::Node::{5}::lookup_first_message_after_key]: forward function *) -Fixpoint betree_node_lookup_first_message_after_key_fwd - (n : nat) (key : u64) (msgs : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * Betree_message_t)) +Fixpoint betree_Node_lookup_first_message_after_key + (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => match msgs with - | BetreeListCons p next_msgs => + | Betree_List_Cons p next_msgs => let (k, m) := p in if k s= key - then betree_node_lookup_first_message_after_key_fwd n0 key next_msgs - else Return (BetreeListCons (k, m) next_msgs) - | BetreeListNil => Return BetreeListNil + then betree_Node_lookup_first_message_after_key n0 key next_msgs + else Return (Betree_List_Cons (k, m) next_msgs) + | Betree_List_Nil => Return Betree_List_Nil end end . (** [betree_main::betree::Node::{5}::lookup_first_message_after_key]: backward function 0 *) -Fixpoint betree_node_lookup_first_message_after_key_back - (n : nat) (key : u64) (msgs : Betree_list_t (u64 * Betree_message_t)) - (ret : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * Betree_message_t)) +Fixpoint betree_Node_lookup_first_message_after_key_back + (n : nat) (key : u64) (msgs : betree_List_t (u64 * betree_Message_t)) + (ret : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => match msgs with - | BetreeListCons p next_msgs => + | Betree_List_Cons p next_msgs => let (k, m) := p in if k s= key then ( next_msgs0 <- - betree_node_lookup_first_message_after_key_back n0 key next_msgs ret; - Return (BetreeListCons (k, m) next_msgs0)) + betree_Node_lookup_first_message_after_key_back n0 key next_msgs ret; + Return (Betree_List_Cons (k, m) next_msgs0)) else Return ret - | BetreeListNil => Return ret + | Betree_List_Nil => Return ret end end . (** [betree_main::betree::Node::{5}::apply_to_internal]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition betree_node_apply_to_internal_fwd_back - (n : nat) (msgs : Betree_list_t (u64 * Betree_message_t)) (key : u64) - (new_msg : Betree_message_t) : - result (Betree_list_t (u64 * Betree_message_t)) +Definition betree_Node_apply_to_internal + (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) (key : u64) + (new_msg : betree_Message_t) : + result (betree_List_t (u64 * betree_Message_t)) := - msgs0 <- betree_node_lookup_first_message_for_key_fwd n key msgs; - b <- betree_list_head_has_key_fwd Betree_message_t msgs0 key; + msgs0 <- betree_Node_lookup_first_message_for_key n key msgs; + b <- betree_List_head_has_key betree_Message_t msgs0 key; if b then match new_msg with - | BetreeMessageInsert i => - msgs1 <- betree_node_filter_messages_for_key_fwd_back n key msgs0; + | Betree_Message_Insert i => + msgs1 <- betree_Node_filter_messages_for_key n key msgs0; msgs2 <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs1 (key, - BetreeMessageInsert i); - betree_node_lookup_first_message_for_key_back n key msgs msgs2 - | BetreeMessageDelete => - msgs1 <- betree_node_filter_messages_for_key_fwd_back n key msgs0; + betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + Betree_Message_Insert i); + betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + | Betree_Message_Delete => + msgs1 <- betree_Node_filter_messages_for_key n key msgs0; msgs2 <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs1 (key, - BetreeMessageDelete); - betree_node_lookup_first_message_for_key_back n key msgs msgs2 - | BetreeMessageUpsert s => - p <- betree_list_hd_fwd (u64 * Betree_message_t) msgs0; + betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + Betree_Message_Delete); + betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + | Betree_Message_Upsert s => + p <- betree_List_hd (u64 * betree_Message_t) msgs0; let (_, m) := p in match m with - | BetreeMessageInsert prev => - v <- betree_upsert_update_fwd (Some prev) s; - msgs1 <- betree_list_pop_front_back (u64 * Betree_message_t) msgs0; + | Betree_Message_Insert prev => + v <- betree_upsert_update (Some prev) s; + msgs1 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs0; msgs2 <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs1 (key, - BetreeMessageInsert v); - betree_node_lookup_first_message_for_key_back n key msgs msgs2 - | BetreeMessageDelete => - v <- betree_upsert_update_fwd None s; - msgs1 <- betree_list_pop_front_back (u64 * Betree_message_t) msgs0; + betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + Betree_Message_Insert v); + betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + | Betree_Message_Delete => + v <- betree_upsert_update None s; + msgs1 <- betree_List_pop_front_back (u64 * betree_Message_t) msgs0; msgs2 <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs1 (key, - BetreeMessageInsert v); - betree_node_lookup_first_message_for_key_back n key msgs msgs2 - | BetreeMessageUpsert ufs => - msgs1 <- betree_node_lookup_first_message_after_key_fwd n key msgs0; + betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + Betree_Message_Insert v); + betree_Node_lookup_first_message_for_key_back n key msgs msgs2 + | Betree_Message_Upsert ufs => + msgs1 <- betree_Node_lookup_first_message_after_key n key msgs0; msgs2 <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs1 (key, - BetreeMessageUpsert s); + betree_List_push_front (u64 * betree_Message_t) msgs1 (key, + Betree_Message_Upsert s); msgs3 <- - betree_node_lookup_first_message_after_key_back n key msgs0 msgs2; - betree_node_lookup_first_message_for_key_back n key msgs msgs3 + betree_Node_lookup_first_message_after_key_back n key msgs0 msgs2; + betree_Node_lookup_first_message_for_key_back n key msgs msgs3 end end else ( msgs1 <- - betree_list_push_front_fwd_back (u64 * Betree_message_t) msgs0 (key, - new_msg); - betree_node_lookup_first_message_for_key_back n key msgs msgs1) + betree_List_push_front (u64 * betree_Message_t) msgs0 (key, new_msg); + betree_Node_lookup_first_message_for_key_back n key msgs msgs1) . (** [betree_main::betree::Node::{5}::apply_messages_to_internal]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Fixpoint betree_node_apply_messages_to_internal_fwd_back - (n : nat) (msgs : Betree_list_t (u64 * Betree_message_t)) - (new_msgs : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * Betree_message_t)) +Fixpoint betree_Node_apply_messages_to_internal + (n : nat) (msgs : betree_List_t (u64 * betree_Message_t)) + (new_msgs : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * betree_Message_t)) := match n with | O => Fail_ OutOfFuel | S n0 => match new_msgs with - | BetreeListCons new_msg new_msgs_tl => + | Betree_List_Cons new_msg new_msgs_tl => let (i, m) := new_msg in - msgs0 <- betree_node_apply_to_internal_fwd_back n0 msgs i m; - betree_node_apply_messages_to_internal_fwd_back n0 msgs0 new_msgs_tl - | BetreeListNil => Return msgs + msgs0 <- betree_Node_apply_to_internal n0 msgs i m; + betree_Node_apply_messages_to_internal n0 msgs0 new_msgs_tl + | Betree_List_Nil => Return msgs end end . (** [betree_main::betree::Node::{5}::lookup_mut_in_bindings]: forward function *) -Fixpoint betree_node_lookup_mut_in_bindings_fwd - (n : nat) (key : u64) (bindings : Betree_list_t (u64 * u64)) : - result (Betree_list_t (u64 * u64)) +Fixpoint betree_Node_lookup_mut_in_bindings + (n : nat) (key : u64) (bindings : betree_List_t (u64 * u64)) : + result (betree_List_t (u64 * u64)) := match n with | O => Fail_ OutOfFuel | S n0 => match bindings with - | BetreeListCons hd tl => + | Betree_List_Cons hd tl => let (i, i0) := hd in if i s>= key - then Return (BetreeListCons (i, i0) tl) - else betree_node_lookup_mut_in_bindings_fwd n0 key tl - | BetreeListNil => Return BetreeListNil + then Return (Betree_List_Cons (i, i0) tl) + else betree_Node_lookup_mut_in_bindings n0 key tl + | Betree_List_Nil => Return Betree_List_Nil end end . (** [betree_main::betree::Node::{5}::lookup_mut_in_bindings]: backward function 0 *) -Fixpoint betree_node_lookup_mut_in_bindings_back - (n : nat) (key : u64) (bindings : Betree_list_t (u64 * u64)) - (ret : Betree_list_t (u64 * u64)) : - result (Betree_list_t (u64 * u64)) +Fixpoint betree_Node_lookup_mut_in_bindings_back + (n : nat) (key : u64) (bindings : betree_List_t (u64 * u64)) + (ret : betree_List_t (u64 * u64)) : + result (betree_List_t (u64 * u64)) := match n with | O => Fail_ OutOfFuel | S n0 => match bindings with - | BetreeListCons hd tl => + | Betree_List_Cons hd tl => let (i, i0) := hd in if i s>= key then Return ret else ( - tl0 <- betree_node_lookup_mut_in_bindings_back n0 key tl ret; - Return (BetreeListCons (i, i0) tl0)) - | BetreeListNil => Return ret + tl0 <- betree_Node_lookup_mut_in_bindings_back n0 key tl ret; + Return (Betree_List_Cons (i, i0) tl0)) + | Betree_List_Nil => Return ret end end . (** [betree_main::betree::Node::{5}::apply_to_leaf]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition betree_node_apply_to_leaf_fwd_back - (n : nat) (bindings : Betree_list_t (u64 * u64)) (key : u64) - (new_msg : Betree_message_t) : - result (Betree_list_t (u64 * u64)) +Definition betree_Node_apply_to_leaf + (n : nat) (bindings : betree_List_t (u64 * u64)) (key : u64) + (new_msg : betree_Message_t) : + result (betree_List_t (u64 * u64)) := - bindings0 <- betree_node_lookup_mut_in_bindings_fwd n key bindings; - b <- betree_list_head_has_key_fwd u64 bindings0 key; + bindings0 <- betree_Node_lookup_mut_in_bindings n key bindings; + b <- betree_List_head_has_key u64 bindings0 key; if b then ( - hd <- betree_list_pop_front_fwd (u64 * u64) bindings0; + hd <- betree_List_pop_front (u64 * u64) bindings0; match new_msg with - | BetreeMessageInsert v => - bindings1 <- betree_list_pop_front_back (u64 * u64) bindings0; - bindings2 <- - betree_list_push_front_fwd_back (u64 * u64) bindings1 (key, v); - betree_node_lookup_mut_in_bindings_back n key bindings bindings2 - | BetreeMessageDelete => - bindings1 <- betree_list_pop_front_back (u64 * u64) bindings0; - betree_node_lookup_mut_in_bindings_back n key bindings bindings1 - | BetreeMessageUpsert s => + | Betree_Message_Insert v => + bindings1 <- betree_List_pop_front_back (u64 * u64) bindings0; + bindings2 <- betree_List_push_front (u64 * u64) bindings1 (key, v); + betree_Node_lookup_mut_in_bindings_back n key bindings bindings2 + | Betree_Message_Delete => + bindings1 <- betree_List_pop_front_back (u64 * u64) bindings0; + betree_Node_lookup_mut_in_bindings_back n key bindings bindings1 + | Betree_Message_Upsert s => let (_, i) := hd in - v <- betree_upsert_update_fwd (Some i) s; - bindings1 <- betree_list_pop_front_back (u64 * u64) bindings0; - bindings2 <- - betree_list_push_front_fwd_back (u64 * u64) bindings1 (key, v); - betree_node_lookup_mut_in_bindings_back n key bindings bindings2 + v <- betree_upsert_update (Some i) s; + bindings1 <- betree_List_pop_front_back (u64 * u64) bindings0; + bindings2 <- betree_List_push_front (u64 * u64) bindings1 (key, v); + betree_Node_lookup_mut_in_bindings_back n key bindings bindings2 end) else match new_msg with - | BetreeMessageInsert v => - bindings1 <- - betree_list_push_front_fwd_back (u64 * u64) bindings0 (key, v); - betree_node_lookup_mut_in_bindings_back n key bindings bindings1 - | BetreeMessageDelete => - betree_node_lookup_mut_in_bindings_back n key bindings bindings0 - | BetreeMessageUpsert s => - v <- betree_upsert_update_fwd None s; - bindings1 <- - betree_list_push_front_fwd_back (u64 * u64) bindings0 (key, v); - betree_node_lookup_mut_in_bindings_back n key bindings bindings1 + | Betree_Message_Insert v => + bindings1 <- betree_List_push_front (u64 * u64) bindings0 (key, v); + betree_Node_lookup_mut_in_bindings_back n key bindings bindings1 + | Betree_Message_Delete => + betree_Node_lookup_mut_in_bindings_back n key bindings bindings0 + | Betree_Message_Upsert s => + v <- betree_upsert_update None s; + bindings1 <- betree_List_push_front (u64 * u64) bindings0 (key, v); + betree_Node_lookup_mut_in_bindings_back n key bindings bindings1 end . (** [betree_main::betree::Node::{5}::apply_messages_to_leaf]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Fixpoint betree_node_apply_messages_to_leaf_fwd_back - (n : nat) (bindings : Betree_list_t (u64 * u64)) - (new_msgs : Betree_list_t (u64 * Betree_message_t)) : - result (Betree_list_t (u64 * u64)) +Fixpoint betree_Node_apply_messages_to_leaf + (n : nat) (bindings : betree_List_t (u64 * u64)) + (new_msgs : betree_List_t (u64 * betree_Message_t)) : + result (betree_List_t (u64 * u64)) := match n with | O => Fail_ OutOfFuel | S n0 => match new_msgs with - | BetreeListCons new_msg new_msgs_tl => + | Betree_List_Cons new_msg new_msgs_tl => let (i, m) := new_msg in - bindings0 <- betree_node_apply_to_leaf_fwd_back n0 bindings i m; - betree_node_apply_messages_to_leaf_fwd_back n0 bindings0 new_msgs_tl - | BetreeListNil => Return bindings + bindings0 <- betree_Node_apply_to_leaf n0 bindings i m; + betree_Node_apply_messages_to_leaf n0 bindings0 new_msgs_tl + | Betree_List_Nil => Return bindings end end . (** [betree_main::betree::Internal::{4}::flush]: forward function *) -Fixpoint betree_internal_flush_fwd - (n : nat) (self : Betree_internal_t) (params : Betree_params_t) - (node_id_cnt : Betree_node_id_counter_t) - (content : Betree_list_t (u64 * Betree_message_t)) (st : state) : - result (state * (Betree_list_t (u64 * Betree_message_t))) +Fixpoint betree_Internal_flush + (n : nat) (self : betree_Internal_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (content : betree_List_t (u64 * betree_Message_t)) (st : state) : + result (state * (betree_List_t (u64 * betree_Message_t))) := match n with | O => Fail_ OutOfFuel | S n0 => p <- - betree_list_partition_at_pivot_fwd Betree_message_t n0 content - self.(Betree_internal_pivot); + betree_List_partition_at_pivot betree_Message_t n0 content + self.(betree_Internal_pivot); let (msgs_left, msgs_right) := p in - len_left <- betree_list_len_fwd (u64 * Betree_message_t) n0 msgs_left; - if len_left s>= params.(Betree_params_min_flush_size) + len_left <- betree_List_len (u64 * betree_Message_t) n0 msgs_left; + if len_left s>= params.(betree_Params_min_flush_size) then ( p0 <- - betree_node_apply_messages_fwd n0 self.(Betree_internal_left) params + betree_Node_apply_messages n0 self.(betree_Internal_left) params node_id_cnt msgs_left st; let (st0, _) := p0 in p1 <- - betree_node_apply_messages_back n0 self.(Betree_internal_left) params + betree_Node_apply_messages_back n0 self.(betree_Internal_left) params node_id_cnt msgs_left st; let (_, node_id_cnt0) := p1 in - len_right <- betree_list_len_fwd (u64 * Betree_message_t) n0 msgs_right; - if len_right s>= params.(Betree_params_min_flush_size) + len_right <- betree_List_len (u64 * betree_Message_t) n0 msgs_right; + if len_right s>= params.(betree_Params_min_flush_size) then ( p2 <- - betree_node_apply_messages_fwd n0 self.(Betree_internal_right) params + betree_Node_apply_messages n0 self.(betree_Internal_right) params node_id_cnt0 msgs_right st0; let (st1, _) := p2 in _ <- - betree_node_apply_messages_back n0 self.(Betree_internal_right) + betree_Node_apply_messages_back n0 self.(betree_Internal_right) params node_id_cnt0 msgs_right st0; - Return (st1, BetreeListNil)) + Return (st1, Betree_List_Nil)) else Return (st0, msgs_right)) else ( p0 <- - betree_node_apply_messages_fwd n0 self.(Betree_internal_right) params + betree_Node_apply_messages n0 self.(betree_Internal_right) params node_id_cnt msgs_right st; let (st0, _) := p0 in _ <- - betree_node_apply_messages_back n0 self.(Betree_internal_right) params + betree_Node_apply_messages_back n0 self.(betree_Internal_right) params node_id_cnt msgs_right st; Return (st0, msgs_left)) end (** [betree_main::betree::Internal::{4}::flush]: backward function 0 *) -with betree_internal_flush_back - (n : nat) (self : Betree_internal_t) (params : Betree_params_t) - (node_id_cnt : Betree_node_id_counter_t) - (content : Betree_list_t (u64 * Betree_message_t)) (st : state) : - result (Betree_internal_t * Betree_node_id_counter_t) +with betree_Internal_flush_back + (n : nat) (self : betree_Internal_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (content : betree_List_t (u64 * betree_Message_t)) (st : state) : + result (betree_Internal_t * betree_NodeIdCounter_t) := match n with | O => Fail_ OutOfFuel | S n0 => p <- - betree_list_partition_at_pivot_fwd Betree_message_t n0 content - self.(Betree_internal_pivot); + betree_List_partition_at_pivot betree_Message_t n0 content + self.(betree_Internal_pivot); let (msgs_left, msgs_right) := p in - len_left <- betree_list_len_fwd (u64 * Betree_message_t) n0 msgs_left; - if len_left s>= params.(Betree_params_min_flush_size) + len_left <- betree_List_len (u64 * betree_Message_t) n0 msgs_left; + if len_left s>= params.(betree_Params_min_flush_size) then ( p0 <- - betree_node_apply_messages_fwd n0 self.(Betree_internal_left) params + betree_Node_apply_messages n0 self.(betree_Internal_left) params node_id_cnt msgs_left st; let (st0, _) := p0 in p1 <- - betree_node_apply_messages_back n0 self.(Betree_internal_left) params + betree_Node_apply_messages_back n0 self.(betree_Internal_left) params node_id_cnt msgs_left st; let (n1, node_id_cnt0) := p1 in - len_right <- betree_list_len_fwd (u64 * Betree_message_t) n0 msgs_right; - if len_right s>= params.(Betree_params_min_flush_size) + len_right <- betree_List_len (u64 * betree_Message_t) n0 msgs_right; + if len_right s>= params.(betree_Params_min_flush_size) then ( p2 <- - betree_node_apply_messages_back n0 self.(Betree_internal_right) + betree_Node_apply_messages_back n0 self.(betree_Internal_right) params node_id_cnt0 msgs_right st0; let (n2, node_id_cnt1) := p2 in - Return (mkBetree_internal_t self.(Betree_internal_id) - self.(Betree_internal_pivot) n1 n2, node_id_cnt1)) + Return (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) n1 n2, node_id_cnt1)) else - Return (mkBetree_internal_t self.(Betree_internal_id) - self.(Betree_internal_pivot) n1 self.(Betree_internal_right), + Return (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) n1 self.(betree_Internal_right), node_id_cnt0)) else ( p0 <- - betree_node_apply_messages_back n0 self.(Betree_internal_right) params + betree_Node_apply_messages_back n0 self.(betree_Internal_right) params node_id_cnt msgs_right st; let (n1, node_id_cnt0) := p0 in - Return (mkBetree_internal_t self.(Betree_internal_id) - self.(Betree_internal_pivot) self.(Betree_internal_left) n1, + Return (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) self.(betree_Internal_left) n1, node_id_cnt0)) end (** [betree_main::betree::Node::{5}::apply_messages]: forward function *) -with betree_node_apply_messages_fwd - (n : nat) (self : Betree_node_t) (params : Betree_params_t) - (node_id_cnt : Betree_node_id_counter_t) - (msgs : Betree_list_t (u64 * Betree_message_t)) (st : state) : +with betree_Node_apply_messages + (n : nat) (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (msgs : betree_List_t (u64 * betree_Message_t)) (st : state) : result (state * unit) := match n with | O => Fail_ OutOfFuel | S n0 => match self with - | BetreeNodeInternal node => - p <- betree_load_internal_node_fwd node.(Betree_internal_id) st; + | Betree_Node_Internal node => + p <- betree_load_internal_node node.(betree_Internal_id) st; let (st0, content) := p in - content0 <- - betree_node_apply_messages_to_internal_fwd_back n0 content msgs; - num_msgs <- betree_list_len_fwd (u64 * Betree_message_t) n0 content0; - if num_msgs s>= params.(Betree_params_min_flush_size) + content0 <- betree_Node_apply_messages_to_internal n0 content msgs; + num_msgs <- betree_List_len (u64 * betree_Message_t) n0 content0; + if num_msgs s>= params.(betree_Params_min_flush_size) then ( - p0 <- - betree_internal_flush_fwd n0 node params node_id_cnt content0 st0; + p0 <- betree_Internal_flush n0 node params node_id_cnt content0 st0; let (st1, content1) := p0 in p1 <- - betree_internal_flush_back n0 node params node_id_cnt content0 st0; + betree_Internal_flush_back n0 node params node_id_cnt content0 st0; let (node0, _) := p1 in p2 <- - betree_store_internal_node_fwd node0.(Betree_internal_id) content1 - st1; + betree_store_internal_node node0.(betree_Internal_id) content1 st1; let (st2, _) := p2 in Return (st2, tt)) else ( p0 <- - betree_store_internal_node_fwd node.(Betree_internal_id) content0 st0; + betree_store_internal_node node.(betree_Internal_id) content0 st0; let (st1, _) := p0 in Return (st1, tt)) - | BetreeNodeLeaf node => - p <- betree_load_leaf_node_fwd node.(Betree_leaf_id) st; + | Betree_Node_Leaf node => + p <- betree_load_leaf_node node.(betree_Leaf_id) st; let (st0, content) := p in - content0 <- betree_node_apply_messages_to_leaf_fwd_back n0 content msgs; - len <- betree_list_len_fwd (u64 * u64) n0 content0; - i <- u64_mul 2%u64 params.(Betree_params_split_size); + content0 <- betree_Node_apply_messages_to_leaf n0 content msgs; + len <- betree_List_len (u64 * u64) n0 content0; + i <- u64_mul 2%u64 params.(betree_Params_split_size); if len s>= i then ( - p0 <- betree_leaf_split_fwd n0 node content0 params node_id_cnt st0; + p0 <- betree_Leaf_split n0 node content0 params node_id_cnt st0; let (st1, _) := p0 in - p1 <- - betree_store_leaf_node_fwd node.(Betree_leaf_id) BetreeListNil st1; + p1 <- betree_store_leaf_node node.(betree_Leaf_id) Betree_List_Nil st1; let (st2, _) := p1 in Return (st2, tt)) else ( - p0 <- betree_store_leaf_node_fwd node.(Betree_leaf_id) content0 st0; + p0 <- betree_store_leaf_node node.(betree_Leaf_id) content0 st0; let (st1, _) := p0 in Return (st1, tt)) end end (** [betree_main::betree::Node::{5}::apply_messages]: backward function 0 *) -with betree_node_apply_messages_back - (n : nat) (self : Betree_node_t) (params : Betree_params_t) - (node_id_cnt : Betree_node_id_counter_t) - (msgs : Betree_list_t (u64 * Betree_message_t)) (st : state) : - result (Betree_node_t * Betree_node_id_counter_t) +with betree_Node_apply_messages_back + (n : nat) (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) + (msgs : betree_List_t (u64 * betree_Message_t)) (st : state) : + result (betree_Node_t * betree_NodeIdCounter_t) := match n with | O => Fail_ OutOfFuel | S n0 => match self with - | BetreeNodeInternal node => - p <- betree_load_internal_node_fwd node.(Betree_internal_id) st; + | Betree_Node_Internal node => + p <- betree_load_internal_node node.(betree_Internal_id) st; let (st0, content) := p in - content0 <- - betree_node_apply_messages_to_internal_fwd_back n0 content msgs; - num_msgs <- betree_list_len_fwd (u64 * Betree_message_t) n0 content0; - if num_msgs s>= params.(Betree_params_min_flush_size) + content0 <- betree_Node_apply_messages_to_internal n0 content msgs; + num_msgs <- betree_List_len (u64 * betree_Message_t) n0 content0; + if num_msgs s>= params.(betree_Params_min_flush_size) then ( - p0 <- - betree_internal_flush_fwd n0 node params node_id_cnt content0 st0; + p0 <- betree_Internal_flush n0 node params node_id_cnt content0 st0; let (st1, content1) := p0 in p1 <- - betree_internal_flush_back n0 node params node_id_cnt content0 st0; + betree_Internal_flush_back n0 node params node_id_cnt content0 st0; let (node0, node_id_cnt0) := p1 in _ <- - betree_store_internal_node_fwd node0.(Betree_internal_id) content1 - st1; - Return (BetreeNodeInternal node0, node_id_cnt0)) + betree_store_internal_node node0.(betree_Internal_id) content1 st1; + Return (Betree_Node_Internal node0, node_id_cnt0)) else ( - _ <- - betree_store_internal_node_fwd node.(Betree_internal_id) content0 st0; - Return (BetreeNodeInternal node, node_id_cnt)) - | BetreeNodeLeaf node => - p <- betree_load_leaf_node_fwd node.(Betree_leaf_id) st; + _ <- betree_store_internal_node node.(betree_Internal_id) content0 st0; + Return (Betree_Node_Internal node, node_id_cnt)) + | Betree_Node_Leaf node => + p <- betree_load_leaf_node node.(betree_Leaf_id) st; let (st0, content) := p in - content0 <- betree_node_apply_messages_to_leaf_fwd_back n0 content msgs; - len <- betree_list_len_fwd (u64 * u64) n0 content0; - i <- u64_mul 2%u64 params.(Betree_params_split_size); + content0 <- betree_Node_apply_messages_to_leaf n0 content msgs; + len <- betree_List_len (u64 * u64) n0 content0; + i <- u64_mul 2%u64 params.(betree_Params_split_size); if len s>= i then ( - p0 <- betree_leaf_split_fwd n0 node content0 params node_id_cnt st0; + p0 <- betree_Leaf_split n0 node content0 params node_id_cnt st0; let (st1, new_node) := p0 in - _ <- - betree_store_leaf_node_fwd node.(Betree_leaf_id) BetreeListNil st1; + _ <- betree_store_leaf_node node.(betree_Leaf_id) Betree_List_Nil st1; node_id_cnt0 <- - betree_leaf_split_back n0 node content0 params node_id_cnt st0; - Return (BetreeNodeInternal new_node, node_id_cnt0)) + betree_Leaf_split_back n0 node content0 params node_id_cnt st0; + Return (Betree_Node_Internal new_node, node_id_cnt0)) else ( - _ <- betree_store_leaf_node_fwd node.(Betree_leaf_id) content0 st0; - Return (BetreeNodeLeaf - {| Betree_leaf_id := node.(Betree_leaf_id); Betree_leaf_size := len + _ <- betree_store_leaf_node node.(betree_Leaf_id) content0 st0; + Return (Betree_Node_Leaf + {| betree_Leaf_id := node.(betree_Leaf_id); betree_Leaf_size := len |}, node_id_cnt)) end end . (** [betree_main::betree::Node::{5}::apply]: forward function *) -Definition betree_node_apply_fwd - (n : nat) (self : Betree_node_t) (params : Betree_params_t) - (node_id_cnt : Betree_node_id_counter_t) (key : u64) - (new_msg : Betree_message_t) (st : state) : +Definition betree_Node_apply + (n : nat) (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) (key : u64) + (new_msg : betree_Message_t) (st : state) : result (state * unit) := - let l := BetreeListNil in + let l := Betree_List_Nil in p <- - betree_node_apply_messages_fwd n self params node_id_cnt (BetreeListCons + betree_Node_apply_messages n self params node_id_cnt (Betree_List_Cons (key, new_msg) l) st; let (st0, _) := p in _ <- - betree_node_apply_messages_back n self params node_id_cnt (BetreeListCons + betree_Node_apply_messages_back n self params node_id_cnt (Betree_List_Cons (key, new_msg) l) st; Return (st0, tt) . (** [betree_main::betree::Node::{5}::apply]: backward function 0 *) -Definition betree_node_apply_back - (n : nat) (self : Betree_node_t) (params : Betree_params_t) - (node_id_cnt : Betree_node_id_counter_t) (key : u64) - (new_msg : Betree_message_t) (st : state) : - result (Betree_node_t * Betree_node_id_counter_t) +Definition betree_Node_apply_back + (n : nat) (self : betree_Node_t) (params : betree_Params_t) + (node_id_cnt : betree_NodeIdCounter_t) (key : u64) + (new_msg : betree_Message_t) (st : state) : + result (betree_Node_t * betree_NodeIdCounter_t) := - let l := BetreeListNil in - betree_node_apply_messages_back n self params node_id_cnt (BetreeListCons + let l := Betree_List_Nil in + betree_Node_apply_messages_back n self params node_id_cnt (Betree_List_Cons (key, new_msg) l) st . (** [betree_main::betree::BeTree::{6}::new]: forward function *) -Definition betree_be_tree_new_fwd +Definition betree_BeTree_new (min_flush_size : u64) (split_size : u64) (st : state) : - result (state * Betree_be_tree_t) + result (state * betree_BeTree_t) := - node_id_cnt <- betree_node_id_counter_new_fwd; - id <- betree_node_id_counter_fresh_id_fwd node_id_cnt; - p <- betree_store_leaf_node_fwd id BetreeListNil st; + node_id_cnt <- betree_NodeIdCounter_new; + id <- betree_NodeIdCounter_fresh_id node_id_cnt; + p <- betree_store_leaf_node id Betree_List_Nil st; let (st0, _) := p in - node_id_cnt0 <- betree_node_id_counter_fresh_id_back node_id_cnt; + node_id_cnt0 <- betree_NodeIdCounter_fresh_id_back node_id_cnt; Return (st0, {| - Betree_be_tree_params := + betree_BeTree_params := {| - Betree_params_min_flush_size := min_flush_size; - Betree_params_split_size := split_size + betree_Params_min_flush_size := min_flush_size; + betree_Params_split_size := split_size |}; - Betree_be_tree_node_id_cnt := node_id_cnt0; - Betree_be_tree_root := - (BetreeNodeLeaf {| Betree_leaf_id := id; Betree_leaf_size := 0%u64 |}) + betree_BeTree_node_id_cnt := node_id_cnt0; + betree_BeTree_root := + (Betree_Node_Leaf + {| betree_Leaf_id := id; betree_Leaf_size := 0%u64 |}) |}) . (** [betree_main::betree::BeTree::{6}::apply]: forward function *) -Definition betree_be_tree_apply_fwd - (n : nat) (self : Betree_be_tree_t) (key : u64) (msg : Betree_message_t) +Definition betree_BeTree_apply + (n : nat) (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) (st : state) : result (state * unit) := p <- - betree_node_apply_fwd n self.(Betree_be_tree_root) - self.(Betree_be_tree_params) self.(Betree_be_tree_node_id_cnt) key msg st; + betree_Node_apply n self.(betree_BeTree_root) self.(betree_BeTree_params) + self.(betree_BeTree_node_id_cnt) key msg st; let (st0, _) := p in _ <- - betree_node_apply_back n self.(Betree_be_tree_root) - self.(Betree_be_tree_params) self.(Betree_be_tree_node_id_cnt) key msg st; + betree_Node_apply_back n self.(betree_BeTree_root) + self.(betree_BeTree_params) self.(betree_BeTree_node_id_cnt) key msg st; Return (st0, tt) . (** [betree_main::betree::BeTree::{6}::apply]: backward function 0 *) -Definition betree_be_tree_apply_back - (n : nat) (self : Betree_be_tree_t) (key : u64) (msg : Betree_message_t) +Definition betree_BeTree_apply_back + (n : nat) (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) (st : state) : - result Betree_be_tree_t + result betree_BeTree_t := p <- - betree_node_apply_back n self.(Betree_be_tree_root) - self.(Betree_be_tree_params) self.(Betree_be_tree_node_id_cnt) key msg st; + betree_Node_apply_back n self.(betree_BeTree_root) + self.(betree_BeTree_params) self.(betree_BeTree_node_id_cnt) key msg st; let (n0, nic) := p in Return {| - Betree_be_tree_params := self.(Betree_be_tree_params); - Betree_be_tree_node_id_cnt := nic; - Betree_be_tree_root := n0 + betree_BeTree_params := self.(betree_BeTree_params); + betree_BeTree_node_id_cnt := nic; + betree_BeTree_root := n0 |} . (** [betree_main::betree::BeTree::{6}::insert]: forward function *) -Definition betree_be_tree_insert_fwd - (n : nat) (self : Betree_be_tree_t) (key : u64) (value : u64) (st : state) : +Definition betree_BeTree_insert + (n : nat) (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : result (state * unit) := - p <- betree_be_tree_apply_fwd n self key (BetreeMessageInsert value) st; + p <- betree_BeTree_apply n self key (Betree_Message_Insert value) st; let (st0, _) := p in - _ <- betree_be_tree_apply_back n self key (BetreeMessageInsert value) st; + _ <- betree_BeTree_apply_back n self key (Betree_Message_Insert value) st; Return (st0, tt) . (** [betree_main::betree::BeTree::{6}::insert]: backward function 0 *) -Definition betree_be_tree_insert_back - (n : nat) (self : Betree_be_tree_t) (key : u64) (value : u64) (st : state) : - result Betree_be_tree_t +Definition betree_BeTree_insert_back + (n : nat) (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : + result betree_BeTree_t := - betree_be_tree_apply_back n self key (BetreeMessageInsert value) st + betree_BeTree_apply_back n self key (Betree_Message_Insert value) st . (** [betree_main::betree::BeTree::{6}::delete]: forward function *) -Definition betree_be_tree_delete_fwd - (n : nat) (self : Betree_be_tree_t) (key : u64) (st : state) : +Definition betree_BeTree_delete + (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : result (state * unit) := - p <- betree_be_tree_apply_fwd n self key BetreeMessageDelete st; + p <- betree_BeTree_apply n self key Betree_Message_Delete st; let (st0, _) := p in - _ <- betree_be_tree_apply_back n self key BetreeMessageDelete st; + _ <- betree_BeTree_apply_back n self key Betree_Message_Delete st; Return (st0, tt) . (** [betree_main::betree::BeTree::{6}::delete]: backward function 0 *) -Definition betree_be_tree_delete_back - (n : nat) (self : Betree_be_tree_t) (key : u64) (st : state) : - result Betree_be_tree_t +Definition betree_BeTree_delete_back + (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : + result betree_BeTree_t := - betree_be_tree_apply_back n self key BetreeMessageDelete st + betree_BeTree_apply_back n self key Betree_Message_Delete st . (** [betree_main::betree::BeTree::{6}::upsert]: forward function *) -Definition betree_be_tree_upsert_fwd - (n : nat) (self : Betree_be_tree_t) (key : u64) - (upd : Betree_upsert_fun_state_t) (st : state) : +Definition betree_BeTree_upsert + (n : nat) (self : betree_BeTree_t) (key : u64) + (upd : betree_UpsertFunState_t) (st : state) : result (state * unit) := - p <- betree_be_tree_apply_fwd n self key (BetreeMessageUpsert upd) st; + p <- betree_BeTree_apply n self key (Betree_Message_Upsert upd) st; let (st0, _) := p in - _ <- betree_be_tree_apply_back n self key (BetreeMessageUpsert upd) st; + _ <- betree_BeTree_apply_back n self key (Betree_Message_Upsert upd) st; Return (st0, tt) . (** [betree_main::betree::BeTree::{6}::upsert]: backward function 0 *) -Definition betree_be_tree_upsert_back - (n : nat) (self : Betree_be_tree_t) (key : u64) - (upd : Betree_upsert_fun_state_t) (st : state) : - result Betree_be_tree_t +Definition betree_BeTree_upsert_back + (n : nat) (self : betree_BeTree_t) (key : u64) + (upd : betree_UpsertFunState_t) (st : state) : + result betree_BeTree_t := - betree_be_tree_apply_back n self key (BetreeMessageUpsert upd) st + betree_BeTree_apply_back n self key (Betree_Message_Upsert upd) st . (** [betree_main::betree::BeTree::{6}::lookup]: forward function *) -Definition betree_be_tree_lookup_fwd - (n : nat) (self : Betree_be_tree_t) (key : u64) (st : state) : +Definition betree_BeTree_lookup + (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : result (state * (option u64)) := - betree_node_lookup_fwd n self.(Betree_be_tree_root) key st + betree_Node_lookup n self.(betree_BeTree_root) key st . (** [betree_main::betree::BeTree::{6}::lookup]: backward function 0 *) -Definition betree_be_tree_lookup_back - (n : nat) (self : Betree_be_tree_t) (key : u64) (st : state) : - result Betree_be_tree_t +Definition betree_BeTree_lookup_back + (n : nat) (self : betree_BeTree_t) (key : u64) (st : state) : + result betree_BeTree_t := - n0 <- betree_node_lookup_back n self.(Betree_be_tree_root) key st; + n0 <- betree_Node_lookup_back n self.(betree_BeTree_root) key st; Return {| - Betree_be_tree_params := self.(Betree_be_tree_params); - Betree_be_tree_node_id_cnt := self.(Betree_be_tree_node_id_cnt); - Betree_be_tree_root := n0 + betree_BeTree_params := self.(betree_BeTree_params); + betree_BeTree_node_id_cnt := self.(betree_BeTree_node_id_cnt); + betree_BeTree_root := n0 |} . (** [betree_main::main]: forward function *) -Definition main_fwd : result unit := +Definition main : result unit := Return tt. (** Unit test for [betree_main::main] *) -Check (main_fwd )%return. +Check (main )%return. End BetreeMain_Funs . diff --git a/tests/coq/betree/BetreeMain_Opaque.v b/tests/coq/betree/BetreeMain_Opaque.v index ecd81b9d..eade90de 100644 --- a/tests/coq/betree/BetreeMain_Opaque.v +++ b/tests/coq/betree/BetreeMain_Opaque.v @@ -11,29 +11,29 @@ Import BetreeMain_Types. Module BetreeMain_Opaque. (** [betree_main::betree_utils::load_internal_node]: forward function *) -Axiom betree_utils_load_internal_node_fwd - : u64 -> state -> result (state * (Betree_list_t (u64 * Betree_message_t))) +Axiom betree_utils_load_internal_node + : u64 -> state -> result (state * (betree_List_t (u64 * betree_Message_t))) . (** [betree_main::betree_utils::store_internal_node]: forward function *) -Axiom betree_utils_store_internal_node_fwd +Axiom betree_utils_store_internal_node : - u64 -> Betree_list_t (u64 * Betree_message_t) -> state -> result (state * + u64 -> betree_List_t (u64 * betree_Message_t) -> state -> result (state * unit) . (** [betree_main::betree_utils::load_leaf_node]: forward function *) -Axiom betree_utils_load_leaf_node_fwd - : u64 -> state -> result (state * (Betree_list_t (u64 * u64))) +Axiom betree_utils_load_leaf_node + : u64 -> state -> result (state * (betree_List_t (u64 * u64))) . (** [betree_main::betree_utils::store_leaf_node]: forward function *) -Axiom betree_utils_store_leaf_node_fwd - : u64 -> Betree_list_t (u64 * u64) -> state -> result (state * unit) +Axiom betree_utils_store_leaf_node + : u64 -> betree_List_t (u64 * u64) -> state -> result (state * unit) . (** [core::option::Option::{0}::unwrap]: forward function *) -Axiom core_option_option_unwrap_fwd : +Axiom core_option_Option_unwrap : forall(T : Type), option T -> state -> result (state * T) . diff --git a/tests/coq/betree/BetreeMain_Types.v b/tests/coq/betree/BetreeMain_Types.v index 4a4e75aa..ee26622e 100644 --- a/tests/coq/betree/BetreeMain_Types.v +++ b/tests/coq/betree/BetreeMain_Types.v @@ -9,98 +9,98 @@ Local Open Scope Primitives_scope. Module BetreeMain_Types. (** [betree_main::betree::List] *) -Inductive Betree_list_t (T : Type) := -| BetreeListCons : T -> Betree_list_t T -> Betree_list_t T -| BetreeListNil : Betree_list_t T +Inductive betree_List_t (T : Type) := +| Betree_List_Cons : T -> betree_List_t T -> betree_List_t T +| Betree_List_Nil : betree_List_t T . -Arguments BetreeListCons {T} _ _. -Arguments BetreeListNil {T}. +Arguments Betree_List_Cons {T} _ _. +Arguments Betree_List_Nil {T}. (** [betree_main::betree::UpsertFunState] *) -Inductive Betree_upsert_fun_state_t := -| BetreeUpsertFunStateAdd : u64 -> Betree_upsert_fun_state_t -| BetreeUpsertFunStateSub : u64 -> Betree_upsert_fun_state_t +Inductive betree_UpsertFunState_t := +| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t +| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t . (** [betree_main::betree::Message] *) -Inductive Betree_message_t := -| BetreeMessageInsert : u64 -> Betree_message_t -| BetreeMessageDelete : Betree_message_t -| BetreeMessageUpsert : Betree_upsert_fun_state_t -> Betree_message_t +Inductive betree_Message_t := +| Betree_Message_Insert : u64 -> betree_Message_t +| Betree_Message_Delete : betree_Message_t +| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t . (** [betree_main::betree::Leaf] *) -Record Betree_leaf_t := -mkBetree_leaf_t { - Betree_leaf_id : u64; Betree_leaf_size : u64; +Record betree_Leaf_t := +mkbetree_Leaf_t { + betree_Leaf_id : u64; betree_Leaf_size : u64; } . (** [betree_main::betree::Internal] *) -Inductive Betree_internal_t := -| mkBetree_internal_t : +Inductive betree_Internal_t := +| mkbetree_Internal_t : u64 -> u64 -> - Betree_node_t -> - Betree_node_t -> - Betree_internal_t + betree_Node_t -> + betree_Node_t -> + betree_Internal_t (** [betree_main::betree::Node] *) -with Betree_node_t := -| BetreeNodeInternal : Betree_internal_t -> Betree_node_t -| BetreeNodeLeaf : Betree_leaf_t -> Betree_node_t +with betree_Node_t := +| Betree_Node_Internal : betree_Internal_t -> betree_Node_t +| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t . -Definition Betree_internal_id (x : Betree_internal_t) := - match x with | mkBetree_internal_t x0 _ _ _ => x0 end +Definition betree_Internal_id (x : betree_Internal_t) := + match x with | mkbetree_Internal_t x0 _ _ _ => x0 end . -Notation "x1 .(Betree_internal_id)" := (Betree_internal_id x1) (at level 9). +Notation "x1 .(betree_Internal_id)" := (betree_Internal_id x1) (at level 9). -Definition Betree_internal_pivot (x : Betree_internal_t) := - match x with | mkBetree_internal_t _ x0 _ _ => x0 end +Definition betree_Internal_pivot (x : betree_Internal_t) := + match x with | mkbetree_Internal_t _ x0 _ _ => x0 end . -Notation "x1 .(Betree_internal_pivot)" := (Betree_internal_pivot x1) +Notation "x1 .(betree_Internal_pivot)" := (betree_Internal_pivot x1) (at level 9) . -Definition Betree_internal_left (x : Betree_internal_t) := - match x with | mkBetree_internal_t _ _ x0 _ => x0 end +Definition betree_Internal_left (x : betree_Internal_t) := + match x with | mkbetree_Internal_t _ _ x0 _ => x0 end . -Notation "x1 .(Betree_internal_left)" := (Betree_internal_left x1) (at level 9) +Notation "x1 .(betree_Internal_left)" := (betree_Internal_left x1) (at level 9) . -Definition Betree_internal_right (x : Betree_internal_t) := - match x with | mkBetree_internal_t _ _ _ x0 => x0 end +Definition betree_Internal_right (x : betree_Internal_t) := + match x with | mkbetree_Internal_t _ _ _ x0 => x0 end . -Notation "x1 .(Betree_internal_right)" := (Betree_internal_right x1) +Notation "x1 .(betree_Internal_right)" := (betree_Internal_right x1) (at level 9) . (** [betree_main::betree::Params] *) -Record Betree_params_t := -mkBetree_params_t { - Betree_params_min_flush_size : u64; Betree_params_split_size : u64; +Record betree_Params_t := +mkbetree_Params_t { + betree_Params_min_flush_size : u64; betree_Params_split_size : u64; } . (** [betree_main::betree::NodeIdCounter] *) -Record Betree_node_id_counter_t := -mkBetree_node_id_counter_t { - Betree_node_id_counter_next_node_id : u64; +Record betree_NodeIdCounter_t := +mkbetree_NodeIdCounter_t { + betree_NodeIdCounter_next_node_id : u64; } . (** [betree_main::betree::BeTree] *) -Record Betree_be_tree_t := -mkBetree_be_tree_t { - Betree_be_tree_params : Betree_params_t; - Betree_be_tree_node_id_cnt : Betree_node_id_counter_t; - Betree_be_tree_root : Betree_node_t; +Record betree_BeTree_t := +mkbetree_BeTree_t { + betree_BeTree_params : betree_Params_t; + betree_BeTree_node_id_cnt : betree_NodeIdCounter_t; + betree_BeTree_root : betree_Node_t; } . diff --git a/tests/coq/betree/Primitives.v b/tests/coq/betree/Primitives.v index 8d6c9c8d..85e38f01 100644 --- a/tests/coq/betree/Primitives.v +++ b/tests/coq/betree/Primitives.v @@ -63,13 +63,15 @@ Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) - Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition mem_replace_fwd (a : Type) (x : a) (y : a) : a := x . -Definition mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . +Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. (*** Scalars *) @@ -408,12 +410,75 @@ 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; - end_: T; +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); + core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. +Arguments core_ops_index_IndexMut_index_mut_back {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; +}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); + core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; }. -Arguments mk_range {_}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. +Arguments core_ops_deref_DerefMut_deref_mut_back {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; + core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; +|}. + (*** Arrays *) Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. @@ -433,51 +498,50 @@ Qed. (* TODO: finish the definitions *) Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. -Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +(* For initialization *) +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. + +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. Axiom slice_len : forall (T : Type) (s : slice T), usize. -Axiom slice_index_shared : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_fwd : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_back : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). (*** Subslices *) -Axiom array_to_slice_shared : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_fwd : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_back : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). -Axiom array_subslice_shared: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_fwd: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_back: forall (T : Type) (n : usize) (x : array T n) (r : range usize) (ns : slice T), result (array T n). -Axiom slice_subslice_shared: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_fwd: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_back: forall (T : Type) (x : slice T) (r : range usize) (ns : slice T), result (slice T). +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). (*** Vectors *) -Definition vec T := { l: list T | Z.of_nat (length l) <= usize_max }. +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. -Definition vec_to_list {T: Type} (v: vec T) : list T := proj1_sig v. +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. -Definition vec_length {T: Type} (v: vec T) : Z := Z.of_nat (length (vec_to_list v)). +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). -Definition vec_new (T: Type) : vec T := (exist _ [] le_0_usize_max). +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). -Lemma vec_len_in_usize {T} (v: vec T) : usize_min <= vec_length v <= usize_max. +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. Proof. - unfold vec_length, usize_min. + unfold alloc_vec_Vec_length, usize_min. split. - lia. - apply (proj2_sig v). Qed. -Definition vec_len (T: Type) (v: vec T) : usize := - exist _ (vec_length v) (vec_len_in_usize v). +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). Fixpoint list_update {A} (l: list A) (n: nat) (a: A) : list A := @@ -488,50 +552,271 @@ Fixpoint list_update {A} (l: list A) (n: nat) (a: A) | S m => x :: (list_update t m a) end end. -Definition vec_bind {A B} (v: vec A) (f: list A -> result (list B)) : result (vec B) := - l <- f (vec_to_list v) ; +Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := + l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. (* The **forward** function shouldn't be used *) -Definition vec_push_fwd (T: Type) (v: vec T) (x: T) : unit := tt. +Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. -Definition vec_push_back (T: Type) (v: vec T) (x: T) : result (vec T) := - vec_bind v (fun l => Return (l ++ [x])). +Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). (* The **forward** function shouldn't be used *) -Definition vec_insert_fwd (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i +Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => if to_Z i Return n - | None => Fail_ Failure - end. - -Definition vec_index_back (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i Return n - | None => Fail_ Failure +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. +Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Return x end. -Definition vec_index_mut_back (T: Type) (v: vec T) (i: usize) (x: T) : result (vec T) := - vec_bind v (fun l => - if to_Z i slice T -> result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: backward function 0 *) +Axiom core_slice_index_Range_get_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_Range_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_Range_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_Range_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_Range_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: backward function 0 *) +Axiom core_slice_index_Range_index_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). + +(* [core::slice::index::[T]::index_mut]: backward function 0 *) +Axiom core_slice_index_Slice_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: backward function 0 *) +Axiom core_array_Array_index_mut_back : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_Range_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_Range_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; + core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: backward function 0 *) +Axiom core_slice_index_usize_get_mut_back : + forall (T : Type), usize -> slice T -> option T -> result (slice T). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: backward function 0 *) +Axiom core_slice_index_usize_index_mut_back : + forall (T : Type), usize -> slice T -> T -> result (slice T). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: backward function 0 *) +Axiom alloc_vec_Vec_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + 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. End Primitives. diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index 054880d4..3ca52a9f 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -11,98 +11,101 @@ Import Hashmap_Types. Module Hashmap_Funs. (** [hashmap::hash_key]: forward function *) -Definition hash_key_fwd (k : usize) : result usize := +Definition hash_key (k : usize) : result usize := Return k. (** [hashmap::HashMap::{0}::allocate_slots]: loop 0: forward function *) -Fixpoint hash_map_allocate_slots_loop_fwd - (T : Type) (n : nat) (slots : vec (List_t T)) (n0 : usize) : - result (vec (List_t T)) +Fixpoint hashMap_allocate_slots_loop + (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n0 : usize) : + result (alloc_vec_Vec (List_t T)) := match n with | O => Fail_ OutOfFuel | S n1 => if n0 s> 0%usize then ( - slots0 <- vec_push_back (List_t T) slots ListNil; + slots0 <- alloc_vec_Vec_push (List_t T) slots List_Nil; n2 <- usize_sub n0 1%usize; - hash_map_allocate_slots_loop_fwd T n1 slots0 n2) + hashMap_allocate_slots_loop T n1 slots0 n2) else Return slots end . (** [hashmap::HashMap::{0}::allocate_slots]: forward function *) -Definition hash_map_allocate_slots_fwd - (T : Type) (n : nat) (slots : vec (List_t T)) (n0 : usize) : - result (vec (List_t T)) +Definition hashMap_allocate_slots + (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n0 : usize) : + result (alloc_vec_Vec (List_t T)) := - hash_map_allocate_slots_loop_fwd T n slots n0 + hashMap_allocate_slots_loop T n slots n0 . (** [hashmap::HashMap::{0}::new_with_capacity]: forward function *) -Definition hash_map_new_with_capacity_fwd +Definition hashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : - result (Hash_map_t T) + result (HashMap_t T) := - let v := vec_new (List_t T) in - slots <- hash_map_allocate_slots_fwd T n v capacity; + let v := alloc_vec_Vec_new (List_t T) in + slots <- hashMap_allocate_slots T n v capacity; i <- usize_mul capacity max_load_dividend; i0 <- usize_div i max_load_divisor; Return {| - Hash_map_num_entries := 0%usize; - Hash_map_max_load_factor := (max_load_dividend, max_load_divisor); - Hash_map_max_load := i0; - Hash_map_slots := slots + hashMap_num_entries := 0%usize; + hashMap_max_load_factor := (max_load_dividend, max_load_divisor); + hashMap_max_load := i0; + hashMap_slots := slots |} . (** [hashmap::HashMap::{0}::new]: forward function *) -Definition hash_map_new_fwd (T : Type) (n : nat) : result (Hash_map_t T) := - hash_map_new_with_capacity_fwd T n 32%usize 4%usize 5%usize +Definition hashMap_new (T : Type) (n : nat) : result (HashMap_t T) := + hashMap_new_with_capacity T n 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 ()) *) -Fixpoint hash_map_clear_loop_fwd_back - (T : Type) (n : nat) (slots : vec (List_t T)) (i : usize) : - result (vec (List_t T)) +Fixpoint hashMap_clear_loop + (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (i : usize) : + result (alloc_vec_Vec (List_t T)) := match n with | O => Fail_ OutOfFuel | S n0 => - let i0 := vec_len (List_t T) slots in + let i0 := alloc_vec_Vec_len (List_t T) slots in if i s< i0 then ( i1 <- usize_add i 1%usize; - slots0 <- vec_index_mut_back (List_t T) slots i ListNil; - hash_map_clear_loop_fwd_back T n0 slots0 i1) + slots0 <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + slots i List_Nil; + hashMap_clear_loop T n0 slots0 i1) else Return slots end . (** [hashmap::HashMap::{0}::clear]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hash_map_clear_fwd_back - (T : Type) (n : nat) (self : Hash_map_t T) : result (Hash_map_t T) := - v <- hash_map_clear_loop_fwd_back T n self.(Hash_map_slots) 0%usize; +Definition hashMap_clear + (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := + v <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; Return {| - Hash_map_num_entries := 0%usize; - Hash_map_max_load_factor := self.(Hash_map_max_load_factor); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := v + hashMap_num_entries := 0%usize; + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v |} . (** [hashmap::HashMap::{0}::len]: forward function *) -Definition hash_map_len_fwd (T : Type) (self : Hash_map_t T) : result usize := - Return self.(Hash_map_num_entries) +Definition hashMap_len (T : Type) (self : HashMap_t T) : result usize := + Return self.(hashMap_num_entries) . (** [hashmap::HashMap::{0}::insert_in_list]: loop 0: forward function *) -Fixpoint hash_map_insert_in_list_loop_fwd +Fixpoint hashMap_insert_in_list_loop (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : result bool := @@ -110,25 +113,25 @@ Fixpoint hash_map_insert_in_list_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey cvalue tl => + | List_Cons ckey cvalue tl => if ckey s= key then Return false - else hash_map_insert_in_list_loop_fwd T n0 key value tl - | ListNil => Return true + else hashMap_insert_in_list_loop T n0 key value tl + | List_Nil => Return true end end . (** [hashmap::HashMap::{0}::insert_in_list]: forward function *) -Definition hash_map_insert_in_list_fwd +Definition hashMap_insert_in_list (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : result bool := - hash_map_insert_in_list_loop_fwd T n key value ls + hashMap_insert_in_list_loop T n key value ls . (** [hashmap::HashMap::{0}::insert_in_list]: loop 0: backward function 0 *) -Fixpoint hash_map_insert_in_list_loop_back +Fixpoint hashMap_insert_in_list_loop_back (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : result (List_t T) := @@ -136,255 +139,275 @@ Fixpoint hash_map_insert_in_list_loop_back | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey cvalue tl => + | List_Cons ckey cvalue tl => if ckey s= key - then Return (ListCons ckey value tl) + then Return (List_Cons ckey value tl) else ( - tl0 <- hash_map_insert_in_list_loop_back T n0 key value tl; - Return (ListCons ckey cvalue tl0)) - | ListNil => let l := ListNil in Return (ListCons key value l) + tl0 <- hashMap_insert_in_list_loop_back T n0 key value tl; + Return (List_Cons ckey cvalue tl0)) + | List_Nil => let l := List_Nil in Return (List_Cons key value l) end end . (** [hashmap::HashMap::{0}::insert_in_list]: backward function 0 *) -Definition hash_map_insert_in_list_back +Definition hashMap_insert_in_list_back (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : result (List_t T) := - hash_map_insert_in_list_loop_back T n key value ls + hashMap_insert_in_list_loop_back T n key value ls . (** [hashmap::HashMap::{0}::insert_no_resize]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hash_map_insert_no_resize_fwd_back - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) (value : T) : - result (Hash_map_t T) +Definition hashMap_insert_no_resize + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (value : T) : + result (HashMap_t T) := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_mut_fwd (List_t T) self.(Hash_map_slots) hash_mod; - inserted <- hash_map_insert_in_list_fwd T n key value l; + l <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + inserted <- hashMap_insert_in_list T n key value l; if inserted then ( - i0 <- usize_add self.(Hash_map_num_entries) 1%usize; - l0 <- hash_map_insert_in_list_back T n key value l; - v <- vec_index_mut_back (List_t T) self.(Hash_map_slots) hash_mod l0; + i0 <- usize_add self.(hashMap_num_entries) 1%usize; + l0 <- hashMap_insert_in_list_back T n key value l; + v <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod l0; Return {| - Hash_map_num_entries := i0; - Hash_map_max_load_factor := self.(Hash_map_max_load_factor); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := v + hashMap_num_entries := i0; + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v |}) else ( - l0 <- hash_map_insert_in_list_back T n key value l; - v <- vec_index_mut_back (List_t T) self.(Hash_map_slots) hash_mod l0; + l0 <- hashMap_insert_in_list_back T n key value l; + v <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod l0; Return {| - Hash_map_num_entries := self.(Hash_map_num_entries); - Hash_map_max_load_factor := self.(Hash_map_max_load_factor); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := v + hashMap_num_entries := self.(hashMap_num_entries); + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v |}) . (** [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 - (T : Type) (n : nat) (ntable : Hash_map_t T) (ls : List_t T) : - result (Hash_map_t T) +Fixpoint hashMap_move_elements_from_list_loop + (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) : + result (HashMap_t T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons k v tl => - ntable0 <- hash_map_insert_no_resize_fwd_back T n0 ntable k v; - hash_map_move_elements_from_list_loop_fwd_back T n0 ntable0 tl - | ListNil => Return ntable + | List_Cons k v tl => + ntable0 <- hashMap_insert_no_resize T n0 ntable k v; + hashMap_move_elements_from_list_loop T n0 ntable0 tl + | List_Nil => Return ntable end end . (** [hashmap::HashMap::{0}::move_elements_from_list]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hash_map_move_elements_from_list_fwd_back - (T : Type) (n : nat) (ntable : Hash_map_t T) (ls : List_t T) : - result (Hash_map_t T) +Definition hashMap_move_elements_from_list + (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) : + result (HashMap_t T) := - hash_map_move_elements_from_list_loop_fwd_back T n ntable ls + hashMap_move_elements_from_list_loop T n ntable ls . (** [hashmap::HashMap::{0}::move_elements]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Fixpoint hash_map_move_elements_loop_fwd_back - (T : Type) (n : nat) (ntable : Hash_map_t T) (slots : vec (List_t T)) - (i : usize) : - result ((Hash_map_t T) * (vec (List_t T))) +Fixpoint hashMap_move_elements_loop + (T : Type) (n : nat) (ntable : HashMap_t T) + (slots : alloc_vec_Vec (List_t T)) (i : usize) : + result ((HashMap_t T) * (alloc_vec_Vec (List_t T))) := match n with | O => Fail_ OutOfFuel | S n0 => - let i0 := vec_len (List_t T) slots in + let i0 := alloc_vec_Vec_len (List_t T) slots in if i s< i0 then ( - l <- vec_index_mut_fwd (List_t T) slots i; - let ls := mem_replace_fwd (List_t T) l ListNil in - ntable0 <- hash_map_move_elements_from_list_fwd_back T n0 ntable ls; + l <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + slots i; + let ls := core_mem_replace (List_t T) l List_Nil in + ntable0 <- hashMap_move_elements_from_list T n0 ntable ls; i1 <- usize_add i 1%usize; - let l0 := mem_replace_back (List_t T) l ListNil in - slots0 <- vec_index_mut_back (List_t T) slots i l0; - hash_map_move_elements_loop_fwd_back T n0 ntable0 slots0 i1) + let l0 := core_mem_replace_back (List_t T) l List_Nil in + slots0 <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + slots i l0; + hashMap_move_elements_loop T n0 ntable0 slots0 i1) else Return (ntable, slots) end . (** [hashmap::HashMap::{0}::move_elements]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hash_map_move_elements_fwd_back - (T : Type) (n : nat) (ntable : Hash_map_t T) (slots : vec (List_t T)) - (i : usize) : - result ((Hash_map_t T) * (vec (List_t T))) +Definition hashMap_move_elements + (T : Type) (n : nat) (ntable : HashMap_t T) + (slots : alloc_vec_Vec (List_t T)) (i : usize) : + result ((HashMap_t T) * (alloc_vec_Vec (List_t T))) := - hash_map_move_elements_loop_fwd_back T n ntable slots i + hashMap_move_elements_loop T n ntable slots i . (** [hashmap::HashMap::{0}::try_resize]: merged forward/backward function (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) := +Definition hashMap_try_resize + (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := max_usize <- scalar_cast U32 Usize core_u32_max; - let capacity := vec_len (List_t T) self.(Hash_map_slots) in + let capacity := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in n1 <- usize_div max_usize 2%usize; - let (i, i0) := self.(Hash_map_max_load_factor) in + let (i, i0) := self.(hashMap_max_load_factor) in i1 <- usize_div n1 i; if capacity s<= i1 then ( i2 <- usize_mul capacity 2%usize; - ntable <- hash_map_new_with_capacity_fwd T n i2 i i0; - p <- - hash_map_move_elements_fwd_back T n ntable self.(Hash_map_slots) 0%usize; + ntable <- hashMap_new_with_capacity T n i2 i i0; + p <- hashMap_move_elements T n ntable self.(hashMap_slots) 0%usize; let (ntable0, _) := p in Return {| - Hash_map_num_entries := self.(Hash_map_num_entries); - Hash_map_max_load_factor := (i, i0); - Hash_map_max_load := ntable0.(Hash_map_max_load); - Hash_map_slots := ntable0.(Hash_map_slots) + hashMap_num_entries := self.(hashMap_num_entries); + hashMap_max_load_factor := (i, i0); + hashMap_max_load := ntable0.(hashMap_max_load); + hashMap_slots := ntable0.(hashMap_slots) |}) else Return {| - Hash_map_num_entries := self.(Hash_map_num_entries); - Hash_map_max_load_factor := (i, i0); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := self.(Hash_map_slots) + hashMap_num_entries := self.(hashMap_num_entries); + hashMap_max_load_factor := (i, i0); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := self.(hashMap_slots) |} . (** [hashmap::HashMap::{0}::insert]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hash_map_insert_fwd_back - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) (value : T) : - result (Hash_map_t T) +Definition hashMap_insert + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (value : T) : + result (HashMap_t T) := - self0 <- hash_map_insert_no_resize_fwd_back T n self key value; - i <- hash_map_len_fwd T self0; - if i s> self0.(Hash_map_max_load) - then hash_map_try_resize_fwd_back T n self0 + self0 <- hashMap_insert_no_resize T n self key value; + i <- hashMap_len T self0; + if i s> self0.(hashMap_max_load) + then hashMap_try_resize T n self0 else Return self0 . (** [hashmap::HashMap::{0}::contains_key_in_list]: loop 0: forward function *) -Fixpoint hash_map_contains_key_in_list_loop_fwd +Fixpoint hashMap_contains_key_in_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey t tl => + | List_Cons ckey t tl => if ckey s= key then Return true - else hash_map_contains_key_in_list_loop_fwd T n0 key tl - | ListNil => Return false + else hashMap_contains_key_in_list_loop T n0 key tl + | List_Nil => Return false end end . (** [hashmap::HashMap::{0}::contains_key_in_list]: forward function *) -Definition hash_map_contains_key_in_list_fwd +Definition hashMap_contains_key_in_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool := - hash_map_contains_key_in_list_loop_fwd T n key ls + hashMap_contains_key_in_list_loop T n key ls . (** [hashmap::HashMap::{0}::contains_key]: forward function *) -Definition hash_map_contains_key_fwd - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) : result bool := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in +Definition hashMap_contains_key + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result bool := + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_fwd (List_t T) self.(Hash_map_slots) hash_mod; - hash_map_contains_key_in_list_fwd T n key l + l <- + alloc_vec_Vec_index (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + hashMap_contains_key_in_list T n key l . (** [hashmap::HashMap::{0}::get_in_list]: loop 0: forward function *) -Fixpoint hash_map_get_in_list_loop_fwd +Fixpoint hashMap_get_in_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey cvalue tl => + | List_Cons ckey cvalue tl => if ckey s= key then Return cvalue - else hash_map_get_in_list_loop_fwd T n0 key tl - | ListNil => Fail_ Failure + else hashMap_get_in_list_loop T n0 key tl + | List_Nil => Fail_ Failure end end . (** [hashmap::HashMap::{0}::get_in_list]: forward function *) -Definition hash_map_get_in_list_fwd +Definition hashMap_get_in_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T := - hash_map_get_in_list_loop_fwd T n key ls + hashMap_get_in_list_loop T n key ls . (** [hashmap::HashMap::{0}::get]: forward function *) -Definition hash_map_get_fwd - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) : result T := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in +Definition hashMap_get + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result T := + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_fwd (List_t T) self.(Hash_map_slots) hash_mod; - hash_map_get_in_list_fwd T n key l + l <- + alloc_vec_Vec_index (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + hashMap_get_in_list T n key l . (** [hashmap::HashMap::{0}::get_mut_in_list]: loop 0: forward function *) -Fixpoint hash_map_get_mut_in_list_loop_fwd +Fixpoint hashMap_get_mut_in_list_loop (T : Type) (n : nat) (ls : List_t T) (key : usize) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey cvalue tl => + | List_Cons ckey cvalue tl => if ckey s= key then Return cvalue - else hash_map_get_mut_in_list_loop_fwd T n0 tl key - | ListNil => Fail_ Failure + else hashMap_get_mut_in_list_loop T n0 tl key + | List_Nil => Fail_ Failure end end . (** [hashmap::HashMap::{0}::get_mut_in_list]: forward function *) -Definition hash_map_get_mut_in_list_fwd +Definition hashMap_get_mut_in_list (T : Type) (n : nat) (ls : List_t T) (key : usize) : result T := - hash_map_get_mut_in_list_loop_fwd T n ls key + hashMap_get_mut_in_list_loop T n ls key . (** [hashmap::HashMap::{0}::get_mut_in_list]: loop 0: backward function 0 *) -Fixpoint hash_map_get_mut_in_list_loop_back +Fixpoint hashMap_get_mut_in_list_loop_back (T : Type) (n : nat) (ls : List_t T) (key : usize) (ret : T) : result (List_t T) := @@ -392,196 +415,219 @@ Fixpoint hash_map_get_mut_in_list_loop_back | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey cvalue tl => + | List_Cons ckey cvalue tl => if ckey s= key - then Return (ListCons ckey ret tl) + then Return (List_Cons ckey ret tl) else ( - tl0 <- hash_map_get_mut_in_list_loop_back T n0 tl key ret; - Return (ListCons ckey cvalue tl0)) - | ListNil => Fail_ Failure + tl0 <- hashMap_get_mut_in_list_loop_back T n0 tl key ret; + Return (List_Cons ckey cvalue tl0)) + | List_Nil => Fail_ Failure end end . (** [hashmap::HashMap::{0}::get_mut_in_list]: backward function 0 *) -Definition hash_map_get_mut_in_list_back +Definition hashMap_get_mut_in_list_back (T : Type) (n : nat) (ls : List_t T) (key : usize) (ret : T) : result (List_t T) := - hash_map_get_mut_in_list_loop_back T n ls key ret + hashMap_get_mut_in_list_loop_back T n ls key ret . (** [hashmap::HashMap::{0}::get_mut]: forward function *) -Definition hash_map_get_mut_fwd - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) : result T := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in +Definition hashMap_get_mut + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result T := + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_mut_fwd (List_t T) self.(Hash_map_slots) hash_mod; - hash_map_get_mut_in_list_fwd T n l key + l <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + hashMap_get_mut_in_list T n l key . (** [hashmap::HashMap::{0}::get_mut]: backward function 0 *) -Definition hash_map_get_mut_back - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) (ret : T) : - result (Hash_map_t T) +Definition hashMap_get_mut_back + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (ret : T) : + result (HashMap_t T) := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_mut_fwd (List_t T) self.(Hash_map_slots) hash_mod; - l0 <- hash_map_get_mut_in_list_back T n l key ret; - v <- vec_index_mut_back (List_t T) self.(Hash_map_slots) hash_mod l0; + l <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + l0 <- hashMap_get_mut_in_list_back T n l key ret; + v <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod l0; Return {| - Hash_map_num_entries := self.(Hash_map_num_entries); - Hash_map_max_load_factor := self.(Hash_map_max_load_factor); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := v + hashMap_num_entries := self.(hashMap_num_entries); + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v |} . (** [hashmap::HashMap::{0}::remove_from_list]: loop 0: forward function *) -Fixpoint hash_map_remove_from_list_loop_fwd +Fixpoint hashMap_remove_from_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (option T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey t tl => + | List_Cons ckey t tl => if ckey s= key then - let mv_ls := mem_replace_fwd (List_t T) (ListCons ckey t tl) ListNil in + let mv_ls := core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil + in match mv_ls with - | ListCons i cvalue tl0 => Return (Some cvalue) - | ListNil => Fail_ Failure + | List_Cons i cvalue tl0 => Return (Some cvalue) + | List_Nil => Fail_ Failure end - else hash_map_remove_from_list_loop_fwd T n0 key tl - | ListNil => Return None + else hashMap_remove_from_list_loop T n0 key tl + | List_Nil => Return None end end . (** [hashmap::HashMap::{0}::remove_from_list]: forward function *) -Definition hash_map_remove_from_list_fwd +Definition hashMap_remove_from_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (option T) := - hash_map_remove_from_list_loop_fwd T n key ls + hashMap_remove_from_list_loop T n key ls . (** [hashmap::HashMap::{0}::remove_from_list]: loop 0: backward function 1 *) -Fixpoint hash_map_remove_from_list_loop_back +Fixpoint hashMap_remove_from_list_loop_back (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (List_t T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons ckey t tl => + | List_Cons ckey t tl => if ckey s= key then - let mv_ls := mem_replace_fwd (List_t T) (ListCons ckey t tl) ListNil in + let mv_ls := core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil + in match mv_ls with - | ListCons i cvalue tl0 => Return tl0 - | ListNil => Fail_ Failure + | List_Cons i cvalue tl0 => Return tl0 + | List_Nil => Fail_ Failure end else ( - tl0 <- hash_map_remove_from_list_loop_back T n0 key tl; - Return (ListCons ckey t tl0)) - | ListNil => Return ListNil + tl0 <- hashMap_remove_from_list_loop_back T n0 key tl; + Return (List_Cons ckey t tl0)) + | List_Nil => Return List_Nil end end . (** [hashmap::HashMap::{0}::remove_from_list]: backward function 1 *) -Definition hash_map_remove_from_list_back +Definition hashMap_remove_from_list_back (T : Type) (n : nat) (key : usize) (ls : List_t T) : result (List_t T) := - hash_map_remove_from_list_loop_back T n key ls + hashMap_remove_from_list_loop_back T n key ls . (** [hashmap::HashMap::{0}::remove]: forward function *) -Definition hash_map_remove_fwd - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) : +Definition hashMap_remove + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result (option T) := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_mut_fwd (List_t T) self.(Hash_map_slots) hash_mod; - x <- hash_map_remove_from_list_fwd T n key l; + l <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + x <- hashMap_remove_from_list T n key l; match x with | None => Return None | Some x0 => - _ <- usize_sub self.(Hash_map_num_entries) 1%usize; Return (Some x0) + _ <- usize_sub self.(hashMap_num_entries) 1%usize; Return (Some x0) end . (** [hashmap::HashMap::{0}::remove]: backward function 0 *) -Definition hash_map_remove_back - (T : Type) (n : nat) (self : Hash_map_t T) (key : usize) : - result (Hash_map_t T) +Definition hashMap_remove_back + (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : + result (HashMap_t T) := - hash <- hash_key_fwd key; - let i := vec_len (List_t T) self.(Hash_map_slots) in + hash <- hash_key key; + let i := alloc_vec_Vec_len (List_t T) self.(hashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_mut_fwd (List_t T) self.(Hash_map_slots) hash_mod; - x <- hash_map_remove_from_list_fwd T n key l; + l <- + alloc_vec_Vec_index_mut (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod; + x <- hashMap_remove_from_list T n key l; match x with | None => - l0 <- hash_map_remove_from_list_back T n key l; - v <- vec_index_mut_back (List_t T) self.(Hash_map_slots) hash_mod l0; + l0 <- hashMap_remove_from_list_back T n key l; + v <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod l0; Return {| - Hash_map_num_entries := self.(Hash_map_num_entries); - Hash_map_max_load_factor := self.(Hash_map_max_load_factor); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := v + hashMap_num_entries := self.(hashMap_num_entries); + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v |} | Some x0 => - i0 <- usize_sub self.(Hash_map_num_entries) 1%usize; - l0 <- hash_map_remove_from_list_back T n key l; - v <- vec_index_mut_back (List_t T) self.(Hash_map_slots) hash_mod l0; + i0 <- usize_sub self.(hashMap_num_entries) 1%usize; + l0 <- hashMap_remove_from_list_back T n key l; + v <- + alloc_vec_Vec_index_mut_back (List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t T)) + self.(hashMap_slots) hash_mod l0; Return {| - Hash_map_num_entries := i0; - Hash_map_max_load_factor := self.(Hash_map_max_load_factor); - Hash_map_max_load := self.(Hash_map_max_load); - Hash_map_slots := v + hashMap_num_entries := i0; + hashMap_max_load_factor := self.(hashMap_max_load_factor); + hashMap_max_load := self.(hashMap_max_load); + hashMap_slots := v |} end . (** [hashmap::test1]: forward function *) -Definition test1_fwd (n : nat) : result unit := - hm <- hash_map_new_fwd u64 n; - hm0 <- hash_map_insert_fwd_back u64 n hm 0%usize 42%u64; - hm1 <- hash_map_insert_fwd_back u64 n hm0 128%usize 18%u64; - hm2 <- hash_map_insert_fwd_back u64 n hm1 1024%usize 138%u64; - hm3 <- hash_map_insert_fwd_back u64 n hm2 1056%usize 256%u64; - i <- hash_map_get_fwd u64 n hm3 128%usize; +Definition test1 (n : nat) : result unit := + hm <- hashMap_new u64 n; + hm0 <- hashMap_insert u64 n hm 0%usize 42%u64; + hm1 <- hashMap_insert u64 n hm0 128%usize 18%u64; + hm2 <- hashMap_insert u64 n hm1 1024%usize 138%u64; + hm3 <- hashMap_insert u64 n hm2 1056%usize 256%u64; + i <- hashMap_get u64 n hm3 128%usize; if negb (i s= 18%u64) then Fail_ Failure else ( - hm4 <- hash_map_get_mut_back u64 n hm3 1024%usize 56%u64; - i0 <- hash_map_get_fwd u64 n hm4 1024%usize; + hm4 <- hashMap_get_mut_back u64 n hm3 1024%usize 56%u64; + i0 <- hashMap_get u64 n hm4 1024%usize; if negb (i0 s= 56%u64) then Fail_ Failure else ( - x <- hash_map_remove_fwd u64 n hm4 1024%usize; + x <- hashMap_remove u64 n hm4 1024%usize; match x with | None => Fail_ Failure | Some x0 => if negb (x0 s= 56%u64) then Fail_ Failure else ( - hm5 <- hash_map_remove_back u64 n hm4 1024%usize; - i1 <- hash_map_get_fwd u64 n hm5 0%usize; + hm5 <- hashMap_remove_back u64 n hm4 1024%usize; + i1 <- hashMap_get u64 n hm5 0%usize; if negb (i1 s= 42%u64) then Fail_ Failure else ( - i2 <- hash_map_get_fwd u64 n hm5 128%usize; + i2 <- hashMap_get u64 n hm5 128%usize; if negb (i2 s= 18%u64) then Fail_ Failure else ( - i3 <- hash_map_get_fwd u64 n hm5 1056%usize; + i3 <- hashMap_get u64 n hm5 1056%usize; if negb (i3 s= 256%u64) then Fail_ Failure else Return tt))) end)) . diff --git a/tests/coq/hashmap/Hashmap_Types.v b/tests/coq/hashmap/Hashmap_Types.v index dbde6be9..63d30eeb 100644 --- a/tests/coq/hashmap/Hashmap_Types.v +++ b/tests/coq/hashmap/Hashmap_Types.v @@ -10,27 +10,27 @@ Module Hashmap_Types. (** [hashmap::List] *) Inductive List_t (T : Type) := -| ListCons : usize -> T -> List_t T -> List_t T -| ListNil : List_t T +| List_Cons : usize -> T -> List_t T -> List_t T +| List_Nil : List_t T . -Arguments ListCons {T} _ _ _. -Arguments ListNil {T}. +Arguments List_Cons {T} _ _ _. +Arguments List_Nil {T}. (** [hashmap::HashMap] *) -Record Hash_map_t (T : Type) := -mkHash_map_t { - Hash_map_num_entries : usize; - Hash_map_max_load_factor : (usize * usize); - Hash_map_max_load : usize; - Hash_map_slots : vec (List_t T); +Record HashMap_t (T : Type) := +mkHashMap_t { + hashMap_num_entries : usize; + hashMap_max_load_factor : (usize * usize); + hashMap_max_load : usize; + hashMap_slots : alloc_vec_Vec (List_t T); } . -Arguments mkHash_map_t {T} _ _ _ _. -Arguments Hash_map_num_entries {T}. -Arguments Hash_map_max_load_factor {T}. -Arguments Hash_map_max_load {T}. -Arguments Hash_map_slots {T}. +Arguments mkHashMap_t {T} _ _ _ _. +Arguments hashMap_num_entries {T}. +Arguments hashMap_max_load_factor {T}. +Arguments hashMap_max_load {T}. +Arguments hashMap_slots {T}. End Hashmap_Types . diff --git a/tests/coq/hashmap/Primitives.v b/tests/coq/hashmap/Primitives.v index 8d6c9c8d..85e38f01 100644 --- a/tests/coq/hashmap/Primitives.v +++ b/tests/coq/hashmap/Primitives.v @@ -63,13 +63,15 @@ Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) - Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition mem_replace_fwd (a : Type) (x : a) (y : a) : a := x . -Definition mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . +Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. (*** Scalars *) @@ -408,12 +410,75 @@ 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; - end_: T; +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); + core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. +Arguments core_ops_index_IndexMut_index_mut_back {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; +}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); + core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; }. -Arguments mk_range {_}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. +Arguments core_ops_deref_DerefMut_deref_mut_back {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; + core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; +|}. + (*** Arrays *) Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. @@ -433,51 +498,50 @@ Qed. (* TODO: finish the definitions *) Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. -Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +(* For initialization *) +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. + +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. Axiom slice_len : forall (T : Type) (s : slice T), usize. -Axiom slice_index_shared : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_fwd : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_back : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). (*** Subslices *) -Axiom array_to_slice_shared : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_fwd : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_back : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). -Axiom array_subslice_shared: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_fwd: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_back: forall (T : Type) (n : usize) (x : array T n) (r : range usize) (ns : slice T), result (array T n). -Axiom slice_subslice_shared: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_fwd: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_back: forall (T : Type) (x : slice T) (r : range usize) (ns : slice T), result (slice T). +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). (*** Vectors *) -Definition vec T := { l: list T | Z.of_nat (length l) <= usize_max }. +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. -Definition vec_to_list {T: Type} (v: vec T) : list T := proj1_sig v. +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. -Definition vec_length {T: Type} (v: vec T) : Z := Z.of_nat (length (vec_to_list v)). +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). -Definition vec_new (T: Type) : vec T := (exist _ [] le_0_usize_max). +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). -Lemma vec_len_in_usize {T} (v: vec T) : usize_min <= vec_length v <= usize_max. +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. Proof. - unfold vec_length, usize_min. + unfold alloc_vec_Vec_length, usize_min. split. - lia. - apply (proj2_sig v). Qed. -Definition vec_len (T: Type) (v: vec T) : usize := - exist _ (vec_length v) (vec_len_in_usize v). +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). Fixpoint list_update {A} (l: list A) (n: nat) (a: A) : list A := @@ -488,50 +552,271 @@ Fixpoint list_update {A} (l: list A) (n: nat) (a: A) | S m => x :: (list_update t m a) end end. -Definition vec_bind {A B} (v: vec A) (f: list A -> result (list B)) : result (vec B) := - l <- f (vec_to_list v) ; +Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := + l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. (* The **forward** function shouldn't be used *) -Definition vec_push_fwd (T: Type) (v: vec T) (x: T) : unit := tt. +Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. -Definition vec_push_back (T: Type) (v: vec T) (x: T) : result (vec T) := - vec_bind v (fun l => Return (l ++ [x])). +Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). (* The **forward** function shouldn't be used *) -Definition vec_insert_fwd (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i +Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => if to_Z i Return n - | None => Fail_ Failure - end. - -Definition vec_index_back (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i Return n - | None => Fail_ Failure +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. +Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Return x end. -Definition vec_index_mut_back (T: Type) (v: vec T) (i: usize) (x: T) : result (vec T) := - vec_bind v (fun l => - if to_Z i slice T -> result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: backward function 0 *) +Axiom core_slice_index_Range_get_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_Range_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_Range_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_Range_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_Range_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: backward function 0 *) +Axiom core_slice_index_Range_index_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). + +(* [core::slice::index::[T]::index_mut]: backward function 0 *) +Axiom core_slice_index_Slice_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: backward function 0 *) +Axiom core_array_Array_index_mut_back : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_Range_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_Range_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; + core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: backward function 0 *) +Axiom core_slice_index_usize_get_mut_back : + forall (T : Type), usize -> slice T -> option T -> result (slice T). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: backward function 0 *) +Axiom core_slice_index_usize_index_mut_back : + forall (T : Type), usize -> slice T -> T -> result (slice T). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: backward function 0 *) +Axiom alloc_vec_Vec_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + 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. End Primitives. diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index a85adbf2..eac78186 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -13,652 +13,668 @@ Import HashmapMain_Opaque. Module HashmapMain_Funs. (** [hashmap_main::hashmap::hash_key]: forward function *) -Definition hashmap_hash_key_fwd (k : usize) : result usize := +Definition hashmap_hash_key (k : usize) : result usize := Return k. (** [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: loop 0: forward function *) -Fixpoint hashmap_hash_map_allocate_slots_loop_fwd - (T : Type) (n : nat) (slots : vec (Hashmap_list_t T)) (n0 : usize) : - result (vec (Hashmap_list_t T)) +Fixpoint hashmap_HashMap_allocate_slots_loop + (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n0 : usize) + : + result (alloc_vec_Vec (hashmap_List_t T)) := match n with | O => Fail_ OutOfFuel | S n1 => if n0 s> 0%usize then ( - slots0 <- vec_push_back (Hashmap_list_t T) slots HashmapListNil; + slots0 <- alloc_vec_Vec_push (hashmap_List_t T) slots Hashmap_List_Nil; n2 <- usize_sub n0 1%usize; - hashmap_hash_map_allocate_slots_loop_fwd T n1 slots0 n2) + hashmap_HashMap_allocate_slots_loop T n1 slots0 n2) else Return slots end . (** [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: forward function *) -Definition hashmap_hash_map_allocate_slots_fwd - (T : Type) (n : nat) (slots : vec (Hashmap_list_t T)) (n0 : usize) : - result (vec (Hashmap_list_t T)) +Definition hashmap_HashMap_allocate_slots + (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n0 : usize) + : + result (alloc_vec_Vec (hashmap_List_t T)) := - hashmap_hash_map_allocate_slots_loop_fwd T n slots n0 + hashmap_HashMap_allocate_slots_loop T n slots n0 . (** [hashmap_main::hashmap::HashMap::{0}::new_with_capacity]: forward function *) -Definition hashmap_hash_map_new_with_capacity_fwd +Definition hashmap_HashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : - result (Hashmap_hash_map_t T) + result (hashmap_HashMap_t T) := - let v := vec_new (Hashmap_list_t T) in - slots <- hashmap_hash_map_allocate_slots_fwd T n v capacity; + let v := alloc_vec_Vec_new (hashmap_List_t T) in + slots <- hashmap_HashMap_allocate_slots T n v capacity; i <- usize_mul capacity max_load_dividend; i0 <- usize_div i max_load_divisor; Return {| - Hashmap_hash_map_num_entries := 0%usize; - Hashmap_hash_map_max_load_factor := (max_load_dividend, max_load_divisor); - Hashmap_hash_map_max_load := i0; - Hashmap_hash_map_slots := slots + hashmap_HashMap_num_entries := 0%usize; + hashmap_HashMap_max_load_factor := (max_load_dividend, max_load_divisor); + hashmap_HashMap_max_load := i0; + hashmap_HashMap_slots := slots |} . (** [hashmap_main::hashmap::HashMap::{0}::new]: forward function *) -Definition hashmap_hash_map_new_fwd - (T : Type) (n : nat) : result (Hashmap_hash_map_t T) := - hashmap_hash_map_new_with_capacity_fwd T n 32%usize 4%usize 5%usize +Definition hashmap_HashMap_new + (T : Type) (n : nat) : result (hashmap_HashMap_t T) := + hashmap_HashMap_new_with_capacity T n 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 ()) *) -Fixpoint hashmap_hash_map_clear_loop_fwd_back - (T : Type) (n : nat) (slots : vec (Hashmap_list_t T)) (i : usize) : - result (vec (Hashmap_list_t T)) +Fixpoint hashmap_HashMap_clear_loop + (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : + result (alloc_vec_Vec (hashmap_List_t T)) := match n with | O => Fail_ OutOfFuel | S n0 => - let i0 := vec_len (Hashmap_list_t T) slots in + let i0 := alloc_vec_Vec_len (hashmap_List_t T) slots in if i s< i0 then ( i1 <- usize_add i 1%usize; - slots0 <- vec_index_mut_back (Hashmap_list_t T) slots i HashmapListNil; - hashmap_hash_map_clear_loop_fwd_back T n0 slots0 i1) + slots0 <- + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) slots i Hashmap_List_Nil; + hashmap_HashMap_clear_loop T n0 slots0 i1) else Return slots end . (** [hashmap_main::hashmap::HashMap::{0}::clear]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hashmap_hash_map_clear_fwd_back - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_clear + (T : Type) (n : nat) (self : hashmap_HashMap_t T) : + result (hashmap_HashMap_t T) := - v <- - hashmap_hash_map_clear_loop_fwd_back T n self.(Hashmap_hash_map_slots) - 0%usize; + v <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize; Return {| - Hashmap_hash_map_num_entries := 0%usize; - Hashmap_hash_map_max_load_factor := - self.(Hashmap_hash_map_max_load_factor); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := v + hashmap_HashMap_num_entries := 0%usize; + hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v |} . (** [hashmap_main::hashmap::HashMap::{0}::len]: forward function *) -Definition hashmap_hash_map_len_fwd - (T : Type) (self : Hashmap_hash_map_t T) : result usize := - Return self.(Hashmap_hash_map_num_entries) +Definition hashmap_HashMap_len + (T : Type) (self : hashmap_HashMap_t T) : result usize := + Return self.(hashmap_HashMap_num_entries) . (** [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: loop 0: forward function *) -Fixpoint hashmap_hash_map_insert_in_list_loop_fwd - (T : Type) (n : nat) (key : usize) (value : T) (ls : Hashmap_list_t T) : +Fixpoint hashmap_HashMap_insert_in_list_loop + (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : result bool := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey cvalue tl => + | Hashmap_List_Cons ckey cvalue tl => if ckey s= key then Return false - else hashmap_hash_map_insert_in_list_loop_fwd T n0 key value tl - | HashmapListNil => Return true + else hashmap_HashMap_insert_in_list_loop T n0 key value tl + | Hashmap_List_Nil => Return true end end . (** [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: forward function *) -Definition hashmap_hash_map_insert_in_list_fwd - (T : Type) (n : nat) (key : usize) (value : T) (ls : Hashmap_list_t T) : +Definition hashmap_HashMap_insert_in_list + (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : result bool := - hashmap_hash_map_insert_in_list_loop_fwd T n key value ls + hashmap_HashMap_insert_in_list_loop T n key value ls . (** [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: loop 0: backward function 0 *) -Fixpoint hashmap_hash_map_insert_in_list_loop_back - (T : Type) (n : nat) (key : usize) (value : T) (ls : Hashmap_list_t T) : - result (Hashmap_list_t T) +Fixpoint hashmap_HashMap_insert_in_list_loop_back + (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : + result (hashmap_List_t T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey cvalue tl => + | Hashmap_List_Cons ckey cvalue tl => if ckey s= key - then Return (HashmapListCons ckey value tl) + then Return (Hashmap_List_Cons ckey value tl) else ( - tl0 <- hashmap_hash_map_insert_in_list_loop_back T n0 key value tl; - Return (HashmapListCons ckey cvalue tl0)) - | HashmapListNil => - let l := HashmapListNil in Return (HashmapListCons key value l) + tl0 <- hashmap_HashMap_insert_in_list_loop_back T n0 key value tl; + Return (Hashmap_List_Cons ckey cvalue tl0)) + | Hashmap_List_Nil => + let l := Hashmap_List_Nil in Return (Hashmap_List_Cons key value l) end end . (** [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: backward function 0 *) -Definition hashmap_hash_map_insert_in_list_back - (T : Type) (n : nat) (key : usize) (value : T) (ls : Hashmap_list_t T) : - result (Hashmap_list_t T) +Definition hashmap_HashMap_insert_in_list_back + (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : + result (hashmap_List_t T) := - hashmap_hash_map_insert_in_list_loop_back T n key value ls + hashmap_HashMap_insert_in_list_loop_back T n key value ls . (** [hashmap_main::hashmap::HashMap::{0}::insert_no_resize]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hashmap_hash_map_insert_no_resize_fwd_back - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) (value : T) - : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_insert_no_resize + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (value : T) : + result (hashmap_HashMap_t T) := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; l <- - vec_index_mut_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - inserted <- hashmap_hash_map_insert_in_list_fwd T n key value l; + alloc_vec_Vec_index_mut (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + inserted <- hashmap_HashMap_insert_in_list T n key value l; if inserted then ( - i0 <- usize_add self.(Hashmap_hash_map_num_entries) 1%usize; - l0 <- hashmap_hash_map_insert_in_list_back T n key value l; + i0 <- usize_add self.(hashmap_HashMap_num_entries) 1%usize; + l0 <- hashmap_HashMap_insert_in_list_back T n key value l; v <- - vec_index_mut_back (Hashmap_list_t T) self.(Hashmap_hash_map_slots) - hash_mod l0; + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) self.(hashmap_HashMap_slots) hash_mod l0; Return {| - Hashmap_hash_map_num_entries := i0; - Hashmap_hash_map_max_load_factor := - self.(Hashmap_hash_map_max_load_factor); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := v + hashmap_HashMap_num_entries := i0; + hashmap_HashMap_max_load_factor := + self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v |}) else ( - l0 <- hashmap_hash_map_insert_in_list_back T n key value l; + l0 <- hashmap_HashMap_insert_in_list_back T n key value l; v <- - vec_index_mut_back (Hashmap_list_t T) self.(Hashmap_hash_map_slots) - hash_mod l0; + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) self.(hashmap_HashMap_slots) hash_mod l0; Return {| - Hashmap_hash_map_num_entries := self.(Hashmap_hash_map_num_entries); - Hashmap_hash_map_max_load_factor := - self.(Hashmap_hash_map_max_load_factor); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := v + hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); + hashmap_HashMap_max_load_factor := + self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v |}) . (** [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 - (T : Type) (n : nat) (ntable : Hashmap_hash_map_t T) (ls : Hashmap_list_t T) - : - result (Hashmap_hash_map_t T) +Fixpoint hashmap_HashMap_move_elements_from_list_loop + (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) : + result (hashmap_HashMap_t T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons k v tl => - ntable0 <- hashmap_hash_map_insert_no_resize_fwd_back T n0 ntable k v; - hashmap_hash_map_move_elements_from_list_loop_fwd_back T n0 ntable0 tl - | HashmapListNil => Return ntable + | Hashmap_List_Cons k v tl => + ntable0 <- hashmap_HashMap_insert_no_resize T n0 ntable k v; + hashmap_HashMap_move_elements_from_list_loop T n0 ntable0 tl + | Hashmap_List_Nil => Return ntable end end . (** [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hashmap_hash_map_move_elements_from_list_fwd_back - (T : Type) (n : nat) (ntable : Hashmap_hash_map_t T) (ls : Hashmap_list_t T) - : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_move_elements_from_list + (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) : + result (hashmap_HashMap_t T) := - hashmap_hash_map_move_elements_from_list_loop_fwd_back T n ntable ls + hashmap_HashMap_move_elements_from_list_loop T n ntable ls . (** [hashmap_main::hashmap::HashMap::{0}::move_elements]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Fixpoint hashmap_hash_map_move_elements_loop_fwd_back - (T : Type) (n : nat) (ntable : Hashmap_hash_map_t T) - (slots : vec (Hashmap_list_t T)) (i : usize) : - result ((Hashmap_hash_map_t T) * (vec (Hashmap_list_t T))) +Fixpoint hashmap_HashMap_move_elements_loop + (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) + (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : + result ((hashmap_HashMap_t T) * (alloc_vec_Vec (hashmap_List_t T))) := match n with | O => Fail_ OutOfFuel | S n0 => - let i0 := vec_len (Hashmap_list_t T) slots in + let i0 := alloc_vec_Vec_len (hashmap_List_t T) slots in if i s< i0 then ( - l <- vec_index_mut_fwd (Hashmap_list_t T) slots i; - let ls := mem_replace_fwd (Hashmap_list_t T) l HashmapListNil in - ntable0 <- - hashmap_hash_map_move_elements_from_list_fwd_back T n0 ntable ls; + l <- + alloc_vec_Vec_index_mut (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) slots i; + let ls := core_mem_replace (hashmap_List_t T) l Hashmap_List_Nil in + ntable0 <- hashmap_HashMap_move_elements_from_list T n0 ntable ls; i1 <- usize_add i 1%usize; - let l0 := mem_replace_back (Hashmap_list_t T) l HashmapListNil in - slots0 <- vec_index_mut_back (Hashmap_list_t T) slots i l0; - hashmap_hash_map_move_elements_loop_fwd_back T n0 ntable0 slots0 i1) + let l0 := core_mem_replace_back (hashmap_List_t T) l Hashmap_List_Nil in + slots0 <- + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) slots i l0; + hashmap_HashMap_move_elements_loop T n0 ntable0 slots0 i1) else Return (ntable, slots) end . (** [hashmap_main::hashmap::HashMap::{0}::move_elements]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hashmap_hash_map_move_elements_fwd_back - (T : Type) (n : nat) (ntable : Hashmap_hash_map_t T) - (slots : vec (Hashmap_list_t T)) (i : usize) : - result ((Hashmap_hash_map_t T) * (vec (Hashmap_list_t T))) +Definition hashmap_HashMap_move_elements + (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) + (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : + result ((hashmap_HashMap_t T) * (alloc_vec_Vec (hashmap_List_t T))) := - hashmap_hash_map_move_elements_loop_fwd_back T n ntable slots i + hashmap_HashMap_move_elements_loop T n ntable slots i . (** [hashmap_main::hashmap::HashMap::{0}::try_resize]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hashmap_hash_map_try_resize_fwd_back - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_try_resize + (T : Type) (n : nat) (self : hashmap_HashMap_t T) : + result (hashmap_HashMap_t T) := max_usize <- scalar_cast U32 Usize core_u32_max; - let capacity := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in + let capacity := + alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in n1 <- usize_div max_usize 2%usize; - let (i, i0) := self.(Hashmap_hash_map_max_load_factor) in + let (i, i0) := self.(hashmap_HashMap_max_load_factor) in i1 <- usize_div n1 i; if capacity s<= i1 then ( i2 <- usize_mul capacity 2%usize; - ntable <- hashmap_hash_map_new_with_capacity_fwd T n i2 i i0; + ntable <- hashmap_HashMap_new_with_capacity T n i2 i i0; p <- - hashmap_hash_map_move_elements_fwd_back T n ntable - self.(Hashmap_hash_map_slots) 0%usize; + hashmap_HashMap_move_elements T n ntable self.(hashmap_HashMap_slots) + 0%usize; let (ntable0, _) := p in Return {| - Hashmap_hash_map_num_entries := self.(Hashmap_hash_map_num_entries); - Hashmap_hash_map_max_load_factor := (i, i0); - Hashmap_hash_map_max_load := ntable0.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := ntable0.(Hashmap_hash_map_slots) + hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); + hashmap_HashMap_max_load_factor := (i, i0); + hashmap_HashMap_max_load := ntable0.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := ntable0.(hashmap_HashMap_slots) |}) else Return {| - Hashmap_hash_map_num_entries := self.(Hashmap_hash_map_num_entries); - Hashmap_hash_map_max_load_factor := (i, i0); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := self.(Hashmap_hash_map_slots) + hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); + hashmap_HashMap_max_load_factor := (i, i0); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := self.(hashmap_HashMap_slots) |} . (** [hashmap_main::hashmap::HashMap::{0}::insert]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition hashmap_hash_map_insert_fwd_back - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) (value : T) - : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_insert + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (value : T) : + result (hashmap_HashMap_t T) := - self0 <- hashmap_hash_map_insert_no_resize_fwd_back T n self key value; - i <- hashmap_hash_map_len_fwd T self0; - if i s> self0.(Hashmap_hash_map_max_load) - then hashmap_hash_map_try_resize_fwd_back T n self0 + self0 <- hashmap_HashMap_insert_no_resize T n self key value; + i <- hashmap_HashMap_len T self0; + if i s> self0.(hashmap_HashMap_max_load) + then hashmap_HashMap_try_resize T n self0 else Return self0 . (** [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list]: loop 0: forward function *) -Fixpoint hashmap_hash_map_contains_key_in_list_loop_fwd - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : result bool := +Fixpoint hashmap_HashMap_contains_key_in_list_loop + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey t tl => + | Hashmap_List_Cons ckey t tl => if ckey s= key then Return true - else hashmap_hash_map_contains_key_in_list_loop_fwd T n0 key tl - | HashmapListNil => Return false + else hashmap_HashMap_contains_key_in_list_loop T n0 key tl + | Hashmap_List_Nil => Return false end end . (** [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list]: forward function *) -Definition hashmap_hash_map_contains_key_in_list_fwd - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : result bool := - hashmap_hash_map_contains_key_in_list_loop_fwd T n key ls +Definition hashmap_HashMap_contains_key_in_list + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool := + hashmap_HashMap_contains_key_in_list_loop T n key ls . (** [hashmap_main::hashmap::HashMap::{0}::contains_key]: forward function *) -Definition hashmap_hash_map_contains_key_fwd - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) : +Definition hashmap_HashMap_contains_key + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result bool := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - hashmap_hash_map_contains_key_in_list_fwd T n key l + l <- + alloc_vec_Vec_index (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + hashmap_HashMap_contains_key_in_list T n key l . (** [hashmap_main::hashmap::HashMap::{0}::get_in_list]: loop 0: forward function *) -Fixpoint hashmap_hash_map_get_in_list_loop_fwd - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : result T := +Fixpoint hashmap_HashMap_get_in_list_loop + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey cvalue tl => + | Hashmap_List_Cons ckey cvalue tl => if ckey s= key then Return cvalue - else hashmap_hash_map_get_in_list_loop_fwd T n0 key tl - | HashmapListNil => Fail_ Failure + else hashmap_HashMap_get_in_list_loop T n0 key tl + | Hashmap_List_Nil => Fail_ Failure end end . (** [hashmap_main::hashmap::HashMap::{0}::get_in_list]: forward function *) -Definition hashmap_hash_map_get_in_list_fwd - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : result T := - hashmap_hash_map_get_in_list_loop_fwd T n key ls +Definition hashmap_HashMap_get_in_list + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T := + hashmap_HashMap_get_in_list_loop T n key ls . (** [hashmap_main::hashmap::HashMap::{0}::get]: forward function *) -Definition hashmap_hash_map_get_fwd - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) : - result T - := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in +Definition hashmap_HashMap_get + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result T := + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; - l <- vec_index_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - hashmap_hash_map_get_in_list_fwd T n key l + l <- + alloc_vec_Vec_index (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + hashmap_HashMap_get_in_list T n key l . (** [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: loop 0: forward function *) -Fixpoint hashmap_hash_map_get_mut_in_list_loop_fwd - (T : Type) (n : nat) (ls : Hashmap_list_t T) (key : usize) : result T := +Fixpoint hashmap_HashMap_get_mut_in_list_loop + (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey cvalue tl => + | Hashmap_List_Cons ckey cvalue tl => if ckey s= key then Return cvalue - else hashmap_hash_map_get_mut_in_list_loop_fwd T n0 tl key - | HashmapListNil => Fail_ Failure + else hashmap_HashMap_get_mut_in_list_loop T n0 tl key + | Hashmap_List_Nil => Fail_ Failure end end . (** [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: forward function *) -Definition hashmap_hash_map_get_mut_in_list_fwd - (T : Type) (n : nat) (ls : Hashmap_list_t T) (key : usize) : result T := - hashmap_hash_map_get_mut_in_list_loop_fwd T n ls key +Definition hashmap_HashMap_get_mut_in_list + (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : result T := + hashmap_HashMap_get_mut_in_list_loop T n ls key . (** [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: loop 0: backward function 0 *) -Fixpoint hashmap_hash_map_get_mut_in_list_loop_back - (T : Type) (n : nat) (ls : Hashmap_list_t T) (key : usize) (ret : T) : - result (Hashmap_list_t T) +Fixpoint hashmap_HashMap_get_mut_in_list_loop_back + (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) (ret : T) : + result (hashmap_List_t T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey cvalue tl => + | Hashmap_List_Cons ckey cvalue tl => if ckey s= key - then Return (HashmapListCons ckey ret tl) + then Return (Hashmap_List_Cons ckey ret tl) else ( - tl0 <- hashmap_hash_map_get_mut_in_list_loop_back T n0 tl key ret; - Return (HashmapListCons ckey cvalue tl0)) - | HashmapListNil => Fail_ Failure + tl0 <- hashmap_HashMap_get_mut_in_list_loop_back T n0 tl key ret; + Return (Hashmap_List_Cons ckey cvalue tl0)) + | Hashmap_List_Nil => Fail_ Failure end end . (** [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: backward function 0 *) -Definition hashmap_hash_map_get_mut_in_list_back - (T : Type) (n : nat) (ls : Hashmap_list_t T) (key : usize) (ret : T) : - result (Hashmap_list_t T) +Definition hashmap_HashMap_get_mut_in_list_back + (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) (ret : T) : + result (hashmap_List_t T) := - hashmap_hash_map_get_mut_in_list_loop_back T n ls key ret + hashmap_HashMap_get_mut_in_list_loop_back T n ls key ret . (** [hashmap_main::hashmap::HashMap::{0}::get_mut]: forward function *) -Definition hashmap_hash_map_get_mut_fwd - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) : - result T - := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in +Definition hashmap_HashMap_get_mut + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result T := + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; l <- - vec_index_mut_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - hashmap_hash_map_get_mut_in_list_fwd T n l key + alloc_vec_Vec_index_mut (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + hashmap_HashMap_get_mut_in_list T n l key . (** [hashmap_main::hashmap::HashMap::{0}::get_mut]: backward function 0 *) -Definition hashmap_hash_map_get_mut_back - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) (ret : T) : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_get_mut_back + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (ret : T) : + result (hashmap_HashMap_t T) := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; l <- - vec_index_mut_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - l0 <- hashmap_hash_map_get_mut_in_list_back T n l key ret; + alloc_vec_Vec_index_mut (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + l0 <- hashmap_HashMap_get_mut_in_list_back T n l key ret; v <- - vec_index_mut_back (Hashmap_list_t T) self.(Hashmap_hash_map_slots) - hash_mod l0; + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod l0; Return {| - Hashmap_hash_map_num_entries := self.(Hashmap_hash_map_num_entries); - Hashmap_hash_map_max_load_factor := - self.(Hashmap_hash_map_max_load_factor); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := v + hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); + hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v |} . (** [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: loop 0: forward function *) -Fixpoint hashmap_hash_map_remove_from_list_loop_fwd - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : +Fixpoint hashmap_HashMap_remove_from_list_loop + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result (option T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey t tl => + | Hashmap_List_Cons ckey t tl => if ckey s= key then let mv_ls := - mem_replace_fwd (Hashmap_list_t T) (HashmapListCons ckey t tl) - HashmapListNil in + core_mem_replace (hashmap_List_t T) (Hashmap_List_Cons ckey t tl) + Hashmap_List_Nil in match mv_ls with - | HashmapListCons i cvalue tl0 => Return (Some cvalue) - | HashmapListNil => Fail_ Failure + | Hashmap_List_Cons i cvalue tl0 => Return (Some cvalue) + | Hashmap_List_Nil => Fail_ Failure end - else hashmap_hash_map_remove_from_list_loop_fwd T n0 key tl - | HashmapListNil => Return None + else hashmap_HashMap_remove_from_list_loop T n0 key tl + | Hashmap_List_Nil => Return None end end . (** [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: forward function *) -Definition hashmap_hash_map_remove_from_list_fwd - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : +Definition hashmap_HashMap_remove_from_list + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result (option T) := - hashmap_hash_map_remove_from_list_loop_fwd T n key ls + hashmap_HashMap_remove_from_list_loop T n key ls . (** [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: loop 0: backward function 1 *) -Fixpoint hashmap_hash_map_remove_from_list_loop_back - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : - result (Hashmap_list_t T) +Fixpoint hashmap_HashMap_remove_from_list_loop_back + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : + result (hashmap_List_t T) := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | HashmapListCons ckey t tl => + | Hashmap_List_Cons ckey t tl => if ckey s= key then let mv_ls := - mem_replace_fwd (Hashmap_list_t T) (HashmapListCons ckey t tl) - HashmapListNil in + core_mem_replace (hashmap_List_t T) (Hashmap_List_Cons ckey t tl) + Hashmap_List_Nil in match mv_ls with - | HashmapListCons i cvalue tl0 => Return tl0 - | HashmapListNil => Fail_ Failure + | Hashmap_List_Cons i cvalue tl0 => Return tl0 + | Hashmap_List_Nil => Fail_ Failure end else ( - tl0 <- hashmap_hash_map_remove_from_list_loop_back T n0 key tl; - Return (HashmapListCons ckey t tl0)) - | HashmapListNil => Return HashmapListNil + tl0 <- hashmap_HashMap_remove_from_list_loop_back T n0 key tl; + Return (Hashmap_List_Cons ckey t tl0)) + | Hashmap_List_Nil => Return Hashmap_List_Nil end end . (** [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: backward function 1 *) -Definition hashmap_hash_map_remove_from_list_back - (T : Type) (n : nat) (key : usize) (ls : Hashmap_list_t T) : - result (Hashmap_list_t T) +Definition hashmap_HashMap_remove_from_list_back + (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : + result (hashmap_List_t T) := - hashmap_hash_map_remove_from_list_loop_back T n key ls + hashmap_HashMap_remove_from_list_loop_back T n key ls . (** [hashmap_main::hashmap::HashMap::{0}::remove]: forward function *) -Definition hashmap_hash_map_remove_fwd - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) : +Definition hashmap_HashMap_remove + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result (option T) := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; l <- - vec_index_mut_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - x <- hashmap_hash_map_remove_from_list_fwd T n key l; + alloc_vec_Vec_index_mut (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + x <- hashmap_HashMap_remove_from_list T n key l; match x with | None => Return None | Some x0 => - _ <- usize_sub self.(Hashmap_hash_map_num_entries) 1%usize; - Return (Some x0) + _ <- usize_sub self.(hashmap_HashMap_num_entries) 1%usize; Return (Some x0) end . (** [hashmap_main::hashmap::HashMap::{0}::remove]: backward function 0 *) -Definition hashmap_hash_map_remove_back - (T : Type) (n : nat) (self : Hashmap_hash_map_t T) (key : usize) : - result (Hashmap_hash_map_t T) +Definition hashmap_HashMap_remove_back + (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : + result (hashmap_HashMap_t T) := - hash <- hashmap_hash_key_fwd key; - let i := vec_len (Hashmap_list_t T) self.(Hashmap_hash_map_slots) in + hash <- hashmap_hash_key key; + let i := alloc_vec_Vec_len (hashmap_List_t T) self.(hashmap_HashMap_slots) in hash_mod <- usize_rem hash i; l <- - vec_index_mut_fwd (Hashmap_list_t T) self.(Hashmap_hash_map_slots) hash_mod; - x <- hashmap_hash_map_remove_from_list_fwd T n key l; + alloc_vec_Vec_index_mut (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t T)) + self.(hashmap_HashMap_slots) hash_mod; + x <- hashmap_HashMap_remove_from_list T n key l; match x with | None => - l0 <- hashmap_hash_map_remove_from_list_back T n key l; + l0 <- hashmap_HashMap_remove_from_list_back T n key l; v <- - vec_index_mut_back (Hashmap_list_t T) self.(Hashmap_hash_map_slots) - hash_mod l0; + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) self.(hashmap_HashMap_slots) hash_mod l0; Return {| - Hashmap_hash_map_num_entries := self.(Hashmap_hash_map_num_entries); - Hashmap_hash_map_max_load_factor := - self.(Hashmap_hash_map_max_load_factor); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := v + hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); + hashmap_HashMap_max_load_factor := + self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v |} | Some x0 => - i0 <- usize_sub self.(Hashmap_hash_map_num_entries) 1%usize; - l0 <- hashmap_hash_map_remove_from_list_back T n key l; + i0 <- usize_sub self.(hashmap_HashMap_num_entries) 1%usize; + l0 <- hashmap_HashMap_remove_from_list_back T n key l; v <- - vec_index_mut_back (Hashmap_list_t T) self.(Hashmap_hash_map_slots) - hash_mod l0; + alloc_vec_Vec_index_mut_back (hashmap_List_t T) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (hashmap_List_t + T)) self.(hashmap_HashMap_slots) hash_mod l0; Return {| - Hashmap_hash_map_num_entries := i0; - Hashmap_hash_map_max_load_factor := - self.(Hashmap_hash_map_max_load_factor); - Hashmap_hash_map_max_load := self.(Hashmap_hash_map_max_load); - Hashmap_hash_map_slots := v + hashmap_HashMap_num_entries := i0; + hashmap_HashMap_max_load_factor := + self.(hashmap_HashMap_max_load_factor); + hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); + hashmap_HashMap_slots := v |} end . (** [hashmap_main::hashmap::test1]: forward function *) -Definition hashmap_test1_fwd (n : nat) : result unit := - hm <- hashmap_hash_map_new_fwd u64 n; - hm0 <- hashmap_hash_map_insert_fwd_back u64 n hm 0%usize 42%u64; - hm1 <- hashmap_hash_map_insert_fwd_back u64 n hm0 128%usize 18%u64; - hm2 <- hashmap_hash_map_insert_fwd_back u64 n hm1 1024%usize 138%u64; - hm3 <- hashmap_hash_map_insert_fwd_back u64 n hm2 1056%usize 256%u64; - i <- hashmap_hash_map_get_fwd u64 n hm3 128%usize; +Definition hashmap_test1 (n : nat) : result unit := + hm <- hashmap_HashMap_new u64 n; + hm0 <- hashmap_HashMap_insert u64 n hm 0%usize 42%u64; + hm1 <- hashmap_HashMap_insert u64 n hm0 128%usize 18%u64; + hm2 <- hashmap_HashMap_insert u64 n hm1 1024%usize 138%u64; + hm3 <- hashmap_HashMap_insert u64 n hm2 1056%usize 256%u64; + i <- hashmap_HashMap_get u64 n hm3 128%usize; if negb (i s= 18%u64) then Fail_ Failure else ( - hm4 <- hashmap_hash_map_get_mut_back u64 n hm3 1024%usize 56%u64; - i0 <- hashmap_hash_map_get_fwd u64 n hm4 1024%usize; + hm4 <- hashmap_HashMap_get_mut_back u64 n hm3 1024%usize 56%u64; + i0 <- hashmap_HashMap_get u64 n hm4 1024%usize; if negb (i0 s= 56%u64) then Fail_ Failure else ( - x <- hashmap_hash_map_remove_fwd u64 n hm4 1024%usize; + x <- hashmap_HashMap_remove u64 n hm4 1024%usize; match x with | None => Fail_ Failure | Some x0 => if negb (x0 s= 56%u64) then Fail_ Failure else ( - hm5 <- hashmap_hash_map_remove_back u64 n hm4 1024%usize; - i1 <- hashmap_hash_map_get_fwd u64 n hm5 0%usize; + hm5 <- hashmap_HashMap_remove_back u64 n hm4 1024%usize; + i1 <- hashmap_HashMap_get u64 n hm5 0%usize; if negb (i1 s= 42%u64) then Fail_ Failure else ( - i2 <- hashmap_hash_map_get_fwd u64 n hm5 128%usize; + i2 <- hashmap_HashMap_get u64 n hm5 128%usize; if negb (i2 s= 18%u64) then Fail_ Failure else ( - i3 <- hashmap_hash_map_get_fwd u64 n hm5 1056%usize; + i3 <- hashmap_HashMap_get u64 n hm5 1056%usize; if negb (i3 s= 256%u64) then Fail_ Failure else Return tt))) end)) . (** [hashmap_main::insert_on_disk]: forward function *) -Definition insert_on_disk_fwd +Definition insert_on_disk (n : nat) (key : usize) (value : u64) (st : state) : result (state * unit) := - p <- hashmap_utils_deserialize_fwd st; + p <- hashmap_utils_deserialize st; let (st0, hm) := p in - hm0 <- hashmap_hash_map_insert_fwd_back u64 n hm key value; - p0 <- hashmap_utils_serialize_fwd hm0 st0; + hm0 <- hashmap_HashMap_insert u64 n hm key value; + p0 <- hashmap_utils_serialize hm0 st0; let (st1, _) := p0 in Return (st1, tt) . (** [hashmap_main::main]: forward function *) -Definition main_fwd : result unit := +Definition main : result unit := Return tt. -(** Unit test for [hashmap_main::main] *) -Check (main_fwd )%return. - End HashmapMain_Funs . diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v b/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v index 2d17cc29..5e376239 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Opaque.v @@ -11,13 +11,13 @@ Import HashmapMain_Types. Module HashmapMain_Opaque. (** [hashmap_main::hashmap_utils::deserialize]: forward function *) -Axiom hashmap_utils_deserialize_fwd - : state -> result (state * (Hashmap_hash_map_t u64)) +Axiom hashmap_utils_deserialize + : state -> result (state * (hashmap_HashMap_t u64)) . (** [hashmap_main::hashmap_utils::serialize]: forward function *) -Axiom hashmap_utils_serialize_fwd - : Hashmap_hash_map_t u64 -> state -> result (state * unit) +Axiom hashmap_utils_serialize + : hashmap_HashMap_t u64 -> state -> result (state * unit) . End HashmapMain_Opaque . diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Types.v b/tests/coq/hashmap_on_disk/HashmapMain_Types.v index 36aaaf25..466119f8 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Types.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Types.v @@ -9,29 +9,29 @@ Local Open Scope Primitives_scope. Module HashmapMain_Types. (** [hashmap_main::hashmap::List] *) -Inductive Hashmap_list_t (T : Type) := -| HashmapListCons : usize -> T -> Hashmap_list_t T -> Hashmap_list_t T -| HashmapListNil : Hashmap_list_t T +Inductive hashmap_List_t (T : Type) := +| Hashmap_List_Cons : usize -> T -> hashmap_List_t T -> hashmap_List_t T +| Hashmap_List_Nil : hashmap_List_t T . -Arguments HashmapListCons {T} _ _ _. -Arguments HashmapListNil {T}. +Arguments Hashmap_List_Cons {T} _ _ _. +Arguments Hashmap_List_Nil {T}. (** [hashmap_main::hashmap::HashMap] *) -Record Hashmap_hash_map_t (T : Type) := -mkHashmap_hash_map_t { - Hashmap_hash_map_num_entries : usize; - Hashmap_hash_map_max_load_factor : (usize * usize); - Hashmap_hash_map_max_load : usize; - Hashmap_hash_map_slots : vec (Hashmap_list_t T); +Record hashmap_HashMap_t (T : Type) := +mkhashmap_HashMap_t { + hashmap_HashMap_num_entries : usize; + hashmap_HashMap_max_load_factor : (usize * usize); + hashmap_HashMap_max_load : usize; + hashmap_HashMap_slots : alloc_vec_Vec (hashmap_List_t T); } . -Arguments mkHashmap_hash_map_t {T} _ _ _ _. -Arguments Hashmap_hash_map_num_entries {T}. -Arguments Hashmap_hash_map_max_load_factor {T}. -Arguments Hashmap_hash_map_max_load {T}. -Arguments Hashmap_hash_map_slots {T}. +Arguments mkhashmap_HashMap_t {T} _ _ _ _. +Arguments hashmap_HashMap_num_entries {T}. +Arguments hashmap_HashMap_max_load_factor {T}. +Arguments hashmap_HashMap_max_load {T}. +Arguments hashmap_HashMap_slots {T}. (** The state type used in the state-error monad *) Axiom state : Type. diff --git a/tests/coq/hashmap_on_disk/Primitives.v b/tests/coq/hashmap_on_disk/Primitives.v index 8d6c9c8d..85e38f01 100644 --- a/tests/coq/hashmap_on_disk/Primitives.v +++ b/tests/coq/hashmap_on_disk/Primitives.v @@ -63,13 +63,15 @@ Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) - Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition mem_replace_fwd (a : Type) (x : a) (y : a) : a := x . -Definition mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . +Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. (*** Scalars *) @@ -408,12 +410,75 @@ 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; - end_: T; +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); + core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. +Arguments core_ops_index_IndexMut_index_mut_back {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; +}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); + core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; }. -Arguments mk_range {_}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. +Arguments core_ops_deref_DerefMut_deref_mut_back {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; + core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; +|}. + (*** Arrays *) Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. @@ -433,51 +498,50 @@ Qed. (* TODO: finish the definitions *) Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. -Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +(* For initialization *) +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. + +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. Axiom slice_len : forall (T : Type) (s : slice T), usize. -Axiom slice_index_shared : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_fwd : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_back : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). (*** Subslices *) -Axiom array_to_slice_shared : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_fwd : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_back : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). -Axiom array_subslice_shared: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_fwd: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_back: forall (T : Type) (n : usize) (x : array T n) (r : range usize) (ns : slice T), result (array T n). -Axiom slice_subslice_shared: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_fwd: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_back: forall (T : Type) (x : slice T) (r : range usize) (ns : slice T), result (slice T). +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). (*** Vectors *) -Definition vec T := { l: list T | Z.of_nat (length l) <= usize_max }. +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. -Definition vec_to_list {T: Type} (v: vec T) : list T := proj1_sig v. +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. -Definition vec_length {T: Type} (v: vec T) : Z := Z.of_nat (length (vec_to_list v)). +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). -Definition vec_new (T: Type) : vec T := (exist _ [] le_0_usize_max). +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). -Lemma vec_len_in_usize {T} (v: vec T) : usize_min <= vec_length v <= usize_max. +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. Proof. - unfold vec_length, usize_min. + unfold alloc_vec_Vec_length, usize_min. split. - lia. - apply (proj2_sig v). Qed. -Definition vec_len (T: Type) (v: vec T) : usize := - exist _ (vec_length v) (vec_len_in_usize v). +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). Fixpoint list_update {A} (l: list A) (n: nat) (a: A) : list A := @@ -488,50 +552,271 @@ Fixpoint list_update {A} (l: list A) (n: nat) (a: A) | S m => x :: (list_update t m a) end end. -Definition vec_bind {A B} (v: vec A) (f: list A -> result (list B)) : result (vec B) := - l <- f (vec_to_list v) ; +Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := + l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. (* The **forward** function shouldn't be used *) -Definition vec_push_fwd (T: Type) (v: vec T) (x: T) : unit := tt. +Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. -Definition vec_push_back (T: Type) (v: vec T) (x: T) : result (vec T) := - vec_bind v (fun l => Return (l ++ [x])). +Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). (* The **forward** function shouldn't be used *) -Definition vec_insert_fwd (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i +Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => if to_Z i Return n - | None => Fail_ Failure - end. - -Definition vec_index_back (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i Return n - | None => Fail_ Failure +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. +Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Return x end. -Definition vec_index_mut_back (T: Type) (v: vec T) (i: usize) (x: T) : result (vec T) := - vec_bind v (fun l => - if to_Z i slice T -> result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: backward function 0 *) +Axiom core_slice_index_Range_get_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_Range_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_Range_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_Range_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_Range_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: backward function 0 *) +Axiom core_slice_index_Range_index_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). + +(* [core::slice::index::[T]::index_mut]: backward function 0 *) +Axiom core_slice_index_Slice_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: backward function 0 *) +Axiom core_array_Array_index_mut_back : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_Range_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_Range_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; + core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: backward function 0 *) +Axiom core_slice_index_usize_get_mut_back : + forall (T : Type), usize -> slice T -> option T -> result (slice T). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: backward function 0 *) +Axiom core_slice_index_usize_index_mut_back : + forall (T : Type), usize -> slice T -> T -> result (slice T). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: backward function 0 *) +Axiom alloc_vec_Vec_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + 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. End Primitives. diff --git a/tests/coq/misc/Constants.v b/tests/coq/misc/Constants.v index 5dd78a09..7cb1a642 100644 --- a/tests/coq/misc/Constants.v +++ b/tests/coq/misc/Constants.v @@ -21,36 +21,35 @@ Definition x2_body : result u32 := Return 3%u32. Definition x2_c : u32 := x2_body%global. (** [constants::incr]: forward function *) -Definition incr_fwd (n : u32) : result u32 := +Definition incr (n : u32) : result u32 := u32_add n 1%u32. (** [constants::X3] *) -Definition x3_body : result u32 := incr_fwd 32%u32. +Definition x3_body : result u32 := incr 32%u32. Definition x3_c : u32 := x3_body%global. (** [constants::mk_pair0]: forward function *) -Definition mk_pair0_fwd (x : u32) (y : u32) : result (u32 * u32) := - Return (x, y) -. +Definition mk_pair0 (x : u32) (y : u32) : result (u32 * u32) := + Return (x, y). (** [constants::Pair] *) -Record Pair_t (T1 T2 : Type) := mkPair_t { Pair_x : T1; Pair_y : T2; }. +Record Pair_t (T1 T2 : Type) := mkPair_t { pair_x : T1; pair_y : T2; }. Arguments mkPair_t {T1} {T2} _ _. -Arguments Pair_x {T1} {T2}. -Arguments Pair_y {T1} {T2}. +Arguments pair_x {T1} {T2}. +Arguments pair_y {T1} {T2}. (** [constants::mk_pair1]: forward function *) -Definition mk_pair1_fwd (x : u32) (y : u32) : result (Pair_t u32 u32) := - Return {| Pair_x := x; Pair_y := y |} +Definition mk_pair1 (x : u32) (y : u32) : result (Pair_t u32 u32) := + Return {| pair_x := x; pair_y := y |} . (** [constants::P0] *) -Definition p0_body : result (u32 * u32) := mk_pair0_fwd 0%u32 1%u32. +Definition p0_body : result (u32 * u32) := mk_pair0 0%u32 1%u32. Definition p0_c : (u32 * u32) := p0_body%global. (** [constants::P1] *) -Definition p1_body : result (Pair_t u32 u32) := mk_pair1_fwd 0%u32 1%u32. +Definition p1_body : result (Pair_t u32 u32) := mk_pair1 0%u32 1%u32. Definition p1_c : Pair_t u32 u32 := p1_body%global. (** [constants::P2] *) @@ -59,31 +58,31 @@ Definition p2_c : (u32 * u32) := p2_body%global. (** [constants::P3] *) Definition p3_body : result (Pair_t u32 u32) := - Return {| Pair_x := 0%u32; Pair_y := 1%u32 |} + Return {| pair_x := 0%u32; pair_y := 1%u32 |} . Definition p3_c : Pair_t u32 u32 := p3_body%global. (** [constants::Wrap] *) -Record Wrap_t (T : Type) := mkWrap_t { Wrap_val : T; }. +Record Wrap_t (T : Type) := mkWrap_t { wrap_value : T; }. Arguments mkWrap_t {T} _. -Arguments Wrap_val {T}. +Arguments wrap_value {T}. (** [constants::Wrap::{0}::new]: forward function *) -Definition wrap_new_fwd (T : Type) (val : T) : result (Wrap_t T) := - Return {| Wrap_val := val |} +Definition wrap_new (T : Type) (value : T) : result (Wrap_t T) := + Return {| wrap_value := value |} . (** [constants::Y] *) -Definition y_body : result (Wrap_t i32) := wrap_new_fwd i32 2%i32. +Definition y_body : result (Wrap_t i32) := wrap_new i32 2%i32. Definition y_c : Wrap_t i32 := y_body%global. (** [constants::unwrap_y]: forward function *) -Definition unwrap_y_fwd : result i32 := - Return y_c.(Wrap_val). +Definition unwrap_y : result i32 := + Return y_c.(wrap_value). (** [constants::YVAL] *) -Definition yval_body : result i32 := unwrap_y_fwd. +Definition yval_body : result i32 := unwrap_y. Definition yval_c : i32 := yval_body%global. (** [constants::get_z1::Z1] *) @@ -91,11 +90,11 @@ Definition get_z1_z1_body : result i32 := Return 3%i32. Definition get_z1_z1_c : i32 := get_z1_z1_body%global. (** [constants::get_z1]: forward function *) -Definition get_z1_fwd : result i32 := +Definition get_z1 : result i32 := Return get_z1_z1_c. (** [constants::add]: forward function *) -Definition add_fwd (a : i32) (b : i32) : result i32 := +Definition add (a : i32) (b : i32) : result i32 := i32_add a b. (** [constants::Q1] *) @@ -107,20 +106,19 @@ Definition q2_body : result i32 := Return q1_c. Definition q2_c : i32 := q2_body%global. (** [constants::Q3] *) -Definition q3_body : result i32 := add_fwd q2_c 3%i32. +Definition q3_body : result i32 := add q2_c 3%i32. Definition q3_c : i32 := q3_body%global. (** [constants::get_z2]: forward function *) -Definition get_z2_fwd : result i32 := - i <- get_z1_fwd; i0 <- add_fwd i q3_c; add_fwd q1_c i0 -. +Definition get_z2 : result i32 := + i <- get_z1; i0 <- add i q3_c; add q1_c i0. (** [constants::S1] *) Definition s1_body : result u32 := Return 6%u32. Definition s1_c : u32 := s1_body%global. (** [constants::S2] *) -Definition s2_body : result u32 := incr_fwd s1_c. +Definition s2_body : result u32 := incr s1_c. Definition s2_c : u32 := s2_body%global. (** [constants::S3] *) @@ -128,7 +126,7 @@ Definition s3_body : result (Pair_t u32 u32) := Return p3_c. Definition s3_c : Pair_t u32 u32 := s3_body%global. (** [constants::S4] *) -Definition s4_body : result (Pair_t u32 u32) := mk_pair1_fwd 7%u32 8%u32. +Definition s4_body : result (Pair_t u32 u32) := mk_pair1 7%u32 8%u32. Definition s4_c : Pair_t u32 u32 := s4_body%global. End Constants . diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v index 28370b2b..018ce13c 100644 --- a/tests/coq/misc/External_Funs.v +++ b/tests/coq/misc/External_Funs.v @@ -13,9 +13,9 @@ Import External_Opaque. Module External_Funs. (** [external::swap]: forward function *) -Definition swap_fwd +Definition swap (T : Type) (x : T) (y : T) (st : state) : result (state * unit) := - p <- core_mem_swap_fwd T x y st; + p <- core_mem_swap T x y st; let (st0, _) := p in p0 <- core_mem_swap_back0 T x y st st0; let (st1, _) := p0 in @@ -29,7 +29,7 @@ Definition swap_back (T : Type) (x : T) (y : T) (st : state) (st0 : state) : result (state * (T * T)) := - p <- core_mem_swap_fwd T x y st; + p <- core_mem_swap T x y st; let (st1, _) := p in p0 <- core_mem_swap_back0 T x y st st1; let (st2, x0) := p0 in @@ -39,25 +39,27 @@ Definition swap_back . (** [external::test_new_non_zero_u32]: forward function *) -Definition test_new_non_zero_u32_fwd - (x : u32) (st : state) : result (state * Core_num_nonzero_non_zero_u32_t) := - p <- core_num_nonzero_non_zero_u32_new_fwd x st; - let (st0, opt) := p in - core_option_option_unwrap_fwd Core_num_nonzero_non_zero_u32_t opt st0 +Definition test_new_non_zero_u32 + (x : u32) (st : state) : result (state * core_num_nonzero_NonZeroU32_t) := + p <- core_num_nonzero_NonZeroU32_new x st; + let (st0, o) := p in + core_option_Option_unwrap core_num_nonzero_NonZeroU32_t o st0 . (** [external::test_vec]: forward function *) -Definition test_vec_fwd : result unit := - let v := vec_new u32 in _ <- vec_push_back u32 v 0%u32; Return tt +Definition test_vec : result unit := + let v := alloc_vec_Vec_new u32 in + _ <- alloc_vec_Vec_push u32 v 0%u32; + Return tt . (** Unit test for [external::test_vec] *) -Check (test_vec_fwd )%return. +Check (test_vec )%return. (** [external::custom_swap]: forward function *) -Definition custom_swap_fwd +Definition custom_swap (T : Type) (x : T) (y : T) (st : state) : result (state * T) := - p <- core_mem_swap_fwd T x y st; + p <- core_mem_swap T x y st; let (st0, _) := p in p0 <- core_mem_swap_back0 T x y st st0; let (st1, x0) := p0 in @@ -71,7 +73,7 @@ Definition custom_swap_back (T : Type) (x : T) (y : T) (st : state) (ret : T) (st0 : state) : result (state * (T * T)) := - p <- core_mem_swap_fwd T x y st; + p <- core_mem_swap T x y st; let (st1, _) := p in p0 <- core_mem_swap_back0 T x y st st1; let (st2, _) := p0 in @@ -81,9 +83,9 @@ Definition custom_swap_back . (** [external::test_custom_swap]: forward function *) -Definition test_custom_swap_fwd +Definition test_custom_swap (x : u32) (y : u32) (st : state) : result (state * unit) := - p <- custom_swap_fwd u32 x y st; let (st0, _) := p in Return (st0, tt) + p <- custom_swap u32 x y st; let (st0, _) := p in Return (st0, tt) . (** [external::test_custom_swap]: backward function 0 *) @@ -95,9 +97,8 @@ Definition test_custom_swap_back . (** [external::test_swap_non_zero]: forward function *) -Definition test_swap_non_zero_fwd - (x : u32) (st : state) : result (state * u32) := - p <- swap_fwd u32 x 0%u32 st; +Definition test_swap_non_zero (x : u32) (st : state) : result (state * u32) := + p <- swap u32 x 0%u32 st; let (st0, _) := p in p0 <- swap_back u32 x 0%u32 st st0; let (st1, p1) := p0 in diff --git a/tests/coq/misc/External_Opaque.v b/tests/coq/misc/External_Opaque.v index d2ee42d4..80be37e7 100644 --- a/tests/coq/misc/External_Opaque.v +++ b/tests/coq/misc/External_Opaque.v @@ -11,7 +11,7 @@ Import External_Types. Module External_Opaque. (** [core::mem::swap]: forward function *) -Axiom core_mem_swap_fwd : +Axiom core_mem_swap : forall(T : Type), T -> T -> state -> result (state * unit) . @@ -26,12 +26,12 @@ Axiom core_mem_swap_back1 : . (** [core::num::nonzero::NonZeroU32::{14}::new]: forward function *) -Axiom core_num_nonzero_non_zero_u32_new_fwd - : u32 -> state -> result (state * (option Core_num_nonzero_non_zero_u32_t)) +Axiom core_num_nonzero_NonZeroU32_new + : u32 -> state -> result (state * (option core_num_nonzero_NonZeroU32_t)) . (** [core::option::Option::{0}::unwrap]: forward function *) -Axiom core_option_option_unwrap_fwd : +Axiom core_option_Option_unwrap : forall(T : Type), option T -> state -> result (state * T) . diff --git a/tests/coq/misc/External_Types.v b/tests/coq/misc/External_Types.v index 1883fa6c..9e49ca41 100644 --- a/tests/coq/misc/External_Types.v +++ b/tests/coq/misc/External_Types.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module External_Types. (** [core::num::nonzero::NonZeroU32] *) -Axiom Core_num_nonzero_non_zero_u32_t : Type. +Axiom core_num_nonzero_NonZeroU32_t : Type. (** The state type used in the state-error monad *) Axiom state : Type. diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index 82e57576..180a1d68 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -9,23 +9,23 @@ Local Open Scope Primitives_scope. Module Loops. (** [loops::sum]: loop 0: forward function *) -Fixpoint sum_loop_fwd (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := +Fixpoint sum_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with | O => Fail_ OutOfFuel | S n0 => if i s< max - then (s0 <- u32_add s i; i0 <- u32_add i 1%u32; sum_loop_fwd n0 max i0 s0) + then (s0 <- u32_add s i; i0 <- u32_add i 1%u32; sum_loop n0 max i0 s0) else u32_mul s 2%u32 end . (** [loops::sum]: forward function *) -Definition sum_fwd (n : nat) (max : u32) : result u32 := - sum_loop_fwd n max 0%u32 0%u32 +Definition sum (n : nat) (max : u32) : result u32 := + sum_loop n max 0%u32 0%u32 . (** [loops::sum_with_mut_borrows]: loop 0: forward function *) -Fixpoint sum_with_mut_borrows_loop_fwd +Fixpoint sum_with_mut_borrows_loop (n : nat) (max : u32) (mi : u32) (ms : u32) : result u32 := match n with | O => Fail_ OutOfFuel @@ -34,18 +34,18 @@ Fixpoint sum_with_mut_borrows_loop_fwd then ( ms0 <- u32_add ms mi; mi0 <- u32_add mi 1%u32; - sum_with_mut_borrows_loop_fwd n0 max mi0 ms0) + sum_with_mut_borrows_loop n0 max mi0 ms0) else u32_mul ms 2%u32 end . (** [loops::sum_with_mut_borrows]: forward function *) -Definition sum_with_mut_borrows_fwd (n : nat) (max : u32) : result u32 := - sum_with_mut_borrows_loop_fwd n max 0%u32 0%u32 +Definition sum_with_mut_borrows (n : nat) (max : u32) : result u32 := + sum_with_mut_borrows_loop n max 0%u32 0%u32 . (** [loops::sum_with_shared_borrows]: loop 0: forward function *) -Fixpoint sum_with_shared_borrows_loop_fwd +Fixpoint sum_with_shared_borrows_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with | O => Fail_ OutOfFuel @@ -54,87 +54,88 @@ Fixpoint sum_with_shared_borrows_loop_fwd then ( i0 <- u32_add i 1%u32; s0 <- u32_add s i0; - sum_with_shared_borrows_loop_fwd n0 max i0 s0) + sum_with_shared_borrows_loop n0 max i0 s0) else u32_mul s 2%u32 end . (** [loops::sum_with_shared_borrows]: forward function *) -Definition sum_with_shared_borrows_fwd (n : nat) (max : u32) : result u32 := - sum_with_shared_borrows_loop_fwd n max 0%u32 0%u32 +Definition sum_with_shared_borrows (n : nat) (max : u32) : result u32 := + sum_with_shared_borrows_loop n max 0%u32 0%u32 . (** [loops::clear]: loop 0: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Fixpoint clear_loop_fwd_back - (n : nat) (v : vec u32) (i : usize) : result (vec u32) := +Fixpoint clear_loop + (n : nat) (v : alloc_vec_Vec u32) (i : usize) : result (alloc_vec_Vec u32) := match n with | O => Fail_ OutOfFuel | S n0 => - let i0 := vec_len u32 v in + let i0 := alloc_vec_Vec_len u32 v in if i s< i0 then ( i1 <- usize_add i 1%usize; - v0 <- vec_index_mut_back u32 v i 0%u32; - clear_loop_fwd_back n0 v0 i1) + v0 <- + alloc_vec_Vec_index_mut_back u32 usize + (core_slice_index_usize_coresliceindexSliceIndexInst u32) v i 0%u32; + clear_loop n0 v0 i1) else Return v end . (** [loops::clear]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition clear_fwd_back (n : nat) (v : vec u32) : result (vec u32) := - clear_loop_fwd_back n v 0%usize +Definition clear + (n : nat) (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) := + clear_loop n v 0%usize . (** [loops::List] *) Inductive List_t (T : Type) := -| 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 . -Arguments ListCons {T} _ _. -Arguments ListNil {T}. +Arguments List_Cons {T} _ _. +Arguments List_Nil {T}. (** [loops::list_mem]: loop 0: forward function *) -Fixpoint list_mem_loop_fwd - (n : nat) (x : u32) (ls : List_t u32) : result bool := +Fixpoint list_mem_loop (n : nat) (x : u32) (ls : List_t u32) : result bool := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons y tl => - if y s= x then Return true else list_mem_loop_fwd n0 x tl - | ListNil => Return false + | List_Cons y tl => if y s= x then Return true else list_mem_loop n0 x tl + | List_Nil => Return false end end . (** [loops::list_mem]: forward function *) -Definition list_mem_fwd (n : nat) (x : u32) (ls : List_t u32) : result bool := - list_mem_loop_fwd n x ls +Definition list_mem (n : nat) (x : u32) (ls : List_t u32) : result bool := + list_mem_loop n x ls . (** [loops::list_nth_mut_loop]: loop 0: forward function *) -Fixpoint list_nth_mut_loop_loop_fwd +Fixpoint list_nth_mut_loop_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut_loop_loop_fwd T n0 tl i0) - | ListNil => Fail_ Failure + else (i0 <- u32_sub i 1%u32; list_nth_mut_loop_loop T n0 tl i0) + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_mut_loop]: forward function *) -Definition list_nth_mut_loop_fwd +Definition list_nth_mut_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - list_nth_mut_loop_loop_fwd T n ls i + list_nth_mut_loop_loop T n ls i . (** [loops::list_nth_mut_loop]: loop 0: backward function 0 *) @@ -146,14 +147,14 @@ Fixpoint list_nth_mut_loop_loop_back | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else ( i0 <- u32_sub i 1%u32; tl0 <- list_nth_mut_loop_loop_back T n0 tl i0 ret; - Return (ListCons x tl0)) - | ListNil => Fail_ Failure + Return (List_Cons x tl0)) + | List_Nil => Fail_ Failure end end . @@ -167,46 +168,50 @@ Definition list_nth_mut_loop_back . (** [loops::list_nth_shared_loop]: loop 0: forward function *) -Fixpoint list_nth_shared_loop_loop_fwd +Fixpoint list_nth_shared_loop_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_shared_loop_loop_fwd T n0 tl i0) - | ListNil => Fail_ Failure + else (i0 <- u32_sub i 1%u32; list_nth_shared_loop_loop T n0 tl i0) + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_shared_loop]: forward function *) -Definition list_nth_shared_loop_fwd +Definition list_nth_shared_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - list_nth_shared_loop_loop_fwd T n ls i + list_nth_shared_loop_loop T n ls i . (** [loops::get_elem_mut]: loop 0: forward function *) -Fixpoint get_elem_mut_loop_fwd +Fixpoint get_elem_mut_loop (n : nat) (x : usize) (ls : List_t usize) : result usize := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons y tl => - if y s= x then Return y else get_elem_mut_loop_fwd n0 x tl - | ListNil => Fail_ Failure + | List_Cons y tl => if y s= x then Return y else get_elem_mut_loop n0 x tl + | List_Nil => Fail_ Failure end end . (** [loops::get_elem_mut]: forward function *) -Definition get_elem_mut_fwd - (n : nat) (slots : vec (List_t usize)) (x : usize) : result usize := - l <- vec_index_mut_fwd (List_t usize) slots 0%usize; - get_elem_mut_loop_fwd n x l +Definition get_elem_mut + (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : + result usize + := + l <- + alloc_vec_Vec_index_mut (List_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t usize)) + slots 0%usize; + get_elem_mut_loop n x l . (** [loops::get_elem_mut]: loop 0: backward function 0 *) @@ -218,50 +223,60 @@ Fixpoint get_elem_mut_loop_back | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons y tl => + | List_Cons y tl => if y s= x - then Return (ListCons ret tl) - else (tl0 <- get_elem_mut_loop_back n0 x tl ret; Return (ListCons y tl0)) - | ListNil => Fail_ Failure + then Return (List_Cons ret tl) + else ( + tl0 <- get_elem_mut_loop_back n0 x tl ret; Return (List_Cons y tl0)) + | List_Nil => Fail_ Failure end end . (** [loops::get_elem_mut]: backward function 0 *) Definition get_elem_mut_back - (n : nat) (slots : vec (List_t usize)) (x : usize) (ret : usize) : - result (vec (List_t usize)) + (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) (ret : usize) : + result (alloc_vec_Vec (List_t usize)) := - l <- vec_index_mut_fwd (List_t usize) slots 0%usize; + l <- + alloc_vec_Vec_index_mut (List_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t usize)) + slots 0%usize; l0 <- get_elem_mut_loop_back n x l ret; - vec_index_mut_back (List_t usize) slots 0%usize l0 + alloc_vec_Vec_index_mut_back (List_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t usize)) slots + 0%usize l0 . (** [loops::get_elem_shared]: loop 0: forward function *) -Fixpoint get_elem_shared_loop_fwd +Fixpoint get_elem_shared_loop (n : nat) (x : usize) (ls : List_t usize) : result usize := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons y tl => - if y s= x then Return y else get_elem_shared_loop_fwd n0 x tl - | ListNil => Fail_ Failure + | List_Cons y tl => + if y s= x then Return y else get_elem_shared_loop n0 x tl + | List_Nil => Fail_ Failure end end . (** [loops::get_elem_shared]: forward function *) -Definition get_elem_shared_fwd - (n : nat) (slots : vec (List_t usize)) (x : usize) : result usize := - l <- vec_index_fwd (List_t usize) slots 0%usize; - get_elem_shared_loop_fwd n x l +Definition get_elem_shared + (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : + result usize + := + l <- + alloc_vec_Vec_index (List_t usize) usize + (core_slice_index_usize_coresliceindexSliceIndexInst (List_t usize)) + slots 0%usize; + get_elem_shared_loop n x l . (** [loops::id_mut]: forward function *) -Definition id_mut_fwd (T : Type) (ls : List_t T) : result (List_t T) := - Return ls -. +Definition id_mut (T : Type) (ls : List_t T) : result (List_t T) := + Return ls. (** [loops::id_mut]: backward function 0 *) Definition id_mut_back @@ -270,31 +285,30 @@ Definition id_mut_back . (** [loops::id_shared]: forward function *) -Definition id_shared_fwd (T : Type) (ls : List_t T) : result (List_t T) := +Definition id_shared (T : Type) (ls : List_t T) : result (List_t T) := Return ls . (** [loops::list_nth_mut_loop_with_id]: loop 0: forward function *) -Fixpoint list_nth_mut_loop_with_id_loop_fwd +Fixpoint list_nth_mut_loop_with_id_loop (T : Type) (n : nat) (i : u32) (ls : List_t T) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x - else ( - i0 <- u32_sub i 1%u32; list_nth_mut_loop_with_id_loop_fwd T n0 i0 tl) - | ListNil => Fail_ Failure + else (i0 <- u32_sub i 1%u32; list_nth_mut_loop_with_id_loop T n0 i0 tl) + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_mut_loop_with_id]: forward function *) -Definition list_nth_mut_loop_with_id_fwd +Definition list_nth_mut_loop_with_id (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - ls0 <- id_mut_fwd T ls; list_nth_mut_loop_with_id_loop_fwd T n i ls0 + ls0 <- id_mut T ls; list_nth_mut_loop_with_id_loop T n i ls0 . (** [loops::list_nth_mut_loop_with_id]: loop 0: backward function 0 *) @@ -306,14 +320,14 @@ Fixpoint list_nth_mut_loop_with_id_loop_back | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else ( i0 <- u32_sub i 1%u32; tl0 <- list_nth_mut_loop_with_id_loop_back T n0 i0 tl ret; - Return (ListCons x tl0)) - | ListNil => Fail_ Failure + Return (List_Cons x tl0)) + | List_Nil => Fail_ Failure end end . @@ -323,36 +337,36 @@ Definition list_nth_mut_loop_with_id_back (T : Type) (n : nat) (ls : List_t T) (i : u32) (ret : T) : result (List_t T) := - ls0 <- id_mut_fwd T ls; + ls0 <- id_mut T ls; l <- list_nth_mut_loop_with_id_loop_back T n i ls0 ret; id_mut_back T ls l . (** [loops::list_nth_shared_loop_with_id]: loop 0: forward function *) -Fixpoint list_nth_shared_loop_with_id_loop_fwd +Fixpoint list_nth_shared_loop_with_id_loop (T : Type) (n : nat) (i : u32) (ls : List_t T) : result T := match n with | O => Fail_ OutOfFuel | S n0 => match ls with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x else ( - i0 <- u32_sub i 1%u32; list_nth_shared_loop_with_id_loop_fwd T n0 i0 tl) - | ListNil => Fail_ Failure + i0 <- u32_sub i 1%u32; list_nth_shared_loop_with_id_loop T n0 i0 tl) + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_shared_loop_with_id]: forward function *) -Definition list_nth_shared_loop_with_id_fwd +Definition list_nth_shared_loop_with_id (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := - ls0 <- id_shared_fwd T ls; list_nth_shared_loop_with_id_loop_fwd T n i ls0 + ls0 <- id_shared T ls; list_nth_shared_loop_with_id_loop T n i ls0 . (** [loops::list_nth_mut_loop_pair]: loop 0: forward function *) -Fixpoint list_nth_mut_loop_pair_loop_fwd +Fixpoint list_nth_mut_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -360,27 +374,26 @@ Fixpoint list_nth_mut_loop_pair_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( - i0 <- u32_sub i 1%u32; - list_nth_mut_loop_pair_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + i0 <- u32_sub i 1%u32; list_nth_mut_loop_pair_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_mut_loop_pair]: forward function *) -Definition list_nth_mut_loop_pair_fwd +Definition list_nth_mut_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_mut_loop_pair_loop_fwd T n ls0 ls1 i + list_nth_mut_loop_pair_loop T n ls0 ls1 i . (** [loops::list_nth_mut_loop_pair]: loop 0: backward function 0 *) @@ -392,18 +405,18 @@ Fixpoint list_nth_mut_loop_pair_loop_back'a | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then Return (ListCons ret tl0) + then Return (List_Cons ret tl0) else ( i0 <- u32_sub i 1%u32; tl00 <- list_nth_mut_loop_pair_loop_back'a T n0 tl0 tl1 i0 ret; - 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 end . @@ -425,18 +438,18 @@ Fixpoint list_nth_mut_loop_pair_loop_back'b | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then Return (ListCons ret tl1) + then Return (List_Cons ret tl1) else ( i0 <- u32_sub i 1%u32; tl10 <- list_nth_mut_loop_pair_loop_back'b T n0 tl0 tl1 i0 ret; - 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 end . @@ -450,7 +463,7 @@ Definition list_nth_mut_loop_pair_back'b . (** [loops::list_nth_shared_loop_pair]: loop 0: forward function *) -Fixpoint list_nth_shared_loop_pair_loop_fwd +Fixpoint list_nth_shared_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -458,31 +471,30 @@ Fixpoint list_nth_shared_loop_pair_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( - i0 <- u32_sub i 1%u32; - list_nth_shared_loop_pair_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + i0 <- u32_sub i 1%u32; list_nth_shared_loop_pair_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_shared_loop_pair]: forward function *) -Definition list_nth_shared_loop_pair_fwd +Definition list_nth_shared_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_shared_loop_pair_loop_fwd T n ls0 ls1 i + list_nth_shared_loop_pair_loop T n ls0 ls1 i . (** [loops::list_nth_mut_loop_pair_merge]: loop 0: forward function *) -Fixpoint list_nth_mut_loop_pair_merge_loop_fwd +Fixpoint list_nth_mut_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -490,27 +502,27 @@ Fixpoint list_nth_mut_loop_pair_merge_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( i0 <- u32_sub i 1%u32; - list_nth_mut_loop_pair_merge_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + list_nth_mut_loop_pair_merge_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_mut_loop_pair_merge]: forward function *) -Definition list_nth_mut_loop_pair_merge_fwd +Definition list_nth_mut_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_mut_loop_pair_merge_loop_fwd T n ls0 ls1 i + list_nth_mut_loop_pair_merge_loop T n ls0 ls1 i . (** [loops::list_nth_mut_loop_pair_merge]: loop 0: backward function 0 *) @@ -523,19 +535,19 @@ Fixpoint list_nth_mut_loop_pair_merge_loop_back | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then let (t, t0) := ret in Return (ListCons t tl0, ListCons t0 tl1) + then let (t, t0) := ret in Return (List_Cons t tl0, List_Cons t0 tl1) else ( i0 <- u32_sub i 1%u32; p <- list_nth_mut_loop_pair_merge_loop_back T n0 tl0 tl1 i0 ret; let (tl00, tl10) := p 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 end . @@ -550,7 +562,7 @@ Definition list_nth_mut_loop_pair_merge_back . (** [loops::list_nth_shared_loop_pair_merge]: loop 0: forward function *) -Fixpoint list_nth_shared_loop_pair_merge_loop_fwd +Fixpoint list_nth_shared_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -558,31 +570,31 @@ Fixpoint list_nth_shared_loop_pair_merge_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( i0 <- u32_sub i 1%u32; - list_nth_shared_loop_pair_merge_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + list_nth_shared_loop_pair_merge_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_shared_loop_pair_merge]: forward function *) -Definition list_nth_shared_loop_pair_merge_fwd +Definition list_nth_shared_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_shared_loop_pair_merge_loop_fwd T n ls0 ls1 i + list_nth_shared_loop_pair_merge_loop T n ls0 ls1 i . (** [loops::list_nth_mut_shared_loop_pair]: loop 0: forward function *) -Fixpoint list_nth_mut_shared_loop_pair_loop_fwd +Fixpoint list_nth_mut_shared_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -590,27 +602,27 @@ Fixpoint list_nth_mut_shared_loop_pair_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( i0 <- u32_sub i 1%u32; - list_nth_mut_shared_loop_pair_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + list_nth_mut_shared_loop_pair_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_mut_shared_loop_pair]: forward function *) -Definition list_nth_mut_shared_loop_pair_fwd +Definition list_nth_mut_shared_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_mut_shared_loop_pair_loop_fwd T n ls0 ls1 i + list_nth_mut_shared_loop_pair_loop T n ls0 ls1 i . (** [loops::list_nth_mut_shared_loop_pair]: loop 0: backward function 0 *) @@ -622,18 +634,18 @@ Fixpoint list_nth_mut_shared_loop_pair_loop_back | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then Return (ListCons ret tl0) + then Return (List_Cons ret tl0) else ( i0 <- u32_sub i 1%u32; tl00 <- list_nth_mut_shared_loop_pair_loop_back T n0 tl0 tl1 i0 ret; - 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 end . @@ -647,7 +659,7 @@ Definition list_nth_mut_shared_loop_pair_back . (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: forward function *) -Fixpoint list_nth_mut_shared_loop_pair_merge_loop_fwd +Fixpoint list_nth_mut_shared_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -655,27 +667,27 @@ Fixpoint list_nth_mut_shared_loop_pair_merge_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( i0 <- u32_sub i 1%u32; - list_nth_mut_shared_loop_pair_merge_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + list_nth_mut_shared_loop_pair_merge_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_mut_shared_loop_pair_merge]: forward function *) -Definition list_nth_mut_shared_loop_pair_merge_fwd +Definition list_nth_mut_shared_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_mut_shared_loop_pair_merge_loop_fwd T n ls0 ls1 i + list_nth_mut_shared_loop_pair_merge_loop T n ls0 ls1 i . (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: backward function 0 *) @@ -687,19 +699,19 @@ Fixpoint list_nth_mut_shared_loop_pair_merge_loop_back | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then Return (ListCons ret tl0) + then Return (List_Cons ret tl0) else ( i0 <- u32_sub i 1%u32; tl00 <- list_nth_mut_shared_loop_pair_merge_loop_back T n0 tl0 tl1 i0 ret; - 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 end . @@ -713,7 +725,7 @@ Definition list_nth_mut_shared_loop_pair_merge_back . (** [loops::list_nth_shared_mut_loop_pair]: loop 0: forward function *) -Fixpoint list_nth_shared_mut_loop_pair_loop_fwd +Fixpoint list_nth_shared_mut_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -721,27 +733,27 @@ Fixpoint list_nth_shared_mut_loop_pair_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( i0 <- u32_sub i 1%u32; - list_nth_shared_mut_loop_pair_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + list_nth_shared_mut_loop_pair_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_shared_mut_loop_pair]: forward function *) -Definition list_nth_shared_mut_loop_pair_fwd +Definition list_nth_shared_mut_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_shared_mut_loop_pair_loop_fwd T n ls0 ls1 i + list_nth_shared_mut_loop_pair_loop T n ls0 ls1 i . (** [loops::list_nth_shared_mut_loop_pair]: loop 0: backward function 1 *) @@ -753,18 +765,18 @@ Fixpoint list_nth_shared_mut_loop_pair_loop_back | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then Return (ListCons ret tl1) + then Return (List_Cons ret tl1) else ( i0 <- u32_sub i 1%u32; tl10 <- list_nth_shared_mut_loop_pair_loop_back T n0 tl0 tl1 i0 ret; - 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 end . @@ -778,7 +790,7 @@ Definition list_nth_shared_mut_loop_pair_back . (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: forward function *) -Fixpoint list_nth_shared_mut_loop_pair_merge_loop_fwd +Fixpoint list_nth_shared_mut_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := @@ -786,27 +798,27 @@ Fixpoint list_nth_shared_mut_loop_pair_merge_loop_fwd | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 then Return (x0, x1) else ( i0 <- u32_sub i 1%u32; - list_nth_shared_mut_loop_pair_merge_loop_fwd T n0 tl0 tl1 i0) - | ListNil => Fail_ Failure + list_nth_shared_mut_loop_pair_merge_loop T n0 tl0 tl1 i0) + | List_Nil => Fail_ Failure end - | ListNil => Fail_ Failure + | List_Nil => Fail_ Failure end end . (** [loops::list_nth_shared_mut_loop_pair_merge]: forward function *) -Definition list_nth_shared_mut_loop_pair_merge_fwd +Definition list_nth_shared_mut_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) := - list_nth_shared_mut_loop_pair_merge_loop_fwd T n ls0 ls1 i + list_nth_shared_mut_loop_pair_merge_loop T n ls0 ls1 i . (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: backward function 0 *) @@ -818,19 +830,19 @@ Fixpoint list_nth_shared_mut_loop_pair_merge_loop_back | O => Fail_ OutOfFuel | S n0 => match ls0 with - | ListCons x0 tl0 => + | List_Cons x0 tl0 => match ls1 with - | ListCons x1 tl1 => + | List_Cons x1 tl1 => if i s= 0%u32 - then Return (ListCons ret tl1) + then Return (List_Cons ret tl1) else ( i0 <- u32_sub i 1%u32; tl10 <- list_nth_shared_mut_loop_pair_merge_loop_back T n0 tl0 tl1 i0 ret; - 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 end . diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index c1c24e00..47cdc3af 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -9,113 +9,113 @@ Local Open Scope Primitives_scope. Module NoNestedBorrows. (** [no_nested_borrows::Pair] *) -Record Pair_t (T1 T2 : Type) := mkPair_t { Pair_x : T1; Pair_y : T2; }. +Record Pair_t (T1 T2 : Type) := mkPair_t { pair_x : T1; pair_y : T2; }. Arguments mkPair_t {T1} {T2} _ _. -Arguments Pair_x {T1} {T2}. -Arguments Pair_y {T1} {T2}. +Arguments pair_x {T1} {T2}. +Arguments pair_y {T1} {T2}. (** [no_nested_borrows::List] *) Inductive List_t (T : Type) := -| 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 . -Arguments ListCons {T} _ _. -Arguments ListNil {T}. +Arguments List_Cons {T} _ _. +Arguments List_Nil {T}. (** [no_nested_borrows::One] *) -Inductive One_t (T1 : Type) := | OneOne : T1 -> One_t T1. +Inductive One_t (T1 : Type) := | One_One : T1 -> One_t T1. -Arguments OneOne {T1} _. +Arguments One_One {T1} _. (** [no_nested_borrows::EmptyEnum] *) -Inductive Empty_enum_t := | EmptyEnumEmpty : Empty_enum_t. +Inductive EmptyEnum_t := | EmptyEnum_Empty : EmptyEnum_t. (** [no_nested_borrows::Enum] *) -Inductive Enum_t := | EnumVariant1 : Enum_t | EnumVariant2 : Enum_t. +Inductive Enum_t := | Enum_Variant1 : Enum_t | Enum_Variant2 : Enum_t. (** [no_nested_borrows::EmptyStruct] *) -Record Empty_struct_t := mkEmpty_struct_t { }. +Record EmptyStruct_t := mkEmptyStruct_t { }. (** [no_nested_borrows::Sum] *) Inductive Sum_t (T1 T2 : Type) := -| 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 . -Arguments SumLeft {T1} {T2} _. -Arguments SumRight {T1} {T2} _. +Arguments Sum_Left {T1} {T2} _. +Arguments Sum_Right {T1} {T2} _. (** [no_nested_borrows::neg_test]: forward function *) -Definition neg_test_fwd (x : i32) : result i32 := +Definition neg_test (x : i32) : result i32 := i32_neg x. (** [no_nested_borrows::add_test]: forward function *) -Definition add_test_fwd (x : u32) (y : u32) : result u32 := +Definition add_test (x : u32) (y : u32) : result u32 := u32_add x y. (** [no_nested_borrows::subs_test]: forward function *) -Definition subs_test_fwd (x : u32) (y : u32) : result u32 := +Definition subs_test (x : u32) (y : u32) : result u32 := u32_sub x y. (** [no_nested_borrows::div_test]: forward function *) -Definition div_test_fwd (x : u32) (y : u32) : result u32 := +Definition div_test (x : u32) (y : u32) : result u32 := u32_div x y. (** [no_nested_borrows::div_test1]: forward function *) -Definition div_test1_fwd (x : u32) : result u32 := +Definition div_test1 (x : u32) : result u32 := u32_div x 2%u32. (** [no_nested_borrows::rem_test]: forward function *) -Definition rem_test_fwd (x : u32) (y : u32) : result u32 := +Definition rem_test (x : u32) (y : u32) : result u32 := u32_rem x y. (** [no_nested_borrows::cast_test]: forward function *) -Definition cast_test_fwd (x : u32) : result i32 := +Definition cast_test (x : u32) : result i32 := scalar_cast U32 I32 x. (** [no_nested_borrows::test2]: forward function *) -Definition test2_fwd : result unit := +Definition test2 : result unit := _ <- u32_add 23%u32 44%u32; Return tt. (** Unit test for [no_nested_borrows::test2] *) -Check (test2_fwd )%return. +Check (test2 )%return. (** [no_nested_borrows::get_max]: forward function *) -Definition get_max_fwd (x : u32) (y : u32) : result u32 := +Definition get_max (x : u32) (y : u32) : result u32 := if x s>= y then Return x else Return y . (** [no_nested_borrows::test3]: forward function *) -Definition test3_fwd : result unit := - x <- get_max_fwd 4%u32 3%u32; - y <- get_max_fwd 10%u32 11%u32; +Definition test3 : result unit := + x <- get_max 4%u32 3%u32; + y <- get_max 10%u32 11%u32; z <- u32_add x y; if negb (z s= 15%u32) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test3] *) -Check (test3_fwd )%return. +Check (test3 )%return. (** [no_nested_borrows::test_neg1]: forward function *) -Definition test_neg1_fwd : result unit := +Definition test_neg1 : result unit := y <- i32_neg 3%i32; if negb (y s= (-3)%i32) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test_neg1] *) -Check (test_neg1_fwd )%return. +Check (test_neg1 )%return. (** [no_nested_borrows::refs_test1]: forward function *) -Definition refs_test1_fwd : result unit := +Definition refs_test1 : result unit := if negb (1%i32 s= 1%i32) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::refs_test1] *) -Check (refs_test1_fwd )%return. +Check (refs_test1 )%return. (** [no_nested_borrows::refs_test2]: forward function *) -Definition refs_test2_fwd : result unit := +Definition refs_test2 : result unit := if negb (2%i32 s= 2%i32) then Fail_ Failure else @@ -128,85 +128,83 @@ Definition refs_test2_fwd : result unit := . (** Unit test for [no_nested_borrows::refs_test2] *) -Check (refs_test2_fwd )%return. +Check (refs_test2 )%return. (** [no_nested_borrows::test_list1]: forward function *) -Definition test_list1_fwd : result unit := +Definition test_list1 : result unit := Return tt. (** Unit test for [no_nested_borrows::test_list1] *) -Check (test_list1_fwd )%return. +Check (test_list1 )%return. (** [no_nested_borrows::test_box1]: forward function *) -Definition test_box1_fwd : result unit := +Definition test_box1 : result unit := let b := 1%i32 in let x := b in if negb (x s= 1%i32) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test_box1] *) -Check (test_box1_fwd )%return. +Check (test_box1 )%return. (** [no_nested_borrows::copy_int]: forward function *) -Definition copy_int_fwd (x : i32) : result i32 := +Definition copy_int (x : i32) : result i32 := Return x. (** [no_nested_borrows::test_unreachable]: forward function *) -Definition test_unreachable_fwd (b : bool) : result unit := +Definition test_unreachable (b : bool) : result unit := if b then Fail_ Failure else Return tt . (** [no_nested_borrows::test_panic]: forward function *) -Definition test_panic_fwd (b : bool) : result unit := +Definition test_panic (b : bool) : result unit := if b then Fail_ Failure else Return tt . (** [no_nested_borrows::test_copy_int]: forward function *) -Definition test_copy_int_fwd : result unit := - y <- copy_int_fwd 0%i32; - if negb (0%i32 s= y) then Fail_ Failure else Return tt +Definition test_copy_int : result unit := + y <- copy_int 0%i32; if negb (0%i32 s= y) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test_copy_int] *) -Check (test_copy_int_fwd )%return. +Check (test_copy_int )%return. (** [no_nested_borrows::is_cons]: forward function *) -Definition is_cons_fwd (T : Type) (l : List_t T) : result bool := - match l with | ListCons t l0 => Return true | ListNil => Return false end +Definition is_cons (T : Type) (l : List_t T) : result bool := + match l with | List_Cons t l0 => Return true | List_Nil => Return false end . (** [no_nested_borrows::test_is_cons]: forward function *) -Definition test_is_cons_fwd : result unit := - let l := ListNil in - b <- is_cons_fwd i32 (ListCons 0%i32 l); +Definition test_is_cons : result unit := + let l := List_Nil in + b <- is_cons i32 (List_Cons 0%i32 l); if negb b then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test_is_cons] *) -Check (test_is_cons_fwd )%return. +Check (test_is_cons )%return. (** [no_nested_borrows::split_list]: forward function *) -Definition split_list_fwd - (T : Type) (l : List_t T) : result (T * (List_t T)) := +Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := 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 *) -Definition test_split_list_fwd : result unit := - let l := ListNil in - p <- split_list_fwd i32 (ListCons 0%i32 l); +Definition test_split_list : result unit := + let l := List_Nil in + p <- split_list i32 (List_Cons 0%i32 l); let (hd, _) := p in if negb (hd s= 0%i32) then Fail_ Failure else Return tt . (** Unit test for [no_nested_borrows::test_split_list] *) -Check (test_split_list_fwd )%return. +Check (test_split_list )%return. (** [no_nested_borrows::choose]: forward function *) -Definition choose_fwd (T : Type) (b : bool) (x : T) (y : T) : result T := +Definition choose (T : Type) (b : bool) (x : T) (y : T) : result T := if b then Return x else Return y . @@ -217,8 +215,8 @@ Definition choose_back . (** [no_nested_borrows::choose_test]: forward function *) -Definition choose_test_fwd : result unit := - z <- choose_fwd i32 true 0%i32 0%i32; +Definition choose_test : result unit := + z <- choose i32 true 0%i32 0%i32; z0 <- i32_add z 1%i32; if negb (z0 s= 1%i32) then Fail_ Failure @@ -231,57 +229,56 @@ Definition choose_test_fwd : result unit := . (** Unit test for [no_nested_borrows::choose_test] *) -Check (choose_test_fwd )%return. +Check (choose_test )%return. (** [no_nested_borrows::test_char]: forward function *) -Definition test_char_fwd : result char := - Return (char_of_byte Coq.Init.Byte.x61) -. +Definition test_char : result char := + Return (char_of_byte Coq.Init.Byte.x61). (** [no_nested_borrows::Tree] *) Inductive Tree_t (T : Type) := -| 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] *) -with Node_elem_t (T : Type) := -| NodeElemCons : Tree_t T -> Node_elem_t T -> Node_elem_t T -| NodeElemNil : Node_elem_t T +with NodeElem_t (T : Type) := +| NodeElem_Cons : Tree_t T -> NodeElem_t T -> NodeElem_t T +| NodeElem_Nil : NodeElem_t T . -Arguments TreeLeaf {T} _. -Arguments TreeNode {T} _ _ _. +Arguments Tree_Leaf {T} _. +Arguments Tree_Node {T} _ _ _. -Arguments NodeElemCons {T} _ _. -Arguments NodeElemNil {T}. +Arguments NodeElem_Cons {T} _ _. +Arguments NodeElem_Nil {T}. (** [no_nested_borrows::list_length]: forward function *) -Fixpoint list_length_fwd (T : Type) (l : List_t T) : result u32 := +Fixpoint list_length (T : Type) (l : List_t T) : result u32 := match l with - | ListCons t l1 => i <- list_length_fwd T l1; u32_add 1%u32 i - | ListNil => Return 0%u32 + | List_Cons t l1 => i <- list_length T l1; u32_add 1%u32 i + | List_Nil => Return 0%u32 end . (** [no_nested_borrows::list_nth_shared]: forward function *) -Fixpoint list_nth_shared_fwd (T : Type) (l : List_t T) (i : u32) : result T := +Fixpoint list_nth_shared (T : Type) (l : List_t T) (i : u32) : result T := match l with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_shared_fwd T tl i0) - | ListNil => Fail_ Failure + else (i0 <- u32_sub i 1%u32; list_nth_shared T tl i0) + | List_Nil => Fail_ Failure end . (** [no_nested_borrows::list_nth_mut]: forward function *) -Fixpoint list_nth_mut_fwd (T : Type) (l : List_t T) (i : u32) : result T := +Fixpoint list_nth_mut (T : Type) (l : List_t T) (i : u32) : result T := match l with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut_fwd T tl i0) - | ListNil => Fail_ Failure + else (i0 <- u32_sub i 1%u32; list_nth_mut T tl i0) + | List_Nil => Fail_ Failure end . @@ -289,73 +286,72 @@ Fixpoint list_nth_mut_fwd (T : Type) (l : List_t T) (i : u32) : result T := Fixpoint list_nth_mut_back (T : Type) (l : List_t T) (i : u32) (ret : T) : result (List_t T) := match l with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else ( i0 <- u32_sub i 1%u32; tl0 <- list_nth_mut_back T tl i0 ret; - 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 *) -Fixpoint list_rev_aux_fwd +Fixpoint list_rev_aux (T : Type) (li : List_t T) (lo : List_t T) : result (List_t T) := 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 ()) *) -Definition list_rev_fwd_back (T : Type) (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 +Definition list_rev (T : Type) (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 *) -Definition test_list_functions_fwd : result unit := - let l := ListNil in - let l0 := ListCons 2%i32 l in - let l1 := ListCons 1%i32 l0 in - i <- list_length_fwd i32 (ListCons 0%i32 l1); +Definition test_list_functions : result unit := + let l := List_Nil in + let l0 := List_Cons 2%i32 l in + let l1 := List_Cons 1%i32 l0 in + i <- list_length i32 (List_Cons 0%i32 l1); if negb (i s= 3%u32) then Fail_ Failure else ( - i0 <- list_nth_shared_fwd i32 (ListCons 0%i32 l1) 0%u32; + i0 <- list_nth_shared i32 (List_Cons 0%i32 l1) 0%u32; if negb (i0 s= 0%i32) then Fail_ Failure else ( - i1 <- list_nth_shared_fwd i32 (ListCons 0%i32 l1) 1%u32; + i1 <- list_nth_shared i32 (List_Cons 0%i32 l1) 1%u32; if negb (i1 s= 1%i32) then Fail_ Failure else ( - i2 <- list_nth_shared_fwd i32 (ListCons 0%i32 l1) 2%u32; + i2 <- list_nth_shared i32 (List_Cons 0%i32 l1) 2%u32; if negb (i2 s= 2%i32) then Fail_ Failure else ( - ls <- list_nth_mut_back i32 (ListCons 0%i32 l1) 1%u32 3%i32; - i3 <- list_nth_shared_fwd i32 ls 0%u32; + ls <- list_nth_mut_back i32 (List_Cons 0%i32 l1) 1%u32 3%i32; + i3 <- list_nth_shared i32 ls 0%u32; if negb (i3 s= 0%i32) then Fail_ Failure else ( - i4 <- list_nth_shared_fwd i32 ls 1%u32; + i4 <- list_nth_shared i32 ls 1%u32; if negb (i4 s= 3%i32) then Fail_ Failure else ( - i5 <- list_nth_shared_fwd i32 ls 2%u32; + i5 <- list_nth_shared i32 ls 2%u32; if negb (i5 s= 2%i32) then Fail_ Failure else Return tt)))))) . (** Unit test for [no_nested_borrows::test_list_functions] *) -Check (test_list_functions_fwd )%return. +Check (test_list_functions )%return. (** [no_nested_borrows::id_mut_pair1]: forward function *) -Definition id_mut_pair1_fwd - (T1 T2 : Type) (x : T1) (y : T2) : result (T1 * T2) := +Definition id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : result (T1 * T2) := Return (x, y) . @@ -366,8 +362,7 @@ Definition id_mut_pair1_back . (** [no_nested_borrows::id_mut_pair2]: forward function *) -Definition id_mut_pair2_fwd - (T1 T2 : Type) (p : (T1 * T2)) : result (T1 * T2) := +Definition id_mut_pair2 (T1 T2 : Type) (p : (T1 * T2)) : result (T1 * T2) := let (t, t0) := p in Return (t, t0) . @@ -378,8 +373,7 @@ Definition id_mut_pair2_back . (** [no_nested_borrows::id_mut_pair3]: forward function *) -Definition id_mut_pair3_fwd - (T1 T2 : Type) (x : T1) (y : T2) : result (T1 * T2) := +Definition id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : result (T1 * T2) := Return (x, y) . @@ -396,8 +390,7 @@ Definition id_mut_pair3_back'b . (** [no_nested_borrows::id_mut_pair4]: forward function *) -Definition id_mut_pair4_fwd - (T1 T2 : Type) (p : (T1 * T2)) : result (T1 * T2) := +Definition id_mut_pair4 (T1 T2 : Type) (p : (T1 * T2)) : result (T1 * T2) := let (t, t0) := p in Return (t, t0) . @@ -414,101 +407,101 @@ Definition id_mut_pair4_back'b . (** [no_nested_borrows::StructWithTuple] *) -Record Struct_with_tuple_t (T1 T2 : Type) := -mkStruct_with_tuple_t { - Struct_with_tuple_p : (T1 * T2); +Record StructWithTuple_t (T1 T2 : Type) := +mkStructWithTuple_t { + structWithTuple_p : (T1 * T2); } . -Arguments mkStruct_with_tuple_t {T1} {T2} _. -Arguments Struct_with_tuple_p {T1} {T2}. +Arguments mkStructWithTuple_t {T1} {T2} _. +Arguments structWithTuple_p {T1} {T2}. (** [no_nested_borrows::new_tuple1]: forward function *) -Definition new_tuple1_fwd : result (Struct_with_tuple_t u32 u32) := - Return {| Struct_with_tuple_p := (1%u32, 2%u32) |} +Definition new_tuple1 : result (StructWithTuple_t u32 u32) := + Return {| structWithTuple_p := (1%u32, 2%u32) |} . (** [no_nested_borrows::new_tuple2]: forward function *) -Definition new_tuple2_fwd : result (Struct_with_tuple_t i16 i16) := - Return {| Struct_with_tuple_p := (1%i16, 2%i16) |} +Definition new_tuple2 : result (StructWithTuple_t i16 i16) := + Return {| structWithTuple_p := (1%i16, 2%i16) |} . (** [no_nested_borrows::new_tuple3]: forward function *) -Definition new_tuple3_fwd : result (Struct_with_tuple_t u64 i64) := - Return {| Struct_with_tuple_p := (1%u64, 2%i64) |} +Definition new_tuple3 : result (StructWithTuple_t u64 i64) := + Return {| structWithTuple_p := (1%u64, 2%i64) |} . (** [no_nested_borrows::StructWithPair] *) -Record Struct_with_pair_t (T1 T2 : Type) := -mkStruct_with_pair_t { - Struct_with_pair_p : Pair_t T1 T2; +Record StructWithPair_t (T1 T2 : Type) := +mkStructWithPair_t { + structWithPair_p : Pair_t T1 T2; } . -Arguments mkStruct_with_pair_t {T1} {T2} _. -Arguments Struct_with_pair_p {T1} {T2}. +Arguments mkStructWithPair_t {T1} {T2} _. +Arguments structWithPair_p {T1} {T2}. (** [no_nested_borrows::new_pair1]: forward function *) -Definition new_pair1_fwd : result (Struct_with_pair_t u32 u32) := - Return {| Struct_with_pair_p := {| Pair_x := 1%u32; Pair_y := 2%u32 |} |} +Definition new_pair1 : result (StructWithPair_t u32 u32) := + Return {| structWithPair_p := {| pair_x := 1%u32; pair_y := 2%u32 |} |} . (** [no_nested_borrows::test_constants]: forward function *) -Definition test_constants_fwd : result unit := - swt <- new_tuple1_fwd; - let (i, _) := swt.(Struct_with_tuple_p) in +Definition test_constants : result unit := + swt <- new_tuple1; + let (i, _) := swt.(structWithTuple_p) in if negb (i s= 1%u32) then Fail_ Failure else ( - swt0 <- new_tuple2_fwd; - let (i0, _) := swt0.(Struct_with_tuple_p) in + swt0 <- new_tuple2; + let (i0, _) := swt0.(structWithTuple_p) in if negb (i0 s= 1%i16) then Fail_ Failure else ( - swt1 <- new_tuple3_fwd; - let (i1, _) := swt1.(Struct_with_tuple_p) in + swt1 <- new_tuple3; + let (i1, _) := swt1.(structWithTuple_p) in if negb (i1 s= 1%u64) then Fail_ Failure else ( - swp <- new_pair1_fwd; - if negb (swp.(Struct_with_pair_p).(Pair_x) s= 1%u32) + swp <- new_pair1; + if negb (swp.(structWithPair_p).(pair_x) s= 1%u32) then Fail_ Failure else Return tt))) . (** Unit test for [no_nested_borrows::test_constants] *) -Check (test_constants_fwd )%return. +Check (test_constants )%return. (** [no_nested_borrows::test_weird_borrows1]: forward function *) -Definition test_weird_borrows1_fwd : result unit := +Definition test_weird_borrows1 : result unit := Return tt. (** Unit test for [no_nested_borrows::test_weird_borrows1] *) -Check (test_weird_borrows1_fwd )%return. +Check (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 ()) *) -Definition test_mem_replace_fwd_back (px : u32) : result u32 := - let y := mem_replace_fwd u32 px 1%u32 in +Definition test_mem_replace (px : u32) : result u32 := + let y := core_mem_replace u32 px 1%u32 in if negb (y s= 0%u32) then Fail_ Failure else Return 2%u32 . (** [no_nested_borrows::test_shared_borrow_bool1]: forward function *) -Definition test_shared_borrow_bool1_fwd (b : bool) : result u32 := +Definition test_shared_borrow_bool1 (b : bool) : result u32 := if b then Return 0%u32 else Return 1%u32 . (** [no_nested_borrows::test_shared_borrow_bool2]: forward function *) -Definition test_shared_borrow_bool2_fwd : result u32 := +Definition test_shared_borrow_bool2 : result u32 := Return 0%u32. (** [no_nested_borrows::test_shared_borrow_enum1]: forward function *) -Definition test_shared_borrow_enum1_fwd (l : List_t u32) : result u32 := - match l with | ListCons i l0 => Return 1%u32 | ListNil => Return 0%u32 end +Definition test_shared_borrow_enum1 (l : List_t u32) : result u32 := + match l with | List_Cons i l0 => Return 1%u32 | List_Nil => Return 0%u32 end . (** [no_nested_borrows::test_shared_borrow_enum2]: forward function *) -Definition test_shared_borrow_enum2_fwd : result u32 := +Definition test_shared_borrow_enum2 : result u32 := Return 0%u32. End NoNestedBorrows . diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v index 175a523d..d397995b 100644 --- a/tests/coq/misc/Paper.v +++ b/tests/coq/misc/Paper.v @@ -10,20 +10,19 @@ Module Paper. (** [paper::ref_incr]: merged forward/backward function (there is a single backward function, and the forward function returns ()) *) -Definition ref_incr_fwd_back (x : i32) : result i32 := +Definition ref_incr (x : i32) : result i32 := i32_add x 1%i32. (** [paper::test_incr]: forward function *) -Definition test_incr_fwd : result unit := - x <- ref_incr_fwd_back 0%i32; - if negb (x s= 1%i32) then Fail_ Failure else Return tt +Definition test_incr : result unit := + x <- ref_incr 0%i32; if negb (x s= 1%i32) then Fail_ Failure else Return tt . (** Unit test for [paper::test_incr] *) -Check (test_incr_fwd )%return. +Check (test_incr )%return. (** [paper::choose]: forward function *) -Definition choose_fwd (T : Type) (b : bool) (x : T) (y : T) : result T := +Definition choose (T : Type) (b : bool) (x : T) (y : T) : result T := if b then Return x else Return y . @@ -34,8 +33,8 @@ Definition choose_back . (** [paper::test_choose]: forward function *) -Definition test_choose_fwd : result unit := - z <- choose_fwd i32 true 0%i32 0%i32; +Definition test_choose : result unit := + z <- choose i32 true 0%i32 0%i32; z0 <- i32_add z 1%i32; if negb (z0 s= 1%i32) then Fail_ Failure @@ -48,25 +47,25 @@ Definition test_choose_fwd : result unit := . (** Unit test for [paper::test_choose] *) -Check (test_choose_fwd )%return. +Check (test_choose )%return. (** [paper::List] *) Inductive List_t (T : Type) := -| 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 . -Arguments ListCons {T} _ _. -Arguments ListNil {T}. +Arguments List_Cons {T} _ _. +Arguments List_Nil {T}. (** [paper::list_nth_mut]: forward function *) -Fixpoint list_nth_mut_fwd (T : Type) (l : List_t T) (i : u32) : result T := +Fixpoint list_nth_mut (T : Type) (l : List_t T) (i : u32) : result T := match l with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 then Return x - else (i0 <- u32_sub i 1%u32; list_nth_mut_fwd T tl i0) - | ListNil => Fail_ Failure + else (i0 <- u32_sub i 1%u32; list_nth_mut T tl i0) + | List_Nil => Fail_ Failure end . @@ -74,44 +73,44 @@ Fixpoint list_nth_mut_fwd (T : Type) (l : List_t T) (i : u32) : result T := Fixpoint list_nth_mut_back (T : Type) (l : List_t T) (i : u32) (ret : T) : result (List_t T) := match l with - | ListCons x tl => + | List_Cons x tl => if i s= 0%u32 - then Return (ListCons ret tl) + then Return (List_Cons ret tl) else ( i0 <- u32_sub i 1%u32; tl0 <- list_nth_mut_back T tl i0 ret; - Return (ListCons x tl0)) - | ListNil => Fail_ Failure + Return (List_Cons x tl0)) + | List_Nil => Fail_ Failure end . (** [paper::sum]: forward function *) -Fixpoint sum_fwd (l : List_t i32) : result i32 := +Fixpoint sum (l : List_t i32) : result i32 := match l with - | ListCons x tl => i <- sum_fwd tl; i32_add x i - | ListNil => Return 0%i32 + | List_Cons x tl => i <- sum tl; i32_add x i + | List_Nil => Return 0%i32 end . (** [paper::test_nth]: forward function *) -Definition test_nth_fwd : result unit := - let l := ListNil in - let l0 := ListCons 3%i32 l in - let l1 := ListCons 2%i32 l0 in - x <- list_nth_mut_fwd i32 (ListCons 1%i32 l1) 2%u32; +Definition test_nth : result unit := + let l := List_Nil in + let l0 := List_Cons 3%i32 l in + let l1 := List_Cons 2%i32 l0 in + x <- list_nth_mut i32 (List_Cons 1%i32 l1) 2%u32; x0 <- i32_add x 1%i32; - l2 <- list_nth_mut_back i32 (ListCons 1%i32 l1) 2%u32 x0; - i <- sum_fwd l2; + l2 <- list_nth_mut_back i32 (List_Cons 1%i32 l1) 2%u32 x0; + i <- sum l2; if negb (i s= 7%i32) then Fail_ Failure else Return tt . (** Unit test for [paper::test_nth] *) -Check (test_nth_fwd )%return. +Check (test_nth )%return. (** [paper::call_choose]: forward function *) -Definition call_choose_fwd (p : (u32 * u32)) : result u32 := +Definition call_choose (p : (u32 * u32)) : result u32 := let (px, py) := p in - pz <- choose_fwd u32 true px py; + pz <- choose u32 true px py; pz0 <- u32_add pz 1%u32; p0 <- choose_back u32 true px py pz0; let (px0, _) := p0 in diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index 54021bdf..4f804b55 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -10,19 +10,19 @@ Module PoloniusList. (** [polonius_list::List] *) Inductive List_t (T : Type) := -| 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 . -Arguments ListCons {T} _ _. -Arguments ListNil {T}. +Arguments List_Cons {T} _ _. +Arguments List_Nil {T}. (** [polonius_list::get_list_at_x]: forward function *) -Fixpoint get_list_at_x_fwd (ls : List_t u32) (x : u32) : result (List_t u32) := +Fixpoint get_list_at_x (ls : List_t u32) (x : u32) : result (List_t u32) := match ls with - | ListCons hd tl => - if hd s= x then Return (ListCons hd tl) else get_list_at_x_fwd tl x - | ListNil => Return ListNil + | List_Cons hd tl => + if hd s= x then Return (List_Cons hd tl) else get_list_at_x tl x + | List_Nil => Return List_Nil end . @@ -30,11 +30,11 @@ Fixpoint get_list_at_x_fwd (ls : List_t u32) (x : u32) : result (List_t u32) := Fixpoint get_list_at_x_back (ls : List_t u32) (x : u32) (ret : List_t u32) : result (List_t u32) := match ls with - | ListCons hd tl => + | List_Cons hd tl => if hd s= x then Return ret - else (tl0 <- get_list_at_x_back tl x ret; Return (ListCons hd tl0)) - | ListNil => Return ret + else (tl0 <- get_list_at_x_back tl x ret; Return (List_Cons hd tl0)) + | List_Nil => Return ret end . diff --git a/tests/coq/misc/Primitives.v b/tests/coq/misc/Primitives.v index 8d6c9c8d..85e38f01 100644 --- a/tests/coq/misc/Primitives.v +++ b/tests/coq/misc/Primitives.v @@ -63,13 +63,15 @@ Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) - Definition string := Coq.Strings.String.string. Definition char := Coq.Strings.Ascii.ascii. Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. -Definition mem_replace_fwd (a : Type) (x : a) (y : a) : a := x . -Definition mem_replace_back (a : Type) (x : a) (y : a) : a := y . +Definition core_mem_replace (a : Type) (x : a) (y : a) : a := x . +Definition core_mem_replace_back (a : Type) (x : a) (y : a) : a := y . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. (*** Scalars *) @@ -408,12 +410,75 @@ 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; - end_: T; +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : Self -> Idx -> result core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output); + core_ops_index_IndexMut_index_mut_back : Self -> Idx -> core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self; +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. +Arguments core_ops_index_IndexMut_index_mut_back {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; +}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : Self -> result core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target); + core_ops_deref_DerefMut_deref_mut_back : Self -> core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self; }. -Arguments mk_range {_}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. +Arguments core_ops_deref_DerefMut_deref_mut_back {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; + core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; +|}. + (*** Arrays *) Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. @@ -433,51 +498,50 @@ Qed. (* TODO: finish the definitions *) Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. -Axiom array_index_shared : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_fwd : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. -Axiom array_index_mut_back : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). +(* For initialization *) +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. + +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). (*** Slice *) Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. Axiom slice_len : forall (T : Type) (s : slice T), usize. -Axiom slice_index_shared : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_fwd : forall (T : Type) (x : slice T) (i : usize), result T. -Axiom slice_index_mut_back : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). (*** Subslices *) -Axiom array_to_slice_shared : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_fwd : forall (T : Type) (n : usize) (x : array T n), result (slice T). -Axiom array_to_slice_mut_back : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). -Axiom array_subslice_shared: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_fwd: forall (T : Type) (n : usize) (x : array T n) (r : range usize), result (slice T). -Axiom array_subslice_mut_back: forall (T : Type) (n : usize) (x : array T n) (r : range usize) (ns : slice T), result (array T n). -Axiom slice_subslice_shared: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_fwd: forall (T : Type) (x : slice T) (r : range usize), result (slice T). -Axiom slice_subslice_mut_back: forall (T : Type) (x : slice T) (r : range usize) (ns : slice T), result (slice T). +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). (*** Vectors *) -Definition vec T := { l: list T | Z.of_nat (length l) <= usize_max }. +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. -Definition vec_to_list {T: Type} (v: vec T) : list T := proj1_sig v. +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. -Definition vec_length {T: Type} (v: vec T) : Z := Z.of_nat (length (vec_to_list v)). +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). -Definition vec_new (T: Type) : vec T := (exist _ [] le_0_usize_max). +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). -Lemma vec_len_in_usize {T} (v: vec T) : usize_min <= vec_length v <= usize_max. +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. Proof. - unfold vec_length, usize_min. + unfold alloc_vec_Vec_length, usize_min. split. - lia. - apply (proj2_sig v). Qed. -Definition vec_len (T: Type) (v: vec T) : usize := - exist _ (vec_length v) (vec_len_in_usize v). +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). Fixpoint list_update {A} (l: list A) (n: nat) (a: A) : list A := @@ -488,50 +552,271 @@ Fixpoint list_update {A} (l: list A) (n: nat) (a: A) | S m => x :: (list_update t m a) end end. -Definition vec_bind {A B} (v: vec A) (f: list A -> result (list B)) : result (vec B) := - l <- f (vec_to_list v) ; +Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := + l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. (* The **forward** function shouldn't be used *) -Definition vec_push_fwd (T: Type) (v: vec T) (x: T) : unit := tt. +Definition alloc_vec_Vec_push_fwd (T: Type) (v: alloc_vec_Vec T) (x: T) : unit := tt. -Definition vec_push_back (T: Type) (v: vec T) (x: T) : result (vec T) := - vec_bind v (fun l => Return (l ++ [x])). +Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). (* The **forward** function shouldn't be used *) -Definition vec_insert_fwd (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i +Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := + alloc_vec_Vec_bind v (fun l => if to_Z i Return n - | None => Fail_ Failure - end. - -Definition vec_index_back (T: Type) (v: vec T) (i: usize) (x: T) : result unit := - if to_Z i Return n - | None => Fail_ Failure +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut_back : Self -> T -> option core_slice_index_SliceIndex_Output -> result T; + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut_back : Self -> T -> core_slice_index_SliceIndex_Output -> result T; +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_mut_back {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. +Arguments core_slice_index_SliceIndex_index_mut_back {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Return x end. -Definition vec_index_mut_back (T: Type) (v: vec T) (i: usize) (x: T) : result (vec T) := - vec_bind v (fun l => - if to_Z i slice T -> result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: backward function 0 *) +Axiom core_slice_index_Range_get_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_Range_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_Range_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_Range_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_Range_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: backward function 0 *) +Axiom core_slice_index_Range_index_mut_back : + forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> result inst.(core_slice_index_SliceIndex_Output). + +(* [core::slice::index::[T]::index_mut]: backward function 0 *) +Axiom core_slice_index_Slice_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> inst.(core_slice_index_SliceIndex_Output) -> result (slice T). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: backward function 0 *) +Axiom core_array_Array_index_mut_back : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_Range_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_Range_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; + core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: backward function 0 *) +Axiom core_slice_index_usize_get_mut_back : + forall (T : Type), usize -> slice T -> option T -> result (slice T). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: backward function 0 *) +Axiom core_slice_index_usize_index_mut_back : + forall (T : Type), usize -> slice T -> T -> result (slice T). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_usize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_usize_index_mut_back T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: backward function 0 *) +Axiom alloc_vec_Vec_index_mut_back : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx) (x : inst.(core_slice_index_SliceIndex_Output)), result (alloc_vec_Vec T). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; + core_ops_index_IndexMut_index_mut_back := alloc_vec_Vec_index_mut_back T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + 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. End Primitives. -- 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 'backends') 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 From c3b6ad3685995b3b96dc88789e8512560d3257b3 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 21 Nov 2023 10:23:14 +0100 Subject: Update the standard libraries --- backends/coq/Primitives.v | 56 +++++++++++++++------------ backends/fstar/Primitives.fst | 56 +++++++++++++-------------- backends/lean/Base/Primitives/Alloc.lean | 6 +-- backends/lean/Base/Primitives/ArraySlice.lean | 39 +++++++++---------- backends/lean/Base/Primitives/Vec.lean | 6 +-- 5 files changed, 85 insertions(+), 78 deletions(-) (limited to 'backends') diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 85e38f01..846a5e4b 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -467,14 +467,14 @@ Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result T := Return x. Definition alloc_boxed_Box_deref_mut_back (T : Type) (_ : T) (x : T) : result T := Return x. (* Trait instance *) -Definition alloc_boxed_Box_coreOpsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| +Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| core_ops_deref_Deref_target := Self; core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; |}. (* Trait instance *) -Definition alloc_boxed_Box_coreOpsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| - core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreOpsDerefInst Self; +Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; core_ops_deref_DerefMut_deref_mut_back := alloc_boxed_Box_deref_mut_back Self; |}. @@ -576,7 +576,7 @@ Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) else Fail_ Failure). (* Helper *) -Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result T. +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize), result T. (* Helper *) Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). @@ -683,22 +683,14 @@ Axiom core_array_Array_index_mut_back : forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) (a : array T N) (i : Idx) (x : inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output)), result (array T N). -(* Trait implementation: [core::slice::index::[T]] *) -Definition core_slice_index_Slice_coreopsindexIndexInst (T Idx : Type) - (inst : core_slice_index_SliceIndex Idx (slice T)) : - core_ops_index_Index (slice T) Idx := {| - core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); - core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; -|}. - (* Trait implementation: [core::slice::index::private_slice_index::Range] *) -Definition core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst +Definition core_slice_index_private_slice_index_SealedRangeUsizeInst : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. (* Trait implementation: [core::slice::index::Range] *) -Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : +Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| - core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_SealedRangeUsizeInst; core_slice_index_SliceIndex_Output := slice T; core_slice_index_SliceIndex_get := core_slice_index_Range_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; @@ -711,16 +703,24 @@ Definition core_slice_index_Range_coresliceindexSliceIndexInst (T : Type) : |}. (* Trait implementation: [core::slice::index::[T]] *) -Definition core_slice_index_Slice_coreopsindexIndexMutInst (T Idx : Type) +Definition core_ops_index_IndexSliceTIInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) : core_ops_index_IndexMut (slice T) Idx := {| - core_ops_index_IndexMut_indexInst := core_slice_index_Slice_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; core_ops_index_IndexMut_index_mut_back := core_slice_index_Slice_index_mut_back T Idx inst; |}. (* Trait implementation: [core::array::[T; N]] *) -Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) +Definition core_ops_index_IndexArrayInst (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) : core_ops_index_Index (array T N) Idx := {| core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); @@ -728,10 +728,10 @@ Definition core_array_Array_coreopsindexIndexInst (T Idx : Type) (N : usize) |}. (* Trait implementation: [core::array::[T; N]] *) -Definition core_array_Array_coreopsindexIndexMutInst (T Idx : Type) (N : usize) +Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) : core_ops_index_IndexMut (array T N) Idx := {| - core_ops_index_IndexMut_indexInst := core_array_Array_coreopsindexIndexInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; core_ops_index_IndexMut_index_mut_back := core_array_Array_index_mut_back T Idx N inst; |}. @@ -765,13 +765,13 @@ Axiom core_slice_index_usize_index_mut_back : forall (T : Type), usize -> slice T -> T -> result (slice T). (* Trait implementation: [core::slice::index::private_slice_index::usize] *) -Definition core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst +Definition core_slice_index_private_slice_index_SealedUsizeInst : core_slice_index_private_slice_index_Sealed usize := tt. (* Trait implementation: [core::slice::index::usize] *) -Definition core_slice_index_usize_coresliceindexSliceIndexInst (T : Type) : +Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex usize (slice T) := {| - core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_SealedUsizeInst; core_slice_index_SliceIndex_Output := T; core_slice_index_SliceIndex_get := core_slice_index_usize_get T; core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; @@ -815,8 +815,16 @@ Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) (*** Theorems *) +Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = + alloc_vec_Vec_index_usize v i. + +Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = + alloc_vec_Vec_index_usize v i. + Axiom alloc_vec_Vec_index_mut_back_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), - alloc_vec_Vec_index_mut_back a usize (core_slice_index_usize_coresliceindexSliceIndexInst a) v i x = + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x = alloc_vec_Vec_update_usize v i x. End Primitives. diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 3297803c..19c4e7a3 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -351,14 +351,14 @@ let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result t = Return x let alloc_boxed_Box_deref_mut_back (t : Type) (_ : t) (x : t) : result t = Return x // Trait instance -let alloc_boxed_Box_coreOpsDerefInst (self : Type0) : core_ops_deref_Deref self = { +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { target = self; deref = alloc_boxed_Box_deref self; } // Trait instance -let alloc_boxed_Box_coreOpsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { - derefInst = alloc_boxed_Box_coreOpsDerefInst self; +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; deref_mut = alloc_boxed_Box_deref_mut self; deref_mut_back = alloc_boxed_Box_deref_mut_back self; } @@ -559,22 +559,14 @@ let core_array_Array_index_mut_back (a : array t n) (i : idx) (x : inst.indexInst.output) : result (array t n) = admit () // TODO -// Trait implementation: [core::slice::index::[T]] -let core_slice_index_Slice_coreopsindexIndexInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_Index (slice t) idx = { - output = inst.output; - index = core_slice_index_Slice_index t idx inst; -} - // Trait implementation: [core::slice::index::private_slice_index::Range] -let core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst +let core_slice_index_private_slice_index_SealedRangeUsizeInst : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () // Trait implementation: [core::slice::index::Range] -let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { - sealedInst = core_slice_index_private_slice_index_Range_coresliceindexprivate_slice_indexSealedInst; + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; output = slice t; get = core_slice_index_Range_get t; get_mut = core_slice_index_Range_get_mut t; @@ -587,16 +579,24 @@ let core_slice_index_Range_coresliceindexSliceIndexInst (t : Type0) : } // Trait implementation: [core::slice::index::[T]] -let core_slice_index_Slice_coreopsindexIndexMutInst (t idx : Type0) +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : core_ops_index_IndexMut (slice t) idx = { - indexInst = core_slice_index_Slice_coreopsindexIndexInst t idx inst; + indexInst = core_ops_index_IndexSliceTIInst t idx inst; index_mut = core_slice_index_Slice_index_mut t idx inst; index_mut_back = core_slice_index_Slice_index_mut_back t idx inst; } // Trait implementation: [core::array::[T; N]] -let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) : core_ops_index_Index (array t n) idx = { output = inst.output; @@ -604,10 +604,10 @@ let core_array_Array_coreopsindexIndexInst (t idx : Type0) (n : usize) } // Trait implementation: [core::array::[T; N]] -let core_array_Array_coreopsindexIndexMutInst (t idx : Type0) (n : usize) +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) : core_ops_index_IndexMut (array t n) idx = { - indexInst = core_array_Array_coreopsindexIndexInst t idx n inst.indexInst; + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; index_mut = core_array_Array_index_mut t idx n inst; index_mut_back = core_array_Array_index_mut_back t idx n inst; } @@ -651,13 +651,13 @@ let core_slice_index_usize_index_mut_back admit () // TODO // Trait implementation: [core::slice::index::private_slice_index::usize] -let core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst +let core_slice_index_private_slice_index_SealedUsizeInst : core_slice_index_private_slice_index_Sealed usize = () // Trait implementation: [core::slice::index::usize] -let core_slice_index_usize_coresliceindexSliceIndexInst (t : Type0) : +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : core_slice_index_SliceIndex usize (slice t) = { - sealedInst = core_slice_index_private_slice_index_usize_coresliceindexprivate_slice_indexSealedInst; + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; output = t; get = core_slice_index_usize_get t; get_mut = core_slice_index_usize_get_mut t; @@ -706,24 +706,24 @@ let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) 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 a usize (core_slice_index_SliceIndexUsizeSliceTInst 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)] + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst 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_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst 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)] + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst 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 == + alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst 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)] + [SMTPat (alloc_vec_Vec_index_mut_back a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i x)] = admit() diff --git a/backends/lean/Base/Primitives/Alloc.lean b/backends/lean/Base/Primitives/Alloc.lean index 34590499..6c89c6bb 100644 --- a/backends/lean/Base/Primitives/Alloc.lean +++ b/backends/lean/Base/Primitives/Alloc.lean @@ -16,16 +16,16 @@ def deref_mut (T : Type) (x : T) : Result T := ret x def deref_mut_back (T : Type) (_ : T) (x : T) : Result T := ret x /-- Trait instance -/ -def coreOpsDerefInst (Self : Type) : +def coreopsDerefInst (Self : Type) : core.ops.deref.Deref Self := { Target := Self deref := deref Self } /-- Trait instance -/ -def coreOpsDerefMutInst (Self : Type) : +def coreopsDerefMutInst (Self : Type) : core.ops.deref.DerefMut Self := { - derefInst := coreOpsDerefInst Self + derefInst := coreopsDerefInst Self deref_mut := deref_mut Self deref_mut_back := deref_mut_back Self } diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index cfc9a6b2..8bb9a855 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -439,23 +439,14 @@ def core.array.Array.index_mut_back (a : Array T N) (i : I) (x : inst.indexInst.Output) : Result (Array T N) := sorry -- TODO -/- Trait implementation: [core::slice::index::[T]] -/ -def core.slice.index.Slice.coreopsindexIndexInst (T I : Type) - (inst : core.slice.index.SliceIndex I (Slice T)) : - core.ops.index.Index (Slice T) I := { - Output := inst.Output - index := core.slice.index.Slice.index T I inst -} - /- Trait implementation: [core::slice::index::private_slice_index::Range] -/ -def core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst +def core.slice.index.private_slice_index.SealedRangeUsizeInst : core.slice.index.private_slice_index.Sealed (Range Usize) := {} /- Trait implementation: [core::slice::index::Range] -/ -def core.slice.index.Range.coresliceindexSliceIndexInst (T : Type) : +def core.slice.index.SliceIndexRangeUsizeSliceTInst (T : Type) : core.slice.index.SliceIndex (Range Usize) (Slice T) := { - sealedInst := - core.slice.index.private_slice_index.Range.coresliceindexprivate_slice_indexSealedInst + sealedInst := core.slice.index.private_slice_index.SealedRangeUsizeInst Output := Slice T get := core.slice.index.Range.get T get_mut := core.slice.index.Range.get_mut T @@ -468,16 +459,24 @@ def core.slice.index.Range.coresliceindexSliceIndexInst (T : Type) : } /- Trait implementation: [core::slice::index::[T]] -/ -def core.slice.index.Slice.coreopsindexIndexMutInst (T I : Type) +def core.ops.index.IndexSliceTIInst (T I : Type) + (inst : core.slice.index.SliceIndex I (Slice T)) : + core.ops.index.Index (Slice T) I := { + Output := inst.Output + index := core.slice.index.Slice.index T I inst +} + +/- Trait implementation: [core::slice::index::[T]] -/ +def core.ops.index.IndexMutSliceTIInst (T I : Type) (inst : core.slice.index.SliceIndex I (Slice T)) : core.ops.index.IndexMut (Slice T) I := { - indexInst := core.slice.index.Slice.coreopsindexIndexInst T I inst + indexInst := core.ops.index.IndexSliceTIInst T I inst index_mut := core.slice.index.Slice.index_mut T I inst index_mut_back := core.slice.index.Slice.index_mut_back T I inst } /- Trait implementation: [core::array::[T; N]] -/ -def core.array.Array.coreopsindexIndexInst (T I : Type) (N : Usize) +def core.ops.index.IndexArrayIInst (T I : Type) (N : Usize) (inst : core.ops.index.Index (Slice T) I) : core.ops.index.Index (Array T N) I := { Output := inst.Output @@ -485,10 +484,10 @@ def core.array.Array.coreopsindexIndexInst (T I : Type) (N : Usize) } /- Trait implementation: [core::array::[T; N]] -/ -def core.array.Array.coreopsindexIndexMutInst (T I : Type) (N : Usize) +def core.ops.index.IndexMutArrayIInst (T I : Type) (N : Usize) (inst : core.ops.index.IndexMut (Slice T) I) : core.ops.index.IndexMut (Array T N) I := { - indexInst := core.array.Array.coreopsindexIndexInst T I N inst.indexInst + indexInst := core.ops.index.IndexArrayIInst T I N inst.indexInst index_mut := core.array.Array.index_mut T I N inst index_mut_back := core.array.Array.index_mut_back T I N inst } @@ -532,13 +531,13 @@ def core.slice.index.Usize.index_mut_back sorry -- TODO /- Trait implementation: [core::slice::index::private_slice_index::usize] -/ -def core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst +def core.slice.index.private_slice_index.SealedUsizeInst : core.slice.index.private_slice_index.Sealed Usize := {} /- Trait implementation: [core::slice::index::usize] -/ -def core.slice.index.usize.coresliceindexSliceIndexInst (T : Type) : +def core.slice.index.SliceIndexUsizeSliceTInst (T : Type) : core.slice.index.SliceIndex Usize (Slice T) := { - sealedInst := core.slice.index.private_slice_index.usize.coresliceindexprivate_slice_indexSealedInst + sealedInst := core.slice.index.private_slice_index.SealedUsizeInst Output := T get := core.slice.index.Usize.get T get_mut := core.slice.index.Usize.get_mut T diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index bbed6082..e600a151 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -153,19 +153,19 @@ def Vec.coreopsindexIndexMutInst (T I : Type) @[simp] theorem Vec.index_slice_index {α : Type} (v : Vec α) (i : Usize) : - Vec.index α Usize (core.slice.index.usize.coresliceindexSliceIndexInst α) v i = + Vec.index α Usize (core.slice.index.SliceIndexUsizeSliceTInst α) 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_mut α Usize (core.slice.index.SliceIndexUsizeSliceTInst α) 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.index_mut_back α Usize (core.slice.index.SliceIndexUsizeSliceTInst α) v i x = Vec.update_usize v i x := sorry -- cgit v1.3.1 From 1dbdd9e316e690e5c63de2e1923afad520c76e4d Mon Sep 17 00:00:00 2001 From: Son Ho Date: Tue, 21 Nov 2023 10:27:08 +0100 Subject: Update more names --- backends/coq/Primitives.v | 32 +++++++++++++-------------- backends/fstar/Primitives.fst | 32 +++++++++++++-------------- backends/lean/Base/Primitives/ArraySlice.lean | 32 +++++++++++++-------------- compiler/ExtractBuiltin.ml | 13 ++++++----- 4 files changed, 55 insertions(+), 54 deletions(-) (limited to 'backends') diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 846a5e4b..83f860b6 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -620,18 +620,18 @@ Definition core_slice_index_Slice_index end. (* [core::slice::index::Range:::get]: forward function *) -Axiom core_slice_index_Range_get : forall (T : Type) (i : core_ops_range_Range usize) (s : slice T), result (option (slice T)). +Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Range usize) (s : slice T), result (option (slice T)). (* [core::slice::index::Range::get_mut]: forward function *) -Axiom core_slice_index_Range_get_mut : +Axiom core_slice_index_RangeUsize_get_mut : forall (T : Type), core_ops_range_Range usize -> slice T -> result (option (slice T)). (* [core::slice::index::Range::get_mut]: backward function 0 *) -Axiom core_slice_index_Range_get_mut_back : +Axiom core_slice_index_RangeUsize_get_mut_back : forall (T : Type), core_ops_range_Range usize -> slice T -> option (slice T) -> result (slice T). (* [core::slice::index::Range::get_unchecked]: forward function *) -Definition core_slice_index_Range_get_unchecked +Definition core_slice_index_RangeUsize_get_unchecked (T : Type) : core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := (* Don't know what the model should be - for now we always fail to make @@ -639,7 +639,7 @@ Definition core_slice_index_Range_get_unchecked fun _ _ => Fail_ Failure. (* [core::slice::index::Range::get_unchecked_mut]: forward function *) -Definition core_slice_index_Range_get_unchecked_mut +Definition core_slice_index_RangeUsize_get_unchecked_mut (T : Type) : core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := (* Don't know what the model should be - for now we always fail to make @@ -647,15 +647,15 @@ Definition core_slice_index_Range_get_unchecked_mut fun _ _ => Fail_ Failure. (* [core::slice::index::Range::index]: forward function *) -Axiom core_slice_index_Range_index : +Axiom core_slice_index_RangeUsize_index : forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). (* [core::slice::index::Range::index_mut]: forward function *) -Axiom core_slice_index_Range_index_mut : +Axiom core_slice_index_RangeUsize_index_mut : forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). (* [core::slice::index::Range::index_mut]: backward function 0 *) -Axiom core_slice_index_Range_index_mut_back : +Axiom core_slice_index_RangeUsize_index_mut_back : forall (T : Type), core_ops_range_Range usize -> slice T -> slice T -> result (slice T). (* [core::slice::index::[T]::index_mut]: forward function *) @@ -692,14 +692,14 @@ Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_SealedRangeUsizeInst; core_slice_index_SliceIndex_Output := slice T; - core_slice_index_SliceIndex_get := core_slice_index_Range_get T; - core_slice_index_SliceIndex_get_mut := core_slice_index_Range_get_mut T; - core_slice_index_SliceIndex_get_mut_back := core_slice_index_Range_get_mut_back T; - core_slice_index_SliceIndex_get_unchecked := core_slice_index_Range_get_unchecked T; - core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_Range_get_unchecked_mut T; - core_slice_index_SliceIndex_index := core_slice_index_Range_index T; - core_slice_index_SliceIndex_index_mut := core_slice_index_Range_index_mut T; - core_slice_index_SliceIndex_index_mut_back := core_slice_index_Range_index_mut_back T; + core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; + core_slice_index_SliceIndex_get_mut_back := core_slice_index_RangeUsize_get_mut_back T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; + core_slice_index_SliceIndex_index_mut_back := core_slice_index_RangeUsize_index_mut_back T; |}. (* Trait implementation: [core::slice::index::[T]] *) diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 19c4e7a3..94322ead 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -483,23 +483,23 @@ let core_slice_index_Slice_index | Some x -> Return x // [core::slice::index::Range:::get]: forward function -let core_slice_index_Range_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : +let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : result (option (slice t)) = admit () // TODO // [core::slice::index::Range::get_mut]: forward function -let core_slice_index_Range_get_mut +let core_slice_index_RangeUsize_get_mut (t : Type0) : core_ops_range_Range usize → slice t → result (option (slice t)) = admit () // TODO // [core::slice::index::Range::get_mut]: backward function 0 -let core_slice_index_Range_get_mut_back +let core_slice_index_RangeUsize_get_mut_back (t : Type0) : core_ops_range_Range usize → slice t → option (slice t) → result (slice t) = admit () // TODO // [core::slice::index::Range::get_unchecked]: forward function -let core_slice_index_Range_get_unchecked +let core_slice_index_RangeUsize_get_unchecked (t : Type0) : core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = // Don't know what the model should be - for now we always fail to make @@ -507,7 +507,7 @@ let core_slice_index_Range_get_unchecked fun _ _ -> Fail Failure // [core::slice::index::Range::get_unchecked_mut]: forward function -let core_slice_index_Range_get_unchecked_mut +let core_slice_index_RangeUsize_get_unchecked_mut (t : Type0) : core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = // Don't know what the model should be - for now we always fail to make @@ -515,17 +515,17 @@ let core_slice_index_Range_get_unchecked_mut fun _ _ -> Fail Failure // [core::slice::index::Range::index]: forward function -let core_slice_index_Range_index +let core_slice_index_RangeUsize_index (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = admit () // TODO // [core::slice::index::Range::index_mut]: forward function -let core_slice_index_Range_index_mut +let core_slice_index_RangeUsize_index_mut (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = admit () // TODO // [core::slice::index::Range::index_mut]: backward function 0 -let core_slice_index_Range_index_mut_back +let core_slice_index_RangeUsize_index_mut_back (t : Type0) : core_ops_range_Range usize → slice t → slice t → result (slice t) = admit () // TODO @@ -568,14 +568,14 @@ let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; output = slice t; - get = core_slice_index_Range_get t; - get_mut = core_slice_index_Range_get_mut t; - get_mut_back = core_slice_index_Range_get_mut_back t; - get_unchecked = core_slice_index_Range_get_unchecked t; - get_unchecked_mut = core_slice_index_Range_get_unchecked_mut t; - index = core_slice_index_Range_index t; - index_mut = core_slice_index_Range_index_mut t; - index_mut_back = core_slice_index_Range_index_mut_back t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_mut_back = core_slice_index_RangeUsize_get_mut_back t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; + index_mut_back = core_slice_index_RangeUsize_index_mut_back t; } // Trait implementation: [core::slice::index::[T]] diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index 8bb9a855..f68c0846 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -363,23 +363,23 @@ def core.slice.index.Slice.index | some x => ret x /- [core::slice::index::Range:::get]: forward function -/ -def core.slice.index.Range.get (T : Type) (i : Range Usize) (slice : Slice T) : +def core.slice.index.RangeUsize.get (T : Type) (i : Range Usize) (slice : Slice T) : Result (Option (Slice T)) := sorry -- TODO /- [core::slice::index::Range::get_mut]: forward function -/ -def core.slice.index.Range.get_mut +def core.slice.index.RangeUsize.get_mut (T : Type) : Range Usize → Slice T → Result (Option (Slice T)) := sorry -- TODO /- [core::slice::index::Range::get_mut]: backward function 0 -/ -def core.slice.index.Range.get_mut_back +def core.slice.index.RangeUsize.get_mut_back (T : Type) : Range Usize → Slice T → Option (Slice T) → Result (Slice T) := sorry -- TODO /- [core::slice::index::Range::get_unchecked]: forward function -/ -def core.slice.index.Range.get_unchecked +def core.slice.index.RangeUsize.get_unchecked (T : Type) : Range Usize → ConstRawPtr (Slice T) → Result (ConstRawPtr (Slice T)) := -- Don't know what the model should be - for now we always fail to make @@ -387,7 +387,7 @@ def core.slice.index.Range.get_unchecked fun _ _ => fail panic /- [core::slice::index::Range::get_unchecked_mut]: forward function -/ -def core.slice.index.Range.get_unchecked_mut +def core.slice.index.RangeUsize.get_unchecked_mut (T : Type) : Range Usize → MutRawPtr (Slice T) → Result (MutRawPtr (Slice T)) := -- Don't know what the model should be - for now we always fail to make @@ -395,17 +395,17 @@ def core.slice.index.Range.get_unchecked_mut fun _ _ => fail panic /- [core::slice::index::Range::index]: forward function -/ -def core.slice.index.Range.index +def core.slice.index.RangeUsize.index (T : Type) : Range Usize → Slice T → Result (Slice T) := sorry -- TODO /- [core::slice::index::Range::index_mut]: forward function -/ -def core.slice.index.Range.index_mut +def core.slice.index.RangeUsize.index_mut (T : Type) : Range Usize → Slice T → Result (Slice T) := sorry -- TODO /- [core::slice::index::Range::index_mut]: backward function 0 -/ -def core.slice.index.Range.index_mut_back +def core.slice.index.RangeUsize.index_mut_back (T : Type) : Range Usize → Slice T → Slice T → Result (Slice T) := sorry -- TODO @@ -448,14 +448,14 @@ def core.slice.index.SliceIndexRangeUsizeSliceTInst (T : Type) : core.slice.index.SliceIndex (Range Usize) (Slice T) := { sealedInst := core.slice.index.private_slice_index.SealedRangeUsizeInst Output := Slice T - get := core.slice.index.Range.get T - get_mut := core.slice.index.Range.get_mut T - get_mut_back := core.slice.index.Range.get_mut_back T - get_unchecked := core.slice.index.Range.get_unchecked T - get_unchecked_mut := core.slice.index.Range.get_unchecked_mut T - index := core.slice.index.Range.index T - index_mut := core.slice.index.Range.index_mut T - index_mut_back := core.slice.index.Range.index_mut_back T + get := core.slice.index.RangeUsize.get T + get_mut := core.slice.index.RangeUsize.get_mut T + get_mut_back := core.slice.index.RangeUsize.get_mut_back T + get_unchecked := core.slice.index.RangeUsize.get_unchecked T + get_unchecked_mut := core.slice.index.RangeUsize.get_unchecked_mut T + index := core.slice.index.RangeUsize.index T + index_mut := core.slice.index.RangeUsize.index_mut T + index_mut_back := core.slice.index.RangeUsize.index_mut_back T } /- Trait implementation: [core::slice::index::[T]] -/ diff --git a/compiler/ExtractBuiltin.ml b/compiler/ExtractBuiltin.ml index f4f34155..b0a5159f 100644 --- a/compiler/ExtractBuiltin.ml +++ b/compiler/ExtractBuiltin.ml @@ -278,18 +278,19 @@ let builtin_funs () : (pattern * bool list option * builtin_fun_info list) list mk_fun "core::array::{[@T; @C]}::index" None None true false; mk_fun "core::array::{[@T; @C]}::index_mut" None None true false; mk_fun "core::slice::index::{core::ops::range::Range}::get" - (Some "core::slice::index::Range::get") None true false; + (Some "core::slice::index::RangeUsize::get") None true false; mk_fun "core::slice::index::{core::ops::range::Range}::get_mut" - (Some "core::slice::index::Range::get_mut") None true false; + (Some "core::slice::index::RangeUsize::get_mut") None true false; mk_fun "core::slice::index::{core::ops::range::Range}::index" - (Some "core::slice::index::Range::index") None true false; + (Some "core::slice::index::RangeUsize::index") None true false; mk_fun "core::slice::index::{core::ops::range::Range}::index_mut" - (Some "core::slice::index::Range::index_mut") None true false; + (Some "core::slice::index::RangeUsize::index_mut") None true false; mk_fun "core::slice::index::{core::ops::range::Range}::get_unchecked" - (Some "core::slice::index::Range::get_unchecked") None false false; + (Some "core::slice::index::RangeUsize::get_unchecked") None false false; mk_fun "core::slice::index::{core::ops::range::Range}::get_unchecked_mut" - (Some "core::slice::index::Range::get_unchecked_mut") None false false; + (Some "core::slice::index::RangeUsize::get_unchecked_mut") None false + false; mk_fun "core::slice::index::{usize}::get" None None true false; mk_fun "core::slice::index::{usize}::get_mut" None None true false; mk_fun "core::slice::index::{usize}::get_unchecked" None None false false; -- cgit v1.3.1 From dc4b11689131bdb41a43e5aca76538556a3a120c Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 29 Nov 2023 15:45:27 +0100 Subject: Add support for more bitwise operations and update the extraction --- Makefile | 19 ++-- backends/coq/Primitives.v | 76 ++++++++++++++ backends/fstar/Primitives.fst | 167 ++++++++++++++++++++++++++++-- backends/lean/Base/Primitives/Scalar.lean | 42 +++++++- compiler/ExtractBase.ml | 12 +-- compiler/ExtractTypes.ml | 14 ++- 6 files changed, 302 insertions(+), 28 deletions(-) (limited to 'backends') diff --git a/Makefile b/Makefile index 88cb7d05..2cce30d9 100644 --- a/Makefile +++ b/Makefile @@ -91,7 +91,7 @@ tests: test-no_nested_borrows test-paper \ testp-polonius_list testp-betree_main \ ctest-testp-betree_main \ test-loops \ - test-array test-traits # TODO: generalize to all backends + test-array test-traits test-bitwise # Verify the F* files generated by the translation .PHONY: verify @@ -139,14 +139,6 @@ tlean-traits: SUBDIR := tlean-traits: OPTIONS += thol4-traits: OPTIONS += -# TODO: activate the arrays for all the backends -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" - test-loops: OPTIONS += test-loops: SUBDIR := misc tfstar-loops: OPTIONS += -decreases-clauses -template-clauses -split-files @@ -198,6 +190,15 @@ tlean-external: OPTIONS += thol4-external: SUBDIR := misc-external thol4-external: OPTIONS += +test-bitwise: OPTIONS += -test-trans-units +test-bitwise: SUBDIR := misc +tfstar-bitwise: OPTIONS += +tcoq-bitwise: OPTIONS += +tlean-bitwise: SUBDIR := +tlean-bitwise: OPTIONS += +thol4-bitwise: SUBDIR := misc-bitwise +thol4-bitwise: OPTIONS += + BETREE_FSTAR_OPTIONS = -decreases-clauses -template-clauses testp-betree_main: OPTIONS += -backward-no-state-update -test-trans-units -state -split-files testp-betree_main: SUBDIR:=betree diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 83f860b6..99ffe070 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -255,6 +255,12 @@ Definition scalar_rem {ty} (x y: scalar ty) : result (scalar ty) := mk_scalar ty Definition scalar_neg {ty} (x: scalar ty) : result (scalar ty) := mk_scalar ty (-(to_Z x)). +Axiom scalar_xor : forall ty, scalar ty -> scalar ty -> scalar ty. (* TODO *) +Axiom scalar_or : forall ty, scalar ty -> scalar ty -> scalar ty. (* TODO *) +Axiom scalar_and : forall ty, scalar ty -> scalar ty -> scalar ty. (* TODO *) +Axiom scalar_shl : forall ty0 ty1, scalar ty0 -> scalar ty1 -> result (scalar ty0). (* TODO *) +Axiom scalar_shr : forall ty0 ty1, scalar ty0 -> scalar ty1 -> result (scalar ty0). (* TODO *) + (** Cast an integer from a [src_ty] to a [tgt_ty] *) (* TODO: check the semantics of casts in Rust *) Definition scalar_cast (src_ty tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) := @@ -372,6 +378,76 @@ Definition u32_mul := @scalar_mul U32. Definition u64_mul := @scalar_mul U64. Definition u128_mul := @scalar_mul U128. +(** Xor *) +Definition u8_xor := @scalar_xor U8. +Definition u16_xor := @scalar_xor U16. +Definition u32_xor := @scalar_xor U32. +Definition u64_xor := @scalar_xor U64. +Definition u128_xor := @scalar_xor U128. +Definition usize_xor := @scalar_xor Usize. +Definition i8_xor := @scalar_xor I8. +Definition i16_xor := @scalar_xor I16. +Definition i32_xor := @scalar_xor I32. +Definition i64_xor := @scalar_xor I64. +Definition i128_xor := @scalar_xor I128. +Definition isize_xor := @scalar_xor Isize. + +(** Or *) +Definition u8_or := @scalar_or U8. +Definition u16_or := @scalar_or U16. +Definition u32_or := @scalar_or U32. +Definition u64_or := @scalar_or U64. +Definition u128_or := @scalar_or U128. +Definition usize_or := @scalar_or Usize. +Definition i8_or := @scalar_or I8. +Definition i16_or := @scalar_or I16. +Definition i32_or := @scalar_or I32. +Definition i64_or := @scalar_or I64. +Definition i128_or := @scalar_or I128. +Definition isize_or := @scalar_or Isize. + +(** And *) +Definition u8_and := @scalar_and U8. +Definition u16_and := @scalar_and U16. +Definition u32_and := @scalar_and U32. +Definition u64_and := @scalar_and U64. +Definition u128_and := @scalar_and U128. +Definition usize_and := @scalar_and Usize. +Definition i8_and := @scalar_and I8. +Definition i16_and := @scalar_and I16. +Definition i32_and := @scalar_and I32. +Definition i64_and := @scalar_and I64. +Definition i128_and := @scalar_and I128. +Definition isize_and := @scalar_and Isize. + +(** Shift left *) +Definition u8_shl {ty} := @scalar_shl U8 ty. +Definition u16_shl {ty} := @scalar_shl U16 ty. +Definition u32_shl {ty} := @scalar_shl U32 ty. +Definition u64_shl {ty} := @scalar_shl U64 ty. +Definition u128_shl {ty} := @scalar_shl U128 ty. +Definition usize_shl {ty} := @scalar_shl Usize ty. +Definition i8_shl {ty} := @scalar_shl I8 ty. +Definition i16_shl {ty} := @scalar_shl I16 ty. +Definition i32_shl {ty} := @scalar_shl I32 ty. +Definition i64_shl {ty} := @scalar_shl I64 ty. +Definition i128_shl {ty} := @scalar_shl I128 ty. +Definition isize_shl {ty} := @scalar_shl Isize ty. + +(** Shift right *) +Definition u8_shr {ty} := @scalar_shr U8 ty. +Definition u16_shr {ty} := @scalar_shr U16 ty. +Definition u32_shr {ty} := @scalar_shr U32 ty. +Definition u64_shr {ty} := @scalar_shr U64 ty. +Definition u128_shr {ty} := @scalar_shr U128 ty. +Definition usize_shr {ty} := @scalar_shr Usize ty. +Definition i8_shr {ty} := @scalar_shr I8 ty. +Definition i16_shr {ty} := @scalar_shr I16 ty. +Definition i32_shr {ty} := @scalar_shr I32 ty. +Definition i64_shr {ty} := @scalar_shr I64 ty. +Definition i128_shr {ty} := @scalar_shr I128 ty. +Definition isize_shr {ty} := @scalar_shr Isize ty. + (** Small utility *) Definition usize_to_nat (x: usize) : nat := Z.to_nat (to_Z x). diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index 94322ead..dd340c00 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -65,6 +65,10 @@ type const_raw_ptr (t : Type0) = { v : t } (*** Scalars *) /// Rem.: most of the following code was partially generated +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + let isize_min : int = -9223372036854775808 // TODO: should be opaque let isize_max : int = 9223372036854775807 // TODO: should be opaque let i8_min : int = -128 @@ -108,7 +112,6 @@ let is_unsigned = function | Isize | I8 | I16 | I32 | I64 | I128 -> false | Usize | U8 | U16 | U32 | U64 | U128 -> true - let scalar_min (ty : scalar_ty) : int = match ty with | Isize -> isize_min @@ -171,7 +174,7 @@ let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scala let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = mk_scalar ty (x * y) -let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) +let scalar_xor (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : scalar ty = match ty with | U8 -> FStar.UInt.logxor #8 x y @@ -179,6 +182,91 @@ let scalar_lxor (#ty : scalar_ty { is_unsigned ty && ty <> Usize }) | U32 -> FStar.UInt.logxor #32 x y | U64 -> FStar.UInt.logxor #64 x y | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() (** Cast an integer from a [src_ty] to a [tgt_ty] *) // TODO: check the semantics of casts in Rust @@ -304,12 +392,75 @@ let u32_mul = scalar_mul #U32 let u64_mul = scalar_mul #U64 let u128_mul = scalar_mul #U128 -/// Logical operators, defined for unsigned types only, so far -let u8_xor = scalar_lxor #U8 -let u16_xor = scalar_lxor #U16 -let u32_xor = scalar_lxor #U32 -let u64_xor = scalar_lxor #U64 -let u128_xor = scalar_lxor #U128 +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty (*** core::ops *) diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean index ec9665a5..cdd6d6f9 100644 --- a/backends/lean/Base/Primitives/Scalar.lean +++ b/backends/lean/Base/Primitives/Scalar.lean @@ -386,10 +386,28 @@ def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (x.val * y.val) --- TODO: instances of +, -, * etc. for scalars +-- TODO: shift left +def Scalar.shiftl {ty0 ty1 : ScalarTy} (x : Scalar ty0) (y : Scalar ty1) : Result (Scalar ty0) := + sorry + +-- TODO: shift right +def Scalar.shiftr {ty0 ty1 : ScalarTy} (x : Scalar ty0) (y : Scalar ty1) : Result (Scalar ty0) := + sorry + +-- TODO: xor +def Scalar.xor {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Scalar ty := + sorry + +-- TODO: and +def Scalar.and {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Scalar ty := + sorry + +-- TODO: or +def Scalar.or {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Scalar ty := + sorry -- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust +-- TODO: double-check the semantics of casts in Rust def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := Scalar.tryMk tgt_ty x.val @@ -486,6 +504,26 @@ instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where hMod x y := Scalar.rem x y +-- Shift left +instance {ty0 ty1} : HShiftLeft (Scalar ty0) (Scalar ty1) (Result (Scalar ty0)) where + hShiftLeft x y := Scalar.shiftl x y + +-- Shift right +instance {ty0 ty1} : HShiftRight (Scalar ty0) (Scalar ty1) (Result (Scalar ty0)) where + hShiftRight x y := Scalar.shiftr x y + +-- Xor +instance {ty} : HXor (Scalar ty) (Scalar ty) (Scalar ty) where + hXor x y := Scalar.xor x y + +-- Or +instance {ty} : HOr (Scalar ty) (Scalar ty) (Scalar ty) where + hOr x y := Scalar.or x y + +-- And +instance {ty} : HAnd (Scalar ty) (Scalar ty) (Scalar ty) where + hAnd x y := Scalar.and x y + -- Generic theorem - shouldn't be used much @[cpspec] theorem Scalar.add_spec {ty} {x y : Scalar ty} diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 85ab1112..73ccac44 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -786,7 +786,7 @@ let unop_name (unop : unop) : string = like [<]). *) let named_binop_name (binop : E.binop) (int_ty : integer_type) : string = - let binop = + let binop_s = match binop with | Div -> "div" | Rem -> "rem" @@ -800,16 +800,14 @@ let named_binop_name (binop : E.binop) (int_ty : integer_type) : string = | BitXor -> "xor" | BitAnd -> "and" | BitOr -> "or" - | Shl -> "lsl" - | Shr -> - "asr" - (* NOTE: make sure arithmetic shift right is implemented, i.e. OCaml's asr operator, not lsr *) + | Shl -> "shl" + | Shr -> "shr" | _ -> raise (Failure "Unreachable") in (* Remark: the Lean case is actually not used *) match !backend with - | Lean -> int_name int_ty ^ "." ^ binop - | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop + | Lean -> int_name int_ty ^ "." ^ binop_s + | FStar | Coq | HOL4 -> int_name int_ty ^ "_" ^ binop_s (** A list of keywords/identifiers used by the backend and with which we want to check collision. diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index f61c28e4..66418410 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -163,7 +163,7 @@ let extract_binop (extract_expr : bool -> texpression -> unit) (match (!backend, binop) with | HOL4, (Eq | Ne) | (FStar | Coq | Lean), (Eq | Lt | Le | Ne | Ge | Gt) - | Lean, (Div | Rem | Add | Sub | Mul) -> + | Lean, (Div | Rem | Add | Sub | Mul | Shl | Shr | BitXor | BitOr | BitAnd) -> let binop = match binop with | Eq -> "=" @@ -179,7 +179,9 @@ let extract_binop (extract_expr : bool -> texpression -> unit) | Mul -> "*" | Shl -> "<<<" | Shr -> ">>>" - | BitXor | BitAnd | BitOr -> raise (Failure "Unimplemented") + | BitXor -> "^^^" + | BitOr -> "|||" + | BitAnd -> "&&&" in let binop = match !backend with FStar | Lean | HOL4 -> binop | Coq -> "s" ^ binop @@ -192,6 +194,14 @@ let extract_binop (extract_expr : bool -> texpression -> unit) | _ -> let binop = named_binop_name binop int_ty in F.pp_print_string fmt binop; + (* In the case of F*, because machine integers are simply integers + with a refinement, if the second argument is a constant we + need to provide the second implicit type argument *) + if !backend = FStar && is_const arg1 then ( + F.pp_print_space fmt (); + let ty = ty_as_integer arg1.ty in + F.pp_print_string fmt + ("#" ^ StringUtils.capitalize_first_letter (int_name ty))); F.pp_print_space fmt (); extract_expr true arg0; F.pp_print_space fmt (); -- cgit v1.3.1