X-Git-Url: https://scm.cri.ensmp.fr/git/Faustine.git/blobdiff_plain/9fdfd04e29fcefdb9120a4d9467827ceaf8dfaa0..42d607127a467ca737dd903ad007d50a54533cf0:/interpretor/basic.ml

diff --git a/interpretor/basic.ml b/interpretor/basic.ml
index cc01071..1295390 100644
--- a/interpretor/basic.ml
+++ b/interpretor/basic.ml
@@ -278,23 +278,56 @@ let rec basic_power : basic -> basic -> basic =
       |	(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")
+      |	(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, Vec vec2) -> raise (Basic_operation "f1 ** vec2")
+      |	(R f1, Zero) -> basic_power b1 (R 0.)
       |	(R f1, Error) -> Error
       |	(Zero, N i2) -> basic_power b1 (R (float_of_int i2))
-      |	(Zero, R f2) -> R 0.
+      |	(Zero, R f2) -> basic_power (R 0.) b2
       |	(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, Vec vec2) -> raise (Basic_operation "Error ** vec2")
       |	(Error, _) -> Error;;
 
+let rec basic_shift : (int -> int -> int) -> 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_shift 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_shift oper b1 vec_zeros
+    | (Vec vec1, _) -> raise (Basic_operation "vec1 shift sca2")
+    | (N i1, N i2) -> basic_normalize (N (oper i1 i2))
+    | (N i1, Vec vec2) -> raise (Basic_operation "sca1 shift vec2")
+    | (N i1, Zero) -> basic_shift oper b1 (N 0)
+    | (N i1, R f2) -> 
+	raise (Basic_operation "Logical shift doesn't accept float.")
+    | (N i1, Error) -> Error
+    | (R f1, _) -> 
+	raise (Basic_operation "Logical shift doesn't accept float.")
+    | (Zero, N i2) -> basic_shift oper (N 0) b2
+    | (Zero, R f2) -> 
+	raise (Basic_operation "Logical shift doesn't accept float.")
+    | (Zero, Vec vec2) -> 
+	let vec_zeros = Vec (new vector vec2#size (fun i -> Zero)) in
+	basic_shift oper vec_zeros b2
+    | (Zero, Zero) -> basic_shift oper (N 0) (N 0)
+    | (Zero, Error) -> Error
+    | (Error, Vec vec2) -> raise (Basic_operation "sca1 shift vec2")
+    | (Error, _) -> Error;;
+
+let basic_shl = basic_shift (lsl);;
+let basic_shr = basic_shift (lsr);;	
 
 let rec basic_logic : 
     (bool -> bool -> bool) -> basic -> basic -> basic =