PLACE
spec
solutions
Fortran

RPN Calculator in Fortran

Was I to use an older version of the language, fully implementing the calculator in Fortran would not be possible. Old Fortrans, including Fortran 77, make no provision for dynamic allocation – not even recursion – and therefore introduction of hard-coded explicit limitations on the amount of input data is inavoidable. The following implementation is in Fortran 95.

The calculator consists of a main routine and three subroutines nested in it. Readline reads a current line and returns it as an array of characters pointed to by bp, whose length is stored in nc. On end of input, readline sets nc to -1, to which the main program reacts by stopping execution.

Empty lines and ones containing only blanks are detected by the call of the array function all, and correspondingly not processed further. Non-empty lines are passed to evalrpn, which returns a Boolean (logical, in Fortran), indicating success or failure in evaluating an RPN expression. When successful, evalrpn sets r to the result obtained. Correspondingly, the main program prints either that result or an error message.

Readline dynamically maintains a buffer to store the characters that it finds on the standard input. The capacity sz of the buffer is initially set to 100 and doubles whenever necessary. Enlarging the buffer requires several steps. First, a new portion of memory is allocated and pointed at by the temporary pointer p. Next, the contents of the current buffer are copied to the new place. The old buffer's space is then deallocated and, finally, bp is set to point at the new buffer. Because sz has to retain its value between calls of readline, it is declared save, meaning static.

Reading itself is done one character at a time. If a character is successfully read and it turns out to be a tab (char(9)), it is replaced by an ordinary space character for the sake of simplifying the parsing phase later on.

There are several options that control the behaviour of the read operator. Advance='no' means that, if possible, the next reading operation should continue on the same line rather than advancing to the next one. Eor= and end= specify labels, within the subroutine, to pass control to when end-of-record (i.e., end-of-line) and end-of-input conditions occur.

Evalrpn is a recursive function, and as such it is mandatory to declare a variable (here, ok) that holds the function's returned value. As stated above, that value is Boolean. The function scans backward the RPN expression to evaluate it recursively. It makes use of the adjustl and scan intrinsic functions for finding a token, which it then checks on being a number, an operator, or none. A number, if any, is obtained through a call of readnum. If the current token is an operator, and if the two calls of evalrpn to itself for finding the operator's arguments are successful, the resulting value r is computed. Each time a token has been processed, the expression s is correspondingly shortened.

Evalrpn returns .false., indicating lack of success, when it finds an invalid token, or when no token at all is available for it to process, or when tokens are left out in the expression after the evaluation is completed. The last of these cases is detected within the top-level call of evalrpn – the one that comes from the main program and not from evalrpn itself. In order to tell whether the current call is not the top-level one, evalrpn is equipped, besides s and r, with an optional third parameter nested, only used in the nested calls to itself. That parameter's value is irrelevant – it suffices to check whether the actual argument is present.

While the main program receives the input string as an array of characters, it passes it to evalrpn as a character string. Strings and arrays of characters are very different objects in Fortran. The work with each one is facilitated by a set of intrinsic functions, not applicable to the other. Strings cannot be dynamically allocated with varying size, only arrays, that is why readln has to use an array buffer. For evalrpn, however, a string is better, in view of the kind of processing needed.

The transition from an array to a string is done by a call of transfer in the main program. In that call, the array is reversed, so that evalrpn could work on the resulting string from start to end to evaluate the expression from its last token backwards. Reversing is specified by the triplet (nc:1:-1). A space is appended to the resulting string to ensure that even after all tokens are removed, there still will be at least one character left in the string – this is a property on which evalrpn relies.

Finding out whether a token parses as a number is a responsibility of the readnum function. Logically, readnum should be local to evalrpn, but the latter is already nested (contained), and Fortran does not allow nesting more than once. Readnum is a Boolean-valued function. If the string that it receives represents a number, it returns .true. and its second parameter, r, is set to that number. Being not recursive, the returned value is carried by a variable named after the function, and not by a different variable, as is the case with evalrpn.

Through counting the characters that it finds in a string, readnum ensures that the string does read as a number, namely, there are digits, possibly a decimal dot, and possibly an arithmetic sign in front of it, and there are no other characters. It turns out to be a bit more convenient to do these checks on an array rather than on a string, so the string s is transferred (again) into an array ca. Finally, if its content is found to represent a number, ca is transferred back into a string rs, which is read out into r by the read statement. The latter uses rs as an internal input file. Note that ca has to be reversed before it is transferred, to restore the original order of characters of the input line. (And this is one more reason to have an array as an intermediate representation of the given string: there is no direct way to reverse a string as there is for arrays.)

In principle, there should be no need for one to program explicitly the test of whether a string reads as a number. The read statement can be given an err= option, similar to eor= and end= that we have used in readln, which provides a label to receive control if an error occurs while reading. It seems, however, that the language leaves undefined what happens when a non-number string is being read as a number using free format (*). It follows that certain non-numbers can still be seen as numbers by read instead of raising an error condition, i.e. the err= option is rendered useless in this case. Hence, the whole readnum subroutine is needed, rather than just using read, to avoid such misinterpretations.

      character, pointer :: bp(:)
      do
        call readln()
        if (nc<0) stop
        if (all(bp(1:nc)==' ')) cycle
        if (evalrpn(transfer(bp(nc:1:-1),repeat(' ',nc))//' ',r)) then
          print '(f0.6)', r
        else
          print '(a)', 'error'
        end if
      end do

      contains
      subroutine readln()
      integer, save :: sz = 0
      character, pointer :: p(:)
      character :: c
      if (sz==0) then;  sz = 100;  allocate(bp(sz));  end if
      nc = 0
      do
        read (*,'(a)',advance='no',eor=2,end=1) c
        if (c==char(9))  c = ' '
        if (nc==sz) then
          n = 2*sz
          allocate(p(n))
          p = bp(1:sz)
          deallocate(bp)
          bp => p
          sz = n
        end if
        nc = nc+1
        bp(nc) = c
      end do
    1 nc = -1
    2 end subroutine

      recursive function evalrpn(s,r,nested) result(ok)
      logical :: ok
      optional :: nested
      character(*) :: s
      character :: c
      s = adjustl(s)
      c = s(1:1)
      if (c==' ') goto 1
      i = scan(s,' ')
      ok = readnum(s(:i-1),r)
      s = s(i:)
      if (.not.ok) then
        if (i>2 .or. verify(c,'+-*/')>0) goto 1
        if (.not.evalrpn(s,y,0)) goto 1
        if (.not.evalrpn(s,x,0)) goto 1
        select case(c)
          case('+'); r = x+y
          case('-'); r = x-y
          case('*'); r = x*y
          case('/'); r = x/y
        end select
      end if
      if (present(nested)) then
        ok = .true.
      else
        ok = verify(s,' ')==0
      end if
      return
    1 ok = .false.
      end function

      function readnum(s,r)
      logical :: readnum
      character(*) :: s
      character :: ca(len(s))
      character(len(s)) :: rs
      ca = transfer(s,ca)
      kd = 0;  kt = 0;  ks = 0
      n = len(s)
      do i=1,n
        if (verify(ca(i),'0123456789')==0) then
          kd = kd+1
        else if (ca(i)=='.') then
          kt = kt+1
        else if (ca(i)=='+' .or. ca(i)=='-') then
          if (i<n) ks = 1
          ks = ks+1
        end if
      end do
      readnum = kd>0 .and. kt<=1 .and. ks<=1 .and. kd+kt+ks==n
      if (readnum) then
        rs = transfer(ca(n:1:-1),rs)
        read (rs,*) r
        readnum = .true.
      end if
      return
      end function
      end program

boykobbatgmaildotcom