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.

  1 with ada.Unchecked_Deallocation;

  2 

  3 with ada.Strings.fixed;

  4 use ada.Strings;

  5 use ada.Strings.fixed;

  6 

  7 package body ariane.numerics.biginteger is

  8 

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

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

 11 

 12   -- underlying deallocation method

 13   -- note: seems it has to be declared after the object definition and

 14   --       invoked by a public wrapper method, as the deallocation method

 15   --       needs information of the object type

 16   procedure deallocate is new ada.Unchecked_Deallocation(Object=>object,

 17                                                          Name=>objectptr);

 18 

 19   -- get the maximum of two instances of length_t type

 20   function max(a, b : length_t) return length_t is

 21   begin

 22     if a > b then

 23       return a;

 24     else

 25       return b;

 26     end if;

 27   end max;

 28 

 29   -- get the minimum of two instances of length_t type

 30   function min(a, b : length_t) return length_t is

 31   begin

 32     if a > b then

 33       return b;

 34     else

 35       return a;

 36     end if;

 37   end min;

 38 

 39   -- compacts a given number so that its effective length is the same as

 40   -- the same as its array length

 41   function compact(o : object) return object is

 42     res : object(o.actln);

 43   begin

 44     for i in 1 .. o.actln loop

 45       res.cells(i) := o.cells(i);

 46     end loop;

 47     res.actln := o.actln;

 48     return res;

 49   end;

 50 

 51   -- returns the sign of the given value

 52   function getsgn(o : object) return sign_t is

 53   begin

 54     if o.cells(o.actln) > 0 then

 55       return 1;

 56     elsif o.cells(o.actln) < 0 then

 57       return -1;

 58     else

 59       return 0;

 60     end if;

 61   end getsgn;

 62 

 63   -- returns the absolute value of the big integer object

 64   function getabs(o : object) return object is

 65     res : object := o;

 66   begin

 67     if res.cells(res.actln) < 0 then

 68       res.cells(res.actln) := -res.cells(res.actln);

 69     end if;

 70     return res;

 71   end getabs;

 72 

 73   -- compares the absolute values of the two operands of length_t type

 74   -- ensure the two numbers are non-negative

 75   function cmpasabs(lhs, rhs : object) return cmpres_t is

 76   begin

 77     if lhs.actln < rhs.actln then

 78       return -1;

 79     elsif lhs.actln > rhs.actln then

 80       return 1;

 81     end if;

 82 

 83     for i in reverse 1 .. lhs.actln loop

 84       if lhs.cells(i) < rhs.cells(i) then

 85         return -1;

 86       elsif lhs.cells(i) > rhs.cells(i) then

 87         return 1;

 88       end if;

 89     end loop;

 90 

 91     return 0;

 92 

 93   end cmpasabs;

 94 

 95   -- adds two numbers; ensure the two numbers are non-negative

 96   -- the return value is neither made definite nor compacted

 97   procedure addasabs(lhs, rhs : object; res : out object) is

 98     maxn : length_t := max(lhs.actln, rhs.actln);

 99     minn : length_t := min(lhs.actln, rhs.actln);

100     tmp : integer;

101     carry : integer := 0;

102 

103     procedure handlehighdigits(highref : cells_t) is begin

104       for i in minn + 1 .. maxn loop

105         tmp := highref(i) + carry;

106         if tmp > maxcellval then

107           tmp := tmp - maxmulten;

108           carry := 1;

109         end if;

110         res.cells(i) := tmp;

111       end loop;

112 

113       if carry > 0 then

114         res.cells(maxn + 1) := carry;

115         res.actln := maxn + 1;

116       else

117         res.actln := maxn;

118       end if;

119     end handlehighdigits;

120 

121   begin

122     for i in 1 .. minn loop

123       tmp := lhs.cells(i) + rhs.cells(i) + carry;

124       if tmp > maxcellval then

125         tmp := tmp - maxmulten;

126         carry := 1;

127       else

128         carry := 0;

129       end if;

130       res.cells(i) := tmp;

131     end loop;

132 

133     if lhs.actln > rhs.actln then

134       handlehighdigits(lhs.cells);

135     else

136       handlehighdigits(rhs.cells);

137     end if;

138 

139   end addasabs;

140 

141   -- subtracts rhs from lhs; ensure that lhs is greater than rhs

142   -- ensure the two numbers are non-negative

143   -- the return value is neither made definite nor compacted

144   procedure subasabs(lhs, rhs : object; res : out object) is

145     tmp : integer;

146     carry : integer := 0;

147   begin

148     for i in 1 .. rhs.actln loop

149       tmp := lhs.cells(i) - rhs.cells(i) - carry;

150       if tmp < 0 then

151         tmp := tmp + maxmulten;

152         carry := 1;

153       end if;

154       res.cells(i) := tmp;

155       if tmp /= 0 then

156         res.actln := i;

157       end if;

158     end loop;

159 

160     for i in rhs.actln + 1 .. lhs.actln loop

161       tmp := lhs.cells(i) - carry;

162       if tmp < 0 then

163         tmp := tmp + maxmulten;

164         carry := 1;

165       end if;

166       res.cells(i) := tmp;

167       if tmp /= 0 then

168         res.actln := i;

169       end if;

170     end loop;

171   end subasabs;

172 

173   -- create a big integer object

174   function create(cells : in cells_t) return object is

175     n : length_t := cells'Length;

176     actln : length_t := 1;

177   begin

178     for i in reverse 1 .. n loop

179       if cells(i) /= 0 then

180         actln := i;

181         exit;

182       end if;

183     end loop;

184     declare

185       res : object(actln);

186     begin

187       for i in 1 .. actln loop

188         res.cells(i) := cells(i);

189       end loop;

190       res.actln := actln;

191       return res;

192     end;

193   end create;

194 

195   -- creates a big integer object on heap with value given by the argument

196   function create(o : object) return objectptr is

197     res : objectptr := new object(o.actln);

198   begin

199     for i in 1 .. o.actln loop

200       res.cells(i) := o.cells(i);

201     end loop;

202     res.actln := o.actln;

203     return res;

204   end;

205 

206   -- gets the string representation of the big integer object

207   function tostring(o : in object) return string is

208     res : string := (integer(o.actln) * maxdigitspercell+1) * ' ';

209     wr : positive := 1;

210   begin

211     for i in reverse 1 .. o.actln loop

212       declare

213         tmp : string := integer'Image(o.cells(i));

214         trimmed : string := trim(tmp, both);

215       begin

216         if i = o.actln or else trimmed'length = 9 then

217           overwrite(res, wr, trimmed);

218           wr := wr + trimmed'Length;

219         else

220           declare

221             pad : string := 9 * '0';

222           begin

223             overwrite(pad, 9 - trimmed'length, trimmed);

224             overwrite(res, wr, pad);

225             wr := wr + 9;

226           end;

227         end if;

228       end;

229     end loop;

230 

231     return res;

232   end tostring;

233 

234   -- destroys the big integer object created on heap

235   procedure free(p : in out objectptr) is

236   begin

237     deallocate(p);

238   end free;

239 

240   -- defines operator "+" on big integers

241   function "+"(lhs, rhs : in object) return object is

242     res : object(lhs.actln + rhs.actln + 1);

243     cmp : integer;

244     labs : object := getabs(lhs);

245     rabs : object := getabs(rhs);

246     lsgn : sign_t := getsgn(lhs);

247     rsgn : sign_t := getsgn(rhs);

248   begin

249     if lsgn = rsgn or else lsgn = 0 or else rsgn = 0 then

250       addasabs(labs, rabs, res);

251       if lsgn < 0 or rsgn < 0 then

252         res.cells(res.actln) := -res.cells(res.actln);

253       end if;

254     else

255       cmp := cmpasabs(labs, rabs);

256       if cmp < 0 then

257         subasabs(rabs, labs, res);

258         if rsgn < 0 then

259           res.cells(res.actln) := -res.cells(res.actln);

260         end if;

261       elsif cmp > 0 then

262         subasabs(labs, rabs, res);

263         if lsgn < 0 then

264           res.cells(res.actln) := -res.cells(res.actln);

265         end if;

266       else

267         res.actln := 1;

268         res.cells(1) := 0;

269       end if;

270     end if;

271 

272     declare

273       compacted : object := compact(res);

274     begin

275       return compacted;

276     end;

277 

278   end "+";

279 

280   -- defines operator "-" on big integers

281   function "-"(lhs, rhs : in object) return object is

282     res : object(lhs.actln + rhs.actln + 1);

283     cmp : integer;

284     labs : object := getabs(lhs);

285     rabs : object := getabs(rhs);

286     lsgn : sign_t := getsgn(lhs);

287     rsgn : sign_t := getsgn(rhs);

288   begin

289     if lsgn /= rsgn and then lsgn /= 0 and then rsgn /= 0 then

290       cmp := cmpasabs(labs, rabs);

291       if cmp < 0 then

292         subasabs(rabs, labs, res);

293         if rsgn < 0 then

294           res.cells(res.actln) := -res.cells(res.actln);

295         end if;

296       elsif cmp > 0 then

297         subasabs(labs, rabs, res);

298         if lsgn < 0 then

299           res.cells(res.actln) := -res.cells(res.actln);

300         end if;

301       else

302         res.actln := 1;

303         res.cells(1) := 0;

304       end if;

305     else

306       addasabs(labs, rabs, res);

307       if lsgn < 0 or rsgn < 0 then

308         res.cells(res.actln) := -res.cells(res.actln);

309       end if;

310     end if;

311 

312     declare

313       compacted : object := compact(res);

314     begin

315       return compacted;

316     end;

317   end "-";

318 

319 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.