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

Let's build a transpiler! Part 50

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

When you're less than a cog

I started working at my previous job in 2012.
I had to deal with an offshore team daily. It started with only two members but, over time, it grew to around 15 people.
I'm not good with names. Talking to faceless people thousands of miles away did not help.
So, I came up with an idea: People should introduce themselves by e-mail with a picture, and I was the first to do that.
Not long after it started, I've sent an e-mail making fun of me, then it progressed to a kinda newsletter making fun of everyone.
(I consulted a foreign fellow to make sure I was not offending anyone, though.)
There were six of these newsletters. After it was over, our offshore manager told me they missed it because it was a stress reliever.
Due to this initiative and others, I was promoted from technical leader to team leader after some six months.

In my new position, I had all the obligations and none of the powers (but it came with a salary hike, so yay, I guess?)
One of my new duties was to attend bi-weekly meetings with our client SMEs. They were four at the time.
There was the guy for whom everything had the highest priority - what made me understand that nothing had real priority.
Two other guys were OK, although one of them was dumb.
He did two things that stuck with me: Anyway, the fourth SME was a woman who shall remain nameless.
She was very, very strict. She was fast at pointing at any mistake our team did, no matter how little it was.
But she was fair, or so I thought.

Mind you, my company was/is the second larger IT provider in its country.
Our customer was a worldwide chemical and seeds company later acquired by the Chinese.

One morning I received a customer's internal communication warning that a protest was being scheduled to happen near our workplace.
(Protest against the government, not the company.)
It recommended we should leave earlier to avoid any risks.

Three thoughts occurred to me when I read it:
  1. How our customer cared about its employees in recommending that;
  2. How my company didn't care about its employees, as I have never seen any such communication during my tenure there;
  3. Oh, shoot, I have a bi-weekly meeting with nameless woman this afternoon!
So I moved my butt to nameless woman's desk and said something along the lines:
"Hey, did you see the company's e-mail? It is recommending we leave early to avoid a possible riot. I suppose we can postpone our meeting?"
Her answer? "No way, we are going to have our meeting."

I left thinking how low she considered her safety and mine, but, oh well.
I supposed I could hide inside the building if needed and leave when it was safe, maybe?

To lunch I went, then waited until our appointed meeting time, and then sat at her desk waiting for nameless woman.
And waited.
And waited.
She did not attend it.

It took me some time to figure out what probably happened:
When I talked to her, she most certainly has not read that particular e-mail yet. So she was not aware of the danger.
When the realization came to her, she took her personal belongings and left without a trace, not caring to let me know about it.
It was a nice "Frack you, I'm saving my ass" message from her.

I was reminded of this episode by reading A megacorp is not your dream job.
I'm glad I don't have to put up with this kind of BS any more.

Back to business

Last time I said we'll take a step back. Let me explain what happened:
It's been over a month I did not touch anything related to our transpiler.
I've started a new project with my partner in hopes to sell it. So, far, hope is all we have.
As things did not happen the way we wanted them to, my partner asked me why I would not try to develop further a side-project I have, so we could integrate it with our system to make it more "sellable."
So, I've put that second project with my partner on hold to re-start this third one.

My prototype was made entirely of SQL scripts, with no user interface.
I choose to use Blazor for that, so I could learn it as I went on.
Let me tell you, it is not an easy journey. My feeling is that the tech is not mature enough. Its debugging experience is among the top three worst I have had so far.
But I was able to create something that works, even though my interface is ugly and outdated as hell.
It is not complete yet, though, because while working on it I had an idea of a project that would be fun to work on.
So, I stopped working on that third project and started a fourth one. 😊

To make a long story short, I've worked on it until I saw I was able to do what I've planned to, but it was clear I would not be able to complete it.
It depends on having several pictures available, and roughly 40% of them were missing.
Even though, the ones I have are over 20,000, and I kinda went through them one by one.
I've put this fourth project on hold. Maybe I'll get back to it later if my brother can provide those missing pieces he said he could.
Regarding the third project, it is not a priority. I've created some GUI components in it that I can adapt to JavaScript and may turn into a post or two.
Back to the second project, things seem to be gaining a little traction again, so maybe I'll need to jump back to it.

So... back to business, again

My last iteration with the transpiler left me without a pretty printer among other things (I could not complete some code validation, for instance.)
To get used to the project again - remember, it's been over a month since the last I saw it - I choose to start another new VBScript version, to get it pretty-printing my code again.
This time, I would not take shortcuts. I'd do what I thought it should be done, but for one reason or another, I didn't in my previous deeds.
I worked on it for three days. It can do a good job, but it has a fatal flaw: It cannot print comments.
I'm still thinking about what can I do to fix it.

While I could not solve it yet, I did improve our transpiler a bit.
For starters, I finally collected Scanner's messages and put them into class Messages.
Then, I noticed I was dealing with compiler directives while parsing classes, modules, and procedures bodies, but not while parsing the procedure area. I've fixed that, and while I was at it, I also made it possible to have compiler directives inside compiler directives working.
You can see the changes here.

I'm also supporting the Exit <value> statement, even though in a half-baked way.
I'm transforming Exit <value> inside a function, say, MyFunction, to MyFunction = <value>.
The problem is I'm not able yet to tell if the value is a reference or not, so I could transform it properly to Set MyFunction = <value>.
So far it is a WIP. Its fixes are here.

I even fixed a couple of bugs!
When reading identifiers, I read one character too far so I can check whether it is a data type suffix or not.
But, if there's no next character, I would put the last read identifier's last character back to the reading buffer, then I would read it again and complain about it not being a proper keyword.
As I am swallowing BOMs when reading files, I'm using it to mark the EOF and avoid this mistake.

The second one has to do with removing an item from a KeyedList.
I keep the last item inserted in the aptly named Last_ variable, but failed to update it when removing the last item...
Here are the fixes.

Speaking of reading files, now we can have them encoded in UTF-8, UTF-16, or OEM.
To enable it, I created a class to read command-line arguments.
It allowed me to not only receive what the files' encoding is but also compiling-time constants.
The additions and changes needed to have it working are here.

Next week I'll try to go back to transpiling code for real. Let's see how it goes.

Andrej Biasic
2021-09-08
Public Class Parser
 (...)

 Private Downgrade_ As Boolean
 Private WasAs_ As Boolean
 Private Pad_ As Pad
 Private LastToken_ As Token
 Private LookAhead_ As Token
 Private Scanner_ As Scanner
 Private State_ As NarrowContext
+Private CompDir_ As CompilationDirective

 (...)
Private Function ParseDeclarationArea() As AccessToken
(...)
+ElseIf Token.Kind = tkDirective Then
+ParseDirective Token

 Else
 Fail Token, m.ExpOptEtc
 End If
 Loop

 With ParseDeclarationArea
 .Access = Access
 Set .Token = Token
 .IsDefault = HadDefault
 End With
 
 Exit Function

 ErrHandler:
 ErrReraise "ParseDeclarationArea"
 End Function
 Private Sub ParseDirective(ByVal Token As Token)
-Rem TODO: Using Static prevents it to be used when evaluating an #If inside another #If.
-Static Bool As Boolean
-Static Stage As Integer
+Const OutsideIf = 0
+Const InsideIf = 1
+Const InsideElseIf = 2
+Const InsideElse = 3

 Dim Vt As Long
 Dim Expr As IExpression
 Dim Xp As Expressionist
 Dim Cnt As ConstConstruct
+Dim CD As CompilationDirective

On Error GoTo ErrHandler
Set Xp = New Expressionist
Xp.FullMode = True

Do
If Token.Kind = tkEndOfStream Then Fail Token, m.EndDirective

Select Case Token.Code
Case kwIf
-If Stage <> 0 Then Fail Token, m.ExpDirective
+If CompDir_ Is Nothing Then
+Set CompDir_ = New CompilationDirective
+Else
+Set CD = New CompilationDirective
+Set CD.Previous = CompDir_
+Set CompDir_ = CD
+End If

+Set CompDir_.Token = Token
-Stage = 1
+CompDir_.State = InsideIf
-GoSub CheckCondition
+CompDir_.Quit = CheckCondition(Xp, Token)
+If CompDir_.Quit Then Exit Do

Case kwElseIf
+If CompDir_ Is Nothing Then Fail Token, m.WrongDirective
-If Stage = 0 Or Stage > 2 Then Fail Token, m.WrongDirective
+If CompDir_.State = OutsideIf Or CompDir_.State = InsideElse Then Fail Token, m.WrongDirective
-Stage = 2
+CompDir_.State = InsideElseIf

-If Bool Then
+If CompDir_.Quit Then
-GoSub DiscardSection
+DiscardSection Token
 Else
-GoSub CheckCondition
+CompDir_.Quit = CheckCondition(Xp, Token)
+If CompDir_.Quit Then Exit Do
 End If

Case kwElse
+If CompDir_ Is Nothing Then Fail Token, m.WrongDirective
-If Stage = 0 Or Stage = 3 Then Fail Token, m.WrongDirective
+If CompDir_.State = OutsideIf Or CompDir_.State = InsideElse Then Fail Token, m.WrongDirective
-Stage = 3
+CompDir_.State = InsideElse
-If Not Bool Then Exit Do
+If Not CompDir_.Quit Then Exit Do
-GoSub DiscardSection
+DiscardSection Token

Case kwEnd
+If CompDir_ Is Nothing Then Fail Token, m.WrongDirective
-If Stage = 0 Then Fail Token, m.WrongDirective
+If CompDir_.State = OutsideIf Then Fail Token, m.WrongDirective
-Stage = 0
+CompDir_.State = OutsideIf

 Set Token = NextToken
 If Not Token.IsKeyword(kwIf) Then Fail Token, m.EndDirective

-Bool = False
+Set CompDir_ = CompDir_.Previous
 Exit Do

Case kwConst
Do
Set Token = NextToken
If Not IsProperId(Token) Then Fail Token, m.RuleConst, m.IdName

Set Cnt = New ConstConstruct
Set Cnt.Id = NewId(Token)

Set Token = NextToken
If Not Token.IsOperator(opEq) Then Fail Token, m.RuleConst, m.Equal

Set Expr = Xp.GetExpression(Me)
If Expr Is Nothing Then Fail Token, m.InvExpr
If Not IsConstant(Expr) Then Fail Token, m.ConstExprReq

Set Cnt.Value = Expr
Vt = InferType(Pad_, Expr)

CompileConsts.Add Item:=EvaluateDirective(Pad_.Source.Path, Cnt.Value), Key:=NameBank(Cnt.Id.Name)
Set Token = Xp.LastToken
Loop While Token.Kind = tkListSeparator

If Token.Kind <> tkHardLineBreak Then Fail Token, m.ExpEOS
Exit Do
End Select
Loop

ErrHandler:
 ErrReraise "ParseDirective"
-Exit Sub
+End Sub

-DiscardSection:
+Private Sub DiscardSection(ByRef Token As Token)
Do
Do
Set Token = NextToken
Loop Until IsBreak(Token)

Set Token = NextToken
Loop Until Token.Kind = tkDirective

-Return
+End Sub

-CheckCondition:
+Private Function CheckCondition(ByVal Xp As Expressionist, ByRef Token As Token)
+Dim Expr As IExpression
+Dim Keep As Boolean

Set Expr = Xp.GetExpression(Me)
If Not Xp.LastToken.IsKeyword(kwThen) Then Fail Token, m.RuleDirectiveIf, v.Then

-Bool = CBool(EvaluateDirective(Pad_.Source.Path, Expr))
+Keep = CBool(EvaluateDirective(Pad_.Source.Path, Expr))
-If Not Bool Then Exit Sub
-GoSub DiscardSection
+If Not Keep Then DiscardSection Token
+CheckCondition = Keep
-Return
+End Function
Public Sub Parse(ByVal Prj As Project)
(...)
+If Not CompDir_ Is Nothing Then
+While Not CompDir_.Previous Is Nothing
+Set CompDir_ = CompDir_.Previous
+Wend

+Fail CompDir_.Token, m.EndDirective
+End If

 Exit Sub

ErrHandler:
 ErrReraise "Parse"
End Sub
Private Sub ParseVar( _
ByVal Adder As IVarAdder, _
ByVal Access As Accessibility, _
Optional ByVal Context As VbTriState, _
Optional ByVal IsStatic As Boolean, _
Optional ByVal Token As Token, _
Optional ByRef HasDefault As Boolean _
)
Dim Name As String
Dim WasArray As Boolean
Dim Var As Variable
Dim Expr As IExpression
Dim Subs As SubscriptPair
Dim Xp As Expressionist
Dim Bin As BinaryExpression

On Error GoTo ErrHandler
Adder.Panel.HadDim = True
If Context = vbTrue Then If Access = acPublic Or Access = acPrivate Then Fail Token, m.NotInsideMethod
If Token Is Nothing Then Set Token = NextToken

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

Do
+If Token.Kind = tkDirective Then
+ParseDirective Token
+Set Token = SkipLineBreaks
+End If

 Set Var = New Variable
 (...)
Loop

Exit Sub

ErrHandler:
ErrReraise "ParseVar"
End Sub
Private Function SkipLineBreaks() As Token
Dim Token As Token

 Do
Set Token = NextToken
+Select Case Token.Kind
+Case tkSoftLineBreak, tkHardLineBreak, tkComment
+Rem OK

+Case tkDirective
+ParseDirective Token

+Case Else
+Exit Do
+End Select
+Loop
-Loop While Token.Kind = tkSoftLineBreak Or Token.Kind = tkHardLineBreak Or Token.Kind = tkComment

 Set SkipLineBreaks = Token
End Function
End Class
Public Class CompilationDirective
Option Explicit

Public State As Integer
Public Quit As Boolean
Public Token As Token
Public Previous As CompilationDirective
End Class
Public Class NameBank
(...)
Public Default Function Item(ByVal Token As Token) As String
Select Case Token.Kind
 Case tkOperator
Item = Operators_(Token.Code)

-Case tkKeyword
+Case tkKeyword, tkDirective
If Token.Code <= Keywords_.Count Then
Item = Keywords_(Token.Code)
Else
Item = Contextuals_(Token.Code - Keywords_.Count)
End If

 Case Else
If Token.Code <= Keywords_.Count + Contextuals_.Count Then
Item = Contextuals_(Token.Code - Keywords_.Count)
Else
Item = Ids_(Token.Code - Keywords_.Count - Contextuals_.Count)
End If
End Select
End Function
(...)
End Class   Private Function ParseExit(ByVal Panel As ControlPanel, ByVal Body As KeyedList) As Token
(...)
Else
+Xp.FullMode = True
+Set RHS = Xp.GetExpression(Me, Token)
-Fail Token, m.ExpDoForEtc
+If RHS Is Nothing Then Fail Token, m.ExpDoForEtc
+Set ParseExit = Xp.LastToken

+Set Token = New Token
+Token.Kind = tkIdentifier
+Token.Code = Pad_.Method.Id.Name.Code

+Set Sym = New Symbol
+Set Sym.Value = Token

+Set Token = New Token
+Token.Kind = tkOperator
+Token.Code = opEq
+Set Op = NewOperator(Token)

+Set LStmt = New LetConstruct
+Set LStmt.Name = Sym
+Set LStmt.Operator = Op
+Set LStmt.Value = RHS
+Body.Add LStmt

+EStmt.What = IIf(Pad_.Method.Kind = VbMethod, ewFunction, ewProperty)
+End If

+Body.Add EStmt
 Exit Function

ErrHandler:
 ErrReraise "ParseExit"
End Function    Private Function ReadIdentifier(ByVal CodePoint As Integer)
 Const MAX_LENGTH = 255
+Const E_O_F = &HFEFF

 Dim IsOK As Boolean
 Dim Cp As Integer
 Dim Count As Integer
 Dim Index As Long
 Dim Name As String
 Dim Ch As String * 1
 Dim Suffix As String * 1
 Dim Buffer As String * MAX_LENGTH
 Dim Result As Token

 Count = 1
 Mid$(Buffer, Count, 1) = ChrW(CodePoint)

-Do Until AtEnd
+Do
+If AtEnd Then
+Ch = ChrW(E_O_F)
+Exit Do
+End If

 Cp = GetCodePoint
 Ch = ToChar(Cp)

 IsOK = Ch = "_"
 If Not IsOK Then IsOK = Ch >= "0" And Ch <= "9"
 If Not IsOK Then IsOK = IsLetter(Cp)
 If Not IsOK Then IsOK = IsSurrogate(Cp)
 If Not IsOK Then Exit Do

 Count = Count + 1
 If Count > MAX_LENGTH Then Fail "Identifier too long"
 Mid$(Buffer, Count, 1) = Ch
Loop

Select Case Ch
 Case "!"
 Suffix = Ch
 Cp = GetCodePoint
 Ch = ToChar(Cp)

 Rem A!B scenario
 If IsLetter(Cp) Then
 UngetChar Ch
 UngetChar "!"
 Suffix = vbNullChar
 Else
 UngetChar Ch
 End If

 Case "%", "&", "^", "@", "#", "$"
 Suffix = Ch

+Case ChrW(E_O_F)
+Rem OK

 Case Else
 UngetChar Ch
End Select
(...)
 End Function
Public Sub Remove(ByVal Index As Variant)
Dim Found As Boolean
Dim Idx As Long
Dim Key As String
Dim CurNode As KLNode
Dim PrvNode As KLNode

If ReadOnly_ Then Err.Raise 5, "KeyedList.Remove"
Set CurNode = Root_

If VarType(Index) = vbString Then
Key = CStr(Index)

Do Until CurNode Is Nothing
If StrComp(CurNode.Key, Key, CompareMode) = 0 Then
 If Not PrvNode Is Nothing Then Set PrvNode.NextNode = CurNode.NextNode
+If Last_ Is CurNode Then Set Last_ = PrvNode
 Found = True
 Exit Do
End If

Set PrvNode = CurNode
Set CurNode = CurNode.NextNode
Loop
Else
Idx = CLng(Index)
Idx = Idx - Base

Do Until CurNode Is Nothing
If Idx = 0 Then
If CurNode Is Root_ Then
Set Root_ = CurNode.NextNode

ElseIf Not PrvNode Is Nothing Then
Set PrvNode.NextNode = CurNode.NextNode
End If

If CurNode Is Last_ Then Set Last_ = PrvNode
Found = True
Exit Do
End If

Idx = Idx - 1
Set PrvNode = CurNode
Set CurNode = CurNode.NextNode
Loop
End If

If Found Then Count_ = Count_ - 1 Else Err.Raise 5, "KeyedList.Remove"
End Sub   Public Class IEncoderReader
Option Explicit

Public FileHandle As Integer

Public Sub Class_Initialize()
Err.Raise 5
End Function

Public Function AtEnd() As Boolean
End Function

Public Function GetChar() As String
End Function

Public Function GetCodePoint() As Long
End Function

Public Property Get Encoding() As VbTriState
End Property
End Class
Public Class CodePageReader
Option Explicit
Implements IEncoderReader

Private FileHandle_ As Integer

Private Declare Function MultiByteToWideChar Lib "Kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As LongPtr, _
ByVal cchMultiByte As Long, _
ByVal lpWideCharStr As LongPtr, _
ByVal cchWideChar As Long _
) As Long

Public CodePage As Long

Public Function AtEnd() As Boolean
If FileHandle_ <> 0 Then AtEnd = Seek(FileHandle_) > LOF(FileHandle_)
End Function

Public Function GetChar() As String
Dim Cp As Long
Dim Count As Long
Dim Ch As String
Dim Buffer As String

Cp = GetCodePoint
Ch = ChrB(Cp)
Count = MultiByteToWideChar(CodePage, 0, StrPtr(Ch), 1, 0, 0)
Buffer = Space(Count)
Count = MultiByteToWideChar(CodePage, 0, StrPtr(Ch), 1, StrPtr(Buffer), Count)
GetChar = Buffer
End Function

Public Function GetCodePoint() As Long
Dim Ch As Byte

Get #FileHandle_, , Ch
GetCodePoint = CLng(Ch)
End Function

Public Property Let FileHandle(ByVal Value As Integer)
If FileHandle_ <> 0 And FileHandle_ <> Value Then Err.Raise 5
FileHandle_ = Value
End Property

Public Property Get FileHandle() As Integer
FileHandle = FileHandle_
End Property

Private Function IEncoderReader_AtEnd() As Boolean
IEncoderReader_AtEnd = AtEnd
End Function

Private Function IEncoderReader_GetChar() As String
IEncoderReader_GetChar = GetChar
End Function

Private Function IEncoderReader_GetCodePoint() As Long
IEncoderReader_GetCodePoint = GetCodePoint
End Function

Private Property Let IEncoderReader_FileHandle(ByVal Value As Integer)
FileHandle = Value
End Property

Private Property Get IEncoderReader_FileHandle() As Integer
IEncoderReader_FileHandle = FileHandle_
End Property

Private Property Get IEncoderReader_Encoding() As VbTriState
IEncoderReader_Encoding = vbUseDefault
End Property
End Class
Public Class UTF16Reader
Option Explicit
Implements IEncoderReader

Private BigEndian_ As Boolean
Private BOMChecked_ As Boolean
Private FileHandle_ As Integer

Public Function AtEnd() As Boolean
If FileHandle_ <> 0 Then AtEnd = Seek(FileHandle_) > LOF(FileHandle_)
End Function

Public Function GetChar() As String
GetChar = ChrW(GetCodePoint)
End Function

Public Function GetCodePoint() As Long
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim Result As Long

Byte1 = GetByte
Byte2 = GetByte

If Not BOMChecked_ Then
If Byte1 = 255 And Byte2 = 254 Or Byte1 = 254 And Byte2 = 255 Then
Byte1 = GetByte
Byte2 = GetByte
End If

BOMChecked_ = True
End If

If BigEndian_ Then
Result = CLng(Byte1)
Byte1 = Byte2
Byte2 = CByte(Result)
End If

Result = CLng(Byte1) + CLng(Byte2) * 256
GetCodePoint = Result
End Function

Public Property Let FileHandle(ByVal Value As Integer)
If FileHandle_ <> 0 And Value <> FileHandle_ Then Err.Raise 5
FileHandle_ = Value
End Property

Public Property Get FileHandle() As Integer
FileHandle = FileHandle_
End Property

Public Property Get IsBigEndian() As Boolean
IsBigEndian = BigEndian_
End Property

Public Property Let IsBigEndian(ByVal Value As Boolean)
BigEndian_ = Value
End Property

Public Property Get IsLittleEndian() As Boolean
IsLittleEndian = Not BigEndian_
End Property

Public Property Let IsLittleEndian(ByVal Value As Boolean)
BigEndian_ = Not Value
End Property

Private Function GetByte() As Byte
Dim Result As Byte

If AtEnd Then Err.Raise -1
Get FileHandle_, , Result
GetByte = Result
End Function

Private Function IEncoderReader_AtEnd() As Boolean
IEncoderReader_AtEnd = AtEnd
End Function

Private Function IEncoderReader_GetChar() As String
IEncoderReader_GetChar = GetChar
End Function

Private Function IEncoderReader_GetCodePoint() As Long
IEncoderReader_GetCodePoint = GetCodePoint
End Function

Private Property Let IEncoderReader_FileHandle(ByVal Value As Integer)
FileHandle = Value
End Property

Private Property Get IEncoderReader_FileHandle() As Integer
IEncoderReader_FileHandle = FileHandle
End Property

Private Property Get IEncoderReader_Encoding() As VbTriState
IEncoderReader_Encoding = vbTrue
End Property
End Class
Public Class UTF8Reader
Option Explicit
Implements IEncoderReader

Private BOMChecked_ As Boolean
Private FileHandle_ As Integer

Public Function AtEnd() As Boolean
If FileHandle_ <> 0 Then AtEnd = Seek(FileHandle_) > LOF(FileHandle_)
End Function

Public Function GetChar() As String
GetChar = ChrW(GetCodePoint)
End Function

Public Function GetCodePoint() As Long
Dim Mask As Byte
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim Byte3 As Byte
Dim Byte4 As Byte
Dim Count As Integer
Dim Result As Long

Mask = &H80
Byte1 = GetByte

If Byte1 And Mask Then
Do
Count = Count + 1
Byte1 = Byte1 Xor Mask
Mask = Mask \ 2
Loop While Byte1 And Mask

Select Case Count
Case 4
Byte2 = GetByte
Byte2 = Byte2 Xor &H80

Byte3 = GetByte
Byte3 = Byte3 Xor &H80

Byte4 = GetByte
Byte4 = Byte4 Xor &H80

Result = CLng(Byte1) * &H40000
Result = Result + CLng(Byte2) * &H1000
Result = Result + CLng(Byte3) * &H40
Result = Result + Byte4

Case 3
Byte2 = GetByte
Byte2 = Byte2 Xor &H80

Byte3 = GetByte
Byte3 = Byte3 Xor &H80

Result = CLng(Byte1) * &H1000
Result = Result + CLng(Byte2) * &H40
Result = Result + Byte3

Case 2
Byte2 = GetByte
Byte2 = Byte2 Xor &H80
Result = CLng(Byte1) * &H40
Result = Result + Byte2
End Select

Else
Result = CLng(Byte1)
End If

If Not BOMChecked_ Then
BOMChecked_ = True
If Result = &HFEFF& Then Result = GetCodePoint()
End If

GetCodePoint = Result
End Function

Public Property Let FileHandle(ByVal Value As Integer)
If FileHandle_ <> 0 And Value <> FileHandle_ Then Err.Raise 5
FileHandle_ = Value
End Property

Public Property Get FileHandle() As Integer
FileHandle = FileHandle_
End Property

Private Function GetByte() As Byte
Dim Result As Byte

If AtEnd Then Err.Raise -1
Get FileHandle_, , Result
GetByte = Result
End Function

Private Function IEncoderReader_AtEnd() As Boolean
IEncoderReader_AtEnd = AtEnd
End Function

Private Function IEncoderReader_GetChar() As String
IEncoderReader_GetChar = GetChar
End Function

Private Function IEncoderReader_GetCodePoint() As Long
IEncoderReader_GetCodePoint = GetCodePoint
End Function

Private Property Let IEncoderReader_FileHandle(ByVal Value As Integer)
FileHandle = Value
End Property

Private Property Get IEncoderReader_FileHandle() As Integer
IEncoderReader_FileHandle = FileHandle_
End Property

Private Property Get IEncoderReader_Encoding() As VbTriState
IEncoderReader_Encoding = vbFalse
End Property
End Class
Public Module Program
Option Explicit

Public Sub Main()
+Dim Idx As Integer
+Dim Folder As String
 Dim Msg As String
+Dim FilePath As String
+Dim Value As Variant
+Dim Key As Variant
 Dim Parser As Parser
 Dim Prj As Project
 Dim Source As SourceFile
 Dim StdOut As TextStream
 Dim StdErr As TextStream
 Dim CTlr As CTranslator
+Dim Args As CommandArgs
+Dim Encoding As VbTriState

 On Error GoTo ErrHandler

+Set Args = New CommandArgs

 If Not InIde Then
 With New FileSystemObject
 Set StdOut = .GetStandardStream(1, Unicode:=True)
 Set StdErr = .GetStandardStream(2, Unicode:=True)
 End With
 End If

 CompileConsts.AddKeyValue "Win32", True
 CompileConsts.AddKeyValue "Version", 6.7
 CompileConsts.AddKeyValue "DebugBuild", True

 Set Prj = New Project
 Prj.Name = "..."
 Prj.BuildPath = "..."

-Set Source = New SourceFile
-Source.Path = Command$
-Prj.SourceFiles.Add Source
+Encoding = vbUseDefault

+For Each Key In Args.Keys
+Select Case Key
+Case "a", "A" 'UTF-8
+Encoding = vbFalse

+Case "u", "U" 'UTF-16
+Encoding = vbTrue

+Case "o", "O" 'OEM
+Encoding = vbUseDefault

+Case "d", "D" 'Directory
+Folder = Args(Key)
+FilePath = Dir(Folder)
+Idx = InStrRev(Folder, "\")
+If Idx Then Folder = Left$(Args(Key), Idx)

+Do
+Set Source = New SourceFile
+Source.Encoding = Encoding
+Source.Path = Folder & FilePath
+Prj.SourceFiles.Add Source
+FilePath = Dir
+Loop While FilePath <> ""

+Case "f", "F" 'File
+Set Source = New SourceFile
+Source.Encoding = Encoding
+Source.Path = Args(Key)
+Prj.SourceFiles.Add Source

+Case "c", "C" 'Constant
+Value = Args(Key)
+Idx = InStr(Value, "=")

+If Idx = 0 Then
+Key = Value
+Value = ""
+Else
+Key = Left$(Value, Idx - 1)
+Value = Mid$(Value, Idx + 1)
+End If

+If IsNumeric(Value) Then Value = Val(Value)
+If StrComp(Value, "True", vbTextCompare) = 0 Then Value = True
+If StrComp(Value, "False", vbTextCompare) = 0 Then Value = False
+If IsDate(Value) Then Value = CDate(Value)

+If CompileConsts.Exists(Key) Then CompileConsts.Remove Key
+CompileConsts.AddKeyValue Key, Value

+Case Else 'File
+Set Source = New SourceFile
+Source.Encoding = Encoding
+Source.Path = Args(Key)
+Prj.SourceFiles.Add Source
+End Select
+Next

 Set Parser = New Parser
 Parser.Parse Prj

 SymTab.ResolveSymbols

 Set CTlr = New CTranslator
 CTlr.Transpile Prj

 If Not InIde Then StdOut.WriteLine "Done!"
 Exit Sub

 ErrHandler:
 Msg = Err.Description

 If Err <> vbObjectError + 13 Then
 Debug.Print "Program.Main"
 Msg = Msg & vbNewLine & "at Program.Main"
 End If

 If InIde Then
 MsgBox Msg, vbCritical, "Error"
 Else
 StdErr.WriteLine Msg
 End If
End Sub
End Module
Public Class CommandArgs
Option Explicit

Private Args_ As KeyedList

Private Sub Class_Initialize()
Init Command
End Sub

Public Sub Init(Args As String)
Dim IsName As Boolean
Dim Length As Integer
Dim Idx As Integer
Dim Name As String
Dim Current As String
Dim Letter As String

Set Args_ = New KeyedList
Args_.CompareMode = TextCompare
Length = Len(Args)

If Length > 0 Then
Args = Args & " "
Length = Length + 1
End If

Idx = 1

Do While Idx <= Length
Letter = Mid(Args, Idx, 1)

Select Case Letter
Case "/"
If Not IsName Then
IsName = True
Else
Current = Current & Letter
End If

Case """"
Do
Idx = Idx + 1
If Idx = Length Then Exit Do
Letter = Mid(Args, Idx, 1)

Select Case Letter
Case """"
If Mid(Args, Idx + 1, 1) <> """" Then Exit Do
Idx = Idx + 1

Case ""
Err.Raise -1, , "Unclosed string"
End Select

Current = Current & Letter
Loop

Case ":"
If IsName Then
IsName = False
Name = Current
Current = ""
Else
Current = Current & Letter
End If

Case " "
If IsName Then
IsName = False
Args_.AddKeyValue Current, "1"

ElseIf Name <> "" Then
Args_.AddKeyValue Name, Current
IsName = False

ElseIf Len(Current) <> 0 Then
Args_.AddKeyValue "ARG" & CStr(Args_.Count), Current
IsName = False
End If

Current = ""
Name = ""

Case Else
Current = Current & Letter
End Select

Idx = Idx + 1
Loop
End Sub

Public Function Exists(ByVal ArgName As String) As Boolean
Exists = Args_.Exists(ArgName)
End Function

Public Property Get Count() As Integer
Count = Args_.Count
End Property

Public Default Property Get Item(ByVal Index As Variant) As String
Item = CStr(Args_(Index))
End Property

Public Iterator Function NewEnum() As IUnknown
Set NewEnum = Args_.NewEnum
End Function

Public Property Get Keys() As String()
Dim Idx As Integer
Dim Node As KLNode

If Count = 0 Then
Keys = Split("")
Exit Property
End If

ReDim Result(0 To Count - 1) As String
Set Node = Args_.Root

While Not Node Is Nothing
Result(Idx) = Node.Key
Idx = Idx + 1
Set Node = Node.NextNode
Wend

Keys = Result
End Property
End Class
Public Class SourceFile
 Option Explicit

 Private Entities_ As KeyedList

 Public Path As String
+Public Encoding As VbTriState

 Private Sub Class_Initialize()
 Set Entities_ = New KeyedList
 Set Entities_.T = NewValidator(TypeName(New Entity))
 Entities_.CompareMode = vbTextCompare
 End Sub

 Public Property Get Entities() As KeyedList
 Set Entities = Entities_
 End Property
End Class
Public Class Scanner
(...)
 Private File_ As Integer
 Private RunningLine_ As Long
 Private RunningColumn_ As Long
 Private FrozenColumn_ As Long
 Private PreviousColumn_ As Long
 Private FilePath_ As String
+Private Chars_ As String
+Private Reader_ As IEncoderReader
 (...)

Private Function AtEnd() As Boolean
+AtEnd = Seek(File_) > LOF(File_)
+AtEnd = Reader_.AtEnd
End Function

-Public Sub OpenFile(ByVal FilePath As String)
+Public Sub OpenFile(ByVal File As SourceFile)
-Dim Cp As Integer
-FilePath_ = FilePath
+FilePath_ = File.Path
-If Dir(FilePath) = "" Then Err.Raise 53
 File_ = FreeFile
 Open FilePath_ For Binary Access Read As #File_

+Select Case File.Encoding
+Case vbUseDefault
+Set Reader_ = New CodePageReader

+Case vbTrue
+Set Reader_ = New UTF16Reader

+Case vbFalse
+Set Reader_ = New UTF8Reader
+End Select

+Reader_.FileHandle = File_
 Rem If the error below happens, we'll let a new-ly created zero-length file behind.
+If Reader_.AtEnd Then Err.Raise 53
+Cp = GetCodePoint
+If Cp <> &HFEFF Then UngetChar ChrW$(Cp)
End Sub

(...)

Private Function NextCodePoint() As Integer
Dim Result As Integer

-Get #File_, , Result
+If Chars_ = "" Then
+Result = Reader_.GetCodePoint
+Else
 RunningColumn_ = RunningColumn_ + 1
 NextCodePoint = Result
+End If
End Function

Private Function GetChar() As String
-Dim Cp As Integer

-Cp = GetCodePoint
-GetChar = ToChar(Cp)
+GetChar = Reader_.GetChar
End Function

Private Sub UngetChar(ByVal Character As String)
-Dim Pos As Long
-Dim Length As Long

-Length = SizeOf(kwInteger)
-If Character = vbBack Then Length = Length * 2 + Len(vbNewLine) * SizeOf(kwInteger)
-Pos = Seek(File_)
-Seek #File_, Pos - Length

-Select Case Character
-Case vbLf, vbBack
-RunningLine_ = RunningLine_ - 1
-RunningColumn_ = PreviousColumn_
-End Select

-RunningColumn_ = RunningColumn_ - IIf(Character = vbBack, 2, 1)
+Select Case Character
+Case vbLf
+Chars_ = vbLf & Chars_
+RunningLine_ = RunningLine_ - 1
+RunningColumn_ = PreviousColumn_

+Case vbBack
+Chars_ = " _" & vbLf & Chars_
+RunningLine_ = RunningLine_ - 1
+RunningColumn_ = PreviousColumn_ - 2

+Case Else
+Chars_ = Character & Chars_
+RunningColumn_ = RunningColumn_ - 1
+End Select
End Sub

(...)
End Class
Public Function GetExpression(ByVal Parser As Parser, Optional ByVal Token As Token) As IExpression
Dim HadTo As Boolean
Dim WantOperand As Boolean
Dim Cp As Integer
Dim Count As Integer
Dim Name As String
Dim Sym As Symbol
Dim Lit As Literal
Dim Op As Operator
Dim Op2 As Operator
Dim OpStack As KeyedList
Dim OutStack As KeyedList
Dim Handle As FileHandle
Dim Args As TupleConstruct

 Set OpStack = New KeyedList
 Set OpStack.T = NewValidator(TypeName(New Operator))

 Set OutStack = New KeyedList
 Set OutStack.T = New ExprValidator

 WantOperand = True

Do
If Token Is Nothing Then Set Token = Parser.NextToken

If WantOperand Then
WantOperand = False

Select Case Token.Kind
Case tkOperator
Select Case Token.Code
Case opAddressOf, opAndAlso, opByVal, opIs, opIsNot, opLike, opNew, opNot, opOrElse, opTo, _
opTypeOf, opAnd, opEqv, opImp, opMod, opOr, opXor
GoSub CheckDowngrade
End Select

Rem This check is not redundant. It is verifying if the call to CheckDowngrade reclassified Token.
If Token.Kind = tkOperator Then
Count = Count + IIf(Count < 0, -1, 1)

Select Case Token.Code
 Case opSum
Token.Code = opIdentity

 Case opSubt
Token.Code = opNeg

 Rem Unary operator
 Case opNew
Select Case Count
Case -2, 1
Rem OK

Case Else
Fail Parser.SourceFile.Path, Token, m.InvUseOf & NameBank(Token)
End Select

 Rem Unary operators
-Case opAddressOf, opNot, opTypeOf, opWithBang, opWithDot
+Case opNeg, opAddressOf, opNot, opTypeOf, opWithBang, opWithDot
Rem OK
(...)
End Function