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

Let's build a transpiler! Part 40

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

WTF VB6! Part 9

While reviewing our code, I noticed I was allowing only proper identifiers to be labels.
It got me thinking "Would VB understand escaped labels?". So I set up the experiment below:

Visual Studio IDE running code
(.GIF made with ScreenToGif)

WTF VB6!

When I separated "Down" from "There", the line turned to red instead of giving me an error message because of the way I set up my IDE.
Anyway, it means it is invalid syntax. But then, after typing the square brackets, VB removes them and seems OK with that. Hitting F8 makes it run the code without issues!
That made me accept escaped and crazy identifiers as labels.
The thing is, if you save the project, close it, and then re-open it, VB paints the line in red again. It is no longer a valid statement.

Let me say that again: WTF VB6!

Back to business

Last week we were able to check duplicated variable declarations. Now we're doing the same, but this time to declaring Consts.
Fortunately, it is a small amount of code:

Public Class ControlPanel
(...)
Private Consts_ As KeyedList

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

(...)

Public Sub AddConst(ByVal Parser As Parser, ByVal Constant As ConstConstruct)
Dim Idx As Long
Dim Name As String
Dim A As AEIOU
Dim Parm As Parameter

Name = NameBank(Constant.Id.Name)
Idx = Consts_.IndexOf(Name)

If Idx = 0 Then
Set A = New AEIOU
A.Name = Name
Set A.Token = Constant.Id.Name
A.IsDeclared = True
Consts_.Add A, Name
Else
Set A = Consts_(Idx)
If A.IsDeclared Then Parser.Fail A.Token, x.Duplicated
A.IsDeclared = True
End If
End Sub
End Class


Private Function ParseConsts( _
ByVal Access As Accessibility, _
ByVal Panel As ControlPanel, _
ByVal Body As KeyedList, _
Optional ByVal InsideProc As Boolean _
) As Token
(...)
Rem Save it
Body.AddKeyValue NameBank(Cnt.Id.Name), Cnt
Panel.AddConst Me, Cnt
(...)
End Function

Next, we'll check that all public methods of an interface have been implemented by any class claiming to implement that interface.
Add the following to the Program module:

Public Sub Main()
Dim Source As SourceFile
Dim Parser As Parser
Dim Builder As FileTextBuilder
Dim Revert As Reverter

On Error GoTo ErrHandler
Set Source = New SourceFile
Source.Path = Command$

Set Parser = New Parser
Parser.Parse Source
CheckImplementations Parser, Source

Set Builder = New FileTextBuilder
Builder.FilePath = Source.Path & ".out"

Set Revert = New Reverter
Set Revert.Builder = Builder
Revert.Transpile Source
Exit Sub

ErrHandler:
MsgBox Err.Description, vbCritical, "Parser Error"
End Sub


Private Sub CheckImplementations(ByVal Parser As Parser, ByVal Source As SourceFile)
Dim Idx As Long
Dim Name As String
Dim IName As String
Dim Jdx As Variant
Dim Cls As Entity
Dim Tmp As Entity
Dim Var As Variable
Dim Prc As SubConstruct
Dim Slt As PropertySlot
Dim Slt2 As PropertySlot
Dim Fnc As FunctionConstruct
Dim Impl As ImplementsConstruct
Dim Prp As PropertyConstruct

For Each Cls In Source.Entities
If Cls.IsClass Then
For Each Impl In Cls.Impls
Idx = Source.Entities.IndexOf(NameBank(Impl.Id.Name))
If Idx = 0 Then Parser.Fail Impl.Id.Name, "User-defined type not defined"
Set Tmp = Source.Entities(Idx)
IName = NameBank(Tmp.Id.Name)

For Each Var In Tmp.Vars
If Var.Access = acPublic Then
If Not Cls.Vars.Exists(NameBank(Var.Id.Name)) Then _
Parser.Fail Var.Id.Name, Fmt(x.NeedImpl, NameBank(Var.Id.Name), IName)
End If
Next

For Each Prc In Tmp.Subs
If Prc.Access = acPublic Then
If Not Cls.Subs.Exists(IName & "_" & NameBank(Prc.Id.Name)) Then _
Parser.Fail Prc.Id.Name, Fmt(x.NeedImpl, NameBank(Prc.Id.Name), IName)
End If
Next

For Each Fnc In Tmp.Functions
If Fnc.Access = acPublic Then
If Not Cls.Functions.Exists(IName & "_" & NameBank(Fnc.Id.Name)) Then _
Parser.Fail Fnc.Id.Name, Fmt(x.NeedImpl, NameBank(Fnc.Id.Name), IName)
End If
Next

For Each Slt In Tmp.Properties
Name = IName & "_" & NameBank(Slt.Id.Name)

For Each Jdx In Array(VbGet, VbLet, VbSet)
If Slt.Exists(Jdx) Then
Set Prp = Slt(Jdx)

If Prp.Access = acPublic Then
If Not Cls.Properties.Exists(Name) Then Parser.Fail Slt.Id.Name, _
Fmt(x.NeedImpl, NameBank(Slt.Id.Name), IName)

Set Slt2 = Cls.Properties(Name)
If Not Slt2.Exists(Jdx) Then Parser.Fail Slt.Id.Name, _
Fmt(x.NeedImpl, NameBank(Slt.Id.Name), IName)
End If
End If
Next
Next
Next
End If
Next
End Sub

Then add this to the Globals module:

Public Function Fmt(ByVal Template As String, ParamArray Values() As Variant) As String
Dim Idx As Integer

For Idx = 0 To UBound(Values)
Template = Replace(Template, "{" & Idx & "}", Values(Idx))
Next

Fmt = Template
End Function

And this to Messages:

Public Property Get NeedImpl() As String
NeedImpl = "Class need to implement '{0}' for interface '{1}'"
End Property

Public Property Get UndefUDT() As String
UndefUDT = "User-defined type not defined"
End Property

Next week we'll assure the correct use of ByVal, New, and named (:=) operators, and also enforce the relationship between elements in the declaration area.

Andrej Biasic
2021-06-23