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

Let's build a transpiler! Part 39

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

Do operators dream of being patented?

If you are following my series of building a transpiler, you should have seen a lot of statements like this:

If Not Token Is Nothing Then (...)
The powers-that-be at Microsoft thought it was kind of weird to have that Not ... Is thingy. So they come up with something better in .NET:

If Token IsNot Nothing Then (...)
Now it is much, much better. It is succinct, it is intuitive, it is... pretty. It debuted in Visual Basic.NET in 2005.
(These days some people think IsNot Nothing is not good enough. They are suggesting to use Is Something instead...)

Microsoft "liked" IsNot so much that they filled a patent application in 2004-11-18.
When word went out, everyone was baffled. Why in the world would MS try to patent a freaking operator?
Criticisms abounded. Paul Vick, one of the applicants, offered his point of view about the whole shenanigan.

Many moons ago I remembered about it when pondering about working on a transpiler. I don't want to be that guy that receives a cease and desist letter from MS, so I went for it.
From what I could get the patent was not granted due to being declared abandoned by USPTO in 2007-06-11.

Back to business

Last time I said we would keep on risking pending things from our list.
First thing will be to deal with crazy identifiers. You may remember them from a previous post.
I mentioned what the issue is in my Past, present, and future post.
Here are the changes needed to support it:

Public Class Scanner
(...)

Private Const ZERO_ As Integer = 48
Private Const NINE_ As Integer = 57

(...)
End Class

Public Enum TokenKind
tkWhiteSpace
tkComment
tkIdentifier
tkEscapedIdentifier
tkCrazyIdentifier
(...)
End Enum

Private Function ReadEscapedIdentifier() As Token
Const MAX_LENGTH = 255

Dim Cp As Integer
Dim Count As Integer
Dim Name As String
Dim Suffix As String * 1
Dim Buffer As String * MAX_LENGTH
Dim Token As Token
Dim Result As TokenKind

Result = tkEscapedIdentifier

Do Until AtEnd
Cp = GetCodePoint

Select Case Cp
Case US_, ZERO_ To NINE_
Rem OK

Case AscW("]")
Exit Do

Case LF_
Fail "Invalid identifier"

Case Else
If Not IsLetter(Cp) Then If Not IsSurrogate(Cp) Then Result = tkCrazyIdentifier
End Select

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

If Not AtEnd Then
Suffix = GetChar

Select Case Suffix
Case "%", "&", "^", "@", "!", "#", "$"
Rem OK

Case Else
UngetChar Suffix
Suffix = vbNullChar
End Select
End If

Set Token = NewToken(Result, Suffix:=Suffix)
Name = Left$(Buffer, Count)
Token.Code = NameBank.Ids.IndexOf(Name)

If Token.Code = 0 Then
NameBank.Ids.Add Name, Name
Token.Code = NameBank.Ids.Count
End If

Token.Code = Token.Code + NameBank.Keywords.Count + NameBank.Contextuals.Count
Set ReadEscapedIdentifier = Token
End Function

Private Sub EmitToken(ByVal Stmt As Token)
Select Case Stmt.Kind

(...)
Case tkEscapedIdentifier, tkCrazyIdentifier
Builder.Append "["
Builder.Append NameBank(Stmt)
Builder.Append "]"
End Select

If Stmt.Suffix <> vbNullChar Then Builder.Append Stmt.Suffix
End Sub

Public Sub PrettyPrint()
(...)
Select Case Token.Kind
(...)
Case tkEscapedIdentifier, tkCrazyIdentifier
Print #HtmlFile, "["; NameBank(Token); "]";
Nbsp = False
(...)
End Sub

Private Function ParseBody( _
ByVal Panel As ControlPanel, _
ByVal Body As KeyedList, _
Optional ByVal IsSingleLine As Boolean, _
Optional ByVal LookAhead As Token _
) As Token
(...)
Rem Do we have a label?
If Token.Kind = tkIdentifier Or Token.Kind = tkEscapedIdentifier Or Token.Kind = tkCrazyIdentifier Then
(...)
End Function

Private Function IsStatement(ByVal Token As Token) As Boolean
Select Case Token.Kind
Case tkOperator
IsStatement = Token.Code = opWithBang Or Token.Code = opWithDot

Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier, tkKeyword
IsStatement = True
End Select
End Function

Private Sub ParseGoSub(ByVal Panel As ControlPanel, 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

Select Case Token.Kind
Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label

Case tkIntegerNumber
If Left$(Token.Text, 1) = "-" Then Fail Token, x.ExpTarget
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum

Case Else
Fail Token, x.ExpTarget
End Select

Body.Add Stmt
End Sub

Private Sub ParseGoTo(ByVal Panel As ControlPanel, 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, tkEscapedIdentifier, tkCrazyIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label

Case tkIntegerNumber
If Left$(Token.Text, 1) = "-" Then Fail Token, x.ExpTarget
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum

Case Else
Fail Token, x.ExpTarget
End Select

Body.Add Stmt
End Sub

Private Function ParseOn(ByVal Panel As ControlPanel, ByVal Body As KeyedList) As Token
(...)
Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
(...)
End Function

Private Function ParseResume(ByVal Panel As ControlPanel, 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
If Left$(Token.Text, 1) = "-" Then Fail Token, x.InvLinNum
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum
Set Token = NextToken

Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
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, x.ExpNext
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"
LinNum.Value.Code = vbInteger
Set Stmt.Target = LinNum
End Select

Body.Add Stmt
Set ParseResume = Token
End Function

Friend Sub Fail(ByVal Token As Token, ByVal Message As String, Optional ByVal Expected As String)
Dim Ch As Integer
Dim Msg As String
Dim Got As String
Dim Text As String

Select Case Token.Kind
Case tkEscapedIdentifier, tkCrazyIdentifier
Got = "[" & NameBank(Token) & "]"
(...)
End Sub

Public Function GetExpression(ByVal Parser As Parser, Optional ByVal Token As Token) As IExpression
(...)
Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
(...)
End Function

Public Function GetStmt(ByVal Parser As Parser, Optional ByVal Token As Token, Optional ByVal LookAhead As Token) As IStmt
(...)
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 And _
Token.Kind <> tkCrazyIdentifier _
Then Exit Do
(...)
End Function

Public Function IsId(ByVal Code As Long, Optional ByVal CanHaveSuffix As Boolean) As Boolean
If Not CanHaveSuffix And Suffix <> vbNullChar Then Exit Function

Select Case Kind
Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
IsId = Me.Code = Code
End Select
End Function
Second, I've managed to validate that GoTo and GoSub targets exist.
This is the code that needs to be added to ControlPanel:

Public Class ControlPanel
Option Explicit

Private Targets_ As KeyedList
(...)

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

Public Sub AddTarget(ByVal Target As Variant)
Dim Idx As Long
Dim Key As String
Dim A As AEIOU
Dim Tkn As Token
Dim Lbl As LabelConstruct
Dim Lin As LineNumberConstruct

If TypeOf Target Is LabelConstruct Then
Set Lbl = Target
Set Tkn = Lbl.Id.Name
Key = "Label " & NameBank(Tkn)
Else
Set Lin = Target
If Lin.Value.Text = "+0" Then Exit Sub
Set Tkn = Lin.Value
Key = "Line number " & CLng(Tkn.Text)
End If

Idx = Targets_.IndexOf(Key)

If Idx = 0 Then
Set A = New AEIOU
A.Name = Key
Set A.Token = Tkn
A.IsUsed = True
Targets_.Add A, Key
Else
Set A = Targets_(Idx)
A.IsUsed = True
End If
End Sub

Public Sub AddLine(ByVal LineNumber As LineNumberConstruct)
Dim Idx As Long
Dim Key As String
Dim A As AEIOU

If LineNumber.Value.Text = "+0" Then Exit Sub
Key = "Line number " & CLng(LineNumber.Value.Text)
Idx = Targets_.IndexOf(Key)

If Idx = 0 Then
Set A = New AEIOU
A.Name = Key
Set A.Token = LineNumber.Value
A.IsDeclared = True
Targets_.Add A, Key
Else
Set A = Targets_(Idx)
A.IsDeclared = True
End If
End Sub

Public Sub AddLabel(ByVal Label As LabelConstruct)
Dim Idx As Long
Dim Key As String
Dim A As AEIOU

Key = "Label " & NameBank(Label.Id.Name)
Idx = Targets_.IndexOf(Key)

If Idx = 0 Then
Set A = New AEIOU
A.Name = Key
Set A.Token = Label.Id.Name
A.IsDeclared = True
Targets_.Add A, Key
Else
Set A = Targets_(Idx)
A.IsDeclared = True
End If
End Sub

Public Sub Validate(ByVal Parser As Parser, ByVal Entity As Entity)
Dim A As AEIOU

For Each A In Targets_
If Not A.IsDeclared Then
Parser.Fail A.Token, A.Name & " does not exist"

ElseIf Not A.IsUsed Then
Parser.Fail A.Token, A.Name & " is not used"
End If
Next
End Sub
End Class
Then we need some little adjustments like the ones below:

Private Function ParseProcedureArea(ByVal Entity As Entity, ByRef AccessToken As AccessToken) As Token
(...)
Case kwSub
Set Panel = New ControlPanel
Set Panel.Entity = Entity
Panel.BodyType = ewSub

Set Proc = ParseSub(Access, Panel)
Panel.Validate Me, Entity
Proc.IsDefault = IsDefault
Proc.IsStatic = IsStatic
GoSub Cleanup

Case kwFunction
Set Panel = New ControlPanel
Set Panel.Entity = Entity
Panel.BodyType = ewFunction

Set Func = ParseFunction(Access, Panel)
Panel.Validate Me, Entity
Func.IsDefault = IsDefault
Func.IsStatic = IsStatic
Func.IsIterator = IsIterator
If Func.IsDefault And Func.IsIterator Then Fail Token, x.NoDefaultIt
GoSub Cleanup

Case cxProperty
Set Panel = New ControlPanel
Set Panel.Entity = Entity
Panel.BodyType = ewProperty

Set Prop = ParseProperty(Access, Panel)
Panel.Validate Me, Entity
Prop.IsDefault = IsDefault
Prop.IsStatic = IsStatic
GoSub Cleanup
(...)
End Function

Private Function ParseBody( _
ByVal Panel As ControlPanel, _
ByVal Body As KeyedList, _
Optional ByVal IsSingleLine As Boolean, _
Optional ByVal LookAhead As Token _
) As Token
(...)
Rem Do we have a line number?
If Token.Kind = tkIntegerNumber And Left$(Token.Text, 1) <> "-" Then
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Body.Add LinNum
Panel.AddLine LinNum
Set Token = NextToken
End If

Rem Do we have a label?
If Token.Kind = tkIdentifier Or Token.Kind = tkEscapedIdentifier Or Token.Kind = tkCrazyIdentifier Then
Set LookAhead = NextToken

If LookAhead.Kind = tkSoftLineBreak Then
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Body.Add Label
Panel.AddLabel Label
Set LookAhead = Nothing
Set Token = NextToken
End If
End If
(...)
End Function

Private Sub ParseGoSub(ByVal Panel As ControlPanel, 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

Select Case Token.Kind
Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label
Panel.AddTarget Label

Case tkIntegerNumber
If Left$(Token.Text, 1) = "-" Then Fail Token, x.ExpTarget
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token

Set Stmt.Target = LinNum
Panel.AddTarget LinNum

Case Else
Fail Token, x.ExpTarget
End Select

Body.Add Stmt
End Sub

Private Sub ParseGoTo(ByVal Panel As ControlPanel, 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, tkEscapedIdentifier, tkCrazyIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label
Panel.AddTarget Label

Case tkIntegerNumber
If Left$(Token.Text, 1) = "-" Then Fail Token, x.ExpTarget
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token

Set Stmt.Target = LinNum
Panel.AddTarget LinNum

Case Else
Fail Token, x.ExpTarget
End Select

Body.Add Stmt
End Sub

Private Function ParseOn(ByVal Panel As ControlPanel, ByVal Body As KeyedList) As Token
(...)
Case tkIntegerNumber
If Left$(Token.Text, 1) = "-" Then Fail Token, x.ExpTarget
Set WentTo = New GoToConstruct
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set WentTo.Target = LinNum
Set OnStmt.Statement = WentTo
Panel.AddTarget LinNum

Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
Set WentTo = New GoToConstruct
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set WentTo.Target = Label
Set OnStmt.Statement = WentTo
Panel.AddTarget Label
(...)
Case tkIntegerNumber
If Left$(Token.Text, 1) = "-" Then Fail Token, x.ExpTarget
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, x.ExpTarget
(...)
End Function

Private Function ParseResume(ByVal Panel As ControlPanel, 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
If Left$(Token.Text, 1) = "-" Then Fail Token, x.InvLinNum
Set LinNum = New LineNumberConstruct
Set LinNum.Value = Token
Set Stmt.Target = LinNum
Set Token = NextToken
Panel.AddLine LinNum

Case tkIdentifier, tkEscapedIdentifier, tkCrazyIdentifier
Set Label = New LabelConstruct
Set Label.Id = NewId(Token)
Set Stmt.Target = Label
Set Token = NextToken
Panel.AddLabel Label

Case tkKeyword
If Token.Code <> kwNext Then Fail Token, x.ExpNext
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"
LinNum.Value.Code = vbInteger
Set Stmt.Target = LinNum
End Select

Body.Add Stmt
Set ParseResume = Token
End Function
Presto!
Next, we'll deal with inline comments' issue I also mentioned in Past, present, and future.
We'll take advantage that it is only used by PrettyPrint, so we'll pass that ForPrint flag all along to Scanner's GetToken method:

Public Enum TokenKind
tkWhiteSpace
tkComment
tkInlineComment
(...)
End Enum

Rem This is DiscardComment renamed
Private Function ReadInlineComment() As Token
Dim Count As Long
Dim Ch As String * 1
Dim Token As Token

Set Token = NewToken(tkInlineComment)
Count = 1

Do Until AtEnd
Ch = GetChar

Select Case Ch
Case "`"
Count = Count + 1

Case "´"
Count = Count - 1
If Count = 0 Then Exit Do
End Select

Token.Text = Token.Text & Ch
Loop

Set ReadInlineComment = Token
End Function

Public Function NextToken(Optional ByVal ForPrint As Boolean) As Token
(...)

Set Token = Scanner_.GetToken(ReturnInlineComment:=ForPrint)

(...)

Select Case Token.Kind
Case tkWhiteSpace, tkInlineComment
Rem OK

Case Else
Set LastToken_ = Token
End Select

(...)
End Function

Public Sub PrettyPrint()
(...)

Case tkInlineComment
Print #HtmlFile, SPAN_COMMENT; "`"; EncodeHtml(Token.Text); "´</span>";
Nbsp = False

(...)
End Sub

Public Function GetToken(Optional ByVal ReturnInlineComment As Boolean) As Token
(...)

Case "`"
Set Token = ReadInlineComment

If Not ReturnInlineComment Then
Done = False
Set Token = New Token
End If

(...)
End Function
For now, this is it.
Next week we still have some pending things to do.

Andrej Biasic
2021-06-16