Vilket programmeringsspråk?

program RPN_Evaluator
  implicit none
  character, pointer :: bp(:)  ! Buffertpekare för teckensträngen
  integer :: nc, sz, n  ! Räknare för antal tecken, buffertstorlek och temporär storlek
  character, pointer :: p(:)  ! Hjälppekare för buffertreallokering
  character :: c  ! Temporär variabel för att läsa in tecken
  real :: r, x, y  ! Variabler för att hålla resultat och operandvärden
  logical :: ok  ! Flagga för att indikera om utvärderingen lyckades eller inte
  character(*) :: s, rs  ! Strängvariabler för inmatning och temporärt omvänt polskt uttryck
  character :: ca(len(s))  ! Hjälparray för att omvandla sträng till teckenarray

  ! Huvudloopen
  do
    call readln()
    if (nc<0) stop
    if (all(bp(1:nc)==' ')) cycle  ! Hoppa över iterationen om det bara finns mellanslag i inmatningen

    ! Utvärdera omvänt polskt notation (RPN)
    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  ! Spara buffertstorleken mellan anrop
    character, pointer :: p(:)  ! Hjälppekare för buffertreallokering
    character :: c  ! Temporär variabel för att läsa in tecken
    if (sz==0) then
      sz = 100
      allocate(bp(sz))  ! Allokera bufferten för teckensträngen om den inte har allokerats tidigare
    end if
    nc = 0  ! Återställ antalet tecken räknare

    ! Läs inmatningen tecken för tecken
    do
      read (*,'(a)',advance='no',eor=2,end=1) c
      if (c==char(9)) c = ' '  ! Ersätt tab-tecken med mellanslag

      ! Kontrollera om bufferten är full och utöka den i så fall
      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  ! Återställ antalet tecken räknare

  2 end subroutine

  recursive function evalrpn(s, r, nested) result(ok)
    logical :: ok  ! Flagga för att indikera om utvärderingen lyckades eller inte
    optional :: nested  ! Tillval för att markera inre utvärdering
    character(*) :: s  ! Inmatningssträng för omvänt polskt uttryck
    character :: c  ! Temporär variabel för att hantera tecken
    integer :: i  ! Iterationsvariabel för att skanna in uttrycket
    real :: x, y  ! Variabler för att hålla operandvärden
    real, optional :: r  ! Variabel för att hålla resultatet
    character(*) :: s  ! Inmatningssträng för omvänt polskt uttryck
    logical :: ok  ! Flagga för att indikera om utvärderingen lyckades eller inte
    character :: c  ! Temporär variabel för att hantera tecken

    ! Trimma bort eventuella inledande mellanslag
    s = adjustl(s)
    c = s(1:1)

    if (c==' ') goto 1  ! Hoppa till etikett 1 om inmatningen börjar med mellanslag

    ! Skanna in första talet eller operatorn
    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  ! Hoppa till etikett 1 om operatorn inte är giltig eller det inte finns något att utvärdera
      if (.not.evalrpn(s, y, 0)) goto 1  ! Rekursivt utvärdera andra operanden
      if (.not.evalrpn(s, x, 0)) goto 1  ! Rekursivt utvärdera första operanden

      ! Utför beräkningen baserat på operatorn
      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.  ! Om utvärderingen är inbäddad, sätt flaggan till sant
    else
      ok = verify(s, ' ') == 0  ! Annars kontrollera om det finns några överblivna tecken i inmatningen
    end if

    return

  1 ok = .false.  ! Om utvärderingen misslyckades, sätt flaggan till falskt

  end function evalrpn

  function readnum(s, r) result(readnum)
    logical :: readnum  ! Flagga för att indikera om strängen kan tolkas som ett tal eller inte
    character(*) :: s  ! Sträng för att kontrollera om den kan tolkas som ett tal
    character :: ca(len(s))  ! Hjälparray för att omvandla strängen till teckenarray
    character(len(s)) :: rs  ! Hjälpsträng för att konvertera strängen omvänd ordning
    real :: r  ! Variabel för att hålla det tolkade talet
    integer :: kd, kt, ks, n, i  ! Variabler för att räkna antal siffror, decimalpunkter och tecken, och för iteration
    character :: c  ! Temporär variabel för att hantera tecken

    ca = transfer(s, ca)
    kd = 0
    kt = 0
    ks = 0
    n = len(s)

    ! Kontrollera om strängen kan tolkas som ett tal
    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  ! Kontrollera om antalet siffror, decimalpunkter och tecken är korrekta

    if (readnum) then
      rs = transfer(ca(n:1:-1), rs)  ! Omvänd ordning på teckenarrayen
      read (rs, *) r  ! Konvertera strängen till ett tal
      readnum = .true.
    end if

    return
  end function readnum

end program RPN_Evaluator