The implementation consists of one main procedure,
rpn, and two help procedures, local within
rpn. The main procedure is an infinite loop, terminated by raising an exception when end of input is encountered. A line is read character by character and stored in the string
s, while getting rid of possible horizontal-tab characters by replacing each one with an ordinary space.
s is an ‘unbounded string’: a library-provided type which, unlike the ordinary strings in Ada, can grow unrestrictedly. By calling
s we remove from (
Both) its ends any possible blanks, and then, if the result is non-empty, we reverse the string and evaluate the RPN expression in it. These two actions are carried out by the two help procedures.
evalrpn is recursive in
slice, it extracts a token
tk and removes the corresponding part from
s is a reversed input, the contents of
tk are reversed again to restore the original order of characters. Note that, like
tk has to be an unbounded string, because we do not want to arbitrarily restrict the length of the tokens that can be handled.
tk is one of
/, two calls of
evalrpn to itself provide the numbers
x on which the operator is to act and the operation itself is carried out. Otherwise, a call to
get tries to read
tk as a number. This can fail in two ways. If there is no number in
data_error exception is raised by
tk contains a number but there are trailing characters left out, the
data_error exception is
evalrpn also raises the same exception when a call to itself finds
s empty (apart from possible blanks), and thus
find_token cannot extract a token. Finally, the same
data_error exception is raised in
rpn if there are nonblanks in
evalrpn has completed the evaluation of the RPN expression.
data_error exceptions designate RPN syntax errors and are eventually handled in
rpn by printing an error message in place of a numeric result.
The program makes use of a lot of library functions belonging to various packages – the
with statements tell the compiler precisely which ones. In addition, the
use statements permit the functions to be called by their proper names instead of having to provide complete names by explicitly prefixing each proper name with the corresponding package name. There are still two names (of constants) defined within the package
ada.strings which are being called by complete names, as that package is not imported in the program.
with text_io; use text_io; with ada.float_text_io; use ada.float_text_io; with ada.strings.unbounded; use ada.strings.unbounded; with ada.strings.maps; use ada.strings.maps; with ada.strings.fixed; use ada.strings.fixed; procedure rpn is procedure reverse_ubstring(s: in out unbounded_string) is i,j: natural; c: character; begin i := 1; j := length(s); loop c := element(s,i); replace_element(s,i,element(s,j)); replace_element(s,j,c); i := i+1; j := j-1; exit when i>=j; end loop; end; s: unbounded_string; function evalrpn return float is m,n: natural; tk: unbounded_string; x,y,z: float; begin find_token(s,to_set(" "),ada.strings.Outside,m,n); if m>n then raise data_error; end if; tk := to_unbounded_string(slice(s,m,n)); delete(s,m,n); reverse_ubstring(tk); m := index("+-*/",to_string(tk)); if length(tk) = 1 and m > 0 then y := evalrpn; x := evalrpn; case m is when 1 => z := x+y; when 2 => z := x-y; when 3 => z := x*y; when others => z := x/y; end case; else get(to_string(tk),z,n); if n < length(tk) then raise data_error; end if; end if; return z; end; c: character; z: float; begin -- main loop s := to_unbounded_string(""); loop get(c); if c = character'val(9) then c := ' '; end if; append(s,c); exit when end_of_line; end loop; trim(s,ada.strings.Both); if length(s) > 0 then reverse_ubstring(s); begin z := evalrpn; if index_non_blank(s) > 0 then raise data_error; end if; put(z); exception when e: data_error => put("error"); end; new_line; end if; end loop; exception when e: end_error => return; end;