【高分高难度】如何解析程序语句？

Question

例如一个字串符的内容是
x=1-2*msgbox("x-3"+instr("123","2"),2)+4*-2
需要写一个函数，处理这个字串符后返回数组，内容分别是
x, =, 1, -, 2, *, msgbox, (, "x-3", +, instr, (, "123", ,, "2", ), ,, 2, ), +, 4, *, -2需要注意的是
1、字串符，"x-3"不拆
2、"-"当负号的情况，2*-2应解析为2, *, -2
3、只需处理+-*/\()^%=这几个运算符我自己也写了一个，效率不敢恭维，还尚有BUGPrivate Function FactorStr(ByVal szExp As String) As Variant
    On Error Resume Next
    Dim Ptr As Integer
    Dim Ptrp As Integer
    Dim sExp() As String
    Dim s()
    Dim sTmp()
    Dim s1 As String
    Dim i As Integer
    Dim j As Integer
    Dim bIn As Boolean
    ReDim sExp(Len(szExp) - 1)
    ReDim s(Len(szExp) - 1)
    Ptrp = 0
    Ptr = InStr(szExp, """")
    Do Until Ptr = 0
        s1 = Mid(szExp, Ptrp + 1 + bIn, Ptr - Ptrp - 1 - bIn - bIn)
        If s1 <> "" Then
            sExp(i) = s1
            i = i + 1
        End If
        bIn = Not bIn
        Ptrp = Ptr
        Ptr = InStr(Ptr + 1, szExp, """")
    Loop
    s1 = Mid(szExp, Ptrp + 1 + bIn)
    If s1 <> "" Then
        sExp(i) = s1
        i = i + 1
    End If
    ReDim Preserve sExp(i - 1)
    Ptr = 0
    For i = 0 To UBound(sExp)
        If Left(sExp(i), 1) = """" Then
            s(Ptr) = sExp(i)
            Ptr = Ptr + 1
        Else
            sTmp = FactorStrX(sExp(i))
            For j = 0 To UBound(sTmp)
                s(Ptr + j) = sTmp(j)
            Next
            Ptr = Ptr + j
        End If
    Next
    ReDim Preserve s(Ptr - 1)
    FactorStr = s
End FunctionPrivate Function FactorStrX(ByVal szExp As String) As Variant
    On Error Resume Next
    Dim s()
    Dim Ptr As Integer
    Dim Ptrp As Integer
    Dim i As Integer
    Dim s1 As String
    ReDim s(Len(szExp) - 1)
    Ptr = InStr(szExp, "-")
    Do Until Ptr = 0
        If InStr("+-*/\%^(," & Chr(0), Mid(szExp, Ptr - 1, 1)) > 0 Then
            szExp = Left(szExp, Ptr - 1) & Chr(1) & Mid(szExp, Ptr + 1)
            Ptr = InStr(szExp, "-")
        Else
            Ptr = InStr(Ptr + 1, szExp, "-")
        End If
    Loop
    Ptr = InstrEx(szExp, "+-*/\%^()=,")
    Do Until Ptr = 0
        s1 = Mid(szExp, Ptrp, 1)
        If s1 <> "" Then
            s(i) = s1
            i = i + 1
        End If
        s1 = Mid(szExp, Ptrp + 1, Ptr - Ptrp - 1)
        If s1 <> "" Then
            s(i) = Replace(s1, Chr(1), "-")
            i = i + 1
        End If
        Ptrp = Ptr
        Ptr = InstrEx(szExp, "+-*/\%^()=,", Ptr + 1)
    Loop
    s(i) = Mid(szExp, Ptrp, 1)
    i = i + 1
    s(i) = Replace(Mid(szExp, Ptrp + 1), Chr(1), "-")
    If s(i) = "" Then i = i - 1
    ReDim Preserve s(i)
    FactorStrX = s
End FunctionPrivate Function InstrEx(ByVal String1 As String, ByVal String2 As String, Optional ByVal Start As Long = -1, Optional ByVal Rev As Boolean = False) As Long
    Dim i As Integer
    Dim szDel As String
    Dim lRes As Long
    If Rev Then InstrEx = 0 Else InstrEx = Len(String1) + 1
    If Not Rev And Start = -1 Then Start = 1
    For i = 1 To Len(String2)
        szDel = Mid(String2, i, 1)
        If Rev Then lRes = InStrRev(String1, szDel, Start) Else lRes = InStr(Start, String1, szDel)
        If lRes Then
            InstrEx = IIf(Rev, IIf(InstrEx > lRes, InstrEx, lRes), IIf(InstrEx > lRes, lRes, InstrEx))
        End If
    Next
    If Not Rev And InstrEx = Len(String1) + 1 Then InstrEx = 0
End Function

Answer 1

Private Sub Command1_Click()
    x = Label1.Caption
    x = Replace(x, "+", ",+,")
    x = Replace(x, "-", ",-,")
    x = Replace(x, "*", ",*,")
    x = Replace(x, "/", ",/,")
    x = Replace(x, "(", ",(,")
    x = Replace(x, ")", ",),")
    x = Replace(x, ",,", ",")
    Me.Caption = x
End Sub

Answer 2

Private Sub Form_Load()
Dim iCtr, jCtr, pCtr, sCtr, lCtr
Dim i, j, k As Integer
Dim sCmd As String    
    jCtr = "+-*/\()^%="""
    
    iCtr = "x=1-2*MsgBox(""x-3""+InStr(""123"",""2""),2)+4*-2"
    
    For i = 1 To Len(iCtr)
        If InStr(1, jCtr, Mid(iCtr, i, 1)) = 11 Then
            sCtr = """"
            For j = i + 1 To Len(iCtr)
                If InStr(1, jCtr, Mid(iCtr, j, 1)) <> 11 Then
                
                    sCtr = sCtr & Mid(iCtr, j, 1)
                Else
                    If pCtr <> "" Then
                        sCmd = sCmd & "," & pCtr & "," & sCtr & Mid(iCtr, j, 1)
                        pCtr = ""
                    Else
                        sCmd = sCmd & "," & sCtr & Mid(iCtr, j, 1)
                    End If
                    i = j
                    Exit For
                End If
            Next j
        Else
            If InStr(1, jCtr, Mid(iCtr, i, 1)) > 0 And InStr(1, jCtr, Mid(iCtr, i, 1)) < 11 Then
                
                If InStr(1, jCtr, Mid(iCtr, i, 1)) = 3 Then
                    If InStr(1, jCtr, Mid(iCtr, i + 1, 1)) = 2 Then
                        lCtr = Mid(iCtr, i, 1) & "," & Mid(iCtr, i + 1, 1) & Mid(iCtr, i + 2, 1)
                        If pCtr = "" Then
                            sCmd = sCmd & "," & lCtr
                        Else
                            sCmd = sCmd & "," & pCtr & "," & lCtr
                            pCtr = ""
                        End If
                        i = i + 2
                            
                    Else
                        If pCtr = "" Then
                            sCmd = sCmd & "," & Mid(iCtr, i, 1)
                            
                        Else
                            sCmd = sCmd & "," & pCtr & "," & Mid(iCtr, i, 1)
                            pCtr = ""
                        End If
                    End If
 
                Else
                    If pCtr = "" Then
                        sCmd = sCmd & "," & Mid(iCtr, i, 1)
                    Else
                        sCmd = sCmd & "," & pCtr & "," & Mid(iCtr, i, 1)
                    End If
                    pCtr = ""
                End If
            Else
                pCtr = pCtr & Mid(iCtr, i, 1)
            End If
        End If    Next i
    If pCtr <> "" Then
        sCmd = sCmd & "," & pCtr
    End If
    sCmd = Mid(sCmd, 2, Len(sCmd))
    Debug.Print sCmd
   
End Sub

Answer 3

本帖最后由 bcrun 于 2010-11-22 07:53:02 编辑

  

Answer 4

就是自己做一个解释器.要考虑挺多的内容.一是运算符.二是其优先级.三是特殊内容,比如你那里面的字符串x-3.之前我也做过一个解释器+编译器,是用于自己开发的一款PLC的,语句只有二十几条,语法还没有你这么复杂,都搞得比较头痛.加油吧.

Answer 5

单纯解析是很简单的，Defanive 的最大问题是没有顺序解析，先用字符串进行分割导致了表达式不完整，反而容易解析错误。建议用一个专门提取元素的函数
Function GetNextElement(ByVal sExpression As String, ByRef lLastPos As Long, ByRef sElement As String) As EnumElementType
　它从表达式 sExpression 的当前位置 lLastPos 提取一个完整的元素到 sElement 中，并且返回该元素的类型{
　　运算符 +-*/=  —— 注：此时符号 - 不分单目/双目运算符
　　分隔符 (),
　　字符串
　　数值
　　标识  —— 变量、函数
　　空  ——　表达式全部结束
　}
　只要看当前第一个有效字符是什么，就很容易区分类型，然后
　
主解析函数中，只要循环调用该函数直到返回类型为空为止。
　大多数都可以直接将元素直接输出，除了：
　如果提取的元素是操作符 “-”，那么需要判断一下前一个元素是什么，如果是运算符或分隔符中的 “(” 和 “,”，那么是单目运算符，需要和下个成员一起输出。又：你的输出规则还需要完善，如果是 -(2) 应该如何输出？如果是 -(1+1) 呢？

Answer 6

Private Sub Command1_Click()
    MsgBox FactorStr("x=1-2*msgbox(""x-3""+instr(""123"",""2""),2)+4*-2")
    Text2.Text = FactorStr(Text1.Text)
End SubPrivate Function FactorStr(ByVal szExp As String) As String
    Dim s$, v, i%
    Dim reg As Object
    Dim matchs As Object, match As Object
    
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True
    reg.Pattern = "("".+?"")"
    
    Set matchs = reg.Execute(szExp)
    
    For Each match In matchs
        s = s & match & "MY_SPLIT"
    Next
    v = Split(s, "MY_SPLIT")
    szExp = reg.Replace(szExp, "MY_TAG")
    
    szExp = Replace(szExp, ",", ",,")
    
    reg.Pattern = "([^\*/]-)"
    szExp = reg.Replace(szExp, "$1,")
    
    reg.Pattern = "("".+?""|\w+|[\+\*/\\\(\)\^%=])"
    szExp = reg.Replace(szExp, "$1,")
    
    For i = 0 To UBound(v)
        szExp = Replace(szExp, "MY_TAG", v(i), , 1)
    Next
    If Right(szExp, 1) = "," Then szExp = Left(szExp, Len(szExp) - 1)
    FactorStr = szExp
End Function

Answer 7

能不能处理双字节的运算符？
我也写了一个能够处理的，不过由于要运用很多次Instr，效率非常低PS：当成交流贴吧，最后会散分的

Answer 8

就是例如&&，>=这类的运算符用正则效率较低，我测试了一下，2L的代码最快，其次是我的，然后是正则双字符运算符的话，可能要考虑到单目运算符等，一会我把我的代码贴上去

Answer 9

双目运算符没考虑到，之前没提到过，貌似有点麻烦。其实可以优先拿出来处理也不是太麻烦。二楼的测试了下有点bug，楼主的也是，例如下面的：
x=1-2*msgbox("x-3"+instr("123","2"),2)+4*((-21+9)/-2)-3正则有个好处可以很方便的修改规则：
reg.Pattern = "([^\*/]-)"改成
reg.Pattern = "([^\*/\(\)]-)"
这样就使得-2这样的数字支持前面带括号了