X-Git-Url: https://scm.cri.mines-paristech.fr/git/Faustine.git/blobdiff_plain/e1705e136ab823be2e76e63728db1a5359d5d443..fc2ec49c325b99370170789886b4be4f43e16d68:/interpretor/basic.ml?ds=inline

diff --git a/interpretor/basic.ml b/interpretor/basic.ml
index cda0c6b..ae096af 100644
--- a/interpretor/basic.ml
+++ b/interpretor/basic.ml
@@ -28,17 +28,17 @@ let fun_ternary oper f g h = fun x -> oper (f x) (g x) (h x);;
 let memorize : int -> (index -> basic) -> (index -> basic) = 
   fun size ->
     fun vec ->
-      let memory_array = Array.create size Error in
-      let index_array = Array.create size false in
+      let memory = Array.create size Error in
+      let filled = Array.create size false in
       let vec_mem : index -> basic = 
 	fun i -> 
 	  if i >= 0 && i < size then (
-	    if index_array.(i) then 
-	      memory_array.(i)
+	    if filled.(i) then 
+	      memory.(i)
 	    else 
 	      let result = vec i in
-	      let () = memory_array.(i) <- result in
-	      let () = index_array.(i) <- true in
+	      let () = memory.(i) <- result in
+	      let () = filled.(i) <- true in
 	      result)
 	  else raise (Invalid_argument "vector overflow.") in 
       vec_mem;;
@@ -79,20 +79,37 @@ let basic_to_float_array : basic -> float array =
   fun v -> 
 	match v with
 	|Vec vec ->
-		let result : basic array = 
+		let basics : basic array = 
 		  Array.init vec#size vec#nth in
-		Array.map basic_to_float result
+		Array.map basic_to_float basics
 	|_ -> [| (basic_to_float v)|];;
 
 
-let basic_to_string : basic -> string = 
+let rec basic_to_string : basic -> string = 
   fun (v : basic) ->
         match v with
-	|N i1 -> "N " ^ (string_of_int i1)
-	|R f1 -> "R " ^ (string_of_float f1)
-	|Vec vec -> "Vec"
-	|Zero -> "Zero"	
-	|Error -> "Error";;
+	|N i1 -> string_of_int i1
+	|R f1 -> string_of_float f1
+	|Vec vec -> 
+	    let basics : basic array = 
+	      Array.init vec#size vec#nth in
+	    let strings = Array.to_list 
+		(Array.map basic_to_string basics) in
+	    String.concat "," strings
+	|Zero -> "0"	
+	|Error -> "0";;
+
+let basic_of_float : float -> basic = fun f -> R f;;
+
+let rec basic_of_float_array : float array -> basic = 
+  fun (data : float array) ->
+    let n = Array.length data in
+    if n = 0 then 
+      raise (Convert_Error "basic_of_float_array : empty.")
+    else if n = 1 then basic_of_float data.(0)
+    else 
+      let vec = Array.get (Array.map basic_of_float data) in
+      Vec (new vector n vec);;
 
 (* VALUE OPERATIONS *)
 
@@ -381,3 +398,39 @@ let basic_smaller : basic -> basic -> basic =
       basic_larger_than_zero (b2 -~ b1);;
 
 
+let basic_max : basic -> basic -> basic = 
+  fun b1 ->
+    fun b2 ->
+      let compare = basic_larger_than_zero (b1 -~ b2) in
+      match compare with
+      |	N i -> 
+	  if i = 1 then b1
+	  else if i = 0 then b2 
+	  else raise (Basic_operation "compare result not bool.")
+      |	Vec vec -> 
+	  let basics = Array.init vec#size vec#nth in
+	  let sum = basic_to_int (Array.fold_left basic_add Zero basics) in
+	  if sum = vec#size then b1
+	  else if sum = 0 then b2
+	  else Error
+      |	Error -> Error
+      |	_ -> raise (Basic_operation "compare result not bool.");;
+
+
+let basic_min : basic -> basic -> basic = 
+  fun b1 ->
+    fun b2 ->
+      let compare = basic_larger_than_zero (b1 -~ b2) in
+      match compare with
+      |	N i -> 
+	  if i = 1 then b2
+	  else if i = 0 then b1 
+	  else raise (Basic_operation "compare result not bool.")
+      |	Vec vec -> 
+	  let basics = Array.init vec#size vec#nth in
+	  let sum = basic_to_int (Array.fold_left basic_add Zero basics) in
+	  if sum = vec#size then b2
+	  else if sum = 0 then b1
+	  else Error
+      |	Error -> Error
+      |	_ -> raise (Basic_operation "compare result not bool.");;