(VB6) Parser Combinators 續(1)

之前所做的Parser是剖析之後重新組成字串。但我需要將詞剖析之後加上詞類。ParseTree.cls應該要保持為tree或linked list的樣子。

'' ParseTree.cls
Option Explicit

Public Parsed As String
Public ParsedType As ParsedType
Private real_rest As String
Public Successor As ParseTree

Public Property Let Rest(Data As String)
    If Me.Successor Is Nothing Then
        real_rest = Data
    Else
        Me.Successor.Rest = Data
    End If
End Property

Public Property Get Rest() As String
    If Me.Successor Is Nothing Then
        Rest = real_rest
    Else
        Rest = Me.Successor.Rest
    End If
End Property

Public Sub Layout()
    Debug.Print TypeInfo.GetParsedType(Me.ParsedType) & "[" & Me.Parsed & "]",
    If Me.Successor Is Nothing Then
        Debug.Print "Rest[" & Me.Rest & "]"
    Else
        Call Me.Successor.Layout
    End If
End Sub

所需的類型定義為:

'' common.bas
Public Enum ParseTreeType
    PtyEquation
    PtyFunction
    PtyString
    PtyNumber
    PtyTerm
    PtySymbol
End Enum

Parser修改如下:

'' Parser.cls
Option Explicit

Private Function fail_parsing(Parsed As ParseTree) As Boolean
    fail_parsing = Parsed Is Nothing
End Function

Public Function ParseTerm(cmd As String) As ParseTree
    Dim i As Long
    Dim symbol1 As String
    Dim parsed1 As ParseTree
    cmd = Trim(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        For i = 1 To Len(cmd)
            symbol1 = Mid(cmd, i, 1)
            If Not category.InTerm(symbol1) Then
                Exit For
            End If
        Next i
        If i = 1 Then
            Set parsed1 = Nothing
        Else
            Set parsed1 = New ParseTree
            With parsed1
                .Parsed = Left(cmd, i - 1)
                .ParsedType = PtyTerm
                .Rest = Mid(cmd, i)
            End With
        End If
    End If
    Set ParseTerm = parsed1
End Function

Public Function ParseString(cmd As String) As ParseTree
    Dim i As Long
    Dim parsed1 As ParseTree
    cmd = Trim(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        Set parsed1 = ParseTerm(cmd)
        If fail_parsing(parsed1) Then
            Set parsed1 = Nothing
        Else
            For i = 1 To Len(parsed1.Parsed)
                If Not category.IsAlphabet(Mid(parsed1.Parsed, i, 1)) Then
                    Exit For
                End If
            Next i
            If i = 1 Then
                Set parsed1 = Nothing
            Else
                parsed1.ParsedType = PtyString
            End If
        End If
    End If
    Set ParseString = parsed1
End Function

Public Function ParseNumber(cmd As String) As ParseTree
    Dim i As Long
    Dim parsed1 As ParseTree
    cmd = Trim(cmd)
    Set parsed1 = ParseTerm(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        If fail_parsing(parsed1) Then
            Set parsed1 = Nothing
        Else
            For i = 1 To Len(parsed1.Parsed)
                If Not category.IsNumber(Mid(parsed1.Parsed, i, 1)) Then
                    Exit For
                End If
            Next i
            If i = 1 Then
                Set parsed1 = Nothing
            Else
                parsed1.ParsedType = PtyNumber
            End If
        End If
    End If
    Set ParseNumber = parsed1
End Function

Public Function ParseSymbol(Symbol As String, cmd As String) As ParseTree
    Dim parsed1 As ParseTree
    cmd = Trim(cmd)
    If cmd = "" And Symbol  "" Then
        Set parsed1 = Nothing
    Else
        Set parsed1 = New ParseTree
        With parsed1
            Select Case Left(cmd, 1)
            Case Symbol
                .Parsed = Symbol
                .ParsedType = PtySymbol
                .Rest = Mid(cmd, Len(Symbol) + 1)
            Case Else
                Set parsed1 = Nothing
            End Select
        End With
    End If
    Set ParseSymbol = parsed1
End Function

Public Function ParseFunction(cmd As String) As ParseTree
    Dim i As Long
    Dim count_symbol As Long
    Dim Args() As String
    Dim parsed1 As ParseTree
    Dim parser1 As New Parser
    cmd = Trim(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        Args = Split("ParseString::ParseSymbol[(]::ParseEquSeq::ParseSymbol[)]", "::")
        Set parsed1 = ParseSequence(cmd, Args)
        If Not fail_parsing(parsed1) Then
            parsed1.ParsedType = PtyFunction
        End If
    End If
    Set parser1 = Nothing
    Set ParseFunction = parsed1
End Function

Public Function ParseEquation(cmd As String) As ParseTree
    Dim i As Long
    Dim count_symbol As Long
    Dim Args() As String
    Dim parsed1 As ParseTree
    Dim parser1 As New Parser
    cmd = Trim(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        Args = Split("ParseFunction::ParseEquSeq", "::")
        Set parsed1 = ParseSequence(cmd, Args)
        If fail_parsing(parsed1) Then
            Args = Split("ParseNumber::ParseEquSeq", "::")
            Set parsed1 = ParseSequence(cmd, Args)
        End If
    End If
    Set parser1 = Nothing
    Set ParseEquation = parsed1
End Function

Public Function ParseEquSeq(cmd As String) As ParseTree
    Dim i As Long
    Dim count_symbol As Long
    Dim Args() As String
    Dim parsed1 As ParseTree
    Dim parser1 As New Parser
    cmd = Trim(cmd)
    Args = Split("ParseSymbol[,]::ParseEquation", "::")
    Set parsed1 = ParseSequence(cmd, Args)
    If fail_parsing(parsed1) Then
        Args = Split("ParseEquation", "::")
        Set parsed1 = ParseSequence(cmd, Args)
        DoEvents
    End If
    If fail_parsing(parsed1) Then
        Set parsed1 = New ParseTree
        parsed1.Parsed = ""
        parsed1.ParsedType = PtyEquation
        parsed1.Rest = cmd
    End If
    Set parser1 = Nothing
    Set ParseEquSeq = parsed1
End Function

Public Function ParseSequence(cmd As String, ParseFns() As String) As ParseTree
    Dim i As Long
    Dim fn1 As String
    Dim arg1 As String
    Dim parsed1 As ParseTree
    Dim p As ParseTree
    Dim q As ParseTree
    Dim parser1 As New Parser
    Dim cmd1 As String
    cmd = Trim(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        cmd1 = cmd
        Set parsed1 = New ParseTree
        Set p = parsed1
        For i = LBound(ParseFns) To UBound(ParseFns)
            arg1 = ""
            If InStr(ParseFns(i), "[") = 0 Then
                fn1 = ParseFns(i)
            Else
                Dim pos1 As Long
                pos1 = InStr(ParseFns(i), "[")
                fn1 = Left(ParseFns(i), pos1 - 1)
                arg1 = Mid(ParseFns(i), pos1 + 1, InStr(pos1 + 1, ParseFns(i), "]") - pos1 - 1)
            End If
            If arg1 = "" Then
                Set p.Successor = CallByName(Me, fn1, VbMethod, cmd)
            Else
                Set p.Successor = CallByName(Me, fn1, VbMethod, arg1, cmd)
            End If
            If fail_parsing(p.Successor) Then
                Exit For
            Else
                cmd = p.Successor.Rest
                If p.Successor.Parsed = "" Then
                    Set p.Successor = p.Successor.Successor
                End If
                While Not p.Successor Is Nothing
                    Set p = p.Successor
                Wend
            End If
        Next i
        If i <= UBound(ParseFns) Then
            Set parsed1 = Nothing
        Else
            If parsed1.Parsed = "" And Not parsed1.Successor Is Nothing Then
                Set p = parsed1
                Set parsed1 = parsed1.Successor
                Set p = Nothing
            End If
            parsed1.Rest = cmd
        End If
    End If
    Set parser1 = Nothing
    Set ParseSequence = parsed1
End Function

Public Function ParseAlternative(cmd As String, ParamArray ListOfParseFns() As Variant) As ParseTree
    Dim i As Long
    Dim fn1 As String
    Dim arg1 As String
    Dim parser1 As New ParseTree
    Dim parsed1 As ParseTree
    cmd = Trim(cmd)
    If cmd = "" Then
        Set parsed1 = Nothing
    Else
        For i = LBound(ListOfParseFns) To UBound(ListOfParseFns)
            If TypeName(ListOfParseFns(i)) = "String()" Then
                Set parsed1 = CallByName(Me, "ParseSequence", VbMethod, cmd, ListOfParseFns(i))
            Else
                arg1 = ""
                If InStr(ListOfParseFns(i), "[") = 0 Then
                    fn1 = ListOfParseFns(i)
                Else
                    Dim pos1 As Long
                    pos1 = InStr(ListOfParseFns(i), "[")
                    fn1 = Left(ListOfParseFns(i), pos1 - 1)
                    arg1 = Mid(ListOfParseFns(i), pos1 + 1, InStr(pos1 + 1, ListOfParseFns(i), "]") - pos1 - 1)
                End If
                If arg1 = "" Then
                    Set parsed1 = CallByName(Me, fn1, VbMethod, cmd)
                Else
                    Set parsed1 = CallByName(Me, fn1, VbMethod, arg1, cmd)
                End If
            End If
            If Not fail_parsing(parsed1) Then
                Exit For
            End If
        Next i
    End If
    Set parser1 = Nothing
    Set ParseAlternative = parsed1
End Function
廣告

About 黃耀賢 (Yau-Hsien Huang)

熱愛 Erlang ,並且有相關工作經驗。喜歡程式語言。喜歡邏輯。目前用 Python 工作。
本篇發表於 Programming。將永久鏈結加入書籤。