Let's build a transpiler! Part 34
This is the thirty-fourth post in a series of building a transpiler.You can find the previous ones here.
When I started this series, I knew it would not be that interesting for the few ones who visit this blog.
Now, that we only have a few installments to complete parsing VB code, I'll start a hybrid approach.
It still will have code for the transpiler, but I will add a kind of a mini-article to each one of them.
What's that "bang" operator anyway?
I've been saying "bang operator" for some time now, but never cared to explain what it is.To understand the bang operator, we need to understand the default method.
When a class has a default method, it can be called on an object of that class without explicitly naming it.
Let's see an example: We can recover an item from a KeyedList using its Item property:
Debug.Print KeyWords_.Item("New")
Item being KeyedList's default method allow us to use it without spelling it:
Debug.Print KeyWords_("New")
But, if the default method's parameter is a String, we can do like this instead:
Debug.Print KeyWords_!New
"Why would anyone use it?", you may be asking yourself.
Because you can fake an object whose values come from a database, for instance.
Here it is a contrived example:
Cmd = "SELECT * FROM Customer"
Set Conn = CreateObject("ADODB.Connection")
Conn.Open ConnStr, "User", "Password"
Set Rd = CreateObject("ADODB.Recordset")
Rd.Open Cmd, Conn
Rd.MoveLast
Rd.MoveFirst
While Not Rd.EOF
Debug.Print Rd!Name
Rd.MoveNext
Wend
Somehow it seems to confound some people.
Nothing to see here people. Just an ordinary operator doing its work...
Back to business
Parsing and reverting the remaining statements are not exciting. We'll be using the same techniques we have been using from the beginning.Here they are the enhanced classes for the GoTo, GoSub, Return, Exit, Continue, LSet, RSet, Resume, On Error, On ... GoTo/GoSub, Erase, ReDim, and RaiseEvent statements.
Public Class GoSubConstruct
Option Explicit
Implements IStmt
Public Target As IStmt
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snGoSub
End Property
End Class
Public Class GoToConstruct
Option Explicit
Implements IStmt
Public Target As IStmt
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snGoTo
End Property
End Class
Public Class ReturnConstruct
Option Explicit
Implements IStmt
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snReturn
End Property
End Class
Public Class ExitConstruct
Option Explicit
Implements IStmt
Public Enum ExitWhat
ewDo
ewFor
ewFunction
ewProperty
ewSelect
ewSub
ewWhile
End Enum
Public What As ExitWhat
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snExit
End Property
End Class
Public Class ContinueConstruct
Option Explicit
Implements IStmt
Public Enum ContinueWhat
cwDo
cwFor
cwWhile
End Enum
Public What As ContinueWhat
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snContinue
End Property
End Class
Public Class LSetConstruct
Option Explicit
Implements IStmt
Public Name As IExpression
Public Value As IExpression
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snLSet
End Property
End Class
Public Class RSetConstruct
Option Explicit
Implements IStmt
Public Name As IExpression
Public Value As IExpression
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snRSet
End Property
End Class
Public Class ResumeConstruct
Option Explicit
Implements IStmt
Public IsNext As Boolean
Public Target As IStmt
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snResume
End Property
End Class
Public Class OnErrorConstruct
Option Explicit
Implements IStmt
Public Statement As IStmt
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snOnError
End Property
End Class
Public Class OnComputedConstruct
Option Explicit
Implements IStmt
Private Targets_ As KeyedList
Public Value As IExpression
Public IsGoTo As Boolean
Private Sub Class_Initialize()
Set Targets_ = New KeyedList
Set Targets_.T = New StmtValidator
End Sub
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snOnComputed
End Property
Public Property Get Targets() As KeyedList
Set Targets = Targets_
End Property
End Class
Public Class EraseConstruct
Option Explicit
Implements IStmt
Private Vars_ As KeyedList
Private Sub Class_Initialize()
Set Vars_ = New KeyedList
Set Vars_.T = NewValidator(TypeName(New Symbol))
End Sub
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snErase
End Property
Public Property Get Vars() As KeyedList
Set Vars = Vars_
End Property
End Class
Public Class ReDimConstruct
Option Explicit
Implements IStmt
Private Vars_ As KeyedList
Public HasPreserve As Boolean
Private Sub Class_Initialize()
Set Vars_ = New KeyedList
Set Vars_.T = NewValidator(TypeName(New Variable))
End Sub
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snReDim
End Property
Public Property Get Vars() As KeyedList
Set Vars = Vars_
End Property
End Class
Public Class RaiseEventConstruct
Option Explicit
Implements IStmt
Private Arguments_ As KeyedList
Public Id As Identifier
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snRaiseEvent
End Property
Public Property Get Arguments() As KeyedList
Set Arguments = Arguments_
End Property
Friend Property Set Arguments(ByVal Value As KeyedList)
Set Arguments_ = Value
End Property
End Class
And below you'll find the updated ParseBody function and the mandatory ParseGoTo, ParseGoSub,
Private Function ParseBody( _
ByVal Entity As Entity, _
ByVal Body As KeyedList, _
Optional ByVal IsSingleLine As Boolean, _
Optional ByVal LookAhead As Token _
) As Token
Dim Token As Token
Dim Stmt As IStmt
Dim Xp As Expressionist
Dim Label As LabelConstruct
Dim LinNum As LineNumberConstruct
Set Xp = New Expressionist
Do
If LookAhead Is Nothing Then
Set Token = SkipLineBreaks
Else
Set Token = LookAhead
Set LookAhead = Nothing
If IsBreak(Token) Then Set Token = SkipLineBreaks
End If
If Not IsSingleLine Then
Rem Do we have a line number?
If Token.Kind = tkIntegerNumber Then
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Body.Add LinNum
Set Token = NextToken
End If
Rem Do we have a label?
If Token.Kind = tkIdentifier Then
Set LookAhead = NextToken
If LookAhead.Kind = tkSoftLineBreak Then
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Body.Add Label
Set LookAhead = Nothing
Set Token = NextToken
End If
End If
End If
Select Case Token.Kind
Case tkKeyword
Select Case Token.Code
Case kwCall
GoSub DiscardLine
Case kwClose
GoSub DiscardLine
Case kwConst
Set Token = ParseConsts(acLocal, Entity, Body, InsideProc:=True)
Case kwContinue
ParseContinue Entity, Body
Case kwDebug
GoSub DiscardLine
Case kwDim
ParseDim acLocal, Entity, Body, InsideProc:=True
Case kwDo
ParseDo Entity, Body
Case kwEnd
Rem Is it a closing End?
Set LookAhead = NextToken
Select Case LookAhead.Kind
Case tkKeyword
Select Case LookAhead.Code
Case kwFunction, kwIf, kwSelect, kwSub, kwWhile, kwWith
Set Token = LookAhead
Exit Do
End Select
Case tkIdentifier
If LookAhead.Code = cxProperty Then
Set Token = LookAhead
Exit Do
End If
End Select
Body.Add New EndConstruct
Case kwErase
Set Token = ParseErase(Entity, Body)
Case kwExit
ParseExit Entity, Body
If IsSingleLine Then Set Token = NextToken
Case kwFor
Set LookAhead = ParseFor(Entity, Body)
Case kwGet
GoSub DiscardLine
Case kwGoSub
ParseGoSub Entity, Body
Case kwGoTo
ParseGoTo Entity, Body
Case kwIf
Set Token = ParseIf(Entity, Body)
Case kwInput
GoSub DiscardLine
Case kwLet
GoSub DiscardLine
Case kwLSet
Set Token = ParseLSet(Entity, Body)
Case kwOn
Set Token = ParseOn(Entity, Body)
Case kwOpen
GoSub DiscardLine
Case kwPrint
GoSub DiscardLine
Case kwPut
GoSub DiscardLine
Case kwRaiseEvent
Set Token = ParseRaiseEvent(Entity, Body)
Case kwReDim
ParseReDim Entity, Body
Case kwResume
Set Token = ParseResume(Entity, Body)
Case kwReturn
Body.Add New ReturnConstruct
Case kwRSet
Set Token = ParseRSet(Entity, Body)
Case kwSeek
GoSub DiscardLine
Case kwSelect
ParseSelect Entity, Body
Case kwSet
GoSub DiscardLine
Case kwStatic
ParseDim acLocal, Entity, Body, InsideProc:=True, IsStatic:=True
Case kwStop
Body.Add New StopConstruct
Set Token = NextToken
Case kwUnlock
GoSub DiscardLine
Case kwWhile
ParseWhile Entity, Body
Case cxWidth
GoSub DiscardLine
Case kwWith
ParseWith Entity, Body
Case kwWrite
GoSub DiscardLine
Case kwCase, kwElse, kwElseIf, kwLoop, kwNext, kwWend
Exit Do
Case cxName
GoSub DiscardLine
Case Else
Rem It should not happen
Debug.Assert False
End Select
Case tkIdentifier
Select Case Token.Code
Case cxLock
GoSub DiscardLine
Case cxReset
GoSub DiscardLine
Case cxWidth
GoSub DiscardLine
Case Else
Set Stmt = Xp.GetStmt(Me, Token, LookAhead)
Set Token = Xp.LastToken
Set LookAhead = Nothing
If Stmt Is Nothing Then Fail Token, Msg094
Body.Add Stmt
End Select
Case tkDirective
GoSub DiscardLine
Case tkOperator
Select Case Token.Code
Case opWithBang, opWithDot
GoSub DiscardLine
Case Else
Debug.Assert False
End Select
Case tkHardLineBreak
Rem Nothing to do
Case Else
Debug.Assert False
Fail Token, Msg087
End Select
Loop Until IsSingleLine
Set ParseBody = Token
Exit Function
DiscardLine:
Do
Set Token = NextToken
Loop Until IsBreak(Token)
Return
End Function
Private Sub ParseGoTo(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Stmt As GoToConstruct
Dim Label As LabelConstruct
Dim LinNum As LineNumberConstruct
Set Stmt = New GoToConstruct
Set Token = NextToken
Select Case Token.Kind
Case tkIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label
Case tkIntegerNumber
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum
Case Else
Fail Token, Msg105
End Select
Body.Add Stmt
End Sub
Private Sub ParseGoSub(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Stmt As GoSubConstruct
Dim Label As LabelConstruct
Dim LinNum As LineNumberConstruct
Set Stmt = New GoSubConstruct
Set Token = NextToken
If IsProperId(Token) Then
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label
ElseIf Token.Kind = tkLineContinuation Then
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum
Else
Fail Token, Msg105
End If
Body.Add Stmt
End Sub
Private Sub ParseExit(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Stmt As ExitConstruct
Set Stmt = New ExitConstruct
Set Token = NextToken
If Token.IsKeyword(kwDo) Then
Stmt.What = ewDo
ElseIf Token.IsKeyword(kwFor) Then
Stmt.What = ewFor
ElseIf Token.IsKeyword(kwWhile) Then
Stmt.What = ewWhile
ElseIf Token.IsKeyword(kwSub) Then
Stmt.What = ewSub
ElseIf Token.IsKeyword(kwFunction) Then
Stmt.What = ewFunction
ElseIf Token.Kind = tkIdentifier And Token.Code = cxProperty Then
Stmt.What = ewProperty
ElseIf Token.IsKeyword(kwSelect) Then
Stmt.What = ewSelect
Else
Fail Token, Msg106
End If
Body.Add Stmt
End Sub
Private Sub ParseContinue(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Stmt As ContinueConstruct
Set Stmt = New ContinueConstruct
Set Token = NextToken
If Token.Kind <> tkKeyword Then Fail Token, Msg107
Select Case Token.Code
Case kwDo
Stmt.What = cwDo
Case kwFor
Stmt.What = cwFor
Case kwWhile
Stmt.What = cwWhile
End Select
Body.Add Stmt
End Sub
Private Function ParseLSet(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim ISt As IStmt
Dim Expr As IExpression
Dim Asg As LetConstruct
Dim Xp As Expressionist
Dim Stmt As LSetConstruct
Set Xp = New Expressionist
Set Stmt = New LSetConstruct
Set ISt = Xp.GetStmt(Me, NextToken)
If ISt.Kind <> snLet Then Stop
Set Asg = ISt
If Asg.Name.Kind <> ekSymbol Then Stop
If Asg.Operator.Value.Code <> opEq Then Fail Asg.Operator.Value, Msg108, "="
Set Stmt.Name = Asg.Name
Set Stmt.Value = Asg.Value
Body.Add Stmt
End Function
Private Function ParseRSet(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim ISt As IStmt
Dim Expr As IExpression
Dim Asg As LetConstruct
Dim Xp As Expressionist
Dim Stmt As RSetConstruct
Set Xp = New Expressionist
Set Stmt = New RSetConstruct
Set ISt = Xp.GetStmt(Me, NextToken)
If ISt.Kind <> snLet Then Stop
Set Asg = ISt
If Asg.Name.Kind <> ekSymbol Then Stop
If Asg.Operator.Value.Code <> opEq Then Fail Asg.Operator.Value, Msg109, "="
Set Stmt.Name = Asg.Name
Set Stmt.Value = Asg.Value
Body.Add Stmt
End Function
Private Function ParseOn(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim WentTo As GoToConstruct
Dim Label As LabelConstruct
Dim ResStmt As ResumeConstruct
Dim OnStmt As OnErrorConstruct
Dim Xp As New Expressionist
Dim Comp As OnComputedConstruct
Dim LinNum As LineNumberConstruct
Set Token = NextToken
If Token.IsKeyword(cxError) Then
Set OnStmt = New OnErrorConstruct
Set Token = NextToken
If Token.IsKeyword(kwLocal) Then Set Token = NextToken
If Token.IsKeyword(kwGoTo) Then
Set Token = NextToken
Select Case Token.Kind
Case tkIntegerNumber
Set WentTo = New GoToConstruct
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set WentTo.Target = LinNum
Set OnStmt.Statement = WentTo
Case tkIdentifier
Set WentTo = New GoToConstruct
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set WentTo.Target = Label
Set OnStmt.Statement = WentTo
Case Else
Fail Token, Msg105
End Select
ElseIf Token.IsKeyword(kwResume) Then
Set Token = NextToken
If Not Token.IsKeyword(kwNext) Then Fail Token, Msg103
Set ResStmt = New ResumeConstruct
ResStmt.IsNext = True
Set OnStmt.Statement = ResStmt
Else
Fail Token, Msg110
End If
Set Token = NextToken
Body.Add OnStmt
Else
Set Comp = New OnComputedConstruct
Xp.FullMode = True
Set Comp.Value = Xp.GetExpression(Me, Token)
Set Token = Xp.LastToken
If Comp.Value Is Nothing Then Fail Token, Msg065
If Token.IsKeyword(kwGoTo) Then
Comp.IsGoTo = True
ElseIf Token.IsKeyword(kwGoSub) Then
'Comp.IsGoTo = False
Else
Fail Token, Msg110
End If
Do
Set Token = NextToken
Select Case Token.Kind
Case tkIntegerNumber
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Comp.Targets.Add LinNum
Panel.AddTarget LinNum
Case tkIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Comp.Targets.Add Label
Panel.AddTarget Label
Case Else
Fail Token, Msg105
End Select
Set Token = NextToken
Loop While Token.Kind = tkListSeparator
Body.Add Comp
End If
Set ParseOn = Token
End Function
Private Function ParseResume(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Label As LabelConstruct
Dim Stmt As ResumeConstruct
Dim LinNum As LineNumberConstruct
Set Stmt = New ResumeConstruct
Set Token = NextToken
Select Case Token.Kind
Case tkIntegerNumber
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum
Set Token = NextToken
Case tkIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label
Set Token = NextToken
Case tkKeyword
If Token.Code <> kwNext Then Fail Token, Msg103
Stmt.IsNext = True
Set Token = NextToken
Case Else
Set LinNum = New LineNumberConstruct
Set LinNum.Value = New Token
LinNum.Value.Kind = tkIntegerNumber
LinNum.Value.Text = "0" 'TODO: It ca be fooled
Set Stmt.Target = LinNum
End Select
Body.Add Stmt
Set ParseResume = Token
End Function
Private Function ParseErase(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Sym As Symbol
Dim Stmt As EraseConstruct
Set Stmt = New EraseConstruct
Do
Set Token = NextToken
If Token.Kind <> tkIdentifier Then Fail Token, Msg111, Msg003
Set Sym = New Symbol
Set Sym.Value = Token
Stmt.Vars.Add Sym
Set Token = NextToken
Loop While Token.Kind = tkListSeparator
Body.Add Stmt
Set ParseErase = Token
End Function
Private Sub ParseReDim(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Var As Variable
Dim Stmt As ReDimConstruct
Set Stmt = New ReDimConstruct
Set Token = NextToken
If Token.IsKeyword(kwPreserve) Then
Stmt.HasPreserve = True
Set Token = NextToken
End If
ParseDim acLocal, Entity, Stmt.Vars, InsideProc:=True, Token:=Token
For Each Var In Stmt.Vars
If Var.HasNew Then Fail Var.Id.Name, Msg062
If Not Var.Init Is Nothing Then Stop
If Var.Subscripts.Count = 0 Then Fail Var.Id.Name, Msg112
Next
Body.Add Stmt
End Sub
Private Function ParseRaiseEvent(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim ISt As IStmt
Dim Sym As Symbol
Dim Xp As Expressionist
Dim Exec As CallConstruct
Dim Stmt As RaiseEventConstruct
Set Stmt = New RaiseEventConstruct
Set Xp = New Expressionist
Xp.FullMode = True
Set ISt = Xp.GetStmt(Me, NextToken)
Set Token = Xp.LastToken
If ISt.Kind <> snCall Then Stop
Set Exec = ISt
If Exec.LHS.Kind <> ekSymbol Then Stop
Set Sym = Exec.LHS
Set Stmt.Id = NewId(Sym.Value)
Set Stmt.Arguments = Exec.Arguments
Body.Add Stmt
Set ParseRaiseEvent = Token
End Function
Their Emit counterparts:
Private Sub EmitGoSub(ByVal Stmt As GoSubConstruct)
Dim Label As LabelConstruct
Dim LinNum As LineNumberConstruct
Builder.Append "GoSub "
If Stmt.Target.Kind = snLineNumber Then
Set LinNum = Stmt.Target
EmitToken LinNum.Value
Else
Set Label = Stmt.Target
EmitId Label.Id
End If
End Sub
Private Sub EmitGoTo(ByVal Stmt As GoToConstruct)
Dim Label As LabelConstruct
Dim LinNum As LineNumberConstruct
Builder.Append "GoTo "
If Stmt.Target.Kind = snLineNumber Then
Set LinNum = Stmt.Target
EmitToken LinNum.Value
Else
Set Label = Stmt.Target
EmitId Label.Id
End If
End Sub
Private Sub EmitReturn(ByVal Stmt As ReturnConstruct)
Builder.Append "Return "
End Sub
Private Sub EmitExit(ByVal Stmt As ExitConstruct)
Builder.Append "Exit "
Select Case Stmt.What
Case ewDo
Builder.Append "Do "
Case ewFor
Builder.Append "For "
Case ewWhile
Builder.Append "While "
Case ewSub
Builder.Append "Sub "
Case ewFunction
Builder.Append "Function "
Case ewProperty
Builder.Append "Property "
Case ewSelect
Builder.Append "Select "
End Select
End Sub
Private Sub EmitContinue(ByVal Stmt As ContinueConstruct)
Builder.Append "Continue "
Select Case Stmt.What
Case cwDo
Builder.Append "Do "
Case cwFor
Builder.Append "For "
Case cwWhile
Builder.Append "While "
End Select
End Sub
Private Sub EmitLSet(ByVal Stmt As LSetConstruct)
Builder.Append "LSet "
EmitExpression Stmt.Name
Builder.Append " = "
EmitExpression Stmt.Value
End Sub
Private Sub EmitRSet(ByVal Stmt As RSetConstruct)
Builder.Append "RSet "
EmitExpression Stmt.Name
Builder.Append " = "
EmitExpression Stmt.Value
End Sub
Private Sub EmitResume(ByVal Stmt As ResumeConstruct)
Dim Label As LabelConstruct
Dim LinNum As LineNumberConstruct
Builder.Append "Resume"
If Stmt.IsNext Then
Builder.Append " Next "
ElseIf Stmt.Target.Kind = snLabel Then
Builder.Append " "
Set Label = Stmt.Target
EmitId Label.Id
Else
Set LinNum = Stmt.Target
If LinNum.Value.Text <> "0" Then
Builder.Append " "
EmitToken LinNum.Value
End If
End If
End Sub
Private Sub EmitOnComputed(ByVal Stmt As OnComputedConstruct)
Dim Count As Integer
Dim Target As IStmt
Dim Label As LabelConstruct
Builder.Append "On "
EmitExpression Stmt.Value
If Stmt.IsGoTo Then
Builder.Append " GoTo "
Else
Builder.Append " GoSub "
End If
For Each Target In Stmt.Targets
If Target.Kind = snLabel Then
Set Label = Target
EmitId Label.Id
Else
EmitLineNumber Target
End If
Count = Count + 1
If Count <> Stmt.Targets.Count Then Builder.Append ", "
Next
End Sub
Private Sub EmitOnError(ByVal Stmt As OnErrorConstruct)
Builder.Append "On Error "
If Stmt.Statement.Kind = snGoTo Then
EmitGoTo Stmt.Statement
ElseIf Stmt.Statement.Kind = snResume Then
EmitResume Stmt.Statement
End If
End Sub
Private Sub EmitStop(ByVal Stmt As StopConstruct)
Builder.Append "Stop "
End Sub
Private Sub EmitErase(ByVal Stmt As EraseConstruct)
Dim Count As Integer
Dim Var As Variable
Builder.Append "Erase "
For Each Var In Stmt.Vars
EmitId Var.Id
Count = Count + 1
If Count <> Stmt.Vars.Count Then Builder.Append ", "
Next
Builder.Append " "
End Sub
Private Sub EmitReDim(ByVal Stmt As ReDimConstruct)
Dim Count As Integer
Dim Var As Variable
Builder.Append "ReDim "
If Stmt.HasPreserve Then Builder.Append "Preserve "
For Each Var In Stmt.Vars
EmitId Var.Id
EmitSubscripts Var.Subscripts
Builder.Append " As "
EmitDataType Var.DataType
Count = Count + 1
If Count <> Stmt.Vars.Count Then Builder.Append ", "
Next
End Sub
Private Sub EmitRaiseEvent(ByVal Stmt As RaiseEventConstruct)
Dim Count As Integer
Dim Expr As IExpression
Builder.Append "RaiseEvent "
EmitId Stmt.Id
If Stmt.Arguments.Count > 0 Then
Builder.Append "("
For Each Expr In Stmt.Arguments
EmitExpression Expr
Count = Count + 1
If Count <> Stmt.Arguments.Count Then Builder.Append ", "
Next
Builder.Append ")"
End If
Builder.Append " "
End Sub
Finally, error messages to add to Messages module:
Public Property Get Msg105() As String
Msg105 = "Expected: Label or line number"
End Property
Public Property Get Msg106() As String
Msg106 = "Expected: Do or For or Function or Property or Sub or Select or While"
End Property
Public Property Get Msg107() As String
Msg107 = "Expected: Do or For or While"
End Property
Public Property Get Msg108() As String
Msg108 = "Rule: LSet variable = value"
End Property
Public Property Get Msg109() As String
Msg109 = "Rule: RSet variable = value"
End Property
Public Property Get Msg110() As String
Msg110 = "Expected: GoTo or GoSub"
End Property
Public Property Get Msg111() As String
Msg111 = "Rule: Erase identifier"
End Property
Public Property Get Msg112() As String
Msg112 = "Expected: subscript"
End Property
Next week, we'll deal with file I/O statements.
Andrej Biasic
2021-04-28