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,
-1, to which the main program reacts by
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,
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
Advance='no' means that, if possible, the next reading operation should continue on the same line rather than advancing to the next one.
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
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.
.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
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
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
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
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
transferred (again) into an array
ca. Finally, if its content is found to represent a number,
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
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