Fibonacci with ADA and others (Part 2/3)

Now it goes the implementation of the package.

Some points about the design. Firstly the structure of the number is more clear to see here. As is said in the previous post, components of the number are represented by cells of the array. However, in regards to the maximum magnitude each component holds, there are two choices, one is make full use of the whole 32-digit integer, which is the most efficient in terms of memory utilization; and the other is use it to represent a largest multiple of ten it can take, which in this case, for a 32-digit integer type is 10^9. The benefit of the latter is the ease of print as a decimal number.

The current source code implements the second approach, where it declares that maximum value for each component as a constant in the package declaration. The constants are useful for the logic to determine in each step of the calculation of an operation whether a particular component has exceeded the maximum value so a bring-down and a carry to the component ahead is needed.

As the big integer to deal with there is signed integer, the sign of the number is carried by the highest component, and the design specifies that a valid big integer object should not have signs on components other than the highest (this makes the highest component the only one that needs to be flipped in a absolute/negative value operation). An alternative approach might use a separate field to store the sign, but it's not necessary and optimal for this design, as component is not fully utilized even as an signed integer.

Operations like add and subtract on big integers are implemented based on add and subtract on their corresponding absolute numbers; since ADA doesn't allow in any way changing the values of the parameters passed to a function (they are always 'in' parameters), so copies of these input parameters as local variables are always needed as long as changes to these numbers are needed in the course of the calculation. If more efficiency is required, one probably needs to consider using a dynamic internal array or data structure alike instead.

Note there is a method named 'compact' that takes in a big integer object and returns an object representing the same big integer number but having an internal array no greater in length than needed.

with ada.Unchecked_Deallocation;

with ada.Strings.fixed;
use ada.Strings;
use ada.Strings.fixed;

package body ariane.numerics.biginteger is

  subtype cmpres_t is integer range -1..1;
  subtype sign_t is integer range -1..1;

  -- underlying deallocation method
  -- note: seems it has to be declared after the object definition and
  --       invoked by a public wrapper method, as the deallocation method
  --       needs information of the object type
  procedure deallocate is new ada.Unchecked_Deallocation(Object=>object,
                                                         Name=>objectptr);

  -- get the maximum of two instances of length_t type
  function max(a, b : length_t) return length_t is
  begin
    if a > b then
      return a;
    else
      return b;
    end if;
  end max;

  -- get the minimum of two instances of length_t type
  function min(a, b : length_t) return length_t is
  begin
    if a > b then
      return b;
    else
      return a;
    end if;
  end min;

  -- compacts a given number so that its effective length is the same as
  -- the same as its array length
  function compact(o : object) return object is
    res : object(o.actln);
  begin
    for i in 1 .. o.actln loop
      res.cells(i) := o.cells(i);
    end loop;
    res.actln := o.actln;
    return res;
  end;

  -- returns the sign of the given value
  function getsgn(o : object) return sign_t is
  begin
    if o.cells(o.actln) > 0 then
      return 1;
    elsif o.cells(o.actln) < 0 then
      return -1;
    else
      return 0;
    end if;
  end getsgn;

  -- returns the absolute value of the big integer object
  function getabs(o : object) return object is
    res : object := o;
  begin
    if res.cells(res.actln) < 0 then
      res.cells(res.actln) := -res.cells(res.actln);
    end if;
    return res;
  end getabs;

  -- compares the absolute values of the two operands of length_t type
  -- ensure the two numbers are non-negative
  function cmpasabs(lhs, rhs : object) return cmpres_t is
  begin
    if lhs.actln < rhs.actln then
      return -1;
    elsif lhs.actln > rhs.actln then
      return 1;
    end if;

    for i in reverse 1 .. lhs.actln loop
      if lhs.cells(i) < rhs.cells(i) then
        return -1;
      elsif lhs.cells(i) > rhs.cells(i) then
        return 1;
      end if;
    end loop;

    return 0;

  end cmpasabs;

  -- adds two numbers; ensure the two numbers are non-negative
  -- the return value is neither made definite nor compacted
  procedure addasabs(lhs, rhs : object; res : out object) is
    maxn : length_t := max(lhs.actln, rhs.actln);
    minn : length_t := min(lhs.actln, rhs.actln);
    tmp : integer;
    carry : integer := 0;

    procedure handlehighdigits(highref : cells_t) is begin
      for i in minn + 1 .. maxn loop
        tmp := highref(i) + carry;
        if tmp > maxcellval then
          tmp := tmp - maxmulten;
          carry := 1;
        end if;
        res.cells(i) := tmp;
      end loop;

      if carry > 0 then
        res.cells(maxn + 1) := carry;
        res.actln := maxn + 1;
      else
        res.actln := maxn;
      end if;
    end handlehighdigits;

  begin
    for i in 1 .. minn loop
      tmp := lhs.cells(i) + rhs.cells(i) + carry;
      if tmp > maxcellval then
        tmp := tmp - maxmulten;
        carry := 1;
      else
        carry := 0;
      end if;
      res.cells(i) := tmp;
    end loop;

    if lhs.actln > rhs.actln then
      handlehighdigits(lhs.cells);
    else
      handlehighdigits(rhs.cells);
    end if;

  end addasabs;

  -- subtracts rhs from lhs; ensure that lhs is greater than rhs
  -- ensure the two numbers are non-negative
  -- the return value is neither made definite nor compacted
  procedure subasabs(lhs, rhs : object; res : out object) is
    tmp : integer;
    carry : integer := 0;
  begin
    for i in 1 .. rhs.actln loop
      tmp := lhs.cells(i) - rhs.cells(i) - carry;
      if tmp < 0 then
        tmp := tmp + maxmulten;
        carry := 1;
      end if;
      res.cells(i) := tmp;
      if tmp /= 0 then
        res.actln := i;
      end if;
    end loop;

    for i in rhs.actln + 1 .. lhs.actln loop
      tmp := lhs.cells(i) - carry;
      if tmp < 0 then
        tmp := tmp + maxmulten;
        carry := 1;
      end if;
      res.cells(i) := tmp;
      if tmp /= 0 then
        res.actln := i;
      end if;
    end loop;
  end subasabs;

  -- create a big integer object
  function create(cells : in cells_t) return object is
    n : length_t := cells'Length;
    actln : length_t := 1;
  begin
    for i in reverse 1 .. n loop
      if cells(i) /= 0 then
        actln := i;
        exit;
      end if;
    end loop;
    declare
      res : object(actln);
    begin
      for i in 1 .. actln loop
        res.cells(i) := cells(i);
      end loop;
      res.actln := actln;
      return res;
    end;
  end create;

  -- creates a big integer object on heap with value given by the argument
  function create(o : object) return objectptr is
    res : objectptr := new object(o.actln);
  begin
    for i in 1 .. o.actln loop
      res.cells(i) := o.cells(i);
    end loop;
    res.actln := o.actln;
    return res;
  end;

  -- gets the string representation of the big integer object
  function tostring(o : in object) return string is
    res : string := (integer(o.actln) * maxdigitspercell+1) * ' ';
    wr : positive := 1;
  begin
    for i in reverse 1 .. o.actln loop
      declare
        tmp : string := integer'Image(o.cells(i));
        trimmed : string := trim(tmp, both);
      begin
        if i = o.actln or else trimmed'length = 9 then
          overwrite(res, wr, trimmed);
          wr := wr + trimmed'Length;
        else
          declare
            pad : string := 9 * '0';
          begin
            overwrite(pad, 9 - trimmed'length, trimmed);
            overwrite(res, wr, pad);
            wr := wr + 9;
          end;
        end if;
      end;
    end loop;

    return res;
  end tostring;

  -- destroys the big integer object created on heap
  procedure free(p : in out objectptr) is
  begin
    deallocate(p);
  end free;

  -- defines operator "+" on big integers
  function "+"(lhs, rhs : in object) return object is
    res : object(lhs.actln + rhs.actln + 1);
    cmp : integer;
    labs : object := getabs(lhs);
    rabs : object := getabs(rhs);
    lsgn : sign_t := getsgn(lhs);
    rsgn : sign_t := getsgn(rhs);
  begin
    if lsgn = rsgn or else lsgn = 0 or else rsgn = 0 then
      addasabs(labs, rabs, res);
      if lsgn < 0 or rsgn < 0 then
        res.cells(res.actln) := -res.cells(res.actln);
      end if;
    else
      cmp := cmpasabs(labs, rabs);
      if cmp < 0 then
        subasabs(rabs, labs, res);
        if rsgn < 0 then
          res.cells(res.actln) := -res.cells(res.actln);
        end if;
      elsif cmp > 0 then
        subasabs(labs, rabs, res);
        if lsgn < 0 then
          res.cells(res.actln) := -res.cells(res.actln);
        end if;
      else
        res.actln := 1;
        res.cells(1) := 0;
      end if;
    end if;

    declare
      compacted : object := compact(res);
    begin
      return compacted;
    end;

  end "+";

  -- defines operator "-" on big integers
  function "-"(lhs, rhs : in object) return object is
    res : object(lhs.actln + rhs.actln + 1);
    cmp : integer;
    labs : object := getabs(lhs);
    rabs : object := getabs(rhs);
    lsgn : sign_t := getsgn(lhs);
    rsgn : sign_t := getsgn(rhs);
  begin
    if lsgn /= rsgn and then lsgn /= 0 and then rsgn /= 0 then
      cmp := cmpasabs(labs, rabs);
      if cmp < 0 then
        subasabs(rabs, labs, res);
        if rsgn < 0 then
          res.cells(res.actln) := -res.cells(res.actln);
        end if;
      elsif cmp > 0 then
        subasabs(labs, rabs, res);
        if lsgn < 0 then
          res.cells(res.actln) := -res.cells(res.actln);
        end if;
      else
        res.actln := 1;
        res.cells(1) := 0;
      end if;
    else
      addasabs(labs, rabs, res);
      if lsgn < 0 or rsgn < 0 then
        res.cells(res.actln) := -res.cells(res.actln);
      end if;
    end if;

    declare
      compacted : object := compact(res);
    begin
      return compacted;
    end;
  end "-";

end ariane.numerics.biginteger;

Also a few things to point out regarding the code and language features.

1. ADA allows counting down (reverse iteration) in a 'for' statement by using 'reverse' reserved word

2. 'declare' block is extremely useful and elegant for defining a variable anywhere in code, and fundamentally allocating space for and instantiating the object on stack. This essentially is an ADA equivalent of arbitrarily placed variable declaration of most C family languages, but with better clarity, explicitness and a good consistency with both the concept and mechanism of allocation and its type system.

3. There is no way to change the content of a input parameter of a record type by setting the member of the method to aliased. And formal parameters can never be declared aliased.