PLACE
spec
solutions
Ada

RPN Calculator in Ada

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 trim on 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 s. Using find_token and slice, it extracts a token tk and removes the corresponding part from s. As s is a reversed input, the contents of tk are reversed again to restore the original order of characters. Note that, like s, tk has to be an unbounded string, because we do not want to arbitrarily restrict the length of the tokens that can be handled.

When tk is one of +, -, *, and /, two calls of evalrpn to itself provide the numbers y and 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 tk, the data_error exception is raised by get. If tk contains a number but there are trailing characters left out, the data_error exception is raised explicitly. 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 s after evalrpn has completed the evaluation of the RPN expression.

All generated 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;

boykobbatgmaildotcom