カテゴリー
Visual Basic

電卓プログラム、林晴比古著「C言語によるアルゴリズム入門」をVBで書いてみる。

Module Program
    Public Enum e_kind
        Print
        Lparen
        Rparen
        Plus
        Minus
        Multi
        Divi
        Assign
        VarName
        IntNum
        Others
        Endo
        EofToken
    End Enum

    Structure Tokenset
        Dim ele_kind As e_kind
        Dim ss As String
    End Structure
    Dim STK_SIZ As Integer = 20
    Dim stack(STK_SIZ + 1) As Integer
    Dim stkct As Integer = 0
    Dim token As Tokenset
    Dim buf As String = ""
    Dim chr_bufp As Integer = 0
    Dim ch As Char
    Dim vari(26) As Integer
    Dim errflg As Boolean = False
    Dim endflg As Boolean = False
    Sub Main(args As String())
        Console.WriteLine("printまたはピリオド(.)で値表示、endで終了")
        While True
            input()
            next_token()
            '以下のコメントはtoken解析の結果をデバッグするため
            'While token.ele_kind <> e_kind.EofToken
            '    Console.Write(token.ss)
            '    Console.WriteLine(token.ele_kind)
            '    If token.ele_kind = e_kind.Endo Then
            '        GoTo mainbreak
            '    Else
            '        token.ss = ""
            '    End If
            '    next_token()
            'End While

            statement()
            If endflg = True Then
                GoTo mainbreak
            End If
            If errflg = True Then
                Console.WriteLine("?")
            End If
            token.ss = ""
        End While
mainbreak:
        Console.WriteLine("終了")
    End Sub
    Sub input()
        buf = Console.ReadLine
        chr_bufp = 0
        ch = next_char()
        errflg = False
        stkct = 0
    End Sub
    Function next_char()
        If chr_bufp <= buf.Length - 1 Then
            next_char = buf(chr_bufp)
        Else
            next_char = ""
        End If
    End Function
    Function isalpha(a)
        isalpha = If(a >= "a" And a <= "z", True, False)
    End Function
    Function isdigit(a)
        isdigit = If(a >= "0" And a <= "9", True, False)
    End Function
    Function strcmp(a As String, b As String)
        strcmp = If(a = b, True, False)
    End Function
    Function strlen(a As String)
        strlen = a.Length
    End Function
    Sub strcpy(ByRef reseve As String, ByVal src As String)
        reseve = src
    End Sub
    Sub next_token()
        Dim chr_pp = 0
        Do
            ch = next_char()
            If ch = " " Then
                chr_bufp += 1
            End If
        Loop While ch = " "
        If isalpha(ch) Then
            While isalpha(ch)
                token.ss = token.ss + ch
                chr_pp += 1
                chr_bufp += 1
                If chr_bufp > buf.Length - 1 Then
                    token.ss = token.ss.Replace(vbNullChar, "")
                    GoTo token_kind
                End If
                ch = next_char()

            End While
        ElseIf isdigit(ch) Then
            While isdigit(ch)
                token.ss &= ch
                chr_pp += 1
                chr_bufp += 1
                If chr_bufp > buf.Length - 1 Then
                    GoTo token_kind
                End If
                ch = next_char()

            End While
        Else
            token.ss = ch
            chr_pp = 0
            chr_bufp += 1
            ch = next_char()

        End If
token_kind:
        chr_pp = 0
        If token.ss = vbNullChar Then
            token.ele_kind = e_kind.EofToken
            Return
        End If
        token.ss = token.ss.Replace(vbNullChar, "")

        token.ele_kind = e_kind.Others
        If strcmp(token.ss, "print") Then
            token.ele_kind = e_kind.Print
            token.ss = ""
        ElseIf strcmp(token.ss, "end") Then
            token.ele_kind = e_kind.Endo
        ElseIf token.ss = vbNullChar Then
            token.ele_kind = e_kind.EofToken
        ElseIf isdigit(token.ss(0)) Then
            token.ele_kind = e_kind.IntNum
        ElseIf strlen(token.ss) = 1 Then
            If isalpha(token.ss(chr_pp)) Then
                token.ele_kind = e_kind.VarName
            Else
                Select Case token.ss(0)
                    Case "." : token.ele_kind = e_kind.Print
                    Case "(" : token.ele_kind = e_kind.Lparen
                    Case ")" : token.ele_kind = e_kind.Rparen
                    Case "+" : token.ele_kind = e_kind.Plus
                    Case "-" : token.ele_kind = e_kind.Minus
                    Case "*" : token.ele_kind = e_kind.Multi
                    Case "/" : token.ele_kind = e_kind.Divi
                    Case "=" : token.ele_kind = e_kind.Assign
                End Select
            End If
        End If
    End Sub
    Sub statement()
        Dim save As String = ""
        Select Case token.ele_kind
            Case e_kind.Print
                next_token()
                express()
                If token.ele_kind <> e_kind.EofToken Then
                    errflg = True
                End If
                If Not errflg = True Then
                    Console.WriteLine(pop())
                End If
            Case e_kind.Endo
                endflg = True
            Case e_kind.VarName
                strcpy(save, token.ss)
                next_token()
                If token.ele_kind <> e_kind.Assign Then
                    errflg = True
                    Return
                End If

                token.ss = ""
                next_token()
                express()
                If token.ele_kind <> e_kind.EofToken Then
                    errflg = True
                End If
                If errflg = False Then
                    letvalue(save(0), pop()) '0607試し
                End If
            Case Else
                errflg = True
        End Select
    End Sub
    Sub express()
        Call term()

        While True
            If token.ele_kind = e_kind.Plus Then
                token.ss = ""   'tamesi
                next_token()
                term()
                operate(e_kind.Plus)
            ElseIf token.ele_kind = e_kind.Minus Then
                token.ss = ""
                next_token()
                term()
                operate(e_kind.Minus)
            Else
                Return
            End If
        End While
    End Sub
    Sub term()
        Call factor()

        While True
            If token.ele_kind = e_kind.Multi Then
                token.ss = ""
                next_token()
                term()
                operate(e_kind.Multi)
            ElseIf token.ele_kind = e_kind.Divi Then
                token.ss = ""
                next_token()
                term()
                operate(e_kind.Divi)
            Else
                Return
            End If
        End While
    End Sub
    Sub factor()
        Select Case token.ele_kind
            Case e_kind.Lparen
                token.ss = ""
                next_token()
                express()
                If token.ele_kind <> e_kind.Rparen Then
                    errflg = True
                    Return
                End If
            Case e_kind.IntNum
                push(Int(token.ss))
            Case e_kind.VarName
                push(getvalue(token.ss)) '0607試験
            Case Else
                errflg = True
                Return
        End Select
        next_token()
    End Sub
    Sub operate(ByVal Ope As e_kind)
        Dim d1 As Integer
        Dim d2 As Integer
        d2 = pop()
        d1 = pop()
        Select Case Ope
            Case e_kind.Plus
                push(d1 + d2)
            Case e_kind.Minus
                push(d1 - d2)
            Case e_kind.Multi
                push(d1 * d2)
            Case e_kind.Divi
                If d2 = 0 Then
                    Console.WriteLine("divide by 0")
                    errflg = True
                Else
                    push(d1 / d2)
                End If
        End Select
    End Sub

    Function getvalue(ByVal vname As Char)
        getvalue = vari(Asc(vname) - Asc("a"c))
    End Function

    Sub letvalue(ByVal vname As Char, ByVal n As Integer)
        vari(Asc(vname) - Asc("a"c)) = n
    End Sub
    Sub push(ByVal n As Integer)
        If stkct + 1 > STK_SIZ Then
            Console.WriteLine("stack over")
            End
        Else
            stkct += 1
            stack(stkct) = n
            'stkct += 1
        End If
    End Sub
    Function pop()
        If errflg = True Then
            pop = 1
            Return pop
        End If
        If stkct < 1 Then
            Console.WriteLine("stack under")
            End
        Else
            pop = stack(stkct)
            stkct -= 1

        End If

    End Function
End Module
カテゴリー
Visual Basic

電卓プログラム

Module Program
    Public Enum e_kind
        Print
        Lparen
        Rparen
        Plus
        Minus
        Multi
        Divi
        Assign
        VarName
        IntNum
        Others
        Endo
        EofToken
    End Enum

    Structure Tokenset
        Dim ele_kind As e_kind
        Dim ss As String
    End Structure
    Dim STK_SIZ As Integer = 20
    Dim stack(STK_SIZ + 1) As Integer
    Dim stkct As Integer = 0
    Dim token As Tokenset
    Dim buf As String = ""
    Dim chr_bufp As Integer = 0
    Dim ch As Char
    Dim vari(26) As Integer
    Dim errflg As Boolean = False
    Dim endflg As Boolean = False
    Sub Main(args As String())
        Console.WriteLine("printまたはピリオド(.)で値表示、endで終了")
        While True
            input()
            next_token()
            '以下のコメントはtoken解析の結果をデバッグするため
            'While token.ele_kind <> e_kind.EofToken
            '    Console.Write(token.ss)
            '    Console.WriteLine(token.ele_kind)
            '    If token.ele_kind = e_kind.Endo Then
            '        GoTo mainbreak
            '    Else
            '        token.ss = ""
            '    End If
            '    next_token()
            'End While

            statement()
            If endflg = True Then
                GoTo mainbreak
            End If
            If errflg = True Then
                Console.WriteLine("?")
            End If
            token.ss = ""
        End While
mainbreak:
        Console.WriteLine("終了")
    End Sub
    Sub input()
        buf = Console.ReadLine
        chr_bufp = 0
        ch = next_char()
        errflg = False
        stkct = 0
    End Sub
    Function next_char()
        If chr_bufp <= buf.Length - 1 Then
            next_char = buf(chr_bufp)
        Else
            next_char = ""
        End If
    End Function
    Function isalpha(a)
        isalpha = If(a >= "a" And a <= "z", True, False)
    End Function
    Function isdigit(a)
        isdigit = If(a >= "0" And a <= "9", True, False)
    End Function
    Function strcmp(a As String, b As String)
        strcmp = If(a = b, True, False)
    End Function
    Function strlen(a As String)
        strlen = a.Length
    End Function
    Sub strcpy(ByRef reseve As String, ByVal src As String)
        reseve = src
    End Sub
    Sub next_token()
        Dim chr_pp = 0
        Do
            ch = next_char()
            If ch = " " Then
                chr_bufp += 1
            End If
        Loop While ch = " "
        If isalpha(ch) Then
            While isalpha(ch)
                token.ss = token.ss + ch
                chr_pp += 1
                chr_bufp += 1
                If chr_bufp > buf.Length - 1 Then
                    token.ss = token.ss.Replace(vbNullChar, "")
                    GoTo token_kind
                End If
                ch = next_char()

            End While
        ElseIf isdigit(ch) Then
            While isdigit(ch)
                token.ss &= ch
                chr_pp += 1
                chr_bufp += 1
                If chr_bufp > buf.Length - 1 Then
                    GoTo token_kind
                End If
                ch = next_char()

            End While
        Else
            token.ss = ch
            chr_pp = 0
            chr_bufp += 1
            ch = next_char()

        End If
token_kind:
        chr_pp = 0
        If token.ss = vbNullChar Then
            token.ele_kind = e_kind.EofToken
            Return
        End If
        token.ss = token.ss.Replace(vbNullChar, "")

        token.ele_kind = e_kind.Others
        If strcmp(token.ss, "print") Then
            token.ele_kind = e_kind.Print
            token.ss = ""
        ElseIf strcmp(token.ss, "end") Then
            token.ele_kind = e_kind.Endo
        ElseIf token.ss = vbNullChar Then
            token.ele_kind = e_kind.EofToken
        ElseIf isdigit(token.ss(0)) Then
            token.ele_kind = e_kind.IntNum
        ElseIf strlen(token.ss) = 1 Then
            If isalpha(token.ss(chr_pp)) Then
                token.ele_kind = e_kind.VarName
            Else
                Select Case token.ss(0)
                    Case "." : token.ele_kind = e_kind.Print
                    Case "(" : token.ele_kind = e_kind.Lparen
                    Case ")" : token.ele_kind = e_kind.Rparen
                    Case "+" : token.ele_kind = e_kind.Plus
                    Case "-" : token.ele_kind = e_kind.Minus
                    Case "*" : token.ele_kind = e_kind.Multi
                    Case "/" : token.ele_kind = e_kind.Divi
                    Case "=" : token.ele_kind = e_kind.Assign
                End Select
            End If
        End If
    End Sub
    Sub statement()
        Dim save As String = ""
        Select Case token.ele_kind
            Case e_kind.Print
                next_token()
                express()
                If token.ele_kind <> e_kind.EofToken Then
                    errflg = True
                End If
                If Not errflg = True Then
                    Console.WriteLine(pop())
                End If
            Case e_kind.Endo
                endflg = True
            Case e_kind.VarName
                strcpy(save, token.ss)
                next_token()
                If token.ele_kind <> e_kind.Assign Then
                    errflg = True
                    Return
                End If

                token.ss = ""
                next_token()
                express()
                If token.ele_kind <> e_kind.EofToken Then
                    errflg = True
                End If
                If errflg = False Then
                    letvalue(save, pop()) '試し
                End If
            Case Else
                errflg = True

        End Select
    End Sub
    Sub express()
        Call term()

        While True
            If token.ele_kind = e_kind.Plus Then
                token.ss = ""   'tamesi
                next_token()
                term()
                operate(e_kind.Plus)
            ElseIf token.ele_kind = e_kind.Minus Then
                token.ss = ""
                next_token()
                term()
                operate(e_kind.Minus)
            Else
                Return
            End If
        End While
    End Sub
    Sub term()
        Call factor()

        While True
            If token.ele_kind = e_kind.Multi Then
                token.ss = ""
                next_token()
                term()
                operate(e_kind.Multi)
            ElseIf token.ele_kind = e_kind.Divi Then
                token.ss = ""
                next_token()
                term()
                operate(e_kind.Divi)
            Else
                Return
            End If
        End While
    End Sub
    Sub factor()
        Select Case token.ele_kind
            Case e_kind.Lparen
                token.ss = ""
                next_token()
                express()
                If token.ele_kind <> e_kind.Rparen Then
                    errflg = True
                    Return
                    'GoTo factorbreak
                End If
            Case e_kind.IntNum
                push(Int(token.ss))
                'GoTo factorbreak
            Case e_kind.VarName
                push(getvalue(token.ss))
                'GoTo factorbreak
            Case Else
                errflg = True
                Return
        End Select

        next_token()

    End Sub
    Sub operate(ByVal Ope As e_kind)
        Dim d1 As Integer
        Dim d2 As Integer
        d2 = pop()
        d1 = pop()
        Select Case Ope
            Case e_kind.Plus
                push(d1 + d2)
            Case e_kind.Minus
                push(d1 - d2)
            Case e_kind.Multi
                push(d1 * d2)
            Case e_kind.Divi
                If d2 = 0 Then
                    Console.WriteLine("divide by 0")
                    errflg = True
                Else
                    push(d1 / d2)
                End If
        End Select
    End Sub
    Function getvalue(ByVal vname As String)
        Select Case vname
            Case "a"
                getvalue = vari(0)
            Case "b"
                getvalue = vari(1)
            Case "c"
                getvalue = vari(2)
            Case "d"
                getvalue = vari(3)
            Case "e"
                getvalue = vari(4)
        End Select
        'getvalue = vari(Int(vname) - "a")
    End Function
    Sub letvalue(ByVal vname As Char, ByVal n As Integer)
        Select Case vname
            Case "a"
                vari(0) = n
            Case "b"
                vari(1) = n
            Case "c"
                vari(2) = n
            Case "d"
                vari(3) = n
            Case "e"
                vari(4) = n

        End Select
        'w = vname
        'vari(Int(vname) - "a") = n
    End Sub
    Sub push(ByVal n As Integer)
        If stkct + 1 > STK_SIZ Then
            Console.WriteLine("stack over")
            End
        Else
            stkct += 1
            stack(stkct) = n
            'stkct += 1
        End If
    End Sub
    Function pop()
        If errflg = True Then
            pop = 1
            Return pop
        End If
        If stkct < 1 Then
            Console.WriteLine("stack under")
            End
        Else
            pop = stack(stkct)
            stkct -= 1

        End If

    End Function
inserted by FC2 system