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

Let's build a transpiler! Part 35

This is the thirty-fifth post in a series of building a transpiler.
You can find the previous ones here.

A new look at As New

Sometimes, wonderful things may be hidden in plain sight.

At first, "Dim Xp As New Expressionist" may seem like a shortcut to a longer statement like "Dim Xp As Expressionist: Set Xp = New Expressionist".
But As New does more than that. Whenever a statement having an As New variable is hit when running code, if the variable is Nothing, it will be automagically instantiated.
If no statement mentioning the variable is ever executed, then that variable will remain unset.

Here's an example:

Dim Condition As Boolean
Dim Xp As New Expressionist

Condition = True

If Condition Then
Debug.Print Xp Is Nothing 'This will print False
Else
'Xp is Nothing here.
'We cannot test it as we did above because Xp would be automagically instantiated defeating the test.
End If
Regarding the "chalenge" in my next to last post, the greatest blue words cluster I could come up with is If Not Me Is Nothing Then On Error Resume Next that... does not make any sense, of course.

Back to business

We will parse the remaining statements, that happen to be file I/O ones.
Here are the classes:

Public Class CloseConstruct
Option Explicit
Implements IStmt

Private FileNumbers_ As KeyedList

Private Sub Class_Initialize()
Set FileNumbers_ = New KeyedList
Set FileNumbers_.T = New ExprValidator
End Sub

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snClose
End Property

Public Property Get FileNumbers() As KeyedList
Set FileNumbers = FileNumbers_
End Property
End Class

Public Class GetConstruct
Option Explicit
Implements IStmt

Public FileNumber As IExpression
Public RecNumber As IExpression
Public Var As Symbol

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snGet
End Property
End Class

Public Class InputConstruct
Option Explicit
Implements IStmt

Private Vars_ As KeyedList

Public FileNumber As IExpression

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 = snInput
End Property

Public Property Get Vars() As KeyedList
Set Vars = Vars_
End Property
End Class

Public Class LockConstruct
Option Explicit
Implements IStmt

Public FileNumber As IExpression
Public RecordRange As IExpression

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snLock
End Property
End Class

Public Class NameConstruct
Option Explicit
Implements IStmt

Public OldPathName As IExpression
Public NewPathName As IExpression

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snName
End Property
End Class

Public Class OpenConstruct
Option Explicit
Implements IStmt

Public Enum FileModes
fmRandom
fmAppend
fmBinary
fmInput
fmOutput
End Enum

Public Enum FileAccesses
faNone
faRead
faWrite
faReadWrite
End Enum

Public Enum FileLocks
flShared
flRead
flWrite
flReadWrite
End Enum

Public PathName As IExpression
Public FileMode As FileModes
Public FileAccess As FileAccesses
Public FileLock As FileLocks
Public FileNumber As IExpression
Public Length As IExpression

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snOpen
End Property
End Class

Public Class PrintArg
Option Explicit

Public Indent As PrintIndent
Public Value As IExpression
Public HasSemicolon As Boolean
End Class

Public Class PrintConstruct
Option Explicit
Implements IStmt

Private Output_ As KeyedList

Public FileNumber As IExpression

Private Sub Class_Initialize()
Set Output_ = New KeyedList
Set Output_.T = NewValidator(TypeName(New PrintArg))
End Sub

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snPrint
End Property

Public Property Get Output() As KeyedList
Set Output = Output_
End Property
End Class

Public Class PrintIndent
Option Explicit

Public IsTab As Boolean
Public Value As IExpression
End Class

Public Class PutConstruct
Option Explicit
Implements IStmt

Public FileNumber As IExpression
Public RecNumber As IExpression
Public Var As Symbol

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snPut
End Property
End Class

Public Class SeekConstruct
Option Explicit
Implements IStmt

Public FileNumber As IExpression
Public Position As IExpression

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snSeek
End Property
End Class

Public Class UnlockConstruct
Option Explicit
Implements IStmt

Public FileNumber As IExpression
Public RecordRange As IExpression

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snUnlock
End Property
End Class

Public Class WidthConstruct
Option Explicit
Implements IStmt

Public FileNumber As IExpression
Public Value As IExpression

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snWidth
End Property
End Class

Public Class WriteConstruct
Option Explicit
Implements IStmt

Private Output_ As KeyedList

Public FileNumber As IExpression

Private Sub Class_Initialize()
Set Output_ = New KeyedList
Set Output_.T = New ExprValidator
End Sub

Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snWrite
End Property

Public Property Get Output() As KeyedList
Set Output = Output_
End Property
End Class
And here are Parser's updated methods. GetStmt had several changes, too many to highlight:

Public Function GetStmt(ByVal Parser As Parser, Optional ByVal Token As Token, Optional ByVal LookAhead As Token) As IStmt
Dim Done As Boolean
Dim Result As IStmt
Dim Sym As Symbol
Dim Name As IExpression
Dim Asg As LetConstruct
Dim Xp As Expressionist
Dim Exec As CallConstruct
Dim Uni As UnaryExpression
Dim Bin As BinaryExpression

Set Xp = New Expressionist

If Token Is Nothing Then Set Token = Parser.NextToken

If Token.Kind = tkOperator Then
If Token.Code = opWithBang Or Token.Code = opWithDot Then
Set Uni = New UnaryExpression
Set Uni.Operator = NewOperator(Token)
Set Token = Parser.NextToken
If Token.Kind <> tkIdentifier And Token.Kind <> tkEscapedIdentifier Then Stop

Set Sym = New Symbol
Set Sym.Value = Token
Set Uni.Value = Sym
Set Name = Uni
Else
Stop
End If
End If

If Name Is Nothing Then
Set Sym = New Symbol
Set Sym.Value = Token
Set Name = Sym
End If

If LookAhead Is Nothing Then
Set Token = Parser.NextToken
Else
Set Token = LookAhead
End If

Do
Done = True

Select Case Token.Kind
Case tkLeftParenthesis
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser)
If Token.Kind = tkRightParenthesis Then Set Token = Parser.NextToken
Set Name = Exec
Rem Let's iterate again
Done = False

Case tkOperator
Select Case Token.Code
Case opAddressOf, opNew, opNot, opTypeOf, opWithDot, opWithBang
Rem Operator is being passed to CollectArgs through Token argument.
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case opDot
Set Bin = New BinaryExpression
Set Bin.Operator = NewOperator(Token)
Set Bin.LHS = Name

Set Token = Parser.NextToken
If Token.Kind <> tkIdentifier And Token.Kind <> tkEscapedIdentifier Then Exit Do

Set Sym = New Symbol
Set Sym.Value = Token
Set Bin.RHS = Sym

Set Name = Bin

Set Token = Parser.NextToken
Done = False

Case opEq
Set Asg = New LetConstruct
Set Asg.Operator = NewOperator(Token)
Set Asg.Name = Name

Xp.FullMode = True
Set Asg.Value = Xp.GetExpression(Parser)
Set Token = Xp.LastToken
If Asg.Value Is Nothing Then Exit Do

Set Result = Asg

Case opSum
Rem Identity operator. We'll ignore it.
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser)
Set Result = Exec

Case opSubt
Rem Operator is being passed to CollectArgs through Token argument.
Token.Code = opNeg
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case opConcat, opCompAnd, opCompEqv, opCompImp, opCompMod, opCompOr, opCompXor, opCompSum, opCompSubt, _
opCompMul, opCompDiv, opCompIntDiv, opCompPow, opCompLSh, opCompRSh, opCompURSh, opCompConcat

Set Asg = New LetConstruct
Set Asg.Operator = NewOperator(Token)
Set Asg.Name = Name

Xp.FullMode = True
Asg.Value = Xp.GetExpression(Parser)
Set Token = Xp.LastToken
If Asg.Value Is Nothing Then Exit Do 'We'll return Nothing to sign a problem.

Set Result = Asg
End Select

Case tkIdentifier, tkEscapedIdentifier
Set Exec = New CallConstruct
Set Exec.LHS = Name

Rem Identifier is being passed to CollectArgs through Token
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case tkKeyword
Rem Keyword is being passed to CollectArgs through Token
Select Case Token.Code
Case kwByVal
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case kwDate, kwString
Token.Kind = tkIdentifier
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case kwEmpty, kwFalse, kwMe, kwNothing, kwNull, kwTrue
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case Else
Exit Do
End Select

Case tkIntegerNumber, tkFloatNumber, tkSciNumber, tkBinaryNumber, tkOctalNumber, tkHexaNumber, tkString, tkDateTime
Set Exec = New CallConstruct
Set Exec.LHS = Name
Rem Literal is being passed to CollectArgs through Token
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case tkListSeparator
Set Exec = New CallConstruct
Set Exec.LHS = Name
Set Token = CollectArgs(Exec.Arguments, Parser, Token)
Set Result = Exec

Case Else
If Not Parser.IsBreak(Token) Then Exit Do

If Name.Kind = ekIndexer Then
Set Exec = Name
Else
Rem Method call with no arguments.
Set Exec = New CallConstruct
Set Exec.LHS = Name
End If

Set Result = Exec
End Select
Loop Until Done

Set LastToken_ = Token
Debug.Assert Parser.IsBreak(Token) Or Token.Code = kwElse
Set GetStmt = Result
End Function

Friend Function CollectArgs(ByVal Args As KeyedList, ByVal Parser As Parser, Optional ByVal Token As Token) As Token
Dim Tkn As Token
Dim Lit As Literal
Dim Expr As IExpression
Dim Xp As Expressionist

Set Xp = New Expressionist
Xp.FullMode = True

If Not Token Is Nothing Then
If Token.Kind = tkListSeparator Then
Token.Kind = tkKeyword
Token.Code = kwVoid

Set Lit = New Literal
Set Lit.Value = Token

Args.Add Lit
Set Token = Nothing
End If
End If

Do
Set Expr = Xp.GetExpression(Parser, Token)
Set Token = Xp.LastToken

If Expr Is Nothing Then
If Token.Kind = tkListSeparator Then
Set Tkn = New Token
Tkn.Column = Token.Column
Tkn.Line = Token.Line
Tkn.Kind = tkKeyword
Tkn.Code = kwVoid
Set Lit = New Literal
Set Lit.Value = Tkn
Set Expr = Lit

ElseIf Token.Kind = tkRightParenthesis Then
Exit Do
End If
End If

Args.Add Expr

If Token.Kind = tkRightParenthesis Then Exit Do
If Token.Kind <> tkListSeparator Then Exit Do
Set Token = Nothing
Loop

Set CollectArgs = Token
End Function

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 LStmt As LetConstruct
Dim SStmt As SetConstruct
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
Set Stmt = Xp.GetStmt(Me)
Set LookAhead = Xp.LastToken
If Stmt Is Nothing Then Fail Token, Msg094
If Stmt.Kind <> snCall Then Stop
Body.Add Stmt

Case kwClose
Set LookAhead = ParseClose(Entity, Body)

Case kwConst
Set LookAhead = ParseConsts(acLocal, Entity, Body, InsideProc:=True)

Case kwContinue
ParseContinue Entity, Body

Case kwDebug
Rem HACK:
GoTo Up

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
Exit Do
End Select

Case tkIdentifier
If LookAhead.Code = cxProperty Then Exit Do
End Select

Body.Add New EndConstruct

Case kwErase
Set LookAhead = ParseErase(Entity, Body)

Case kwExit
ParseExit Entity, Body

Case kwFor
Set LookAhead = ParseFor(Entity, Body)

Case kwGet
ParseGet Entity, Body

Case kwGoSub
ParseGoSub Entity, Body

Case kwGoTo
ParseGoTo Entity, Body

Case kwIf
Set LookAhead = ParseIf(Entity, Body)

Case kwInput
Set LookAhead = ParseInput(Entity, Body)

Case kwLet
Set Stmt = Xp.GetStmt(Me)
Set LookAhead = Xp.LastToken
If Stmt Is Nothing Then Fail Token, Msg094
If Stmt.Kind <> snLet Then Stop
Body.Add Stmt

Case kwLSet
Set LookAhead = ParseLSet(Entity, Body)

Case kwOn
Set LookAhead = ParseOn(Entity, Body)

Case kwOpen
Set LookAhead = ParseOpen(Entity, Body)

Case kwPrint
Set LookAhead = ParsePrint(Entity, Body)

Case kwPut
ParsePut Entity, Body

Case kwRaiseEvent
Set LookAhead = ParseRaiseEvent(Entity, Body)

Case kwReDim
ParseReDim Entity, Body

Case kwResume
Set LookAhead = ParseResume(Entity, Body)

Case kwReturn
Body.Add New ReturnConstruct

Case kwRSet
Set LookAhead = ParseRSet(Entity, Body)

Case kwSeek
Set LookAhead = ParseSeek(Entity, Body)

Case kwSelect
ParseSelect Entity, Body

Case kwSet
Set Stmt = Xp.GetStmt(Me)
Set LookAhead = Xp.LastToken
If Stmt Is Nothing Then Fail Token, Msg094
If Stmt.Kind <> snLet Then Stop

Set LStmt = Stmt
Set SStmt = New SetConstruct
Set SStmt.Name = LStmt.Name
Set SStmt.Value = LStmt.Value
Set Stmt = SStmt
Body.Add Stmt

Case kwStatic
ParseDim acLocal, Entity, Body, InsideProc:=True, IsStatic:=True

Case kwStop
Body.Add New StopConstruct

Case kwUnlock
Set LookAhead = ParseUnlock(Entity, Body)

Case kwWhile
ParseWhile Entity, Body

Case cxWidth
Set LookAhead = ParseWidth(Entity, Body)

Case kwWith
ParseWith Entity, Body

Case kwWrite
Set LookAhead = ParseWrite(Entity, Body)

Case kwCase, kwElse, kwElseIf, kwLoop, kwNext, kwWend
Set LookAhead = Token
Exit Do

Case cxName
Set LookAhead = ParseName(Entity, Body)

Case Else
Rem It should not happen
Debug.Assert False
End Select

Case tkIdentifier
Select Case Token.Code
Case cxLock
Set LookAhead = ParseLock(Entity, Body)

Case cxReset
Body.Add New ResetConstruct

Case cxWidth
Set LookAhead = ParseWidth(Entity, Body)

Case Else
Up:
Set Stmt = Xp.GetStmt(Me, Token, LookAhead)
Set LookAhead = Xp.LastToken
SetLookAhead = Nothing
If Stmt Is Nothing Then Fail Token, Msg094
Body.Add Stmt
End Select

Case tkDirective
Do
Set Token = NextToken
Loop Until IsBreak(Token)

Case tkOperator
Select Case Token.Code
Case opWithBang, opWithDot
GoTo Up

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
If LookAhead Is Nothing Then
Set ParseBody = NextToken
Else
Set ParseBody = LookAhead
End If
End Function

Private Function ParseClose(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Expr As IExpression
Dim Xp As Expressionist
Dim Stmt As CloseConstruct

Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt = New CloseConstruct

Do
Set Expr = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Expr Is Nothing Then Exit Do

Stmt.FileNumbers.Add Expr
Loop While Token.Kind = tkListSeparator

Body.Add Stmt
Set ParseClose = Token
End Function

Private Sub ParseGet(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Stmt As GetConstruct
Dim Xp As Expressionist

Set Stmt = New GetConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken

If Stmt.FileNumber Is Nothing Then Fail Token, Msg113, Msg114
If Token.Kind <> tkListSeparator Then Fail Token, Msg113, ","

Set Stmt.RecNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken
Rem RecNumber can be nothing
If Token.Kind <> tkListSeparator Then Fail Token, Msg113, ","

Set Token = NextToken
If Not IsProperId(Token, CanHaveSuffix:=True) Then Fail Token, Msg113, Msg101

Set Stmt.Var = New Symbol
Set Stmt.Var.Value = Token
Body.Add Stmt
End Sub

Private Function ParseInput(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Sym As Symbol
Dim Xp As Expressionist
Dim Stmt As InputConstruct

Set Stmt = New InputConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Token.Kind <> tkListSeparator Then Fail Token, Msg115, ","

Do
Set Token = NextToken
If Not IsProperId(Token, CanHaveSuffix:=True) Then Fail Token, Msg113, Msg101

Set Sym = New Symbol
Set Sym.Value = NewId(Token)
Stmt.Vars.Add Sym

Set Token = NextToken
Loop While Token.Kind = tkListSeparator

Body.Add Stmt
Set ParseInput = Token
End Function

Private Function ParseLock(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Stmt As LockConstruct
Dim Xp As Expressionist

Set Stmt = New LockConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Msg116, Msg114

If Xp.LastToken.Kind = tkListSeparator Then
Xp.CanHaveTo = True
Set Stmt.RecordRange = Xp.GetExpression(Me)
If Stmt.RecordRange Is Nothing Then Fail Xp.LastToken, Msg116, Msg117
End If

Body.Add Stmt
Set ParseLock = Xp.LastToken
End Function

Private Function ParseName(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Xp As Expressionist
Dim Stmt As NameConstruct

Set Stmt = New NameConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.OldPathName = Xp.GetExpression(Me)
If Stmt.OldPathName Is Nothing Then Fail Xp.LastToken, Msg118, Msg119
If Xp.LastToken.IsKeyword(kwAs) Then Fail Xp.LastToken, Msg118, vAs

Set Stmt.NewPathName = Xp.GetExpression(Me)
If Stmt.NewPathName Is Nothing Then Fail Xp.LastToken, Msg118, Msg120

Body.Add Stmt
Set ParseName = Xp.LastToken
End Function

Private Function ParseOpen(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Stmt As OpenConstruct
Dim Xp As Expressionist

Set Stmt = New OpenConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.PathName = Xp.GetExpression(Me)
If Stmt.PathName Is Nothing Then Fail Xp.LastToken, Msg121, Msg122
If Not Xp.LastToken.IsKeyword(kwFor) Then Fail Xp.LastToken, Msg121, vFor

Set Token = NextToken
If Token.Kind <> tkKeyword Then Fail Token, Msg123

Select Case Token.Code
Case cxAppend
Stmt.FileMode = fmAppend

Case cxBinary
Stmt.FileMode = fmBinary

Case kwInput
Stmt.FileMode = fmInput

Case cxOutput
Stmt.FileMode = fmOutput

Case cxRandom
Stmt.FileMode = fmRandom

Case Else
Fail Token, Msg123
End Select

Set Token = NextToken

If Token.IsKeyword(cxAccess) Then
Set Token = NextToken

If Token.IsKeyword(cxRead) Then
Stmt.FileAccess = faRead
Set Token = NextToken
End If

If Token.IsKeyword(kwWrite) Then
If Stmt.FileAccess = faRead Then Stmt.FileAccess = faReadWrite Else Stmt.FileAccess = faWrite
Set Token = NextToken
End If

If Stmt.FileAccess = faNone Then Fail Token, Msg124
End If

If Token.IsKeyword(cxShared) Then
Stmt.FileLock = flShared
Set Token = NextToken

ElseIf Token.IsKeyword(cxRead) Then
Stmt.FileLock = flRead
Set Token = NextToken

If Token.IsKeyword(kwWrite) Then
Stmt.FileAccess = faReadWrite
Set Token = NextToken
End If

ElseIf Token.IsKeyword(kwWrite) Then
Stmt.FileAccess = faWrite
Set Token = NextToken
End If

If Not Token.IsKeyword(kwAs) Then Fail Token, Msg121, vAs
Set Stmt.FileNumber = Xp.GetExpression(Me)
If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Msg121, Msg114
Set Token = Xp.LastToken

If Token.IsKeyword(cxLen) Then
Set Token = NextToken
If Not Token.IsOperator(opEq) Then Fail Token, Msg121, "="

Set Stmt.Length = Xp.GetExpression(Me)
Set Token = Xp.LastToken
End If

Body.Add Stmt
Set ParseOpen = Token
End Function

Private Function ParsePrint(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Sym As Symbol
Dim Arg As PrintArg
Dim Expr As IExpression
Dim Xp As Expressionist
Dim Exec As CallConstruct
Dim Stmt As PrintConstruct

Set Stmt = New PrintConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Stmt.FileNumber Is Nothing Then Fail Token, Msg125, Msg114
If Token.Kind <> tkListSeparator Then Fail Token, Msg125, ","
Set Token = Nothing

Do
Set Expr = Xp.GetExpression(Me, Token)
Set Token = Xp.LastToken
If Expr Is Nothing Then Fail Xp.LastToken, Msg125, Msg101

Set Arg = New PrintArg

If Expr.Kind = ekIndexer Then
Set Exec = Expr

If Exec.LHS.Kind = ekSymbol Then
Set Sym = Exec.LHS

If Sym.Value.Kind = tkIdentifier And Sym.Value.Code = cxSpc Then
If Exec.Arguments.Count > 1 Then Stop
Set Arg.Indent = New PrintIndent
Set Arg.Indent.Value = Exec.Arguments(1)
Set Expr = Xp.GetExpression(Me, Token)
Set Token = Xp.LastToken

ElseIf Sym.Value.Kind = tkIdentifier And Sym.Value.Code = cxTab Then
If Exec.Arguments.Count > 1 Then Stop
Set Arg.Indent = New PrintIndent
Arg.Indent.IsTab = True
Set Arg.Indent.Value = Exec.Arguments(1)
Set Expr = Xp.GetExpression(Me, Token)
Set Token = Xp.LastToken
End If
End If

ElseIf Expr.Kind = ekSymbol Then
Set Sym = Expr

If Sym.Value.Kind = tkIdentifier And Sym.Value.Code = cxTab Then
Set Arg.Indent = New PrintIndent
Arg.Indent.IsTab = True
Set Expr = Xp.GetExpression(Me, Token)
Set Token = Xp.LastToken
End If
End If

Set Arg.Value = Expr

If Token.Kind = tkPrintSeparator Then
Arg.HasSemicolon = True
Set Token = NextToken
End If

Stmt.Output.Add Arg
Loop Until IsEndOfContext(Token)

Body.Add Stmt
Set ParsePrint = Token
End Function

Private Sub ParsePut(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Stmt As PutConstruct
Dim Xp As Expressionist

Set Stmt = New PutConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken

If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Msg126, Msg101
If Token.Kind <> tkListSeparator Then Fail Xp.LastToken, Msg126, ","

Set Stmt.RecNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken
Rem RecNumber can be nothing
If Token.Kind <> tkListSeparator Then Fail Xp.LastToken, Msg126, ","

Set Token = NextToken
If Not IsProperId(Token, CanHaveSuffix:=True) Then Fail Token, Msg126, Msg003

Set Stmt.Var = New Symbol
Set Stmt.Var.Value = Token
Body.Add Stmt
End Sub

Private Function ParseSeek(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Xp As Expressionist
Dim Stmt As SeekConstruct

Set Stmt = New SeekConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Msg127, Msg101
If Xp.LastToken.Kind <> tkListSeparator Then Fail Xp.LastToken, Msg127, ","

Set Stmt.Position = Xp.GetExpression(Me)
If Stmt.Position Is Nothing Then Fail Xp.LastToken, Msg127, Msg128

Body.Add Stmt
Set ParseSeek = Xp.LastToken
End Function

Private Function ParseUnlock(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Stmt As UnlockConstruct
Dim Xp As Expressionist

Set Stmt = New UnlockConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Msg129, Msg101

If Xp.LastToken.Kind = tkListSeparator Then
Xp.CanHaveTo = True
Set Stmt.RecordRange = Xp.GetExpression(Me)
If Stmt.RecordRange Is Nothing Then Fail Xp.LastToken, Msg129, Msg117
End If

Body.Add Stmt
Set ParseUnlock = Xp.LastToken
End Function

Private Function ParseWidth(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Stmt As WidthConstruct
Dim Xp As Expressionist

Set Stmt = New WidthConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Mg130, Msg101
If Xp.LastToken.Kind <> tkListSeparator Then Fail Xp.LastToken, Msg130, ","

Xp.CanHaveTo = True
Set Stmt.Value = Xp.GetExpression(Me)
If Stmt.Value Is Nothing Then Fail Xp.LastToken, Msg130, Msg131

Body.Add Stmt
Set ParseWidth = Xp.LastToken
End Function

Private Function ParseWrite(ByVal Entity As Entity, ByVal Body As KeyedList) As Token
Dim Token As Token
Dim Expr As IExpression
Dim Xp As Expressionist
Dim Stmt As WriteConstruct

Set Stmt = New WriteConstruct
Set Xp = New Expressionist
Xp.FullMode = True

Set Stmt.FileNumber = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Stmt.FileNumber Is Nothing Then Fail Xp.LastToken, Msg132, Msg101
If Token.Kind <> tkListSeparator Then Fail Xp.LastToken, Msg132, ","

Do
Set Expr = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Expr Is Nothing Then Exit Do

Stmt.Output.Add Expr
Loop While Token.Kind = tkListSeparator

Body.Add Stmt
Set ParseWrite = Token
End Function

Private Sub ParseDim( _
ByVal Access As Accessibility, _
ByVal Entity As Entity, _
ByVal Vars As KeyedList, _
Optional ByVal InsideProc As Boolean, _
Optional ByVal IsStatic As Boolean, _
Optional ByVal Token As Token _
)
Dim Name As String
Dim WasArray As Boolean
Dim Tkn As Token
Dim Lit As Literal
Dim Var As Variable
Dim Expr As IExpression
Dim Subs As SubscriptPair
Dim Xp As Expressionist
Dim Uni As UnaryExpression
Dim Bin As BinaryExpression

If InsideProc Then: If Access = acPublic Or Access = acPrivate Then Fail Token, Msg063
If Token Is Nothing Then Set Token = NextToken

Set Xp = New Expressionist
Xp.CanHaveTo = True
Xp.FullMode = True

(...)
End Sub
Here are Reverter's new methods:

Private Sub EmitClose(ByVal Stmt As CloseConstruct)
Dim Number As IExpression

Builder.Append "Close"

For Each Number In Stmt.FileNumbers
Builder.Append " "
EmitExpression Number
Next
End Sub

Private Sub EmitGet(ByVal Stmt As GetConstruct)
Builder.Append "Get "
EmitExpression Stmt.FileNumber
Builder.Append ", "
If Not Stmt.RecNumber Is Nothing Then EmitExpression Stmt.RecNumber
Builder.Append ", "
EmitToken Stmt.Var.Value
End Sub

Private Sub EmitInput(ByVal Stmt As InputConstruct)
Dim Count As Integer
Dim Var As Symbol

Builder.Append "Input "
EmitExpression Stmt.FileNumber
Builder.Append ", "

For Each Var In Stmt.Vars
EmitToken Var.Value
Count = Count + 1
If Count <> Stmt.Vars.Count Then Builder.Append ", "
Next
End Sub

Private Sub EmitLock(ByVal Stmt As LockConstruct)
Builder.Append "Lock "
EmitExpression Stmt.FileNumber
Builder.Append ", "
EmitExpression Stmt.RecordRange
End Sub

Private Sub EmitName(ByVal Stmt As NameConstruct)
Builder.Append "Name "
EmitExpression Stmt.OldPathName
Builder.Append " As "
EmitExpression Stmt.NewPathName
End Sub

Private Sub EmitOpen(ByVal Stmt As OpenConstruct)
Builder.Append "Open "
EmitExpression Stmt.PathName
Builder.Append " For "

Select Case Stmt.FileMode
Case fmAppend
Builder.Append "Append"

Case fmBinary
Builder.Append "Binary"

Case fmInput
Builder.Append "Input"

Case fmOutput
Builder.Append "Output"

Case fmRandom
Builder.Append "Random"
End Select

If Stmt.FileAccess <> faNone Then
Builder.Append " Access "

Select Case Stmt.FileAccess
Case faRead
Builder.Append "Read"

Case faReadWrite
Builder.Append "Read Write"

Case faWrite
Builder.Append "Write"
End Select
End If

Select Case Stmt.FileLock
Case flRead
Builder.Append " Read"

Case flReadWrite
Builder.Append " Read Write"

Case flShared
Builder.Append " Shared"

Case flWrite
Builder.Append " Write"
End Select

Builder.Append " As "
EmitExpression Stmt.FileNumber

If Not Stmt.Length Is Nothing Then
Builder.Append " Len="
EmitExpression Stmt.Length
End If
End Sub

Private Sub EmitPrint(ByVal Stmt As PrintConstruct)
Dim Count As Integer
Dim Arg As PrintArg

Builder.Append "Print #"
EmitExpression Stmt.FileNumber
Builder.Append ","

For Each Arg In Stmt.Output
Count = Count + 1

If Not Arg.Indent Is Nothing Then
Builder.Append IIf(Arg.Indent.IsTab, " Tab", " Spc")

If Not Arg.Indent.Value Is Nothing Then
Builder.Append "("
EmitExpression Arg.Indent.Value
Builder.Append ")"
End If

Builder.Append " "
End If

EmitExpression Arg.Value

If Arg.HasSemicolon Then
Builder.Append ";"
Else
If Count <> Stmt.Output.Count Then Builder.Append " "
End If
Next
End Sub

Private Sub EmitPut(ByVal Stmt As PutConstruct)
Builder.Append "Put "
EmitExpression Stmt.FileNumber
Builder.Append ", "
If Not Stmt.RecNumber Is Nothing Then EmitExpression Stmt.RecNumber
Builder.Append ", "
EmitToken Stmt.Var.Value
End Sub

Private Sub EmitReset(ByVal Stmt As ResetConstruct)
Builder.Append "Reset"
End Sub

Private Sub EmitSeek(ByVal Stmt As SeekConstruct)
Builder.Append "Seek "
EmitExpression Stmt.FileNumber
Builder.Append ", "
EmitExpression Stmt.Position
End Sub

Private Sub EmitUnlock(ByVal Stmt As UnlockConstruct)
Builder.Append "Unlock "
EmitExpression Stmt.FileNumber
Builder.Append ", "
EmitExpression Stmt.RecordRange
End Sub

Private Sub EmitWidth(ByVal Stmt As WidthConstruct)
Builder.Append "Width "
EmitExpression Stmt.FileNumber
Builder.Append ", "
EmitExpression Stmt.Value
End Sub

Private Sub EmitWrite(ByVal Stmt As WriteConstruct)
Dim Count As Integer
Dim Expr As IExpression

Builder.Append "Write "
EmitExpression Stmt.FileNumber
Builder.Append ", "

For Each Expr In Stmt.Output
EmitExpression Expr
Count = Count + 1
If Count <> Stmt.Output.Count Then Builder.Append ", "
Next
End Sub
Finally, the error messages:

Public Property Get Msg113() As String
Msg113 = "Rule: Get [#]filenumber, [recnumber], varname"
End Property

Public Property Get Msg114() As String
Msg114 = "#filenumber"
End Property

Public Property Get Msg115() As String
Msg115 = "Rule: Input #filenumber, variable[, variable, ...]"
End Property

Public Property Get Msg116() As String
Msg116 = "Rule: Lock [#]filenumber[, recordrange]"
End Property

Public Property Get Msg117() As String
Msg117 = "recordrange"
End Property

Public Property Get Msg118() As String
Msg118 = "Rule: Name oldpathname As newpathname"
End Property

Public Property Get Msg119() As String
Msg119 = "oldpathname"
End Property

Public Property Get Msg120() As String
Msg120 = "newpathname"
End Property

Public Property Get Msg121() As String
Msg121 = "Rule: Open pathname For mode [Access access] [lock] As [#]filenumber [Len=reclength]"
End Property

Public Property Get Msg122() As String
Msg122 = "pathname"
End Property

Public Property Get Msg123() As String
Msg123 = "Expected: Append or Binary or Input or Random"
End Property

Public Property Get Msg124() As String
Msg124 = "Expected: Read or Write"
End Property

Public Property Get Msg125() As String
Msg125 = "Rule: Print #filenumber, [outputlist]"
End Property

Public Property Get Msg126() As String
Msg126 = "Rule: Put [#]filenumber, [recnumber], varname"
End Property

Public Property Get Msg127() As String
Msg127 = "Rule: Seek [#]filenumber, position"
End Property

Public Property Get Msg128() As String
Msg128 = "position"
End Property

Public Property Get Msg129() As String
Msg129 = "Rule: Unlock [#]filenumber[, recordrange]"
End Property

Public Property Get Msg130() As String
Msg130 = "Rule: Width #filenumber, width"
End Property

Public Property Get Msg131() As String
Msg131 = "width"
End Property

Public Property Get Msg132() As String
Msg132 = "Rule: Write #filenumber, [outputlist]"
End Property
Next week we will convert all this project to VBScript again, but this time dealing with the optional parameters, transforming Vocabulary in a class, solving the bug we workedaround in part 15, and discussing two bugs in VBScript itself!

Andrej Biasic
2021-05-05