Metamorphing Machine I rather be this walking metamorphosis
than having that old formed opinion about everything!

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, ParseReturn (we inlined it), ParseExit, ParseContinue, ParseLSet, ParseRSet, ParseResume, ParseOn, ParseErase, ParseReDim, and ParseRaiseEvent procedures:

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