scalable debut

.gitignore

@@ -31,6 +31,7 @@ _opam/
 # Local files
 *~
 
+# Log files
+
 *.log
-*.cache
+*.cache
-*caml-toplevel*

Source/builtin/tests/test_builtin_generate_primes.ml

@@ -26,7 +26,7 @@ let () = let t_list = [((20, is_prime), [(2, 5); (3, 7); (5, 11); (11, 23)])]
          run_test template_1f_L2 "Double Primes Generator" double_primes t_list
 ;;
 
-let () = let t_list = [((20, is_prime), [(2, 3); (3, 5); (5, 7); (11, 13); (17, 19)])]
+let () = let t_list = [((20, is_prime), [(3, 5); (5, 7); (11, 13); (17, 19)])]
          in
          run_test template_1f_L2 "Twin Primes Generator" twin_primes t_list
 ;;

Source/scalable/scalable.ml

@@ -1,3 +1,4 @@
+
 (** A naive implementation of big integers
 
 This module aims at creating a set of big integers naively. Such data
@@ -17,19 +18,82 @@ decomposition of a non-negative integer.
 (** Creates a bitarray from a built-in integer.
     @param x built-in integer.
 *)
-let from_int x = []
+let sign x =
+  if x < 0 then
+    -1
+  else
+    1;;
+
+
+let from_int x =
+  if x = 0 then []
+  else
+    let rec from_int_rec n =
+      match n with
+          0 -> []
+        | n -> n mod 2::from_int_rec (n/2)
+    in let bitsign =
+         if sign x = -1 then
+           1
+         else
+           0
+       in bitsign::from_int_rec (sign x * x);;
 
 (** Transforms bitarray of built-in size to built-in integer.
     UNSAFE: possible integer overflow.
     @param bA bitarray object.
- *)
+*)
-let to_int bA = 0
+
+let modulo a b =
+  match sign a = -1 && a mod b != 0 with
+      true -> a mod b + b
+    | _  -> a mod b;;
+
+let power x n =
+  if n = 0 then 1 else
+  let rec power_rec x1 n =
+    match n with
+        1 -> x1
+      | n when modulo n 2 = 0 -> power_rec (x1 * x1) (n/2)
+      | n -> x1 * power_rec (x1 * x1) ((n-1)/2)
+  in power_rec x n;;
+
+
+let to_int bA =
+  match bA with
+      [] -> 0
+    | e::bA1 -> begin
+      let sign = match e with
+          0 -> 1
+        | _ -> -1
+      in let rec to_int_rec bA pow =
+           match bA with
+               [] -> 0
+             | e::bA1 -> (e * power 2 pow) + to_int_rec bA1 (pow + 1)
+         in sign * to_int_rec bA1 0
+    end;;
 
 (** Prints bitarray as binary number on standard output.
     @param bA a bitarray.
   *)
-let print_b bA = ()
+let print_b bA =
-
+  match bA with
+      [] -> print_endline "0"
+    | e::l1 -> begin
+      let rec print_b_rec bA =
+        match bA with
+            [] -> print_endline ""
+          | e::l1 -> begin
+            print_b_rec l1;
+            print_int e
+          end
+      in
+      if e = 1 then (
+        print_string "-";
+        print_b_rec l1
+      ) else
+        print_b_rec l1
+    end;;
 (** Toplevel directive to use print_b as bitarray printer.
     CAREFUL: print_b is then list int printer.
     UNCOMMENT FOR TOPLEVEL USE.
@@ -46,22 +110,45 @@ let print_b bA = ()
     @param nA A natural, a bitarray having no sign bit.
            Assumed non-negative.
     @param nB A natural.
- *)
+*)
-let rec compare_n nA nB = 0
+
+let rec rem_0 bA =
+  match bA with
+      [] -> []
+    | 1::l1 -> 1::l1
+    | _::l1 -> rem_0 l1;;
+
+
+let compare_n nA nB =
+  let nA = rem_0 (List.rev nA)
+  and nB = rem_0 (List.rev nB)
+  in if List.length nA > List.length nB then
+      1
+    else if List.length nA < List.length nB then
+      -1
+    else
+      let rec compare_n_rec nA nB =
+        match (nA, nB) with
+            ([], []) -> 0
+          | ([], _) | (0::_, 1::_) -> -1
+          | (_, []) | (1::_, 0::_) -> 1
+          | (_::l1, _::l2) -> compare_n_rec l1 l2
+      in compare_n_rec nA nB;;
+
 
 (** Bigger inorder comparison operator on naturals. Returns true if
     first argument is bigger than second and false otherwise.
     @param nA natural.
     @param nB natural.
  *)
-let (>>!) nA nB = true
+let (>>!) nA nB = compare_n nA nB = 1;;
 
 (** Smaller inorder comparison operator on naturals. Returns true if
     first argument is smaller than second and false otherwise.
     @param nA natural.
     @param nB natural.
  *)
-let (<<!) nA nB = true
+let (<<!) nA nB = compare_n nA nB = -1;;
 
 (** Bigger or equal inorder comparison operator on naturals. Returns
     true if first argument is bigger or equal to second and false
@@ -69,7 +156,7 @@ let (<<!) nA nB = true
     @param nA natural.
     @param nB natural.
  *)
-let (>=!) nA nB = true
+let (>=!) nA nB = compare_n nA nB = 1 || compare_n nA nB = 0;;
 
 (** Smaller or equal inorder comparison operator on naturals. Returns
     true if first argument is smaller or equal to second and false
@@ -77,28 +164,36 @@ let (>=!) nA nB = true
     @param nA natural.
     @param nB natural.
  *)
-let (<=!) nA nB = true
+let (<=!) nA nB = compare_n nA nB = -1 || compare_n nA nB = 0;;
 
 (** Comparing two bitarrays. Output is 1 if first argument is bigger
     than second -1 if it smaller and 0 in case of equality.
     @param bA A bitarray.
     @param bB A bitarray.
 *)
-let compare_b bA bB = 0
+let compare_b bA bB =
+  match (bA, bB) with
+      ([], []) -> 0
+    | ([], _) | (1::_, 0::_) -> -1
+    | (_, []) | (0::_, 1::_) -> 1
+    | (sign:: nA, _::nB) ->
+      match sign with
+          0 -> compare_n (0::nA) (0::nB)
+        | _ -> -1 * compare_n (0::nA) (0::nB);;
 
 (** Bigger inorder comparison operator on bitarrays. Returns true if
     first argument is bigger than second and false otherwise.
     @param nA natural.
     @param nB natural.
  *)
-let (<<) bA bB = true
+let (<<) bA bB = compare_b bA bB = -1;;
 
 (** Smaller inorder comparison operator on bitarrays. Returns true if
     first argument is smaller than second and false otherwise.
     @param nA natural.
     @param nB natural.
  *)
-let (>>) bA bB = true
+let (>>) bA bB = compare_b bA bB = 1;;
 
 (** Bigger or equal inorder comparison operator on bitarrays. Returns
     true if first argument is bigger or equal to second and false
@@ -106,7 +201,7 @@ let (>>) bA bB = true
     @param nA natural.
     @param nB natural.
  *)
-let (<<=) bA bB = true
+let (<<=) bA bB = compare_b bA bB = -1 || compare_b bA bB = 0;;
 
 (** Smaller or equal inorder comparison operator on naturals. Returns
     true if first argument is smaller or equal to second and false
@@ -114,52 +209,122 @@ let (<<=) bA bB = true
     @param nA natural.
     @param nB natural.
  *)
-let (>>=) bA bB = true
+let (>>=) bA bB = compare_b bA bB = 1 || compare_b bA bB = 0;;
-;;
 
 (** Sign of a bitarray.
     @param bA Bitarray.
 *)
-let sign_b bA = 0
+let sign_b bA =
+  match bA with
+      [] -> 1
+    | e::_ when e = 1 -> -1
+    | _ -> 1;;
 
 (** Absolute value of bitarray.
     @param bA Bitarray.
 *)
-let abs_b bA = []
+let abs_b bA =
+  match bA with
+      [] -> []
+    | _::bA -> 0::bA;;
 
 (** Quotient of integers smaller than 4 by 2.
     @param a Built-in integer smaller than 4.
 *)
-let _quot_t a = 0
+let _quot_t a =
+  match a with
+      0 | 1-> 0
+    | 2 | 3-> 1
+    | _ -> invalid_arg "must be smaller than 4";;
 
 (** Modulo of integer smaller than 4 by 2.
     @param a Built-in integer smaller than 4.
 *)
-let _mod_t a = 0
+let _mod_t a =
+  match a with
+      0 | 2-> 0
+    | 1 | 3-> 1
+    | _ -> invalid_arg "must be smaller than 4";;
 
 (** Division of integer smaller than 4 by 2.
     @param a Built-in integer smaller than 4.
 *)
-let _div_t a = (0, 0)
+let _div_t a = (_quot_t a, _mod_t a);;
 
 (** Addition of two naturals.
     @param nA Natural.
     @param nB Natural.
 *)
-let add_n nA nB = []
+let add_n nA nB =
+  match (nA, nB) with
+      (l, []) | ([], l) -> l
+    | (_::nA, _::nB) ->
+      let rec add_n_rec nA nB ret res=
+        match (nA, nB) with
+            ([], []) -> ret::res
+          | (e::l1, []) | ([], e::l1) -> let tot = e + ret in
+            let (q, r) = _div_t tot in
+            add_n_rec l1 [] q (r::res)
+          | (e1::nA, e2::nB) ->
+            let tot = e1 + e2 + ret in
+            let (q, r) = _div_t tot in
+            add_n_rec nA nB q (r::res)
+      in List.rev (add_n_rec nA nB 0 [0]);;
+
 
 (** Difference of two naturals.
     UNSAFE: First entry is assumed to be bigger than second.
     @param nA Natural.
     @param nB Natural.
 *)
-let diff_n nA nB = []
+let bit_comp = function 0 -> 1 | _ -> 0;;
+
+
+let complem2  bA n=
+  match bA with
+      [] -> []
+    | e::bA ->
+      let rec complem_rec bA comp res n=
+        match n with
+            0 -> res
+          | n ->
+            let (e:: bA) = match bA with
+                [] -> [0]
+              | _ -> bA in
+            let res = if comp then
+                (bit_comp e)::res
+              else e::res
+            and comp = if not comp && e = 1 then true else comp
+            in complem_rec bA comp res (n-1)
+      in bit_comp e::List.rev (complem_rec bA false [] (n - 1));;
+
+let diff_n nA nB = add_n nA (complem2 nB (List.length nA))
 
 (** Addition of two bitarrays.
     @param bA Bitarray.
     @param bB Bitarray.
- *)
+*)
-let add_b bA bB = []
+
+let get_signed_bitarray bsign bA =
+  match bA with
+      [] -> []
+    | _::bA -> bsign::bA;;
+
+let add_b bA bB =
+  match (bA, bB) with
+      ([], l) | (l, []) -> l
+    | (0::bA, 0::bB) -> get_signed_bitarray 0 (add_n (0::bA) (0::bB))
+    | (1::bA, 1::bB) -> get_signed_bitarray 1 (add_n (0::bA) (0::bB))
+    | (1::bA, 0::bB) when (<<=) (0::bA) (0::bB) ->
+      get_signed_bitarray 0 (diff_n (0::bB) (0::bA))
+    | (1::bA, 0::bB) ->
+      get_signed_bitarray 1 (add_n (0::bB) (complem2 (1::bA) (List.length bA)))
+    | (0::bA, 1::bB) when (<<) (0::bA) (0::bB) ->
+      get_signed_bitarray 1 (add_n (0::bA) (complem2 (1::bB) (List.length bB)))
+    | (0::bA, 1::bB) ->
+      get_signed_bitarray 0 (diff_n (0::bA) (0::bB))
+    | _ -> failwith "error"
+
 
 (** Difference of two bitarrays.
     @param bA Bitarray.
@@ -171,19 +336,48 @@ let diff_b bA bB = []
     @param bA Bitarray.
     @param d Non-negative integer.
 *)
-let rec shift bA d = []
+let rec shift bA d =
+  match d with
+      0 -> bA
+    | d -> 0::shift bA (d-1);;
 
 (** Multiplication of two bitarrays.
     @param bA Bitarray.
     @param bB Bitarray.
 *)
-let mult_b bA bB = []
+let mult_b bA bB =
+  match (bA, bB) with
+      ([], _) | (_, []) -> []
+    | (sign1::bA, sign2::bB) ->
+      let rec mult_b_rec bA bB n =
+        match bA with
+            [] -> []
+          | e::bA ->
+            let a = match e with 0 -> [] | 1 -> bB in
+            add_n (shift a n) (mult_b_rec bA bB (n+1))
+      in match (sign1, sign2) with
+          (0,0) | (1,1) -> 0::mult_b_rec bA bB 0
+        | _ -> 1::mult_b_rec bA bB 0
 
 (** Quotient of two bitarrays.
     @param bA Bitarray you want to divide by second argument.
     @param bB Bitarray you divide by. Non-zero!
 *)
-let quot_b bA bB = []
+let quot_b bA bB =
+  match (bA, bB) with
+      ([], _) | (_, []) -> []
+    | (sign1::bA, sign2::bB) ->
+      let rec quot_b_rec bA bB n =
+        match bA with
+            [] -> []
+          | e::bA ->
+            let a = match e with 0 -> [] | 1 -> bB in
+            add_n (shift a n) (quot_b_rec bA bB (n+1))
+      in match (sign1, sign2) with
+          (0,0) | (1,1) -> 0::mult_b_rec bA bB 0
+        | _ -> 1::mult_b_rec bA bB 0
+
+
 
 (** Modulo of a bitarray against a positive one.
     @param bA Bitarray the modulo of which you're computing.

Source/scalable/tests/test_scalable_ciphers.ml

@@ -11,8 +11,8 @@ open Test_scalable_templates
 let p = from_int 9967 and q = from_int 9973
 let ((_, e), (n, d)) = generate_keys_rsa p q
 
-let phin = mult_b (diff_b p [1;1]) (diff_b q [1;1])
+let phin = mult_b (diff_b p [0;1]) (diff_b q [0;1])
-let is_inverse x y n = mod_b (mult_b (mod_b x n) (mod_b y n)) n = [1; 1]
+let is_inverse x y n = mod_b (mult_b (mod_b x n) (mod_b y n)) n = [0; 1]
 let () = let t_list = [(e, d, phin), true]
          in
          run_test template_3_b "Generate RSA Keys Test" is_inverse t_list