File: [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers / multprec_natural_numbers_io.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:26 2000 UTC (23 years, 10 months ago) by maekawa
Branch: PHC, MAIN
CVS Tags: v2, maekawa-ipv6, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, HEAD Changes since 1.1: +0 -0
lines
Import the second public release of PHCpack.
OKed by Jan Verschelde.
|
with text_io,integer_io; use text_io,integer_io;
with Characters_and_Numbers; use Characters_and_Numbers;
package body Multprec_Natural_Numbers_io is
-- IMPORTANT NOTICE :
-- The choice of base is assumed to be decimal.
-- CONSTANTS :
expo : constant natural := Multprec_Natural_Numbers.Exponent;
maxl : constant natural := 200;
-- DATA STRUCTURE :
type Array_of_Strings is array ( natural range <> ) of String(1..expo);
-- BASIC PRIMITIVES FOR INPUT/OUTPUT :
function Convert ( s : Array_of_Strings ) return Array_of_Naturals is
res : Array_of_Naturals(s'range) := (s'range => 0);
begin
for i in reverse s'range loop
res(res'last-i) := Convert(s(i));
end loop;
return res;
end Convert;
function Size ( len : natural ) return natural is
-- DESCRIPTION :
-- Given the number of characters read, the size of the natural number
-- will be determined.
res : natural := len/expo;
begin
if expo*res = len
then return res-1;
else return res;
end if;
end Size;
function Create ( l : in natural; s : in String ) return Array_of_Strings is
-- DESCRIPTION :
-- Partitions the string in blocks, according to the base.
res : Array_of_Strings(0..l);
ind : natural := l;
cnt : natural := 0;
begin
for i in res'range loop
res(i) := (res(i)'range => ' ');
end loop;
for i in reverse s'range loop
cnt := cnt + 1;
if cnt <= expo
then res(ind)(expo-cnt+1) := s(i);
else ind := ind-1;
cnt := 1;
res(ind)(expo-cnt+1) := s(i);
end if;
end loop;
return res;
end Create;
procedure Write_Block ( file : in file_type; n : in natural ) is
-- DESCRIPTION :
-- This procedure writes the leading zeros.
nbz,acc : natural := 0;
begin
if n = 0
then for i in 1..expo loop
put(file,"0");
end loop;
else acc := 10;
for i in 1..(expo-1) loop
if n < acc
then nbz := expo-i;
else acc := acc*10;
end if;
exit when (nbz /= 0);
end loop;
for i in 1..nbz loop
put(file,"0");
end loop;
put(file,n,1);
end if;
end Write_Block;
procedure Write_Zero_Block ( file : in file_type ) is
begin
for i in 1..expo loop
put(file,"0");
end loop;
end Write_Zero_Block;
-- INPUT ROUTINES :
procedure get ( file : in file_type;
lc : in out character; n : in out Natural_Number ) is
s : String(1..maxl);
cvn : natural := Convert(lc);
cnt : natural := 0;
begin
while cvn < 10 loop
cnt := cnt+1;
s(cnt) := lc;
exit when End_of_Line(file) or (cnt = s'last);
-- Skip_Spaces(file,lc);
Skip_Underscores(file,lc);
cvn := Convert(lc);
end loop;
declare
sz : constant natural := Size(cnt);
sn : Array_of_Strings(0..sz) := Create(sz,s(1..cnt));
an : Array_of_Naturals(0..sz) := Convert(sn);
begin
Clear(n);
n := Create(an);
end;
end get;
procedure get ( lc : in out character; n : in out Natural_Number ) is
begin
get(Standard_Input,lc,n);
end get;
procedure get ( n : in out Natural_Number ) is
begin
get(Standard_Input,n);
end get;
procedure get ( file : in file_type; n : in out Natural_Number ) is
c : character;
begin
Skip_Spaces(file,c);
get(file,c,n);
end get;
-- OUTPUT ROUTINES :
procedure put ( n : in Natural_Number ) is
begin
put(Standard_Output,n);
end put;
procedure put ( file : in file_type; n : in Natural_Number ) is
-- NOTE : the blocks can be separated by underscores.
-- In principal, other symbols could be used, however, only underscores
-- are skipped when processing a natural number.
first : boolean := true; -- first nonzero, leading block still to write
coeff : natural;
begin
if Empty(n)
then put(file,"0");
else for i in reverse 0..Size(n) loop
coeff := Coefficient(n,i);
if coeff /= 0
then if first
then put(file,coeff,1); first := false;
else Write_Block(file,coeff);
end if;
elsif not first
then Write_Zero_Block(file);
-- else skip leading zeros
end if;
-- if (not first and (i>0)) -- leading block written and not at end
-- then put(file,"_"); -- so, write a separator symbol
-- end if;
end loop;
if first
then put(file,"0"); -- there was no nonzero block, so n=0.
end if;
end if;
end put;
procedure put ( n : in Array_of_Naturals ) is
begin
put(Standard_Output,n);
end put;
procedure put ( file : in file_type; n : in Array_of_Naturals ) is
begin
for i in reverse n'range loop
if n(i) = 0
then Write_Zero_Block(file);
else Write_Block(file,n(i));
end if;
-- if i > 0
-- then put(file,"_");
-- end if;
end loop;
end put;
procedure put ( n : in Natural_Number; dp : in natural ) is
begin
put(Standard_Output,n,dp);
end put;
procedure put ( file : in file_type;
n : in Natural_Number; dp : in natural ) is
begin
for i in 1..(dp-Decimal_Places(n)) loop
put(file," ");
end loop;
put(file,n);
end put;
end Multprec_Natural_Numbers_io;