Task

Given the operator characteristics and input from the Shunting-yard algorithm page and tables, use the algorithm to show the changes in the operator stack and RPN output
as each individual token is processed.

 Assume an input of a correct, space separated, string of tokens representing an infix expression
 Generate a space separated output string representing the RPN
 Test with the input string:
  3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3  
 print and display the output here.
 Operator precedence is given in this table:


 operator 
 precedence 
 associativity 
 operation


  ^  
 4 
 right 
 exponentiation


  *  
 3 
 left 
 multiplication


  /  
 3 
 left 
 division


  +  
 2 
 left 
 addition


  -  
 2 
 left 
 subtraction



Extra credit
Add extra text explaining the actions and an optional comment for the action on receipt of each token.



Note
The handling of functions and arguments is not required.



See also

 Parsing/RPN calculator algorithm for a method of calculating a final value from this output RPN expression.
 Parsing/RPN to infix conversion.


      MODULE COMPILER	!At least of arithmetic expressions.
       INTEGER KBD,MSG		!I/O units.
 
       INTEGER ENUFF		!How long s a piece of string?
       PARAMETER (ENUFF = 66)	!This long.
       CHARACTER*(ENUFF) RP	!Holds the Reverse Polish Notation.
       INTEGER LR		!And this is its length.
 
       INTEGER		OPSYMBOLS		!Recognised operator symbols.
       PARAMETER	(OPSYMBOLS = 11)	!There are also some associates.
       TYPE SYMB		!To recognise symbols and carry associated information.
        CHARACTER*1	IS		!Its text. Careful with the trailing space and comparisons.
        INTEGER*1	PRECEDENCE	!Controls the order of evaluation.
        CHARACTER*48	USAGE		!Description.
       END TYPE SYMB		!The cross-linkage of precedences is tricky.
       TYPE(SYMB) SYMBOL(0:OPSYMBOLS)	!Righto, I'll have some.
       PARAMETER (SYMBOL =(/	!Note that "*" is not to be seen as a match to "**".
     o  SYMB(" ", 0,"Not recognised as an operator's symbol."),
     1  SYMB(" ", 1,"separates symbols and aids legibility."),
     2  SYMB(")", 4,"opened with ( to bracket a sub-expression."),
     3  SYMB("]", 4,"opened with [ to bracket a sub-expression."),
     4  SYMB("}", 4,"opened with { to bracket a sub-expression."),
     5  SYMB("+",11,"addition, and unary + to no effect."),
     6  SYMB("-",11,"subtraction, and unary - for neg. numbers."),
     7  SYMB("*",12,"multiplication."),
     8  SYMB("×",12,"multiplication, if you can find this."),
     9  SYMB("/",12,"division."),
     o  SYMB("÷",12,"division for those with a fancy keyboard."),
C                13 is used so that stacked ^ will have lower priority than incoming ^, thus delivering right-to-left evaluation.
     1  SYMB("^",14,"raise to power. Not recognised is **.")/))
       CHARACTER*3	BRAOPEN,BRACLOSE	!Three types are allowed.
       PARAMETER	(BRAOPEN = "([{", BRACLOSE = ")]}")	!These.
       INTEGER		BRALEVEL		!In and out, in and out. That's the game.
       INTEGER		PRBRA,PRPOW		!Special double values.
       PARAMETER (PRBRA = SYMBOL( 3).PRECEDENCE)	!Bracketing
       PARAMETER (PRPOW = SYMBOL(11).PRECEDENCE)	!And powers refer leftwards.
 
       CHARACTER*10 DIGIT		!Numberish is a bit more complex.
       PARAMETER (DIGIT = "0123456789")	!But this will do for integers.
 
       INTEGER STACKLIMIT		!How high is a stack?
       PARAMETER (STACKLIMIT = 66)	!This should suffice.
       TYPE DEFERRED			!I need a siding for lower-precedence operations.
        CHARACTER*1	OPC		!The operation code.
        INTEGER*1	PRECEDENCE	!Its precedence in the siding may differ.
       END TYPE DEFERRED		!Anyway, that's enough.
       TYPE(DEFERRED) OPSTACK(0:STACKLIMIT)	!One siding, please.
       INTEGER OSP			!The operation stack pointer.
 
       INTEGER INCOMING,TOKENTYPE,NOTHING,ANUMBER,OPENBRA,HUH		!Some mnemonics.
       PARAMETER (NOTHING = 0, ANUMBER = -1, OPENBRA = -2, HUH = -3)	!The ordering is not arbitrary.
       CONTAINS	!Now to mess about.
        SUBROUTINE EMIT(STUFF)	!The objective is to produce some RPN text.
         CHARACTER*(*) STUFF	!The term of the moment.
         INTEGER L		!A length.
          WRITE (MSG,1) STUFF	!Announce.
    1     FORMAT ("Emit  ",A)	!Whatever it is.
          IF (STUFF.EQ."") RETURN	!Ha ha.
          L = LEN(STUFF)	!So, how much is there to append?
          IF (LR + L.GE.ENUFF) STOP "Too much RPN for RP!"	!Perhaps too much.
          IF (LR.GT.0) THEN	!Is there existing stuff?
            LR = LR + 1			!Yes. Advance one,
            RP(LR:LR) = " "		!And place a space.
          END IF		!So much for separators.
          RP(LR + 1:LR + L) = STUFF	!Place the stuff.
          LR = LR + L			!Count it in.
        END SUBROUTINE EMIT	!Simple enough, if a bit finicky.
 
        SUBROUTINE STACKOP(C,P)	!Push an item into the siding.
         CHARACTER*1 C	!The operation code.
         INTEGER P	!Its precedence.
          OSP = OSP + 1		!Stacking up...
          IF (OSP.GT.STACKLIMIT) STOP "OSP overtopped!"	!Perhaps not.
          OPSTACK(OSP).OPC = C		!Righto,
          OPSTACK(OSP).PRECEDENCE = P	!The deed is simple.
          WRITE (MSG,1) C,OPSTACK(1:OSP)	!Announce.
    1     FORMAT ("Stack ",A1,9X,",OpStk=",33(A1,I2:","))
        END SUBROUTINE STACKOP	!So this is more for mnemonic ease.
 
        LOGICAL FUNCTION COMPILE(TEXT)	!A compiler confronts a compiler!
         CHARACTER*(*) TEXT	!To be inspected.
         INTEGER L1,L2		!Fingers for the scan.
         CHARACTER*1 C		!Character of the moment.
         INTEGER HAPPY		!Ah, shades of mood.
          LR = 0		!No output yet.
          OSP = 0		!Nothing stacked.
          OPSTACK(0).OPC = ""		!Prepare a bouncer.
          OPSTACK(0).PRECEDENCE = 0	!So that loops won't go past.
          BRALEVEL = 0		!None seen.
          HAPPY = +1		!Nor any problems.
          L2 = 1		!Syncopation: one past the end of the previous token.
Chew into an operand, possibly obstructed by an open bracket.
  100     CALL FORASIGN		!Find something to inspect.
          IF (TOKENTYPE.EQ.NOTHING) THEN	!Run off the end?
            IF (OSP.GT.0) CALL GRUMP("Another operand or one of "	!E.g. "1 +".
     1       //BRAOPEN//" is expected.")				!Give a hint, because stacked stuff awaits.
          ELSE IF (TOKENTYPE.EQ.ANUMBER) THEN	!If a number,
            CALL EMIT(TEXT(L1:L2 - 1))			!Roll all its digits.
          ELSE IF (TOKENTYPE.EQ.OPENBRA) THEN	!Starting a sub-expression?
            CALL STACKOP(C,PRBRA - 1)			!Thus ( has less precedence than ).
            GO TO 100					!And I still want an operand.
C         ELSE IF (TOKENTYPE.EQ.ANAME) THEN	!Name of something?
C           CALL EMIT(TEXT(L1:L2 - 1))			!Roll it.
          ELSE					!No further options.
            CALL GRUMP("Huh? Unexpected "//C)		!Probably something like "1 + +"
          END IF				!Righto, finished with operands.
Chase after an operator, possibly interrupted by a close bracket,.
  200     CALL FORASIGN		!Find something to inspect.
          IF (TOKENTYPE.LT.0) THEN	!But, have I an operand-like token instead?
            CALL GRUMP("Operator expected, not "//C)	!It seems so.
           ELSE			!Normally, an operator is to hand. Possibly a NOTHING, though.
            WRITE (MSG,201) C,INCOMING,OPSTACK(1:OSP)	!Document it.
  201       FORMAT ("Oprn=>",A1,"< Prec=",I2,		!Try to align with other output.
     1       ",OpStk=",33(A1,I2:","))			!So as not to clutter the display.
            DO WHILE(OPSTACK(OSP).PRECEDENCE .GE. INCOMING)	!Shunt higher-precedence stuff out.
              IF (OPSTACK(OSP).PRECEDENCE .EQ. PRBRA - 1)		!Only opening brackets have this  precedence.
     1         CALL GRUMP("Unbalanced "//OPSTACK(OSP).OPC)		!And they vanish only when meeting their closing bracket.
              CALL EMIT(OPSTACK(OSP).OPC)				!Otherwise we have an operator.
              OSP = OSP - 1						!It has gone forth.
            END DO						!On to the next.
            IF (TOKENTYPE.GT.NOTHING) THEN	!Now, only lower-precedence items are still in the stack.
              IF (INCOMING.EQ.PRBRA) THEN		!And this is a special arrival.
                CALL BALANCEBRA(C)			!It should match an earlier entry.
                BRALEVEL = BRALEVEL - 1			!Count it out.
                GO TO 200				!And I still haven't got an operator.
               ELSE				!All others are normal operators.
                IF (C.EQ."^") INCOMING = PRPOW - 1	!Special trick to cause leftwards association of x^2^3.
                CALL STACKOP(C,INCOMING)		!Shunt aside, to await the next arrival.
              END IF			!So much for that operator.
            END IF			!Providing it was not just an end-of-input flusher.
          END IF		!And not a misplaced operand.
Carry on?
          IF (HAPPY .GT. 0) GO TO 100 	!No problems, and not a nothing from the end of the text.
Completed.
          COMPILE = HAPPY.GE.0	!One hopes so.
         CONTAINS	!Now for some assistants.
          SUBROUTINE GRUMP(GROWL)	!There might be a problem.
           CHARACTER*(*) GROWL	!The fault.
            WRITE (MSG,1) GROWL	!Say it.
            IF (L1.GT. 1)        WRITE (MSG,1) "Tasty:",TEXT( 1:L1 - 1)	!Now explain the context.
            IF (L2.GT.L1)        WRITE (MSG,1) "Nasty:",TEXT(L1:L2 - 1)	!This is the token when trouble was found.
            IF (L2.LE.LEN(TEXT)) WRITE (MSG,1) "Misty:",TEXT(L2:)	!And this remains to be seen.
    1       FORMAT (4X,A,1X,A)	!A simple layout works nicely for reasonable-length texts.
            HAPPY = -1	.	!Just so.
          END SUBROUTINE GRUMP	!Enuogh said.
 
          SUBROUTINE BALANCEBRA(B)	!Perhaps a happy meeting.
           CHARACTER*1 B	!The closer.
           CHARACTER*1 O	!The putative opener.
           INTEGER IT,L		!Fingers.
           CHARACTER*88 GROWL	!A scratchpad.
            O = OPSTACK(OSP).OPC	!This should match B.
            WRITE (MSG,1) O,B		!Perhaps.
    1       FORMAT ("Match ",2A)	!Show what I've got, anyway.
            IT = INDEX(BRAOPEN,O)	!So, what sort did I save?
            IF (IT .EQ. INDEX(BRACLOSE,B)) THEN	!A friend?
              OSP = OSP - 1			!Yes. They vanish together.
             ELSE	!Otherwise, something is out of place.
              GROWL = "Unbalanced {[(...)]} bracketing! The closing "	!Alas.
     1         //B//" is unmatched."				!So, a mess.
              IF (IT.GT.0) GROWL(62:) =  "A "//BRACLOSE(IT:IT)	!Perhaps there had been no opening bracket.
     1         //" would be better."		!But if there had, this would be its friend.
              CALL GRUMP(GROWL)		!Take that!
            END IF			!So much for discrepancies.
          END SUBROUTINE BALANCEBRA	!But, hopefully, amity prevails.
 
          SUBROUTINE FORASIGN	!See what comes next.
           INTEGER I	!A stepper.
            L1 = L2		!Pick up where the previous scan left off.
   10       IF (L1.GT.LEN(TEXT)) THEN	!Are we off the end yet?
              C = ""			!Yes. Scrub the marker.
              L2 = L1			!TEXT(L1:L2 - 1) will be null.
              TOKENTYPE = NOTHING	!But this is to be checked first.
              INCOMING = SYMBOL(1).PRECEDENCE	!For flushing sidetracked operators.
              HAPPY = 0			!Fading away.
             ELSE	!Otherwise, there is grist.
Check for spaces and move past them.
              C = TEXT(L1:L1)	!Grab the first character of the prospective token.
              IF (C.LE." ") THEN	!Boring?
                L1 = L1 + 1		!Yes. Step past it.
                GO TO 10		!And look afresh.
              END IF		!Otherwise, L1 now fingers the start.
Caught something to inspect.
              L2 = L1 + 1		!This is one beyond. Just for digit strings.
              IF (INDEX(DIGIT,C).GT.0) THEN	!So, has one started?
                TOKENTYPE = ANUMBER 		!Yep.
   20           IF (L2.LE.LEN(TEXT)) THEN	!Probe ahead.
                  IF (INDEX(DIGIT,TEXT(L2:L2)).GT.0) THEN	!Another digit?
                    L2 = L2 + 1			!Yes. Leaving L1 fingering its start,
                    GO TO 20			!Chase its end.
                  END IF			!So much for another digit.
                END IF			!And checking against the end.
C             ELSE IF (INDEX(LETTERS,C).GT.0) THEN	!Some sort of name?
C               advance L2 while in NAMEISH.
              ELSE IF (INDEX(BRAOPEN,C).GT.0) THEN	!An open bracket?
                TOKENTYPE = OPENBRA			!Yep.
              ELSE			!Otherwise, anything else.
                DO I = OPSYMBOLS,1,-1	!Scan backwards, to find ** before *, if present.
                  IF (SYMBOL(I).IS .EQ. C) EXIT	!Found?
                END DO			!On to the next. A linear search will do.
                IF (I.LE.0) THEN	!Is it identified?
                  TOKENTYPE = HUH		!No.
                  INCOMING = SYMBOL(0).PRECEDENCE	!And this might provoke a flush.
                 ELSE			!If it is identified,
                  TOKENTYPE = I			!Then this is a positive number.
                  INCOMING = SYMBOL(I).PRECEDENCE	!And this is of interest.
                END IF			!Righto, anything has been identified, possibly as HUH.
              END IF		!So much for classification.
            END IF	!If there is something to see.
            WRITE (MSG,30) C,INCOMING,TOKENTYPE		!Announce.
   30       FORMAT ("Next=>",A1,"< Prec=",I2,",Ttype=",I2)	!C might be blank.
          END SUBROUTINE FORASIGN	!I call for a sign, and I see what?
        END FUNCTION COMPILE	!That's the main activity.
      END MODULE COMPILER	!So, enough of this.
 
      PROGRAM POKE
      USE COMPILER
      CHARACTER*66 TEXT
      LOGICAL HIC
      MSG = 6
      KBD = 5
      WRITE (MSG,1)
    1 FORMAT ("Produce RPN from infix...",/)
 
   10 WRITE (MSG,11)
   11 FORMAT("Infix: ",$)
      READ(KBD,12) TEXT
   12 FORMAT (A)
      IF (TEXT.EQ."") STOP "Enough."
      HIC = COMPILE(TEXT)
      WRITE (MSG,13) HIC,RP(1:LR)
   13 FORMAT (L6," RPN: >",A,"<")
      GO TO 10
      END