本文共 10995 字，大约阅读时间需要 36 分钟。

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;

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.

转载地址：http://pheki.baihongyu.com/