summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/CfimOfJson.ml87
-rw-r--r--src/Scalars.ml110
2 files changed, 158 insertions, 39 deletions
diff --git a/src/CfimOfJson.ml b/src/CfimOfJson.ml
index cc7b5603..0b9caebc 100644
--- a/src/CfimOfJson.ml
+++ b/src/CfimOfJson.ml
@@ -12,6 +12,7 @@ open Yojson.Basic
open Identifiers
open Types
open OfJsonBasic
+open Scalars
let name_of_json (js : json) : (name, string) result =
combine_error_msgs js "name_of_json" (list_of_json string_of_json js)
@@ -190,46 +191,54 @@ let big_int_of_json (js : json) : (big_int, string) result =
| `String is -> Ok (Z.of_string is)
| _ -> Error "")
+(** Deserialize a [scalar_value] from JSON and **check the ranges** *)
let scalar_value_of_json (js : json) : (scalar_value, string) result =
- combine_error_msgs js "scalar_value_of_json"
- (match js with
- | `Assoc [ ("Isize", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (Isize bi)
- | `Assoc [ ("I8", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (I8 bi)
- | `Assoc [ ("I16", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (I16 bi)
- | `Assoc [ ("I32", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (I32 bi)
- | `Assoc [ ("I64", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (I64 bi)
- | `Assoc [ ("I128", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (I128 bi)
- | `Assoc [ ("Usize", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (Usize bi)
- | `Assoc [ ("U8", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (U8 bi)
- | `Assoc [ ("U16", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (U16 bi)
- | `Assoc [ ("U32", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (U32 bi)
- | `Assoc [ ("U64", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (U64 bi)
- | `Assoc [ ("U128", bi) ] ->
- let* bi = big_int_of_json bi in
- Ok (U128 bi)
- | _ -> Error "")
+ let res =
+ combine_error_msgs js "scalar_value_of_json"
+ (match js with
+ | `Assoc [ ("Isize", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (Isize bi)
+ | `Assoc [ ("I8", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (I8 bi)
+ | `Assoc [ ("I16", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (I16 bi)
+ | `Assoc [ ("I32", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (I32 bi)
+ | `Assoc [ ("I64", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (I64 bi)
+ | `Assoc [ ("I128", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (I128 bi)
+ | `Assoc [ ("Usize", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (Usize bi)
+ | `Assoc [ ("U8", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (U8 bi)
+ | `Assoc [ ("U16", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (U16 bi)
+ | `Assoc [ ("U32", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (U32 bi)
+ | `Assoc [ ("U64", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (U64 bi)
+ | `Assoc [ ("U128", bi) ] ->
+ let* bi = big_int_of_json bi in
+ Ok (U128 bi)
+ | _ -> Error "")
+ in
+ match res with
+ | Error _ -> res
+ | Ok sv ->
+ assert (check_scalar_value_in_range sv);
+ res
let constant_value_of_json (js : json) : (constant_value, string) result =
combine_error_msgs js "constant_value_of_json"
diff --git a/src/Scalars.ml b/src/Scalars.ml
new file mode 100644
index 00000000..29c2779f
--- /dev/null
+++ b/src/Scalars.ml
@@ -0,0 +1,110 @@
+open Types
+open Values
+
+(** The minimum/maximum values an integer type can have depending on its type *)
+
+let i8_min = Z.of_string "-128"
+
+let i8_max = Z.of_string "127"
+
+let i16_min = Z.of_string "-32768"
+
+let i16_max = Z.of_string "32767"
+
+let i32_min = Z.of_string "-2147483648"
+
+let i32_max = Z.of_string "2147483647"
+
+let i64_min = Z.of_string "-9223372036854775808"
+
+let i64_max = Z.of_string "9223372036854775807"
+
+let i128_min = Z.of_string "-170141183460469231731687303715884105728"
+
+let i128_max = Z.of_string "170141183460469231731687303715884105727"
+
+let u8_min = Z.of_string "0"
+
+let u8_max = Z.of_string "255"
+
+let u16_min = Z.of_string "0"
+
+let u16_max = Z.of_string "65535"
+
+let u32_min = Z.of_string "0"
+
+let u32_max = Z.of_string "4294967295"
+
+let u64_min = Z.of_string "0"
+
+let u64_max = Z.of_string "18446744073709551615"
+
+let u128_min = Z.of_string "0"
+
+let u128_max = Z.of_string "340282366920938463463374607431768211455"
+
+(** Being a bit conservative about isize/usize: depending on the system,
+ the values are encoded as 32-bit values or 64-bit values - we may
+ want to take that into account in the future *)
+
+let isize_min = i32_min
+
+let isize_max = i32_max
+
+let usize_min = u32_min
+
+let usize_max = u32_max
+
+(** Return the integer value in a scalar value *)
+let scalar_value_get_value (v : scalar_value) : big_int =
+ match v with
+ | Isize i -> i
+ | I8 i -> i
+ | I16 i -> i
+ | I32 i -> i
+ | I64 i -> i
+ | I128 i -> i
+ | Usize i -> i
+ | U8 i -> i
+ | U16 i -> i
+ | U32 i -> i
+ | U64 i -> i
+ | U128 i -> i
+
+(** Retrieve the [integer_type] of a scalar value *)
+let scalar_value_get_integer_type (sv : scalar_value) : integer_type =
+ match sv with
+ | Isize _ -> Types.Isize
+ | I8 _ -> Types.I8
+ | I16 _ -> Types.I16
+ | I32 _ -> Types.I32
+ | I64 _ -> Types.I64
+ | I128 _ -> Types.I128
+ | Usize _ -> Types.Usize
+ | U8 _ -> Types.U8
+ | U16 _ -> Types.U16
+ | U32 _ -> Types.U32
+ | U64 _ -> Types.U64
+ | U128 _ -> Types.U128
+
+(** Check that an integer value is in range *)
+let check_int_in_range (int_ty : integer_type) (i : big_int) : bool =
+ match int_ty with
+ | Isize -> Z.leq isize_min i && Z.leq i isize_max
+ | I8 -> Z.leq i8_min i && Z.leq i i8_max
+ | I16 -> Z.leq i16_min i && Z.leq i i16_max
+ | I32 -> Z.leq i32_min i && Z.leq i i32_max
+ | I64 -> Z.leq i64_min i && Z.leq i i64_max
+ | I128 -> Z.leq i128_min i && Z.leq i i128_max
+ | Usize -> Z.leq usize_min i && Z.leq i usize_max
+ | U8 -> Z.leq u8_min i && Z.leq i u8_max
+ | U16 -> Z.leq u16_min i && Z.leq i u16_max
+ | U32 -> Z.leq u32_min i && Z.leq i u32_max
+ | U64 -> Z.leq u64_min i && Z.leq i u64_max
+ | U128 -> Z.leq u128_min i && Z.leq i u128_max
+
+(** Check that a scalar value is correct (the integer value it contains is in range) *)
+let check_scalar_value_in_range (v : scalar_value) : bool =
+ let i = scalar_value_get_value v in
+ let int_ty = scalar_value_get_integer_type v in
+ check_int_in_range int_ty i
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 20:40:51 +0000