X-Git-Url: https://scm.cri.minesparis.psl.eu/git/Faustine.git/blobdiff_plain/f3ad8b46ca1621f4a90db91ed6f9c1eceac96c4c..a186a0b2f3c996e9f17dd96e9f548e81f6447fe0:/interpretor/basic.ml?ds=sidebyside
diff --git a/interpretor/basic.ml b/interpretor/basic.ml
index ae096af..ef8a0fd 100644
--- a/interpretor/basic.ml
+++ b/interpretor/basic.ml
@@ -6,6 +6,7 @@
*)
open Types;;
+open Aux;;
exception Convert_Error of string;;
exception Basic_operation of string;;
@@ -111,6 +112,16 @@ let rec basic_of_float_array : float array -> basic =
let vec = Array.get (Array.map basic_of_float data) in
Vec (new vector n vec);;
+let basic_to_bool : basic -> bool =
+ fun b ->
+ match b with
+ | N i ->
+ if i = 1 then true
+ else if i = 0 then false
+ else raise (Convert_Error "basic_to_bool : only for 0 or 1.")
+ | Zero -> false
+ | _ -> raise (Convert_Error "basic_to_bool : only for 0 or 1.");;
+
(* VALUE OPERATIONS *)
let rec basic_normalize : basic -> basic =
@@ -259,9 +270,83 @@ let rec basic_zero : basic -> basic =
|Error -> R 0.;;
-let rec basic_floor : basic -> basic =
- fun v ->
- match v with
+let rec basic_power : basic -> basic -> basic =
+ fun b1 ->
+ fun b2 ->
+ match (b1, b2) with
+ | (Vec vec1, Vec vec2) ->
+ if vec1#size = vec2#size then
+ Vec (new vector vec1#size
+ (fun_binary basic_power vec1#nth vec2#nth))
+ else raise (Basic_operation "vector size not matched.")
+ | (Vec vec1, Zero) ->
+ let vec_zeros = Vec (new vector vec1#size (fun i -> Zero)) in
+ basic_power b1 vec_zeros
+ | (Vec vec1, _) -> raise (Basic_operation "vec1 *~ sca2")
+
+ | (N i1, _) -> basic_power (R (float_of_int i1)) b2
+
+ | (R f1, N i2) -> basic_power b1 (R (float_of_int i2))
+ | (R f1, R f2) -> basic_normalize (R (f1 ** f2))
+ | (R f1, Vec vec2) -> raise (Basic_operation "f1 *~ vec2")
+ | (R f1, Zero) -> R 1.
+ | (R f1, Error) -> Error
+
+ | (Zero, N i2) -> basic_power b1 (R (float_of_int i2))
+ | (Zero, R f2) -> R 0.
+ | (Zero, Vec vec2) ->
+ let vec_zeros = Vec (new vector vec2#size (fun i -> Zero)) in
+ basic_power vec_zeros b2
+ | (Zero, Zero) -> basic_power (R 0.) (R 0.)
+ | (Zero, Error) -> Error
+
+ | (Error, Vec vec2) -> raise (Basic_operation "Error +~ vec2")
+ | (Error, _) -> Error;;
+
+
+let rec basic_logic :
+ (bool -> bool -> bool) -> basic -> basic -> basic =
+ fun oper -> fun b1 -> fun b2 ->
+ match (b1, b2) with
+ | (Vec vec1, Vec vec2) ->
+ if vec1#size = vec2#size then
+ Vec (new vector vec1#size
+ (fun_binary (basic_logic oper) vec1#nth vec2#nth))
+ else raise (Basic_operation "vector size not matched.")
+ | (Vec vec1, Zero) ->
+ let vec_zeros = Vec (new vector vec1#size (fun i -> Zero)) in
+ basic_and b1 vec_zeros
+ | (Vec vec1, _) -> raise (Basic_operation "vec1 logic sca2")
+
+ | (N i1, N i2) -> oper (basic_to_bool b1) (basic_to_bool b2)
+ | (N i1, R f2) ->
+ raise (Basic_operation "Float shouldn't be in logical oper.")
+ | (N i1, Vec vec2) -> raise (Basic_operation "f1 logic vec2")
+ | (N i1, Zero) -> basic_logic oper b1 (N 0)
+ | (N i1, Error) -> Error
+
+ | (R f1, _) ->
+ raise (Basic_operation "Float shouldn't be in logical oper.")
+
+ | (Zero, N i2) -> basic_logic oper (N 0) b2
+ | (Zero, R f2) ->
+ raise (Basic_operation "Float shouldn't be in logical oper.")
+ | (Zero, Vec vec2) ->
+ let vec_zeros = Vec (new vector vec2#size (fun i -> Zero)) in
+ basic_logic oper vec_zeros b2
+ | (Zero, Zero) -> basic_logic oper (N 0) (N 0)
+ | (Zero, Error) -> Error
+
+ | (Error, Vec vec2) -> raise (Basic_operation "Error logic vec2")
+ | (Error, _) -> Error;;
+
+let basic_and = basic_logic (&&);;
+let basic_or = basic_logic (||);;
+let basic_xor = basic_logic xor;;
+
+let rec basic_adjust : (float -> float) -> basic -> basic =
+ fun oper -> fun b ->
+ match b with
|N i -> R (float_of_int i)
|R f -> R (floor f)
|Vec vec -> Vec (new vector vec#size
@@ -269,17 +354,30 @@ let rec basic_floor : basic -> basic =
|Zero -> R 0.
|Error -> Error;;
+let basic_floor = basic_adjust floor;;
+let basic_ceil = basic_adjust ceil;;
+let basic_rint = basic_adjust rint;;
let rec basic_int : basic -> basic =
- fun v ->
- match v with
- |N i -> v
+ fun b ->
+ match b with
+ |N i -> b
|R f -> N (int_of_float f)
|Vec vec -> Vec (new vector vec#size
(fun_unary basic_int vec#nth))
|Zero -> N 0
|Error -> Error;;
+let rec basic_float : basic -> basic =
+ fun b ->
+ match b with
+ | N i -> R (float_of_int i)
+ | R f -> b
+ | Vec vec -> Vec (new vector vec#size
+ (fun_unary basic_float vec#nth))
+ | Zero -> R 0.
+ | Error -> Error;;
+
let rec basic_unary : (float -> float) -> basic -> basic =
fun oper ->
@@ -349,26 +447,53 @@ let rec basic_mod : basic -> basic -> basic =
fun b2 ->
match (b1, b2) with
| (N i1, N i2) -> N (i1 mod i2)
- | (N i1, R f2) -> basic_mod b1 (N (int_of_float f2))
+ | (_, R f2) ->
+ raise (Basic_operation "b1 mod b2: b2 cannot be float.")
+ | (R f1, _) ->
+ raise (Basic_operation "b1 mod b2: b1 cannot be float.")
| (N i1, Vec vec2) ->
- raise (Basic_operation "Scalaire_Vector: int mod vec.")
+ raise (Basic_operation "Scalar_Vector: sca mod vec.")
| (_, Zero) ->
raise (Basic_operation "b1 mod b2: b2 cannot be zero.")
| (N i1, Error) -> Error
-
- | (R f1, _) -> basic_mod (N (int_of_float f1)) b2
-
| (Vec vec1, Vec vec2) ->
if vec1#size = vec2#size then
- Vec (new vector vec1#size (fun_binary basic_mod vec1#nth vec2#nth))
+ Vec (new vector vec1#size
+ (fun_binary basic_mod vec1#nth vec2#nth))
else raise (Basic_operation "vector size not matched.")
| (Vec vec1, _) ->
- raise (Basic_operation "Vector_Scalaire: vec mod int.")
-
+ raise (Basic_operation "Vector_Scalar: vec mod sca.")
| (Zero, Vec vec2) ->
basic_mod (Vec (new vector vec2#size (fun i -> Zero))) b2
| (Zero, _) -> basic_mod (N 0) b2
+ | (Error, Vec vec2) ->
+ raise (Basic_operation "Scalar_Vector: sca mod vec.")
+ | (Error, _) -> Error;;
+let rec basic_fmod : basic -> basic -> basic =
+ fun b1 ->
+ fun b2 ->
+ match (b1, b2) with
+ | (R f1, R f2) -> R (mod_float f1 f2)
+ | (_, N i2) ->
+ raise (Basic_operation "b1 fmod b2: b2 cannot be int.")
+ | (N i1, _) ->
+ raise (Basic_operation "b1 fmod b2: b1 cannot be int.")
+ | (R f1, Vec vec2) ->
+ raise (Basic_operation "Scalar_Vector: sca fmod vec.")
+ | (_, Zero) ->
+ raise (Basic_operation "b1 fmod b2: b2 cannot be zero.")
+ | (R f1, Error) -> Error
+ | (Vec vec1, Vec vec2) ->
+ if vec1#size = vec2#size then
+ Vec (new vector vec1#size
+ (fun_binary basic_fmod vec1#nth vec2#nth))
+ else raise (Basic_operation "vector size not matched.")
+ | (Vec vec1, _) ->
+ raise (Basic_operation "Vector_Scalaire: vec fmod sca.")
+ | (Zero, Vec vec2) ->
+ basic_fmod (Vec (new vector vec2#size (fun i -> Zero))) b2
+ | (Zero, _) -> basic_mod (N 0) b2
| (Error, Vec vec2) ->
raise (Basic_operation "Scalaire_Vector: int mod vec.")
| (Error, _) -> Error;;