clscode.cls

编译原理课程设计用vb编写

            Case "do while"
                'dowhile_loop
                skWhile.Push i
            Case "loop"
                'loop_dowhile
                If skWhile.Count > 0 Then
                    tmp = skWhile.Pop
                    Lines(i).loop_dowhile = tmp
                    Lines(tmp).dowhile_loop = i
                Else
                    Err.Raise 303, , "Loop没有Do While"
                    Exit Function
                End If
            Case "do"
                'do_loopuntil_id
                skDo.Push i
            Case "loop until"
                'loopuntile_do_id
                If skDo.Count > 0 Then
                    tmp = skDo.Pop
                    Lines(i).loopuntile_do_id = tmp
                    Lines(tmp).do_loopuntil_id = i
                Else
                    Err.Raise 305, , "Loop Until没有Do"
                    Exit Function
                End If
            Case "exit do"
                'exitdo_dowhile
                'exitdo_do
                If skWhile.Count > 0 And skDo.Count > 0 Then
                    If skWhile.Item(0) > skDo.Item(0) Then
                        tmp = skWhile.Item(0)
                        Lines(i).exitdo_dowhile = tmp
                        Lines(tmp).dowhile_loop = i
                    Else
                        tmp = skDo.Item(0)
                        Lines(i).exitdo_do = tmp
                        Lines(tmp).do_loopuntil_id = i
                    End If
                ElseIf skWhile.Count > 0 Then
                    tmp = skWhile.Item(0)
                    Lines(i).exitdo_dowhile = tmp
                    Lines(tmp).dowhile_loop = i
                ElseIf skDo.Count > 0 Then
                    tmp = skDo.Item(0)
                    Lines(i).exitdo_do = tmp
                    Lines(tmp).do_loopuntil_id = i
                Else
                    Err.Raise 304, , "Exit Do不在循环体内"
                    Exit Function
                End If
            Case ""
            Case "print"
                
        End Select
    Next
    
    If skFor.Count > 0 Then
        Err.Raise 303, , "For没有Next"
        Exit Function
    End If
    
    If sk1.Count > 0 Then
        Err.Raise 304, , "If没有End If"
        Exit Function
    End If
    
    If skDo.Count > 0 Then
        Err.Raise 305, , "Do没有Loop Until"
        Exit Function
    End If
    
    If skWhile.Count > 0 Then
        Err.Raise 306, , "While没有Wend或Do Until没有Loop"
        Exit Function
    End If
    
    '第五遍：解释并执行程序
    Dim sksub As New clsStack
    Dim runId As Integer
    Static lastStopLine As Integer
    runId = 1
    Do While runId <= UBound(Lines)
        DoEvents
        ErrLine = Lines(runId).phLine
        If frmResult.Visible = False Then
            Exit Function
        End If
        If BanHave(ErrLine) Or runFlag = False Then
            If lastStopLine <> ErrLine Then             '防止冗余的逻辑行导致物理行中断多次。
                frmResult.StopWindow
            End If
        End If
        lastStopLine = ErrLine
        Select Case Lines(runId).Head
            Case ""
                ce.exp Lines(runId).strText
            Case "if"
                tmpExp = Lines(runId).Body
                If Lines(runId).if_endif_id <> 0 Then
                    '第一种情况 if logic then
                    If Right(tmpExp, 4) <> "then" Then
                        Err.Raise 209, , "If没有Then"
                        Exit Function
                    End If
                    tmpExp = Trim(Left(tmpExp, Len(tmpExp) - 4))
                    ct = ce.logic(tmpExp)
                    If Err.Number > 0 Then
                        Exit Function
                    End If
                    If ct = True Then
                        'do nothing
                    Else
                        If Lines(runId).if_else_id = 0 Then
                            runId = Lines(runId).if_endif_id
                        Else
                            runId = Lines(runId).if_else_id
                        End If
                    End If
                End If
            Case "else"
                runId = Lines(Lines(runId).else_if_id).if_endif_id
            Case "end if"
                'do nothing
            Case "for"
                '两种情况
                'for var = exp1 to exp2
                'for var = exp1 to exp2 step exp3
                tmpExp = Lines(runId).Body
                var1 = Trim(Left(tmpExp, InstrPlus(tmpExp, "=") - 1))
                exp1 = Trim(Mid(tmpExp, InstrPlus(tmpExp, "="), Len(tmpExp)))
                exp2 = Trim(Mid(exp1, InstrPlus(exp1, " to ") + 3, Len(exp1)))
                exp1 = Trim(Left(exp1, InstrPlus(exp1, " to ") - 1))
                exp1 = Trim(Mid(exp1, InStr(exp1, "=") + 1, Len(exp1)))
                With Lines(runId)
                    If InstrPlus(exp2, " step ") = 0 Then
                        '第1种情况
                        .for_step = 1
                    Else
                        '第2种情况
                        exp3 = Trim(Mid(exp2, InstrPlus(exp2, " step ") + 5, Len(exp2)))
                        exp2 = Trim(Left(exp2, InstrPlus(exp2, " step ") - 1))
                        .for_step = ce.exp(exp3)
                    End If
                    .for_min = ce.exp(exp1)
                    .for_max = ce.exp(exp2)
                    .for_var_name = var1
                    If .for_step = 0 Then
                        Err.Raise 10, , "For语句中Step不能为0"
                        Exit Function
                    ElseIf .for_step > 0 Then
                        If .for_min > .for_max Then
                            runId = .for_next_id    '不满足for条件
                        Else
                            '满足for条件
                            globalCV.setVar .for_var_name, .for_min
                        End If
                    Else
                        '递减循环
                        If .for_min >= .for_max Then
                            globalCV.setVar .for_var_name, .for_min
                        Else
                            runId = .for_next_id
                        End If
                    End If
                End With
            Case "next"
                varn = Lines(Lines(runId).next_for_id).for_var_name
                ivar = ce.exp(varn & "=" & varn & "+(" & Lines(Lines(runId).next_for_id).for_step & ")")
                If (ivar - Lines(Lines(runId).next_for_id).for_max) / Lines(Lines(runId).next_for_id).for_step > 0 Then
                    '同号，说明不满足循环条件了
                    'do nothing
                Else
                    '跳到for
                    runId = Lines(runId).next_for_id
                End If
            Case "exit for"
                runId = Lines(Lines(runId).exitfor_for_id).for_next_id
            Case "print"
                tmpExp = Lines(runId).Body
                Do While True
                    'Exit Do
                    tftf = FindBorder(tmpExp)
                    If Err.Number > 0 Then Exit Function
                    If tftf > 0 Then
                        bd = Mid(tmpExp, FindBorder(tmpExp), 1)
                        If bd = "," Then
                            bd = Chr(9)
                        Else
                            bd = ""
                        End If
                        t1 = Trim(Mid(tmpExp, 1, FindBorder(tmpExp) - 1))
                        tmpExp = Trim(Mid(tmpExp, FindBorder(tmpExp) + 1, Len(tmpExp)))
                        If Left(t1, 1) = """" And Right(t1, 1) = """" Then
                            '输出到控制台
                            frmResult.Append Mid(t1, 2, Len(t1) - 2) & bd
                        Else
                            frmResult.Append ce.exp(t1) & bd
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                
                If tmpExp <> "" Then
                    If Left(tmpExp, 1) = """" And Right(tmpExp, 1) = """" Then
                        '输出到控制台
                        frmResult.Append Mid(tmpExp, 2, Len(tmpExp) - 2) & vbCrLf
                    Else
                        frmResult.Append ce.exp(tmpExp) & vbCrLf
                    End If
                End If
            Case "input"
                tmpExp = Lines(runId).Body
                If Right(tmpExp, 1) = "," Or Right(tmpExp, 1) = ";" Then tmpExp = Left(tmpExp, Len(tmpExp) - 1)
                Do While True
                    'Exit Do
                    tftf = FindBorder(tmpExp)
                    If Err.Number > 0 Then Exit Function
                    If tftf > 0 Then
                        bd = Mid(tmpExp, FindBorder(tmpExp), 1)
                        If bd = "," Then
                            bd = Chr(9)
                        Else
                            bd = ""
                        End If
                        t1 = Trim(Mid(tmpExp, 1, FindBorder(tmpExp) - 1))
                        tmpExp = Trim(Mid(tmpExp, FindBorder(tmpExp) + 1, Len(tmpExp)))
                        If Left(t1, 1) = """" And Right(t1, 1) = """" Then
                            '输出到控制台
                            frmResult.Append Mid(t1, 2, Len(t1) - 2) & bd
                        Else
                            rt = frmResult.InputWindow("输入整数[" & tmpExp & "]：")
                            globalCV.setVar tmpExp, rt
                            frmResult.Append rt & vbCrLf
                        End If
                    Else
                        Exit Do
                    End If
                Loop
                
                If tmpExp <> "" Then
                    If Left(tmpExp, 1) = """" And Right(tmpExp, 1) = """" Then
                        '输出到控制台
                        frmResult.Append Mid(tmpExp, 2, Len(tmpExp) - 2) & vbCrLf
                    Else
                        rt = frmResult.InputWindow("输入整数[" & tmpExp & "]：")
                        globalCV.setVar tmpExp, rt
                        frmResult.Append rt & vbCrLf
                    End If
                End If
            Case "end"
                Exit Do
            Case "goto", "gosub"
                tmpExp = Lines(runId).Body
                If Not IsNumeric(tmpExp) Then
                    Err.Raise 50, , "goto或者gosub语句后面只能跟数字行号"
                    Exit Function
                End If
                If CInt(tmpExp) = 0 Then
                    Err.Raise 52, , "找不到行号"
                    Exit Function
                End If
                cline = 0
                For i = 1 To UBound(Lines)
                    If Lines(i).vLine = CInt(tmpExp) Then
                        cline = i
                        Exit For
                    End If
                Next
                If cline = 0 Then
                    Err.Raise 51, , "找不到行号"
                    Exit Function
                End If
                sksub.Push runId
                runId = cline - 1
            Case "return"
                If sksub.Count > 0 Then
                    runId = sksub.Pop
                End If
            Case "do while"
                tmpExp = Lines(runId).Body
                If ce.logic(tmpExp) = True Then
                    'do nothing
                Else
                    runId = Lines(runId).dowhile_loop
                End If
            Case "do"
                'do nothing
            Case "loop until"
                tmpExp = Lines(runId).Body
                 If ce.logic(tmpExp) = True Then
                    runId = Lines(runId).loopuntile_do_id
                Else
                   'do nothing
                End If
            Case "exit do"
                If Lines(runId).exitdo_do <> "" Then
                    runId = Lines(Lines(runId).exitdo_do).do_loopuntil_id
                Else
                    runId = Lines(Lines(runId).exitdo_dowhile).dowhile_loop
                End If
            Case "loop"
                runId = Lines(runId).loop_dowhile - 1
            Case "stop"
                frmResult.StopWindow
        End Select
        If Err.Number > 0 Then
            Exit Function
        End If
        runId = runId + 1
    Loop
End Function

Private Sub Class_Initialize()
    ReDim Preserve Lines(0)
End Sub