Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/multprec_natural_numbers_io.adb, Revision 1.1
1.1 ! maekawa 1: with text_io,integer_io; use text_io,integer_io;
! 2: with Characters_and_Numbers; use Characters_and_Numbers;
! 3:
! 4: package body Multprec_Natural_Numbers_io is
! 5:
! 6: -- IMPORTANT NOTICE :
! 7: -- The choice of base is assumed to be decimal.
! 8:
! 9: -- CONSTANTS :
! 10:
! 11: expo : constant natural := Multprec_Natural_Numbers.Exponent;
! 12: maxl : constant natural := 200;
! 13:
! 14: -- DATA STRUCTURE :
! 15:
! 16: type Array_of_Strings is array ( natural range <> ) of String(1..expo);
! 17:
! 18: -- BASIC PRIMITIVES FOR INPUT/OUTPUT :
! 19:
! 20: function Convert ( s : Array_of_Strings ) return Array_of_Naturals is
! 21:
! 22: res : Array_of_Naturals(s'range) := (s'range => 0);
! 23:
! 24: begin
! 25: for i in reverse s'range loop
! 26: res(res'last-i) := Convert(s(i));
! 27: end loop;
! 28: return res;
! 29: end Convert;
! 30:
! 31: function Size ( len : natural ) return natural is
! 32:
! 33: -- DESCRIPTION :
! 34: -- Given the number of characters read, the size of the natural number
! 35: -- will be determined.
! 36:
! 37: res : natural := len/expo;
! 38:
! 39: begin
! 40: if expo*res = len
! 41: then return res-1;
! 42: else return res;
! 43: end if;
! 44: end Size;
! 45:
! 46: function Create ( l : in natural; s : in String ) return Array_of_Strings is
! 47:
! 48: -- DESCRIPTION :
! 49: -- Partitions the string in blocks, according to the base.
! 50:
! 51: res : Array_of_Strings(0..l);
! 52: ind : natural := l;
! 53: cnt : natural := 0;
! 54:
! 55: begin
! 56: for i in res'range loop
! 57: res(i) := (res(i)'range => ' ');
! 58: end loop;
! 59: for i in reverse s'range loop
! 60: cnt := cnt + 1;
! 61: if cnt <= expo
! 62: then res(ind)(expo-cnt+1) := s(i);
! 63: else ind := ind-1;
! 64: cnt := 1;
! 65: res(ind)(expo-cnt+1) := s(i);
! 66: end if;
! 67: end loop;
! 68: return res;
! 69: end Create;
! 70:
! 71: procedure Write_Block ( file : in file_type; n : in natural ) is
! 72:
! 73: -- DESCRIPTION :
! 74: -- This procedure writes the leading zeros.
! 75:
! 76: nbz,acc : natural := 0;
! 77:
! 78: begin
! 79: if n = 0
! 80: then for i in 1..expo loop
! 81: put(file,"0");
! 82: end loop;
! 83: else acc := 10;
! 84: for i in 1..(expo-1) loop
! 85: if n < acc
! 86: then nbz := expo-i;
! 87: else acc := acc*10;
! 88: end if;
! 89: exit when (nbz /= 0);
! 90: end loop;
! 91: for i in 1..nbz loop
! 92: put(file,"0");
! 93: end loop;
! 94: put(file,n,1);
! 95: end if;
! 96: end Write_Block;
! 97:
! 98: procedure Write_Zero_Block ( file : in file_type ) is
! 99: begin
! 100: for i in 1..expo loop
! 101: put(file,"0");
! 102: end loop;
! 103: end Write_Zero_Block;
! 104:
! 105: -- INPUT ROUTINES :
! 106:
! 107: procedure get ( file : in file_type;
! 108: lc : in out character; n : in out Natural_Number ) is
! 109:
! 110: s : String(1..maxl);
! 111: cvn : natural := Convert(lc);
! 112: cnt : natural := 0;
! 113:
! 114: begin
! 115: while cvn < 10 loop
! 116: cnt := cnt+1;
! 117: s(cnt) := lc;
! 118: exit when End_of_Line(file) or (cnt = s'last);
! 119: -- Skip_Spaces(file,lc);
! 120: Skip_Underscores(file,lc);
! 121: cvn := Convert(lc);
! 122: end loop;
! 123: declare
! 124: sz : constant natural := Size(cnt);
! 125: sn : Array_of_Strings(0..sz) := Create(sz,s(1..cnt));
! 126: an : Array_of_Naturals(0..sz) := Convert(sn);
! 127: begin
! 128: Clear(n);
! 129: n := Create(an);
! 130: end;
! 131: end get;
! 132:
! 133: procedure get ( lc : in out character; n : in out Natural_Number ) is
! 134: begin
! 135: get(Standard_Input,lc,n);
! 136: end get;
! 137:
! 138: procedure get ( n : in out Natural_Number ) is
! 139: begin
! 140: get(Standard_Input,n);
! 141: end get;
! 142:
! 143: procedure get ( file : in file_type; n : in out Natural_Number ) is
! 144:
! 145: c : character;
! 146:
! 147: begin
! 148: Skip_Spaces(file,c);
! 149: get(file,c,n);
! 150: end get;
! 151:
! 152: -- OUTPUT ROUTINES :
! 153:
! 154: procedure put ( n : in Natural_Number ) is
! 155: begin
! 156: put(Standard_Output,n);
! 157: end put;
! 158:
! 159: procedure put ( file : in file_type; n : in Natural_Number ) is
! 160:
! 161: -- NOTE : the blocks can be separated by underscores.
! 162: -- In principal, other symbols could be used, however, only underscores
! 163: -- are skipped when processing a natural number.
! 164:
! 165: first : boolean := true; -- first nonzero, leading block still to write
! 166: coeff : natural;
! 167:
! 168: begin
! 169: if Empty(n)
! 170: then put(file,"0");
! 171: else for i in reverse 0..Size(n) loop
! 172: coeff := Coefficient(n,i);
! 173: if coeff /= 0
! 174: then if first
! 175: then put(file,coeff,1); first := false;
! 176: else Write_Block(file,coeff);
! 177: end if;
! 178: elsif not first
! 179: then Write_Zero_Block(file);
! 180: -- else skip leading zeros
! 181: end if;
! 182: -- if (not first and (i>0)) -- leading block written and not at end
! 183: -- then put(file,"_"); -- so, write a separator symbol
! 184: -- end if;
! 185: end loop;
! 186: if first
! 187: then put(file,"0"); -- there was no nonzero block, so n=0.
! 188: end if;
! 189: end if;
! 190: end put;
! 191:
! 192: procedure put ( n : in Array_of_Naturals ) is
! 193: begin
! 194: put(Standard_Output,n);
! 195: end put;
! 196:
! 197: procedure put ( file : in file_type; n : in Array_of_Naturals ) is
! 198: begin
! 199: for i in reverse n'range loop
! 200: if n(i) = 0
! 201: then Write_Zero_Block(file);
! 202: else Write_Block(file,n(i));
! 203: end if;
! 204: -- if i > 0
! 205: -- then put(file,"_");
! 206: -- end if;
! 207: end loop;
! 208: end put;
! 209:
! 210: procedure put ( n : in Natural_Number; dp : in natural ) is
! 211: begin
! 212: put(Standard_Output,n,dp);
! 213: end put;
! 214:
! 215: procedure put ( file : in file_type;
! 216: n : in Natural_Number; dp : in natural ) is
! 217: begin
! 218: for i in 1..(dp-Decimal_Places(n)) loop
! 219: put(file," ");
! 220: end loop;
! 221: put(file,n);
! 222: end put;
! 223:
! 224: end Multprec_Natural_Numbers_io;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to multprec_natural_numbers_io.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers