summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--fstar/Assumed.fst107
-rw-r--r--fstar/Primitives.fst205
-rw-r--r--rust-tests/src/main.rs19
-rw-r--r--src/ExtractToFStar.ml28
4 files changed, 241 insertions, 118 deletions
diff --git a/fstar/Assumed.fst b/fstar/Assumed.fst
deleted file mode 100644
index 584606ea..00000000
--- a/fstar/Assumed.fst
+++ /dev/null
@@ -1,107 +0,0 @@
-/// This file lists primitive and assumed functions and types, referenced by the
-/// extraction mechanism.
-module Assumed
-open FStar.Mul
-
-#set-options "--z3rlimit 50 --fuel 0 --ifuel 1"
-
-/// Result type
-type result (a : Type0) : Type0 =
-| Return : a -> result a
-| Fail : result a
-
-let isize_min : int = -9223372036854775808
-let isize_max : int = 9223372036854775807
-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 = 18446744073709551615
-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) : Type0 = 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
-
-let g_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x)
-
-// TODO: remove
-(*let g_lt (x : int) (y : int) = x <= y *)
-
-let g_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) =
- if y <> 0 then mk_scalar ty (x / y) else Fail
-
-(* TODO:
-let g_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) =
- if y <> 0 then mk_scalar ty (x / y) else Fail
-*)
-
-let g_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) =
- mk_scalar ty (x + y)
-
-let g_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) =
- mk_scalar ty (x - y)
-
-let g_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) =
- mk_scalar ty (x * y)
diff --git a/fstar/Primitives.fst b/fstar/Primitives.fst
new file mode 100644
index 00000000..1b3972cc
--- /dev/null
+++ b/fstar/Primitives.fst
@@ -0,0 +1,205 @@
+/// This file lists primitive and assumed functions and types
+module Primitives
+open FStar.Mul
+
+#set-options "--z3rlimit 50 --fuel 0 --ifuel 1"
+
+(*** Result *)
+type result (a : Type0) : Type0 =
+| Return : a -> result a
+| Fail : result a
+
+(*** Scalars *)
+/// Rk.: most of the following code was at least partially generated
+let isize_min : int = -9223372036854775808
+let isize_max : int = 9223372036854775807
+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 = 18446744073709551615
+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) : Type0 = 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
+
+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
+
+/// 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
+
+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)
+
+/// The scalar types
+type isize = scalar Isize
+type i8 = scalar I8
+type i16 = scalar I16
+type i32 = scalar I32
+type i64 = scalar I64
+type i128 = scalar I128
+type usize = scalar Usize
+type u8 = scalar U8
+type u16 = scalar U16
+type u32 = scalar U32
+type u64 = scalar U64
+type u128 = scalar U128
+
+/// 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
diff --git a/rust-tests/src/main.rs b/rust-tests/src/main.rs
index 180ecdd6..125b0d76 100644
--- a/rust-tests/src/main.rs
+++ b/rust-tests/src/main.rs
@@ -13,6 +13,8 @@ fn main() {
"Isize", "I8", "I16", "I32", "I64", "I128", "Usize", "U8", "U16", "U32", "U64", "U128",
];
+ let can_fail_binops_lower = ["div", "rem", "add", "sub", "mul"];
+
let mut ints_pairs = vec![];
for i in 0..ints_lower.len() {
ints_pairs.push((&ints_lower[i], &ints_upper[i]));
@@ -124,8 +126,25 @@ fn main() {
}
println!("\n");
+ // Generate the scalar types for F*
+ for (lo, up) in &ints_pairs {
+ println!("type {} = scalar {}", lo, up);
+ }
+ println!("\n");
+
+ // Generate the unops (rk.: we need to manually filter `-` applied on
+ // unisgned numbers)
+ for binop in &can_fail_binops_lower {
+ for (lo, up) in &ints_pairs {
+ println!("let {}_{} = scalar_{} #{}", lo, binop, binop, up);
+ }
+ println!("");
+ }
+ println!("\n");
+
// Modulo tests
test_modulo(1, 2);
test_modulo(-1, 2);
+ test_modulo(1, -2);
test_modulo(-1, -2);
}
diff --git a/src/ExtractToFStar.ml b/src/ExtractToFStar.ml
index 3a5d2c7a..3ca003a4 100644
--- a/src/ExtractToFStar.ml
+++ b/src/ExtractToFStar.ml
@@ -92,34 +92,40 @@ let fstar_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 treatment *)
(match binop with
- | Eq ->
+ | Eq | Lt | Le | Ne | Ge | Gt ->
+ let binop =
+ match binop with
+ | Eq -> "="
+ | Lt -> "<"
+ | Le -> "<="
+ | Ne -> "<>"
+ | Ge -> ">="
+ | Gt -> ">"
+ | _ -> failwith "Unreachable"
+ in
extract_expr false arg0;
F.pp_print_space fmt ();
- F.pp_print_string fmt "=";
+ F.pp_print_string fmt binop;
F.pp_print_space fmt ();
extract_expr false arg1
- | _ ->
+ | Div | Rem | Add | Sub | Mul ->
let binop =
match binop with
- | Eq -> failwith "Unreachable"
- | Lt -> "lt"
- | Le -> "le"
- | Ne -> "ne"
- | Ge -> "ge"
- | Gt -> "gt"
| Div -> "div"
| Rem -> "rem"
| Add -> "add"
| Sub -> "sub"
| Mul -> "mul"
- | BitXor | BitAnd | BitOr | Shl | Shr -> raise Unimplemented
+ | _ -> failwith "Unreachable"
in
F.pp_print_string fmt (fstar_int_name int_ty ^ "_" ^ binop);
F.pp_print_space fmt ();
extract_expr false arg0;
F.pp_print_space fmt ();
- extract_expr false arg1);
+ extract_expr false arg1
+ | BitXor | BitAnd | BitOr | Shl | Shr -> raise Unimplemented);
if inside then F.pp_print_string fmt ")"
(**
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:56:18 +0000