'Coded by: Electroalek<http://electroalek.com/>, 2014
Imports System
Imports System.Text
Imports System.Xml.Serialization
Imports System.Collections.Generic
Imports System.Text.RegularExpressions
Class JSONSerializer
#Region "Deserializer"
Public Shared Function Deserialize(ByVal input As String) As JSON
Dim output As New JSON
Dim Tree As ParseTree = New Parser(New Scanner).Parse(input)
If Tree.Errors.Count = 0 Then
For Each l As KeyValuePair(Of String, Object) In GetPairs(Tree.Nodes(0).Nodes(0).Nodes)
output.Add(l.Key, l.Value)
Next
End If
Return output
End Function
Private Shared Function GetPairs(ByVal nodes As List(Of ParseNode)) As JSON
Dim output As New JSON
For Each n As ParseNode In nodes
Select Case n.Token.Type
Case TokenType.PAIR
output.Add(GetPair(n.Nodes))
Case TokenType.BLOCK
output.Add(GetPairs(n.Nodes))
End Select
Next
Return output
End Function
Private Shared Function GetPair(ByVal nodes As List(Of ParseNode)) As KeyValuePair(Of String, Object)
Dim key As String = String.Empty
Dim value As Object = Nothing
For Each n As ParseNode In nodes
Select Case n.Token.Type
Case TokenType.P_KEY
key = RemoveQuotes(n.Nodes(0).Token.Text)
Case TokenType.P_VALUE
value = GetValue(n.Nodes)
End Select
Next
Return New KeyValuePair(Of String, Object)(key, value)
End Function
Private Shared Function GetValue(ByVal nodes As List(Of ParseNode)) As Object
Dim output As Object = Nothing
For Each n As ParseNode In nodes
Select Case n.Token.Type
Case TokenType.VALUE
Return GetValueType(n.Nodes)
Case TokenType.BLOCK
Return GetPairs(n.Nodes)
End Select
Next
Return output
End Function
Private Shared Function GetValueType(ByVal nodes As List(Of ParseNode)) As Object
For Each n As ParseNode In nodes
Select Case n.Token.Type
Case TokenType.T_STR
Return RemoveQuotes(n.Token.Text)
Case TokenType.T_INT
Return Integer.Parse(n.Token.Text)
Case TokenType.T_DBL
Return Double.Parse(n.Token.Text)
Case TokenType.T_BOOL
Return Boolean.Parse(n.Token.Text)
End Select
Next
Return Nothing
End Function
#Region "TinyPG"
'<% @TinyPG Language="vb" %>
'T_INT -> @"(?!,)([+-]*[0-9]+)(?<!,)";
'T_DBL -> @"(?!,)([+-]*[0-9]+[.,][0-9]+)(?<!,)";
'T_STR -> @"""(.*?)""";
'T_BOOL -> @"True|False";
'C_OPEN -> @"\{|\[";
'C_CLOSE -> @"\}|\]";
'C_COMMA -> @"\,";
'C_COLON -> @"\:";
'EOF -> @"^$";
'[Skip] WS -> @"(\s|\t)+";
'Start -> BLOCK EOF;
'P_KEY -> T_STR;
'P_VALUE -> VALUE | BLOCK;
'PAIR -> P_KEY C_COLON P_VALUE;
'BLOCK -> C_OPEN (PAIR | BLOCK | VALUE | C_COLON | C_COMMA)* C_CLOSE;
'VALUE -> T_STR | T_INT | T_DBL | T_BOOL;
Private Enum TokenType
'Non terminal tokens:
_NONE_ = 0
_UNDETERMINED_ = 1
'Non terminal tokens:
Start = 2
P_KEY = 3
P_VALUE = 4
PAIR = 5
BLOCK = 6
VALUE = 7
'Terminal tokens:
T_INT = 8
T_DBL = 9
T_STR = 10
T_BOOL = 11
C_OPEN = 12
C_CLOSE = 13
C_COMMA = 14
C_COLON = 15
EOF = 16
WS = 17
End Enum
Private Class Parser
Private m_scanner As Scanner
Private m_tree As ParseTree
Public Sub New(ByVal scanner As Scanner)
m_scanner = scanner
End Sub
Public Function Parse(ByVal input As String) As ParseTree
m_tree = New ParseTree()
Return Parse(input, m_tree)
End Function
Public Function Parse(ByVal input As String, ByVal tree As ParseTree) As ParseTree
m_scanner.Init(input)
m_tree = tree
ParseStart(m_tree)
m_tree.Skipped = m_scanner.Skipped
Return m_tree
End Function
Private Sub ParseStart(ByVal parent As ParseNode)
Dim tok As Token
Dim n As ParseNode
Dim node As ParseNode = parent.CreateNode(m_scanner.GetToken(TokenType.Start), "Start")
parent.Nodes.Add(node)
ParseBLOCK(node)
tok = m_scanner.Scan(TokenType.EOF)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.EOF Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.EOF.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
parent.Token.UpdateRange(node.Token)
End Sub
Private Sub ParseP_KEY(ByVal parent As ParseNode)
Dim tok As Token
Dim n As ParseNode
Dim node As ParseNode = parent.CreateNode(m_scanner.GetToken(TokenType.P_KEY), "P_KEY")
parent.Nodes.Add(node)
tok = m_scanner.Scan(TokenType.T_STR)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.T_STR Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.T_STR.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
parent.Token.UpdateRange(node.Token)
End Sub
Private Sub ParseP_VALUE(ByVal parent As ParseNode)
Dim tok As Token
Dim node As ParseNode = parent.CreateNode(m_scanner.GetToken(TokenType.P_VALUE), "P_VALUE")
parent.Nodes.Add(node)
tok = m_scanner.LookAhead(TokenType.T_STR, TokenType.T_INT, TokenType.T_DBL, TokenType.T_BOOL, TokenType.C_OPEN)
Select Case tok.Type
Case TokenType.T_STR
ParseVALUE(node)
Case TokenType.T_INT
ParseVALUE(node)
Case TokenType.T_DBL
ParseVALUE(node)
Case TokenType.T_BOOL
ParseVALUE(node)
Case TokenType.C_OPEN
ParseBLOCK(node)
Case Else
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found.", &H2, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Exit Select
End Select
parent.Token.UpdateRange(node.Token)
End Sub
Private Sub ParsePAIR(ByVal parent As ParseNode)
Dim tok As Token
Dim n As ParseNode
Dim node As ParseNode = parent.CreateNode(m_scanner.GetToken(TokenType.PAIR), "PAIR")
parent.Nodes.Add(node)
ParseP_KEY(node)
tok = m_scanner.Scan(TokenType.C_COLON)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.C_COLON Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.C_COLON.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
ParseP_VALUE(node)
parent.Token.UpdateRange(node.Token)
End Sub
Private Sub ParseBLOCK(ByVal parent As ParseNode)
Dim tok As Token
Dim n As ParseNode
Dim node As ParseNode = parent.CreateNode(m_scanner.GetToken(TokenType.BLOCK), "BLOCK")
parent.Nodes.Add(node)
tok = m_scanner.Scan(TokenType.C_OPEN)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.C_OPEN Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.C_OPEN.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
tok = m_scanner.LookAhead(TokenType.T_STR, TokenType.C_OPEN, TokenType.T_INT, TokenType.T_DBL, TokenType.T_BOOL, TokenType.C_COLON, TokenType.C_COMMA)
While tok.Type = TokenType.T_STR Or tok.Type = TokenType.C_OPEN Or tok.Type = TokenType.T_INT Or tok.Type = TokenType.T_DBL Or tok.Type = TokenType.T_BOOL Or tok.Type = TokenType.C_COLON Or tok.Type = TokenType.C_COMMA
tok = m_scanner.LookAhead(TokenType.T_STR, TokenType.C_OPEN, TokenType.T_INT, TokenType.T_DBL, TokenType.T_BOOL, TokenType.C_COLON, TokenType.C_COMMA)
Select Case tok.Type
Case TokenType.T_STR
ParsePAIR(node)
Case TokenType.C_OPEN
ParseBLOCK(node)
Case TokenType.T_STR
ParseVALUE(node)
Case TokenType.T_INT
ParseVALUE(node)
Case TokenType.T_DBL
ParseVALUE(node)
Case TokenType.T_BOOL
ParseVALUE(node)
Case TokenType.C_COLON
tok = m_scanner.Scan(TokenType.C_COLON)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.C_COLON Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.C_COLON.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
Case TokenType.C_COMMA
tok = m_scanner.Scan(TokenType.C_COMMA)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.C_COMMA Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.C_COMMA.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
Case Else
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found.", &H2, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Exit Select
End Select
tok = m_scanner.LookAhead(TokenType.T_STR, TokenType.C_OPEN, TokenType.T_INT, TokenType.T_DBL, TokenType.T_BOOL, TokenType.C_COLON, TokenType.C_COMMA)
End While
tok = m_scanner.Scan(TokenType.C_CLOSE)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.C_CLOSE Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.C_CLOSE.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
parent.Token.UpdateRange(node.Token)
End Sub
Private Sub ParseVALUE(ByVal parent As ParseNode)
Dim tok As Token
Dim n As ParseNode
Dim node As ParseNode = parent.CreateNode(m_scanner.GetToken(TokenType.VALUE), "VALUE")
parent.Nodes.Add(node)
tok = m_scanner.LookAhead(TokenType.T_STR, TokenType.T_INT, TokenType.T_DBL, TokenType.T_BOOL)
Select Case tok.Type
Case TokenType.T_STR
tok = m_scanner.Scan(TokenType.T_STR)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.T_STR Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.T_STR.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
Case TokenType.T_INT
tok = m_scanner.Scan(TokenType.T_INT)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.T_INT Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.T_INT.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
Case TokenType.T_DBL
tok = m_scanner.Scan(TokenType.T_DBL)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.T_DBL Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.T_DBL.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
Case TokenType.T_BOOL
tok = m_scanner.Scan(TokenType.T_BOOL)
n = node.CreateNode(tok, tok.ToString())
node.Token.UpdateRange(tok)
node.Nodes.Add(n)
If tok.Type <> TokenType.T_BOOL Then
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found. Expected " + TokenType.T_BOOL.ToString(), &H1001, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Return
End If
Case Else
m_tree.Errors.Add(New ParseError("Unexpected token '" + tok.Text.Replace("\n", "") + "' found.", &H2, 0, tok.StartPos, tok.StartPos, tok.EndPos - tok.StartPos))
Exit Select
End Select
parent.Token.UpdateRange(node.Token)
End Sub
End Class
Private Class Scanner
Public Input As String
Public StartPos As Integer = 0
Public EndPos As Integer = 0
Public CurrentLine As Integer
Public CurrentColumn As Integer
Public CurrentPosition As Integer
Public Skipped As List(Of Token)
Public Patterns As Dictionary(Of TokenType, Regex)
Private LookAheadToken As Token
Private Tokens As List(Of TokenType)
Private SkipList As List(Of TokenType)
Public Sub New()
Dim regex As Regex
Patterns = New Dictionary(Of TokenType, Regex)()
Tokens = New List(Of TokenType)()
LookAheadToken = Nothing
Skipped = New List(Of Token)()
SkipList = New List(Of TokenType)()
SkipList.Add(TokenType.WS)
regex = New Regex("(?!,)([+-]*[0-9]+)(?<!,)", RegexOptions.Compiled)
Patterns.Add(TokenType.T_INT, regex)
Tokens.Add(TokenType.T_INT)
regex = New Regex("(?!,)([+-]*[0-9]+[.,][0-9]+)(?<!,)", RegexOptions.Compiled)
Patterns.Add(TokenType.T_DBL, regex)
Tokens.Add(TokenType.T_DBL)
regex = New Regex("""(.*?)""", RegexOptions.Compiled)
Patterns.Add(TokenType.T_STR, regex)
Tokens.Add(TokenType.T_STR)
regex = New Regex("True|False", RegexOptions.Compiled)
Patterns.Add(TokenType.T_BOOL, regex)
Tokens.Add(TokenType.T_BOOL)
regex = New Regex("\{|\[", RegexOptions.Compiled)
Patterns.Add(TokenType.C_OPEN, regex)
Tokens.Add(TokenType.C_OPEN)
regex = New Regex("\}|\]", RegexOptions.Compiled)
Patterns.Add(TokenType.C_CLOSE, regex)
Tokens.Add(TokenType.C_CLOSE)
regex = New Regex("\,", RegexOptions.Compiled)
Patterns.Add(TokenType.C_COMMA, regex)
Tokens.Add(TokenType.C_COMMA)
regex = New Regex("\:", RegexOptions.Compiled)
Patterns.Add(TokenType.C_COLON, regex)
Tokens.Add(TokenType.C_COLON)
regex = New Regex("^$", RegexOptions.Compiled)
Patterns.Add(TokenType.EOF, regex)
Tokens.Add(TokenType.EOF)
regex = New Regex("(\s|\t)+", RegexOptions.Compiled)
Patterns.Add(TokenType.WS, regex)
Tokens.Add(TokenType.WS)
End Sub
Public Sub Init(ByVal input As String)
Me.Input = input
StartPos = 0
EndPos = 0
CurrentLine = 0
CurrentColumn = 0
CurrentPosition = 0
Skipped = New List(Of Token)()
LookAheadToken = Nothing
End Sub
Public Function GetToken(ByVal type As TokenType) As Token
Dim t As New Token(Me.StartPos, Me.EndPos)
t.Type = type
Return t
End Function
Public Function Scan(ByVal ParamArray expectedtokens As TokenType()) As Token
Dim tok As Token = LookAhead(expectedtokens)
' temporarely retrieve the lookahead
LookAheadToken = Nothing
' reset lookahead token, so scanning will continue
StartPos = tok.EndPos
EndPos = tok.EndPos
' set the tokenizer to the new scan position
Return tok
End Function
Public Function LookAhead(ByVal ParamArray expectedtokens As TokenType()) As Token
Dim i As Integer
Dim start As Integer = StartPos
Dim tok As Token = Nothing
Dim scantokens As List(Of TokenType)
' this prevents double scanning and matching
' increased performance
If LookAheadToken IsNot Nothing AndAlso LookAheadToken.Type <> TokenType._UNDETERMINED_ AndAlso LookAheadToken.Type <> TokenType._NONE_ Then
Return LookAheadToken
End If
If expectedtokens.Length = 0 Then
scantokens = Tokens
Else
scantokens = New List(Of TokenType)(expectedtokens)
scantokens.AddRange(SkipList)
End If
Do
Dim len As Integer = -1
Dim index As TokenType = Integer.MaxValue
Dim m_input As String = Input.Substring(start)
tok = New Token(start, EndPos)
For i = 0 To scantokens.Count - 1
Dim r As Regex = Patterns(scantokens(i))
Dim m As Match = r.Match(m_input)
If m.Success AndAlso m.Index = 0 AndAlso ((m.Length > len) OrElse (scantokens(i) < index AndAlso m.Length = len)) Then
len = m.Length
index = scantokens(i)
End If
Next i
If index >= 0 AndAlso len >= 0 Then
tok.EndPos = start + len
tok.Text = Input.Substring(tok.StartPos, len)
tok.Type = index
Else
If tok.StartPos < tok.EndPos - 1 Then
tok.Text = Input.Substring(tok.StartPos, 1)
End If
End If
If SkipList.Contains(tok.Type) Then
start = tok.EndPos
Skipped.Add(tok)
Else
tok.Skipped = Skipped
Skipped = New List(Of Token)
End If
Loop While SkipList.Contains(tok.Type)
LookAheadToken = tok
Return tok
End Function
End Class
Private Class Token
Private m_startPos As Integer
Private m_endPos As Integer
Private m_text As String
Private m_value As Object
Private m_skipped As List(Of Token)
Public Property StartPos() As Integer
Get
Return m_startPos
End Get
Set(ByVal value As Integer)
m_startPos = value
End Set
End Property
Public Property EndPos() As Integer
Get
Return m_endPos
End Get
Set(ByVal value As Integer)
m_endPos = value
End Set
End Property
Public ReadOnly Property Length() As Integer
Get
Return m_endPos - m_startPos
End Get
End Property
Public Property Text() As String
Get
Return m_text
End Get
Set(ByVal value As String)
m_text = value
End Set
End Property
Public Property Skipped() As List(Of Token)
Get
Return m_skipped
End Get
Set(ByVal value As List(Of Token))
m_skipped = value
End Set
End Property
Public Property Value() As Object
Get
Return m_value
End Get
Set(ByVal value As Object)
Me.m_value = value
End Set
End Property
<XmlAttribute()> _
Public Type As TokenType
Public Sub New()
Me.New(0, 0)
End Sub
Public Sub New(ByVal start As Integer, ByVal endPos As Integer)
Type = TokenType._UNDETERMINED_
m_startPos = start
m_endPos = endPos
Text = ""
' must initialize with empty string, may cause null reference exceptions otherwise
Value = Nothing
End Sub
Public Sub UpdateRange(ByVal token As Token)
If token.StartPos < m_startPos Then
m_startPos = token.StartPos
End If
If token.EndPos > m_endPos Then
m_endPos = token.EndPos
End If
End Sub
Public Overloads Overrides Function ToString() As String
If Text <> Nothing Then
Return Type.ToString() + " '" + Text + "'"
Else
Return Type.ToString()
End If
End Function
End Class
<Serializable()> _
Private Class ParseErrors
Inherits List(Of ParseError)
Public Sub New()
End Sub
End Class
<Serializable()> _
Private Class ParseError
Private m_message As String
Private m_code As Integer
Private m_line As Integer
Private m_col As Integer
Private m_pos As Integer
Private m_length As Integer
Public ReadOnly Property Code() As Integer
Get
Return m_code
End Get
End Property
Public ReadOnly Property Line() As Integer
Get
Return m_line
End Get
End Property
Public ReadOnly Property Column() As Integer
Get
Return m_col
End Get
End Property
Public ReadOnly Property Position() As Integer
Get
Return m_pos
End Get
End Property
Public ReadOnly Property Length() As Integer
Get
Return m_length
End Get
End Property
Public ReadOnly Property Message() As String
Get
Return m_message
End Get
End Property
Public Sub New(ByVal message As String, ByVal code As Integer, ByVal node As ParseNode)
Me.New(message, code, 0, node.Token.StartPos, node.Token.StartPos, node.Token.Length)
End Sub
Public Sub New(ByVal message As String, ByVal code As Integer, ByVal line As Integer, ByVal col As Integer, ByVal pos As Integer, ByVal length As Integer)
m_message = message
m_code = code
m_line = line
m_col = col
m_pos = pos
m_length = length
End Sub
End Class
<Serializable()> _
Private Class ParseTree
Inherits ParseNode
Public Errors As ParseErrors
Public Skipped As List(Of Token)
Public Sub New()
MyBase.New(New Token(), "ParseTree")
Token.Type = TokenType.Start
Token.Text = "Root"
Skipped = New List(Of Token)()
Errors = New ParseErrors()
End Sub
Public Function PrintTree() As String
Dim sb As New StringBuilder()
Dim indent As Integer = 0
PrintNode(sb, Me, indent)
Return sb.ToString()
End Function
Private Sub PrintNode(ByVal sb As StringBuilder, ByVal node As ParseNode, ByVal indent As Integer)
Dim space As String = "".PadLeft(indent, " "c)
sb.Append(space)
sb.AppendLine(node.Text)
For Each n As ParseNode In node.Nodes
PrintNode(sb, n, indent + 2)
Next
End Sub
Public Overloads Function Eval(ByVal ParamArray paramlist As Object()) As Object
Return Nodes(0).Eval(Me, paramlist)
End Function
End Class
<Serializable()>
<XmlInclude(GetType(ParseTree))>
Private Class ParseNode
Protected m_text As String
Protected m_nodes As List(Of ParseNode)
Public ReadOnly Property Nodes() As List(Of ParseNode)
Get
Return m_nodes
End Get
End Property
<XmlIgnore()> _
Public Parent As ParseNode
Public Token As Token
<XmlIgnore()> _
Public Property Text() As String
' text to display in parse tree
Get
Return m_text
End Get
Set(ByVal value As String)
m_text = value
End Set
End Property
Public Overridable Function CreateNode(ByVal token As Token, ByVal text As String) As ParseNode
Dim node As New ParseNode(token, text)
node.Parent = Me
Return node
End Function
Protected Sub New(ByVal token As Token, ByVal text As String)
Me.Token = token
m_text = text
m_nodes = New List(Of ParseNode)()
End Sub
Protected Function GetValue(ByVal tree As ParseTree, ByVal type As TokenType, ByVal index As Integer) As Object
Return GetValueByRef(tree, type, index)
End Function
Protected Function GetValueByRef(ByVal tree As ParseTree, ByVal type As TokenType, ByRef index As Integer) As Object
Dim o As Object = Nothing
If index < 0 Then
Return o
End If
' left to right
For Each node As ParseNode In nodes
If node.Token.Type = type Then
System.Math.Max(System.Threading.Interlocked.Decrement(index), index + 1)
If index < 0 Then
o = node.Eval(tree)
Exit For
End If
End If
Next
Return o
End Function
Friend Function Eval(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Dim Value As Object = Nothing
Select Case Token.Type
Case TokenType.Start
Value = EvalStart(tree, paramlist)
Exit Select
Case TokenType.P_KEY
Value = EvalP_KEY(tree, paramlist)
Exit Select
Case TokenType.P_VALUE
Value = EvalP_VALUE(tree, paramlist)
Exit Select
Case TokenType.PAIR
Value = EvalPAIR(tree, paramlist)
Exit Select
Case TokenType.BLOCK
Value = EvalBLOCK(tree, paramlist)
Exit Select
Case TokenType.VALUE
Value = EvalVALUE(tree, paramlist)
Exit Select
Case Else
Value = Token.Text
Exit Select
End Select
Return Value
End Function
Protected Overridable Function EvalStart(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Return "Could not interpret input; no semantics implemented."
End Function
Protected Overridable Function EvalP_KEY(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Throw New NotImplementedException()
End Function
Protected Overridable Function EvalP_VALUE(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Throw New NotImplementedException()
End Function
Protected Overridable Function EvalPAIR(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Throw New NotImplementedException()
End Function
Protected Overridable Function EvalBLOCK(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Throw New NotImplementedException()
End Function
Protected Overridable Function EvalVALUE(ByVal tree As ParseTree, ByVal ParamArray paramlist As Object()) As Object
Throw New NotImplementedException()
End Function
End Class
#End Region
#End Region
#Region "Serializer"
Public Shared Function Serialize(ByVal data As JSON) As String
Dim sb As New StringBuilder
Dim t As Type = Nothing
sb.Append("{")
For Each i As KeyValuePair(Of String, Object) In data
t = i.Value.GetType
sb.Append(String.Format("""{0}"":", i.Key))
If IsNumeric(t) Or t Is GetType(Boolean) Then
sb.Append(i.Value.ToString)
ElseIf t Is GetType(JSON) Then
sb.Append(Serialize(i.Value))
Else
sb.Append(String.Format("""{0}""", i.Value.ToString))
End If
sb.Append(",")
Next
sb.Remove(sb.Length - 1, 1)
sb.Append("}")
Return sb.ToString
End Function
#End Region
#Region "Helpers"
Public Class JSON
Inherits Dictionary(Of String, Object)
Private id As Integer = 0
Public Overloads Sub Add(ByVal key As String, ByVal value As Object)
If value Is Nothing Then value = String.Empty
If MyBase.ContainsKey(key) Then
MyBase.Item(key) = value
Else
MyBase.Add(key, value)
End If
End Sub
Public Overloads Sub Add(ByVal item As KeyValuePair(Of String, Object))
Add(item.Key, item.Value)
End Sub
Public Overloads Sub Add(ByVal value As Object)
Add(id, value)
id += 1
End Sub
Public Overloads Sub Remove(ByVal key As String)
MyBase.Remove(key)
id -= 1
End Sub
End Class
Private Shared Function RemoveQuotes(ByVal t As String) As String
If t(0) = """" Then t = t.Substring(1, t.Length - 1)
If t(t.Length - 1) = """" Then t = t.Substring(0, t.Length - 1)
Return t
End Function
Private Shared Function IsNumeric(ByVal t As Type) As Boolean
Select Case Type.GetTypeCode(t)
Case TypeCode.Byte,
TypeCode.Decimal,
TypeCode.Double,
TypeCode.Int16,
TypeCode.Int32,
TypeCode.Int64,
TypeCode.SByte,
TypeCode.Single,
TypeCode.UInt16,
TypeCode.UInt32,
TypeCode.UInt64
Return True
End Select
Return False
End Function
#End Region
End Class
