Task: Parsing_Shunting-yard algorithm








VB: Module Module1
    Class SymbolType
        Public ReadOnly symbol As String
        Public ReadOnly precedence As Integer
        Public ReadOnly rightAssociative As Boolean

        Public Sub New(symbol As String, precedence As Integer, rightAssociative As Boolean)
            Me.symbol = symbol
            Me.precedence = precedence
            Me.rightAssociative = rightAssociative
        End Sub
    End Class

    ReadOnly Operators As Dictionary(Of String, SymbolType) = New Dictionary(Of String, SymbolType) From
    {
        {"^", New SymbolType("^", 4, True)},
        {"*", New SymbolType("*", 3, False)},
        {"/", New SymbolType("/", 3, False)},
        {"+", New SymbolType("+", 2, False)},
        {"-", New SymbolType("-", 2, False)}
    }

    Function ToPostfix(infix As String) As String
        Dim tokens = infix.Split(" ")
        Dim stack As New Stack(Of String)
        Dim output As New List(Of String)

        Dim Print = Sub(action As String) Console.WriteLine("{0,-4} {1,-18} {2}", action + ":", $"stack[ {String.Join(" ", stack.Reverse())} ]", $"out[ {String.Join(" ", output)} ]")

        For Each token In tokens
            Dim iv As Integer
            Dim op1 As SymbolType
            Dim op2 As SymbolType
            If Integer.TryParse(token, iv) Then
                output.Add(token)
                Print(token)
            ElseIf Operators.TryGetValue(token, op1) Then
                While stack.Count > 0 AndAlso Operators.TryGetValue(stack.Peek(), op2)
                    Dim c = op1.precedence.CompareTo(op2.precedence)
                    If c < 0 OrElse Not op1.rightAssociative AndAlso c <= 0 Then
                        output.Add(stack.Pop())
                    Else
                        Exit While
                    End If
                End While
                stack.Push(token)
                Print(token)
            ElseIf token = "(" Then
                stack.Push(token)
                Print(token)
            ElseIf token = ")" Then
                Dim top = ""
                While stack.Count > 0
                    top = stack.Pop()
                    If top <> "(" Then
                        output.Add(top)
                    Else
                        Exit While
                    End If
                End While
                If top <> "(" Then
                    Throw New ArgumentException("No matching left parenthesis.")
                End If
                Print(token)
            End If
        Next
        While stack.Count > 0
            Dim top = stack.Pop()
            If Not Operators.ContainsKey(top) Then
                Throw New ArgumentException("No matching right parenthesis.")
            End If
            output.Add(top)
        End While
        Print("pop")
        Return String.Join(" ", output)
    End Function

    Sub Main()
        Dim infix = "3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3"
        Console.WriteLine(ToPostfix(infix))
    End Sub

End Module



Fortran:       MODULE COMPILER	
       INTEGER KBD,MSG		

       INTEGER ENUFF		
       PARAMETER (ENUFF = 66)	
       CHARACTER*(ENUFF) RP	
       INTEGER LR		

       INTEGER		OPSYMBOLS		
       PARAMETER	(OPSYMBOLS = 11)	
       TYPE SYMB		
        CHARACTER*1	IS		
        INTEGER*1	PRECEDENCE	
        CHARACTER*48	USAGE		
       END TYPE SYMB		
       TYPE(SYMB) SYMBOL(0:OPSYMBOLS)	
       PARAMETER (SYMBOL =(/	
     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	
       PARAMETER	(BRAOPEN = "([{", BRACLOSE = ")]}")	
       INTEGER		BRALEVEL		
       INTEGER		PRBRA,PRPOW		
       PARAMETER (PRBRA = SYMBOL( 3).PRECEDENCE)	
       PARAMETER (PRPOW = SYMBOL(11).PRECEDENCE)	

       CHARACTER*10 DIGIT		
       PARAMETER (DIGIT = "0123456789")	

       INTEGER STACKLIMIT		
       PARAMETER (STACKLIMIT = 66)	
       TYPE DEFERRED			
        CHARACTER*1	OPC		
        INTEGER*1	PRECEDENCE	
       END TYPE DEFERRED		
       TYPE(DEFERRED) OPSTACK(0:STACKLIMIT)	
       INTEGER OSP			

       INTEGER INCOMING,TOKENTYPE,NOTHING,ANUMBER,OPENBRA,HUH		
       PARAMETER (NOTHING = 0, ANUMBER = -1, OPENBRA = -2, HUH = -3)	
       CONTAINS	
        SUBROUTINE EMIT(STUFF)	
         CHARACTER*(*) STUFF	
         INTEGER L		
          WRITE (MSG,1) STUFF	
    1     FORMAT ("Emit  ",A)	
          IF (STUFF.EQ."") RETURN	
          L = LEN(STUFF)	
          IF (LR + L.GE.ENUFF) STOP "Too much RPN for RP
          IF (LR.GT.0) THEN	
            LR = LR + 1			
            RP(LR:LR) = " "		
          END IF		
          RP(LR + 1:LR + L) = STUFF	
          LR = LR + L			
        END SUBROUTINE EMIT	

        SUBROUTINE STACKOP(C,P)	
         CHARACTER*1 C	
         INTEGER P	
          OSP = OSP + 1		
          IF (OSP.GT.STACKLIMIT) STOP "OSP overtopped
          OPSTACK(OSP).OPC = C		
          OPSTACK(OSP).PRECEDENCE = P	
          WRITE (MSG,1) C,OPSTACK(1:OSP)	
    1     FORMAT ("Stack ",A1,9X,",OpStk=",33(A1,I2:","))
        END SUBROUTINE STACKOP	

        LOGICAL FUNCTION COMPILE(TEXT)	
         CHARACTER*(*) TEXT	
         INTEGER L1,L2		
         CHARACTER*1 C		
         INTEGER HAPPY		
          LR = 0		
          OSP = 0		
          OPSTACK(0).OPC = ""		
          OPSTACK(0).PRECEDENCE = 0	
          BRALEVEL = 0		
          HAPPY = +1		
          L2 = 1		
Chew into an operand, possibly obstructed by an open bracket.
  100     CALL FORASIGN		
          IF (TOKENTYPE.EQ.NOTHING) THEN	
            IF (OSP.GT.0) CALL GRUMP("Another operand or one of "	
     1       //BRAOPEN//" is expected.")				
          ELSE IF (TOKENTYPE.EQ.ANUMBER) THEN	
            CALL EMIT(TEXT(L1:L2 - 1))			
          ELSE IF (TOKENTYPE.EQ.OPENBRA) THEN	
            CALL STACKOP(C,PRBRA - 1)			
            GO TO 100					
C         ELSE IF (TOKENTYPE.EQ.ANAME) THEN	
C           CALL EMIT(TEXT(L1:L2 - 1))			
          ELSE					
            CALL GRUMP("Huh? Unexpected "//C)		
          END IF				
Chase after an operator, possibly interrupted by a close bracket,.
  200     CALL FORASIGN		
          IF (TOKENTYPE.LT.0) THEN	
            CALL GRUMP("Operator expected, not "//C)	
           ELSE			
            WRITE (MSG,201) C,INCOMING,OPSTACK(1:OSP)	
  201       FORMAT ("Oprn=>",A1,"< Prec=",I2,		
     1       ",OpStk=",33(A1,I2:","))			
            DO WHILE(OPSTACK(OSP).PRECEDENCE .GE. INCOMING)	
              IF (OPSTACK(OSP).PRECEDENCE .EQ. PRBRA - 1)		
     1         CALL GRUMP("Unbalanced "//OPSTACK(OSP).OPC)		
              CALL EMIT(OPSTACK(OSP).OPC)				
              OSP = OSP - 1						
            END DO						
            IF (TOKENTYPE.GT.NOTHING) THEN	
              IF (INCOMING.EQ.PRBRA) THEN		
                CALL BALANCEBRA(C)			
                BRALEVEL = BRALEVEL - 1			
                GO TO 200				
               ELSE				
                IF (C.EQ."^") INCOMING = PRPOW - 1	
                CALL STACKOP(C,INCOMING)		
              END IF			
            END IF			
          END IF		
Carry on?
          IF (HAPPY .GT. 0) GO TO 100 	
Completed.
          COMPILE = HAPPY.GE.0	
         CONTAINS	
          SUBROUTINE GRUMP(GROWL)	
           CHARACTER*(*) GROWL	
            WRITE (MSG,1) GROWL	
            IF (L1.GT. 1)        WRITE (MSG,1) "Tasty:",TEXT( 1:L1 - 1)	
            IF (L2.GT.L1)        WRITE (MSG,1) "Nasty:",TEXT(L1:L2 - 1)	
            IF (L2.LE.LEN(TEXT)) WRITE (MSG,1) "Misty:",TEXT(L2:)	
    1       FORMAT (4X,A,1X,A)	
            HAPPY = -1	.	
          END SUBROUTINE GRUMP	

          SUBROUTINE BALANCEBRA(B)	
           CHARACTER*1 B	
           CHARACTER*1 O	
           INTEGER IT,L		
           CHARACTER*88 GROWL	
            O = OPSTACK(OSP).OPC	
            WRITE (MSG,1) O,B		
    1       FORMAT ("Match ",2A)	
            IT = INDEX(BRAOPEN,O)	
            IF (IT .EQ. INDEX(BRACLOSE,B)) THEN	
              OSP = OSP - 1			
             ELSE	
              GROWL = "Unbalanced {[(...)]} bracketing
     1         //B//" is unmatched."				
              IF (IT.GT.0) GROWL(62:) =  "A "//BRACLOSE(IT:IT)	
     1         //" would be better."		
              CALL GRUMP(GROWL)		
            END IF			
          END SUBROUTINE BALANCEBRA	

          SUBROUTINE FORASIGN	
           INTEGER I	
            L1 = L2		
   10       IF (L1.GT.LEN(TEXT)) THEN	
              C = ""			
              L2 = L1			
              TOKENTYPE = NOTHING	
              INCOMING = SYMBOL(1).PRECEDENCE	
              HAPPY = 0			
             ELSE	
Check for spaces and move past them.
              C = TEXT(L1:L1)	
              IF (C.LE." ") THEN	
                L1 = L1 + 1		
                GO TO 10		
              END IF		
Caught something to inspect.
              L2 = L1 + 1		
              IF (INDEX(DIGIT,C).GT.0) THEN	
                TOKENTYPE = ANUMBER 		
   20           IF (L2.LE.LEN(TEXT)) THEN	
                  IF (INDEX(DIGIT,TEXT(L2:L2)).GT.0) THEN	
                    L2 = L2 + 1			
                    GO TO 20			
                  END IF			
                END IF			
C             ELSE IF (INDEX(LETTERS,C).GT.0) THEN	
C               advance L2 while in NAMEISH.
              ELSE IF (INDEX(BRAOPEN,C).GT.0) THEN	
                TOKENTYPE = OPENBRA			
              ELSE			
                DO I = OPSYMBOLS,1,-1	
                  IF (SYMBOL(I).IS .EQ. C) EXIT	
                END DO			
                IF (I.LE.0) THEN	
                  TOKENTYPE = HUH		
                  INCOMING = SYMBOL(0).PRECEDENCE	
                 ELSE			
                  TOKENTYPE = I			
                  INCOMING = SYMBOL(I).PRECEDENCE	
                END IF			
              END IF		
            END IF	
            WRITE (MSG,30) C,INCOMING,TOKENTYPE		
   30       FORMAT ("Next=>",A1,"< Prec=",I2,",Ttype=",I2)	
          END SUBROUTINE FORASIGN	
        END FUNCTION COMPILE	
      END MODULE COMPILER	

      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