ProcessTokens Function

private recursive function ProcessTokens(TokenIN, NumTokensIN, StackNum, ParsingString) result(ExpressionNum)

Arguments

Type	Intent	Attributes		Name
type(TokenType),	intent(in),	DIMENSION(:)	::	TokenIN
integer,	intent(in)		::	NumTokensIN
integer,	intent(in)		::	StackNum
character(len=*),	intent(in)		::	ParsingString
Return Value integer

Source Code

RECURSIVE FUNCTION ProcessTokens(TokenIN, NumTokensIN, StackNum, ParsingString) RESULT(ExpressionNum)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Peter Graham Ellis
          !       DATE WRITTEN   June 2006
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! Processes tokens into expressions.

          ! METHODOLOGY EMPLOYED:
          ! Uses recursion to handle tokens with compound expressions

          ! USE STATEMENTS:
  USE InputProcessor, ONLY: MakeUpperCase, ProcessNumber
  USE DataInterfaces, ONLY: ShowSevereError, ShowFatalError, ShowContinueError

  IMPLICIT NONE ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE PARAMETER DEFINITIONS:

          ! DERIVED TYPE DEFINITIONS:

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  TYPE(TokenType), DIMENSION(:), INTENT(IN) :: TokenIN
  INTEGER, INTENT(IN) :: NumTokensIN
  INTEGER, INTENT(IN) :: StackNum
  INTEGER             :: ExpressionNum
  CHARACTER(len=*), INTENT(IN) :: ParsingString

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  TYPE(TokenType), DIMENSION(:), ALLOCATABLE :: Token
  TYPE(TokenType), DIMENSION(:), ALLOCATABLE :: TempToken
  TYPE(TokenType), DIMENSION(:), ALLOCATABLE :: SubTokenList
  INTEGER :: Pos
  INTEGER :: LastPos
  INTEGER :: TokenNum
  INTEGER :: NumTokens
  INTEGER :: Depth
  INTEGER :: NumSubTokens
  INTEGER :: NewNumTokens
  INTEGER :: OperatorNum
  INTEGER :: NumOperands
  INTEGER :: ParenthWhileCounter ! used to trap for unbalanced parentheses
  INTEGER :: i

          ! FLOW:
  ExpressionNum = 0
  NumTokens = NumTokensIN
  ALLOCATE(Token(NumTokens))
! safer code below
!  Token = TokenIN

  do i=1,NumTokens
    Token(i)= TokenIN(i)
  enddo

  ! Process parentheses
  Pos = 0
  DO TokenNum = 1, NumTokens
    IF (Token(TokenNum)%Type == TokenParenthesis) THEN
      Pos = TokenNum
      EXIT
    END IF
  END DO


  ParenthWhileCounter = 0

  DO WHILE((Pos > 0) .AND. (ParenthWhileCounter < 50))
    ParenthWhileCounter = ParenthWhileCounter + 1
    Depth = 0
    DO TokenNum = 1, NumTokens
      IF (Token(TokenNum)%Type == TokenParenthesis) THEN
        IF (Token(TokenNum)%Parenthesis == ParenthesisLeft) THEN
          IF (Depth == 0) Pos = TokenNum  ! Record position of first left parenthesis
          Depth = Depth + 1
        END IF
        IF (Token(TokenNum)%Parenthesis == ParenthesisRight) THEN
          Depth = Depth - 1
          IF (Depth == 0) THEN
            LastPos = TokenNum
            NumSubTokens = LastPos - Pos - 1
            ALLOCATE(SubTokenList(NumSubTokens))
            SubTokenList(1:NumSubTokens) = Token(Pos + 1:LastPos - 1)  ! Need to check that these don't exceed bounds
            ExpressionNum = ProcessTokens(SubTokenList, NumSubTokens, StackNum, ParsingString)
            DEALLOCATE(SubTokenList)

            ! Replace the parenthetical tokens with one expression token
            NewNumTokens = NumTokens - NumSubTokens - 1
            IF (NewNumTokens > 0) THEN
              ALLOCATE(TempToken(NewNumTokens))
              IF (Pos - 1 > 0) THEN
                TempToken(1:Pos - 1) = Token(1:Pos - 1)
              END IF
              IF (LastPos + 1 <= NumTokens) THEN
                TempToken(Pos + 1:) = Token(LastPos + 1:)
              END IF
              TempToken(Pos)%Type = TokenExpression
              TempToken(Pos)%Expression = ExpressionNum
              TempToken(Pos)%String = 'Expr'
              DEALLOCATE(Token)
              ALLOCATE(Token(NewNumTokens))
              Token = TempToken
              DEALLOCATE(TempToken)
              NumTokens = NewNumTokens
            END IF

            ! Reset loop for next parenthetical set
            EXIT
          END IF
        END IF
      END IF

    END DO

    ! This repeats code again...  Just checks to see if there are any more parentheses to be found
    Pos = 0
    DO TokenNum = 1, NumTokens
      IF (Token(TokenNum)%Type == TokenParenthesis) THEN
        Pos = TokenNum
        EXIT
      END IF
    END DO

  END DO

  IF (ParenthWhileCounter == 50) THEN ! symptom of mismatched parenthesis
    CALL ShowSevereError('EMS error parsing parentheses, check that parentheses are balanced')
    CALL ShowContinueError('String being parsed="'//trim(ParsingString)//'".')
    CALL ShowFatalError('Program terminates due to preceding error.')
  ENDIF

  Call SetupPossibleOperators ! includes built-in functions

  ! Process operators and builtin functions
  ! Loop thru all operators and group expressions in the order of precedence
  DO OperatorNum = 1, NumPossibleOperators

    ! Find the next occurrence of the operator
    Pos = 0 !  position in sequence of tokens
    DO TokenNum = 1, NumTokens
      IF ((Token(TokenNum)%Type == TokenOperator) &
        .AND. (Token(TokenNum)%Operator == OperatorNum)) THEN
        Pos = TokenNum
        EXIT
      END IF
    END DO

    DO WHILE (Pos > 0)
      IF (Pos == 1) THEN
        !if first token is for a built-in function starting with "@" then okay, otherwise the operator needs a LHS
        IF (Token(TokenNum)%Operator > OperatiorLogicalOR) Then ! we have a function expression to set up
          ExpressionNum = NewExpression()
          ErlExpression(ExpressionNum)%Operator = OperatorNum
          NumOperands = PossibleOperators(OperatorNum)%NumOperands
          ErlExpression(ExpressionNum)%NumOperands = NumOperands
          ALLOCATE(ErlExpression(ExpressionNum)%Operand(NumOperands))

          ErlExpression(ExpressionNum)%Operand(1)%Type        = Token(Pos + 1)%Type
          ErlExpression(ExpressionNum)%Operand(1)%Number      = Token(Pos + 1)%Number
          ErlExpression(ExpressionNum)%Operand(1)%Expression  = Token(Pos + 1)%Expression
          ErlExpression(ExpressionNum)%Operand(1)%Variable    = Token(Pos + 1)%Variable
          IF (Token(Pos + 1)%Variable > 0 ) THEN
            ErlExpression(ExpressionNum)%Operand(1)%TrendVariable  = ErlVariable(Token(Pos + 1)%Variable)%Value%TrendVariable
            ErlExpression(ExpressionNum)%Operand(1)%TrendVarPointer = ErlVariable(Token(Pos + 1)%Variable)%Value%TrendVarPointer
          ENDIF
          IF ((NumOperands >= 2) .AND. (NumTokens >= 3)) THEN
            ErlExpression(ExpressionNum)%Operand(2)%Type       = Token(Pos + 2)%Type
            ErlExpression(ExpressionNum)%Operand(2)%Number     = Token(Pos + 2)%Number
            ErlExpression(ExpressionNum)%Operand(2)%Expression = Token(Pos + 2)%Expression
            ErlExpression(ExpressionNum)%Operand(2)%Variable   = Token(Pos + 2)%Variable
          ENDIF

          IF ((NumOperands >= 3) .AND. (NumTokens >= 4))  THEN
            ErlExpression(ExpressionNum)%Operand(3)%Type       = Token(Pos + 3)%Type
            ErlExpression(ExpressionNum)%Operand(3)%Number     = Token(Pos + 3)%Number
            ErlExpression(ExpressionNum)%Operand(3)%Expression = Token(Pos + 3)%Expression
            ErlExpression(ExpressionNum)%Operand(3)%Variable   = Token(Pos + 3)%Variable
            IF ((NumOperands == 3) .AND. (NumTokens - 4 > 0)) THEN  ! too many tokens for this non-binary operator
              CALL showfatalError('EMS error parsing tokens, too many for built-in function')
            ENDIF
          ENDIF

          IF ((NumOperands >= 4) .AND. (NumTokens >= 5)) THEN
            ErlExpression(ExpressionNum)%Operand(4)%Type       = Token(Pos + 4)%Type
            ErlExpression(ExpressionNum)%Operand(4)%Number     = Token(Pos + 4)%Number
            ErlExpression(ExpressionNum)%Operand(4)%Expression = Token(Pos + 4)%Expression
            ErlExpression(ExpressionNum)%Operand(4)%Variable   = Token(Pos + 4)%Variable
            IF ((NumOperands == 4) .AND. (NumTokens - 5 > 0)) THEN  ! too many tokens for this non-binary operator
              CALL showfatalError('EMS error parsing tokens, too many for built-in function')
            ENDIF
          ENDIF

          IF ((NumOperands == 5) .AND. (NumTokens >= 6)) THEN
            ErlExpression(ExpressionNum)%Operand(5)%Type       = Token(Pos + 5)%Type
            ErlExpression(ExpressionNum)%Operand(5)%Number     = Token(Pos + 5)%Number
            ErlExpression(ExpressionNum)%Operand(5)%Expression = Token(Pos + 5)%Expression
            ErlExpression(ExpressionNum)%Operand(5)%Variable   = Token(Pos + 5)%Variable
            IF ((NumOperands == 5) .AND. (NumTokens - 6 > 0)) THEN  ! too many tokens for this non-binary operator
              CALL showfatalError('EMS error parsing tokens, too many for  built-in function')
            ENDIF
          ENDIF
          EXIT
        ELSE
          CALL ShowSevereError('The operator "'//TRIM(PossibleOperators(OperatorNum)%Symbol)//'" is missing the left-hand operand!')
          CALL ShowContinueError('String being parsed="'//trim(ParsingString)//'".')
          EXIT
        ENDIF
      ELSE IF (Pos == NumTokens) THEN
        CALL ShowSevereError('The operator "'//TRIM(PossibleOperators(OperatorNum)%Symbol)//'" is missing the right-hand operand!')
        CALL ShowContinueError('String being parsed="'//trim(ParsingString)//'".')
        EXIT
      ELSE

        ExpressionNum = NewExpression()
        ErlExpression(ExpressionNum)%Operator = OperatorNum
        NumOperands = PossibleOperators(OperatorNum)%NumOperands
        ErlExpression(ExpressionNum)%NumOperands = NumOperands
        ALLOCATE(ErlExpression(ExpressionNum)%Operand(NumOperands))

        ! PE commment: Need a right-hand and left-hand check for these, not just number of operators
        ! Unification of TYPEs would turn these into one-liners

        ErlExpression(ExpressionNum)%Operand(1)%Type        = Token(Pos - 1)%Type
        ErlExpression(ExpressionNum)%Operand(1)%Number      = Token(Pos - 1)%Number
        ErlExpression(ExpressionNum)%Operand(1)%Expression  = Token(Pos - 1)%Expression
        ErlExpression(ExpressionNum)%Operand(1)%Variable    = Token(Pos - 1)%Variable

        IF (NumOperands >= 2) THEN
          ErlExpression(ExpressionNum)%Operand(2)%Type       = Token(Pos + 1)%Type
          ErlExpression(ExpressionNum)%Operand(2)%Number     = Token(Pos + 1)%Number
          ErlExpression(ExpressionNum)%Operand(2)%Expression = Token(Pos + 1)%Expression
          ErlExpression(ExpressionNum)%Operand(2)%Variable   = Token(Pos + 1)%Variable
        ENDIF

        ! Replace the three tokens with one expression token
        IF ((NumOperands == 2) .AND. (NumTokens - 2 > 0)) THEN
          ALLOCATE(TempToken(NumTokens - 2))
          IF (Pos - 2 > 0) THEN
            TempToken(1:Pos - 2) = Token(1:Pos - 2)
          END IF
          IF (Pos + 2 <= NumTokens) THEN
            TempToken(Pos:NumTokens - 2) = Token(Pos + 2:)
          END IF
          TempToken(Pos - 1)%Type = TokenExpression
          TempToken(Pos - 1)%Expression = ExpressionNum
          TempToken(Pos - 1)%String = 'Expr'
          DEALLOCATE(Token)
          ALLOCATE(Token(NumTokens - 2))
          Token = TempToken
          DEALLOCATE(TempToken)
          NumTokens = NumTokens - 2
        END IF
      END IF

      ! Find the next occurrence of the operator  (this repeats code, but don't have better idea)
      Pos = 0
      DO TokenNum = 1, NumTokens
        IF ((Token(TokenNum)%Type == TokenOperator) &
          .AND. (Token(TokenNum)%Operator == OperatorNum)) THEN
          Pos = TokenNum
          EXIT
        END IF
      END DO

    END DO

  END DO

  ! Should be down to just one token now
  IF (Token(1)%Type == TokenNumber) THEN
    ExpressionNum = NewExpression()
    ErlExpression(ExpressionNum)%Operator = OperatorLiteral
    ErlExpression(ExpressionNum)%NumOperands = 1
    ALLOCATE(ErlExpression(ExpressionNum)%Operand(1))
    ErlExpression(ExpressionNum)%Operand(1)%Type = Token(1)%Type
    ErlExpression(ExpressionNum)%Operand(1)%Number = Token(1)%Number
  ELSE IF (Token(1)%Type == TokenVariable) THEN
    ExpressionNum = NewExpression()
    ErlExpression(ExpressionNum)%Operator = OperatorLiteral
    ErlExpression(ExpressionNum)%NumOperands = 1
    ALLOCATE(ErlExpression(ExpressionNum)%Operand(1))
    ErlExpression(ExpressionNum)%Operand(1)%Type = Token(1)%Type
    ErlExpression(ExpressionNum)%Operand(1)%Variable = Token(1)%Variable
  END IF

  DEALLOCATE(Token)

  RETURN

END FUNCTION ProcessTokens
All Procedures

ProcessTokens Function

Source Code

All Procedures

private recursive function ProcessTokens(TokenIN, NumTokensIN, StackNum, ParsingString) result(ExpressionNum)

Uses:

Arguments

Return Value integer

Calls

Called By

Source Code

Source Code

All Procedures
