Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/multprec_natural_numbers_io.adb, Revision 1.1.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