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