[VBScript] Recursive Descent Parsing - Muhammad Faruq Nuruddinsyah
[VBScript] Recursive Descent Parsing

Algorithm for evaluating an expression using Recursive Descent Parsing (RDP) technique

Sample input:
10 + (5 + 2 * 6 + (3 + 1 * 2))

Output:
32

Source Code:
' Evaluate an Expression Algorithm using Recursive Descent Parsing (RDP) technique
' By: Muhammad Faruq Nuruddinsyah
' Created: January 28, 2013

 
Expr = "10 + (5 + 2 * 6 + (3 + 1 * 2))"
MsgBox EvaluateExpression(Expr)
 
Function EvaluateExpression(Expression)
	Expression = Trim(Expression)
	Expression = RemoveUnusedParentheses(Expression)
 
	Piece = DivideExpressionByOperator(Expression)
 
	If Piece(1) <> "" Then
		LeftOperand = Piece(0)
		RightOperand = Piece(2)
		Operator = Piece(1)
 
		EvaluateExpression = Calculate(LeftOperand, Operator, RightOperand)
	Else
		EvaluateExpression = GetValue(Piece(0))
	End If
End Function
 
Function DivideExpressionByOperator(Expression)
	Dim Result(3)
 
	OperatorPrecedence = 0
	OperatorIndex = 0
	OperatorName = ""
	InQuotes = False
	nParentheses = 0
	nSquareBrackets = 0
 
	For i = 1 To Len(Expression)
		m = Mid(Expression, i, 1)
		mm = Mid(Expression, i, 2)
		p = ""
 
		If i > 1 Then p = Mid(Expression, i - 1, 1)
 
		If m = """" Then
			If InQuotes Then
				InQuotes = False
			Else
				InQuotes = True
			End If
		End If
 
		If m = "(" And Not InQuotes Then nParentheses = nParentheses + 1
		If m = ")" And Not InQuotes Then nParentheses = nParentheses - 1
 
		If m = "[" And Not InQuotes Then nSquareBrackets = nSquareBrackets + 1
		If m = "]" And Not InQuotes Then nSquareBrackets = nSquareBrackets - 1
 
		If nParentheses = 0 And nSquareBrackets = 0 And Not InQuotes Then
			Operator = ""
 
			If mm = "&&" Then
				Operator = mm
			ElseIf mm = "||" Then
				Operator = mm
			ElseIf mm = "^^" Then
				Operator = mm
 
			ElseIf mm = "==" Then
				Operator = mm
			ElseIf mm = "!=" Then
				Operator = mm
			ElseIf mm = "<=" Then
				Operator = mm
			ElseIf mm = ">=" Then
				Operator = mm
 
			ElseIf mm = "+=" Then
				Operator = mm
			ElseIf mm = "-=" Then
				Operator = mm
			ElseIf mm = "*=" Then
				Operator = mm
			ElseIf mm = "/=" Then
				Operator = mm
			ElseIf mm = "%=" Then
				Operator = mm
			ElseIf mm = "\=" Then
				Operator = mm
			ElseIf mm = "&=" Then
				Operator = mm
			ElseIf m = "=" And (p <> "=" And p <> "!" And p <> "<" And p <> ">" And p <> "+" And p <> "-" And p <> "*" And p <> "/" And p <> "%" And p <> "\" And p <> "&") Then
				Operator = m
 
			ElseIf m = "*" Then
				Operator = m
			ElseIf m = "/" Then
				Operator = m
			ElseIf m = "\" Then
				Operator = m
			ElseIf m = "%" Then
				Operator = m
			ElseIf m = "+" Then
				Operator = m
			ElseIf m = "-" Then
				If i > 1 And Not IsOperator(Left(Expression, i - 1)) Then
					Operator = m
				End If
			ElseIf m = "^" And p <> "^" Then
				Operator = m
			ElseIf m = "<" Then
				Operator = m
			ElseIf m = ">" Then
				Operator = m
			ElseIf m = "&" And p <> "&" Then
				Operator = m
			End If
 
			If Operator <> "" Then
				If GetOperatorPrecedence(Operator) = 10 Then
					If GetOperatorPrecedence(Operator) > OperatorPrecedence Then
						OperatorIndex = i
						OperatorName = Operator
						OperatorPrecedence = GetOperatorPrecedence(Operator)
					End If
				Else
					If GetOperatorPrecedence(Operator) >= OperatorPrecedence Then
						OperatorIndex = i
						OperatorName = Operator
						OperatorPrecedence = GetOperatorPrecedence(Operator)
					End If
				End If
			End If
		End If
	Next
 
	If OperatorIndex > 0 Then
		Result(0) = Left(Expression, OperatorIndex - 1)
		Result(1) = OperatorName
		Result(2) = Mid(Expression, OperatorIndex + Len(OperatorName))
	Else
		Result(0) = Expression
		Result(1) = ""
		Result(2) = ""
	End If
 
	DivideExpressionByOperator = Result
End Function
 
Function RemoveUnusedParentheses(Expression)
	E = Expression
	Simetric = False
 
	Do
		If Left(E, 1) = "(" And Right(E, 1) = ")" Then
			Ex = Mid(E, 2, Len(E) - 2)
 
			If ParenthesesSimetric(Ex) Then
				E = Ex
				Simetric = True
			Else
				Simetric = False
			End If
		Else
			Simetric = False
		End If
	Loop While Simetric
 
	RemoveUnusedParentheses = E
End Function
 
Function ParenthesesSimetric(E)
	InQuotes = False
	nParentheses = 0
 
	For i = 1 To Len(E)
		m = Mid(E, i, 1)
 
		If m = """" Then
			If InQuotes Then
				InQuotes = False
			Else
				InQuotes = True
			End If
		End If
 
		If m = "(" And Not InQuotes Then nParentheses = nParentheses + 1
		If m = ")" And Not InQuotes Then
			nParentheses = nParentheses - 1
 
			If nParentheses < 0 Then
				ParenthesesSimetric = False
				Exit Function
			End If
		End If
 
		If nParentheses = 0 Then
			ParenthesesSimetric = True
		Else
			ParenthesesSimetric = False
		End If
	Next
End Function
 
Function IsOperator(E)
	O = Right(Trim(E), 1)
	Result = False
 
	If O = "+" Then
		Result = True
	ElseIf O = "-" Then
		Result = True
	ElseIf O = "*" Then
		Result = True
	ElseIf O = "/" Then
		Result = True
	ElseIf O = "\" Then
		Result = True
	ElseIf O = "%" Then
		Result = True
	ElseIf O = "<" Then
		Result = True
	ElseIf O = ">" Then
		Result = True
	ElseIf O = "=" Then
		Result = True
	ElseIf O = "!" Then
		Result = True
	ElseIf O = "&" Then
		Result = True
	ElseIf O = "|" Then
		Result = True
	ElseIf O = "^" Then
		Result = True
	End If
 
	IsOperator = Result
End Function
 
Function GetOperatorPrecedence(Operator)
	If Operator = "^" Then
		Result = 1
	ElseIf Operator = "*" Or Operator = "/" Or Operator = "%" Or Operator = "\" Then
		Result = 2
	ElseIf Operator = "+" Or Operator = "-" Then
		Result = 3
	ElseIf Operator = "&" Then
		Result = 4
	ElseIf Operator = "<" Or Operator = ">" Or Operator = "<=" Or Operator = ">=" Then
		Result = 5
	ElseIf Operator = "==" Or Operator = "!=" Then
		Result = 6
	ElseIf Operator = "&&" Then
		Result = 7
	ElseIf Operator = "||" Then
		Result = 8
	ElseIf Operator = "^^" Then
		Result = 9
	ElseIf Operator = "=" Or Operator = "+=" Or Operator = "-=" Or Operator = "*=" Or Operator = "/=" Or Operator = "%=" Or Operator = "\=" Or Operator = "&=" Then
		Result = 10
	End If
 
	GetOperatorPrecedence = Result
End Function
 
Function Calculate(A, O, B)
	If O = "=" Or O = "+=" Or O = "-=" Or O = "*=" Or O = "/=" Or O = "%=" Or O = "\=" Or O = "&=" Then
		A = A
		B = EvaluateExpression(B)
	Else
		A = EvaluateExpression(A)
		B = EvaluateExpression(B)
	End If
 
	If O = "*" Then
		Calculate = A * B
	ElseIf O = "/" Then
		Calculate = A / B
	ElseIf O = "%" Then
		Calculate = A Mod B
	ElseIf O = "\" Then
		Calculate = A \ B
	ElseIf O = "+" Then
		Calculate = A + B
	ElseIf O = "-" Then
		Calculate = A - B
	ElseIf O = "&" Then
		Calculate = A & B
	ElseIf O = "<" Then
		Calculate = A < B
	ElseIf O = ">" Then
		Calculate = A > B
	ElseIf O = "<=" Then
		Calculate = A <= B
	ElseIf O = ">=" Then
		Calculate = A >= B
	ElseIf O = "==" Then
		Calculate = A = B
	ElseIf O = "!=" Then
		Calculate = A <> B
	ElseIf O = "&&" Then
		Calculate = A And B
	ElseIf O = "||" Then
		Calculate = A Or B
	ElseIf O = "^^" Then
		Calculate = A Xor B
	ElseIf O = "^" Then
		Calculate = A ^ B
 
	ElseIf O = "=" Then
		MsgBox A & " = " & B
		Calculate = B
	ElseIf O = "+=" Then
		MsgBox A & " += " & B
		Calculate = B
	ElseIf O = "-=" Then
		MsgBox A & " -= " & B
		Calculate = B
	ElseIf O = "*=" Then
		MsgBox A & " *= " & B
		Calculate = B
	ElseIf O = "/=" Then
		MsgBox A & " /= " & B
		Calculate = B
	ElseIf O = "%=" Then
		MsgBox A & " %= " & B
		Calculate = B
	ElseIf O = "\=" Then
		MsgBox A & " \= " & B
		Calculate = B
	ElseIf O = "&=" Then
		MsgBox A & " &= " & B
		Calculate = B
	End If
End Function
 
Function GetValue(Value)
	If IsNumeric(Value) Then
		GetValue = 1 * Value
	ElseIf Left(Value, 1) = """" And Right(Value, 1) = """" Then
		GetValue = Mid(Value, 2, Len(Value) - 2)
	ElseIf Left(Value, 1) = "-" Then
		GetValue = -EvaluateExpression(Mid(Value, 2))
	ElseIf Left(Value, 1) = "!" Then
		GetValue = Not EvaluateExpression(Mid(Value, 2))
	ElseIf LCase(Value) = "true" then
		GetValue = True
	ElseIf LCase(Value) = "false" then
		GetValue = False
	ElseIf Value = "" Then
		GetValue = ""
	Else
		MsgBox "Syntax error:" & value
	End If
End Function

Informasi:
Lihat semua daftar ACS - Download: rdp.vbs - Tanggal: 6 Juni 2013 - Kategori: VBScript