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
カテゴリー