(** A naive implementation of big integers

This module aims at creating a set of big integers naively. Such data
types will be subsequently called bitarrays. A bitarray is a list of
zeros and ones ; first integer representing the sign bit. In this
context zero is reprensented by the empty list []. The list is to
be read from left to right ; this is the opposite convention to the
one you usually write binary decompositions with. After the sign bit
the first encountered bit is the coefficient in front of two to
the power zero. This convention has been chosen to ease writing
down code. A natural bitarray is understood as being a bitarray of
which you've taken out the sign bit, it is just the binary
decomposition of a non-negative integer.

 *)

(** Creates a bitarray from a built-in integer.
    @param x built-in integer.
*)
let sign x =
  if x < 0 then
    -1
  else
    1;;


let rec rem_rec bA =
  match bA with
      [] -> []
    | 1::bA -> 1::bA
    | _::bA -> rem_rec bA;;

let rem0_rev bA = List.rev (rem_rec bA);;

let rem0 bA =
  let bA = List.rev bA
  in rem0_rev bA;;


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 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 =
  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.
*)
(* #install_printer print_b *)

(** Internal comparisons on bitarrays and naturals. Naturals in this
    context are understood as bitarrays missing a bit sign and thus
    assumed to be non-negative.
*)

(** Comparing naturals. Output is 1 if first argument is bigger than
    second -1 if it is smaller and 0 in case of equality.
    @param nA A natural, a bitarray having no sign bit.
           Assumed non-negative.
    @param nB A natural.
*)


let compare_n nA nB =
  match (nA, nB) with
      ([], []) -> 0
    | (_, []) -> 1
    | ([], _) -> -1
    | (_::nA, _::nB) ->
      let nA = List.rev nA and nB = List.rev nB in
      let lengthA = List.length nA and lengthB = List.length nB in
      if lengthA > lengthB then
        1
      else if lengthA < lengthB 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 = 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 = 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
    otherwise.
    @param nA natural.
    @param nB natural.
 *)
let (>=!) nA nB =
  let comp = compare_n nA nB
  in comp = 1 || comp = 0;;

(** Smaller or equal inorder comparison operator on naturals. Returns
    true if first argument is smaller or equal to second and false
    otherwise.
    @param nA natural.
    @param nB natural.
 *)
let (<=!) nA nB =
  let comp = compare_n nA nB
  in comp = -1 || comp = 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 =
  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 = 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 = 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
    otherwise.
    @param nA natural.
    @param nB natural.
 *)
let (<<=) bA bB =
  let comp = compare_b bA bB
  in comp = -1 || comp = 0;;

(** Smaller or equal inorder comparison operator on naturals. Returns
    true if first argument is smaller or equal to second and false
    otherwise.
    @param nA natural.
    @param nB natural.
 *)
let (>>=) bA bB =
  let comp = compare_b bA bB
  in comp = 1 || comp = 0;;

(** Sign of a bitarray.
    @param bA Bitarray.
*)
let sign_b bA =
  match bA with
      [] | 0::_ -> 1
    | _ -> -1;;

(** Absolute value of bitarray.
    @param bA Bitarray.
*)
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 =
  match a with
      0 | 1-> 0
    | _ -> 1

(** Modulo of integer smaller than 4 by 2.
    @param a Built-in integer smaller than 4.
*)
let _mod_t a =
  match a with
      0 | 2 -> 0
    | _ -> 1

(** Division of integer smaller than 4 by 2.
    @param a Built-in integer smaller than 4.
*)
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 =
  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) -> begin
            let tot = e + ret in
            let (q, r) = _div_t tot in
            add_n_rec l1 [] q (r::res)
          end
          | (e1::nA, e2::nB) -> begin
            let tot = e1 + e2 + ret in
            let (q, r) = _div_t tot in
            add_n_rec nA nB q (r::res)
          end
      in rem0_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 rec diff_n_rec nA nB ret res=
    match (nA, nB) with
        ([], [])                                   -> res
      | ([], e::nB) when 0 - (ret + e) = 0         -> diff_n_rec nA nB 0 (0::res)
      | ([], e::nB) when 0 - (ret + e) = -1        -> diff_n_rec nA nB 1 (1::res)
      | ([], e::nB)                                -> diff_n_rec nA nB 1 (0::res)
      | (e::nA, []) when e - ret >= 0              -> diff_n_rec nA nB 0 (e-ret::res)
      | (e::nA, [])                                -> diff_n_rec nA nB 1 (1::res)
      | (e1::nA, e2::nB) when e1 - (e2 + ret) = 0  -> diff_n_rec nA nB 0 (0::res)
      | (e1::nA, e2::nB) when e1 - (e2 + ret) = 1  -> diff_n_rec nA nB 0 (1::res)
      | (e1::nA, e2::nB) when e1 - (e2 + ret) = -1 -> diff_n_rec nA nB 1 (1::res)
      | (_::nA, _::nB)                             -> diff_n_rec nA nB 1 (0::res)
  in match (nA, nB) with
      (l, [])        -> l
    | ([], _::nB)    -> rem0_rev (diff_n_rec [] nB 0 [0])
    | (_::nA, _::nB) -> rem0_rev (diff_n_rec nA nB 0 [0]);;

(** Shifts bitarray to the left by a given natural number.
    @param bA Bitarray.
    @param d Non-negative integer.
*)
let shift bA d =
  match bA with
      [] -> []
    | sign::bA ->
      let rec shift_rec bA d res=
        match d with
            d when d <= 0 -> res
          | d -> shift_rec bA (d-1) (0::res)
      in sign::shift_rec bA d bA;;


(** Addition of two bitarrays.
    @param bA Bitarray.
    @param bB Bitarray.
*)

let abs_neg bA =
  match bA with
      [] -> []
    | _::bA -> 1::bA;;

let add_b bA bB =
  match (bA, bB) with
      ([], l) | (l, []) -> l
    | (0::bA, 0::bB) -> add_n (0::bA) (0::bB)
    | (1::bA, 1::bB) -> abs_neg (add_n (0::bA) (0::bB))
    | (1::bA, 0::bB) when (<=!) (0::bA) (0::bB) -> diff_n (0::bB) (0::bA)
    | (1::bA, 0::bB) -> abs_neg (diff_n (shift [0] (List.length bA)) (diff_n (0::bB) (0::bA)))
    | (0::bA, 1::bB) when (>=!) (0::bA) (0::bB) -> diff_n (0::bA) (0::bB)
    | (0::bA, 1::bB) -> abs_neg (diff_n (shift [0] (List.length bB)) (diff_n (0::bA) (0::bB)))
    | _ -> failwith "error";;


(** Difference of two bitarrays.
    @param bA Bitarray.
    @param bB Bitarray.
*)
let diff_b bA bB =
  match bB with
      [] -> bA
    | 1::bB -> add_b bA (0::bB)
    | _ -> add_b bA (abs_neg bB);;

(** Multiplication of two bitarrays.
    @param bA Bitarray.
    @param bB Bitarray.
*)
let mult_b bA bB =
  match (bA, bB) with
      ([], _) | (_, []) -> []
    | (signA::bA, signB::bB) ->
      let rec mult_b_rec bA bB n =
        match bA with
            [] -> []
          | e::bA ->
            let a = match e with 0 -> [] | _ -> bB in
            add_n (shift a n) (mult_b_rec bA bB (n+1))
      in match (signA, signB) with
          (0,0) | (1,1) ->   abs_b (mult_b_rec bA (0::bB) 0)
        | _             -> abs_neg (mult_b_rec bA (0::bB) 0)

(** Integer division of two bitarrays.
    @param bA Bitarray you want to divide.
    @param bB Bitarray you wnat to divide by.
*)
let div_b bA bB =
  match (bA, bB) with
      (_, []) -> invalid_arg "divider must be Non-Zero"
    | ([],_) -> ([], [])
    | (sign1::bA, sign2::bB) ->
      let rec div_b_rec bA bB res=
        if (>=!) bA bB then
          let bA = diff_n bA bB
          and res = add_n [0;1] res
          in div_b_rec bA bB res
        else (res, bA)
      in let (quot, rest) = div_b_rec (0::bA) (0::bB) [] in
         match (sign1, sign2) with
          (0,0) | (1,1) -> (abs_b quot, rest)
        | _ -> begin
          match (quot, rest) with
              (quot, []) -> (abs_neg quot, [])
            | (quot, rest) -> (abs_neg (add_n [0;1] quot), diff_n (0::bB) rest)
        end


(** 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, _) = div_b bA bB in quot;;



(** Modulo of a bitarray against a positive one.
    @param bA Bitarray the modulo of which you're computing.
    @param bB Bitarray which is modular base.
 *)
let mod_b bA bB =
  let (_, rest) = div_b bA bB in rest;;