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.
