]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* WholeConv.mod implement the ISO WholeConv specification. |
2 | ||
a945c346 | 3 | Copyright (C) 2008-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | Under Section 7 of GPL version 3, you are granted additional | |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 3.1, as published by the Free Software Foundation. | |
21 | ||
22 | You should have received a copy of the GNU General Public License and | |
23 | a copy of the GCC Runtime Library Exception along with this program; | |
24 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
25 | <http://www.gnu.org/licenses/>. *) | |
26 | ||
27 | IMPLEMENTATION MODULE WholeConv ; | |
28 | ||
29 | FROM CharClass IMPORT IsNumeric, IsWhiteSpace ; | |
30 | IMPORT EXCEPTIONS ; | |
31 | ||
32 | FROM ConvTypes IMPORT ScanClass ; | |
33 | ||
34 | ||
35 | TYPE | |
36 | WholeConvException = (noException, invalidSigned, invalidUnsigned) ; | |
37 | ||
38 | VAR | |
39 | wholeConv: EXCEPTIONS.ExceptionSource ; | |
40 | ||
41 | ||
42 | (* | |
43 | ScanInt - represents the start state of a finite state scanner | |
44 | for signed whole numbers - assigns class of inputCh | |
45 | to chClass and a procedure representing the next state | |
46 | to nextState. | |
47 | *) | |
48 | ||
49 | PROCEDURE ScanInt (inputCh: CHAR; | |
50 | VAR chClass: ConvTypes.ScanClass; | |
51 | VAR nextState: ConvTypes.ScanState) ; | |
52 | BEGIN | |
53 | IF IsNumeric(inputCh) | |
54 | THEN | |
55 | nextState := scanRemainingDigits ; | |
56 | chClass := valid | |
57 | ELSIF (inputCh='+') OR (inputCh='-') | |
58 | THEN | |
59 | nextState := scanFirstDigit ; | |
60 | chClass := valid | |
61 | ELSIF IsWhiteSpace(inputCh) | |
62 | THEN | |
63 | nextState := scanSpace ; | |
64 | chClass := padding | |
65 | ELSE | |
66 | nextState := ScanInt ; | |
67 | chClass := invalid | |
68 | END | |
69 | END ScanInt ; | |
70 | ||
71 | ||
72 | PROCEDURE scanFirstDigit (ch: CHAR; | |
73 | VAR chClass: ConvTypes.ScanClass; | |
74 | VAR nextState: ConvTypes.ScanState) ; | |
75 | BEGIN | |
76 | IF IsNumeric(ch) | |
77 | THEN | |
78 | chClass := valid ; | |
79 | nextState := scanRemainingDigits | |
80 | ELSE | |
81 | chClass := invalid | |
82 | END | |
83 | END scanFirstDigit ; | |
84 | ||
85 | ||
86 | PROCEDURE scanRemainingDigits (ch: CHAR; | |
87 | VAR chClass: ConvTypes.ScanClass; | |
88 | VAR nextState: ConvTypes.ScanState) ; | |
89 | BEGIN | |
90 | IF IsNumeric(ch) | |
91 | THEN | |
92 | chClass := valid | |
93 | ELSE | |
94 | chClass := terminator | |
95 | END | |
96 | END scanRemainingDigits ; | |
97 | ||
98 | ||
99 | PROCEDURE scanSpace (ch: CHAR; | |
100 | VAR chClass: ConvTypes.ScanClass; | |
101 | VAR nextState: ConvTypes.ScanState) ; | |
102 | BEGIN | |
103 | IF IsWhiteSpace(ch) | |
104 | THEN | |
105 | chClass := padding | |
106 | ELSIF (ch='+') OR (ch='-') | |
107 | THEN | |
108 | chClass := valid ; | |
109 | nextState := scanFirstDigit | |
110 | ELSE | |
111 | chClass := invalid | |
112 | END | |
113 | END scanSpace ; | |
114 | ||
115 | ||
116 | (* | |
117 | FormatInt - returns the format of the string value for | |
118 | conversion to INTEGER. | |
119 | *) | |
120 | ||
121 | PROCEDURE FormatInt (str: ARRAY OF CHAR) : ConvResults ; | |
122 | VAR | |
123 | proc : ConvTypes.ScanState ; | |
124 | chClass: ConvTypes.ScanClass ; | |
125 | i, h : CARDINAL ; | |
126 | BEGIN | |
127 | i := 1 ; | |
128 | h := LENGTH(str) ; | |
129 | ScanInt(str[0], chClass, proc) ; | |
130 | WHILE (i<h) AND (chClass=padding) DO | |
131 | proc(str[i], chClass, proc) ; | |
132 | INC(i) | |
133 | END ; | |
134 | IF chClass=terminator | |
135 | THEN | |
136 | RETURN( strEmpty ) | |
137 | END ; | |
138 | WHILE (i<h) AND (chClass=valid) DO | |
139 | proc(str[i], chClass, proc) ; | |
140 | INC(i) | |
141 | END ; | |
142 | CASE chClass OF | |
143 | ||
144 | padding : RETURN( strWrongFormat ) | | |
145 | terminator, | |
146 | valid : RETURN( strAllRight ) | | |
147 | invalid : RETURN( strWrongFormat ) | |
148 | ||
149 | END | |
150 | END FormatInt ; | |
151 | ||
152 | ||
153 | (* | |
154 | ValueInt - returns the value corresponding to the signed whole | |
155 | number string value str if str is well-formed; | |
156 | otherwise raises the WholeConv exception. | |
157 | *) | |
158 | ||
159 | PROCEDURE ValueInt (str: ARRAY OF CHAR) : INTEGER; | |
160 | VAR | |
161 | proc : ConvTypes.ScanState ; | |
162 | chClass: ConvTypes.ScanClass ; | |
163 | i, h : CARDINAL ; | |
164 | v : INTEGER ; | |
165 | value : CARDINAL ; | |
166 | neg : BOOLEAN ; | |
167 | BEGIN | |
168 | IF FormatInt(str)=strAllRight | |
169 | THEN | |
170 | value := 0 ; | |
171 | neg := FALSE ; | |
172 | i := 0 ; | |
173 | h := LENGTH(str) ; | |
174 | proc := ScanInt ; | |
175 | chClass := valid ; | |
176 | WHILE (i<h) AND ((chClass=valid) OR (chClass=padding)) DO | |
177 | IF str[i]='-' | |
178 | THEN | |
179 | neg := NOT neg | |
180 | ELSIF str[i]='+' | |
181 | THEN | |
182 | (* ignore *) | |
183 | ELSIF IsNumeric(str[i]) | |
184 | THEN | |
185 | value := value*10+(ORD(str[i])-ORD('0')) | |
186 | END ; | |
187 | proc(str[i], chClass, proc) ; | |
188 | INC(i) | |
189 | END ; | |
190 | IF neg | |
191 | THEN | |
192 | v := -value | |
193 | ELSE | |
194 | v := value | |
195 | END ; | |
196 | RETURN( v ) | |
197 | ELSE | |
198 | EXCEPTIONS.RAISE(wholeConv, ORD(invalidSigned), | |
199 | 'WholeConv.' + __FUNCTION__ + ': signed number is invalid') | |
200 | END | |
201 | END ValueInt ; | |
202 | ||
203 | ||
204 | (* | |
205 | LengthInt - returns the number of characters in the string | |
206 | representation of int. | |
207 | *) | |
208 | ||
209 | PROCEDURE LengthInt (int: INTEGER) : CARDINAL ; | |
210 | VAR | |
211 | c, l: CARDINAL ; | |
212 | BEGIN | |
213 | IF int<0 | |
214 | THEN | |
215 | l := 2 ; | |
216 | IF int=MIN(INTEGER) | |
217 | THEN | |
218 | c := VAL(CARDINAL, MAX(INTEGER))+1 | |
219 | ELSE | |
220 | c := -int | |
221 | END | |
222 | ELSE | |
223 | l := 1 ; | |
224 | c := int | |
225 | END ; | |
226 | WHILE c>9 DO | |
227 | c := c DIV 10 ; | |
228 | INC(l) | |
229 | END ; | |
230 | RETURN( l ) | |
231 | END LengthInt ; | |
232 | ||
233 | ||
234 | (* | |
235 | ScanCard - represents the start state of a finite state scanner for | |
236 | unsigned whole numbers - assigns class of inputCh to | |
237 | chClass and a procedure representing the next state to | |
238 | nextState. | |
239 | *) | |
240 | ||
241 | PROCEDURE ScanCard (inputCh: CHAR; | |
242 | VAR chClass: ConvTypes.ScanClass; | |
243 | VAR nextState: ConvTypes.ScanState) ; | |
244 | BEGIN | |
245 | IF IsNumeric(inputCh) | |
246 | THEN | |
247 | nextState := scanRemainingDigits ; | |
248 | chClass := valid | |
249 | ELSIF inputCh='+' | |
250 | THEN | |
251 | nextState := scanFirstDigit ; | |
252 | chClass := valid | |
253 | ELSIF IsWhiteSpace(inputCh) | |
254 | THEN | |
255 | nextState := scanSpace ; | |
256 | chClass := padding | |
257 | ELSE | |
258 | nextState := ScanCard ; | |
259 | chClass := invalid | |
260 | END | |
261 | END ScanCard ; | |
262 | ||
263 | ||
264 | (* | |
265 | FormatCard - returns the format of the string value for | |
266 | conversion to CARDINAL. | |
267 | *) | |
268 | ||
269 | PROCEDURE FormatCard (str: ARRAY OF CHAR) : ConvResults ; | |
270 | VAR | |
271 | proc : ConvTypes.ScanState ; | |
272 | chClass: ConvTypes.ScanClass ; | |
273 | i, h : CARDINAL ; | |
274 | BEGIN | |
275 | i := 1 ; | |
276 | h := LENGTH(str) ; | |
277 | ScanCard(str[0], chClass, proc) ; | |
278 | WHILE (i<h) AND (chClass=padding) DO | |
279 | proc(str[i], chClass, proc) ; | |
280 | INC(i) | |
281 | END ; | |
282 | IF chClass=terminator | |
283 | THEN | |
284 | RETURN( strEmpty ) | |
285 | END ; | |
286 | WHILE (i<h) AND (chClass=valid) DO | |
287 | proc(str[i], chClass, proc) ; | |
288 | INC(i) | |
289 | END ; | |
290 | CASE chClass OF | |
291 | ||
292 | padding : RETURN( strWrongFormat ) | | |
293 | terminator, | |
294 | valid : RETURN( strAllRight ) | | |
295 | invalid : RETURN( strWrongFormat ) | |
296 | ||
297 | END | |
298 | END FormatCard ; | |
299 | ||
300 | ||
301 | (* | |
302 | ValueCard - returns the value corresponding to the unsigned | |
303 | whole number string value str if str is well-formed; | |
304 | otherwise raises the WholeConv exception. | |
305 | *) | |
306 | ||
307 | PROCEDURE ValueCard (str: ARRAY OF CHAR) : CARDINAL ; | |
308 | VAR | |
309 | proc : ConvTypes.ScanState ; | |
310 | chClass: ConvTypes.ScanClass ; | |
311 | i, h : CARDINAL ; | |
312 | value : CARDINAL ; | |
313 | BEGIN | |
314 | IF FormatCard(str)=strAllRight | |
315 | THEN | |
316 | value := 0 ; | |
317 | i := 0 ; | |
318 | h := LENGTH(str) ; | |
319 | ScanCard(str[0], chClass, proc) ; | |
320 | proc := ScanCard ; | |
321 | chClass := valid ; | |
322 | WHILE (i<h) AND ((chClass=valid) OR (chClass=padding)) DO | |
323 | IF str[i]='+' | |
324 | THEN | |
325 | (* ignore *) | |
326 | ELSIF IsNumeric(str[i]) | |
327 | THEN | |
328 | value := value*10+(ORD(str[i])-ORD('0')) | |
329 | END ; | |
330 | proc(str[i], chClass, proc) ; | |
331 | INC(i) | |
332 | END ; | |
333 | RETURN( value ) | |
334 | ELSE | |
335 | EXCEPTIONS.RAISE(wholeConv, ORD(invalidUnsigned), | |
336 | 'WholeConv:' + __FUNCTION__ + ': unsigned number is invalid') | |
337 | END | |
338 | END ValueCard ; | |
339 | ||
340 | ||
341 | (* | |
342 | LengthCard - returns the number of characters in the string | |
343 | representation of, card. | |
344 | *) | |
345 | ||
346 | PROCEDURE LengthCard (card: CARDINAL) : CARDINAL ; | |
347 | VAR | |
348 | l: CARDINAL ; | |
349 | BEGIN | |
350 | l := 1 ; | |
351 | WHILE card>9 DO | |
352 | card := card DIV 10 ; | |
353 | INC(l) | |
354 | END ; | |
355 | RETURN( l ) | |
356 | END LengthCard ; | |
357 | ||
358 | ||
359 | (* | |
360 | IsWholeConvException - returns TRUE if the current coroutine is | |
361 | in the exceptional execution state because | |
362 | of the raising of an exception in a routine | |
363 | from this module; otherwise returns FALSE. | |
364 | *) | |
365 | ||
366 | PROCEDURE IsWholeConvException () : BOOLEAN ; | |
367 | BEGIN | |
368 | RETURN( EXCEPTIONS.IsCurrentSource(wholeConv) ) | |
369 | END IsWholeConvException ; | |
370 | ||
371 | ||
372 | BEGIN | |
373 | EXCEPTIONS.AllocateSource(wholeConv) | |
374 | END WholeConv. |