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

Let's build a transpiler! Part 20

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

Last time I said we would parse Declares.

By now you should know the drill. Create a class DeclareConstruct:

Class DeclareConstruct
Private Parms_ As Dictionary

Public Access As Accessibility
Public IsSub As Boolean
Public Name As Token
Public IsCDecl As Boolean
Public LibName As String
Public AliasName As String
Public ReturnDataType As Token
Public ReturnsArray As Boolean

Private Sub Class_Initialize()
Set Parms_ = New Dictionary
Parms_.CompareMode = vbTextCompare
End Sub

Public Property Get Parameters() As Dictionary
Set Parameters = Parms_
End Property
End Class

Change the Entity class to have Declares:

Class Entity
Private Consts_ As Dictionary
Private Enums_ As Dictionary
Private Declares_ As Dictionary

Public IsClass As Boolean
Public Accessibility As Accessibility
Public Name As Token
Public OptionBase As Integer
Public OptionCompare As VbCompareMethod
Public OptionExplicit As Boolean

Private Sub Class_Initialize()
Set Consts_ = New Dictionary
Consts_.CompareMode = vbTextCompare

Set Enums_ = New Dictionary
Enums_.CompareMode = vbTextCompare

Set Declares_ = New Dictionary
Declares_.CompareMode = vbTextCompare
End Sub

Public Property Get Consts() As Dictionary
Set Consts = Consts_
End Property

Public Property Get Enums() As Dictionary
Set Enums = Enums_
End Property

Public Property Get Declares() As Dictionary
Set Declares = Declares_
End Property
End Class

Adapt ParseDeclarationArea:

(...)
ElseIf IsKw(Token, vEnum) Then
ParseEnum Access, Entity
Access = AccessLocal

ElseIf IsKw(Token, vDeclare) Then
ParseDeclare Access, Entity
Access = AccessLocal

ElseIf IsKw(Token, vEnd) Then
Exit Do
(...)

Implement ParseDeclare:

Private Sub ParseDeclare(ByVal Access As Accessibility, ByVal Entity As Entity)
Const RULE = "Rule: [Public | Private] Declare (Sub | Function) identifier [CDecl] " & _
"Lib lib-string [Alias alias-string] (parms) [As data-type[()]]"
Dim Token As Token
Dim Dcl As DeclareConstruct

Set Dcl = New DeclareConstruct
If Access = AccessLocal Then Access = AccessPublic
Dcl.Access = Access

Rem Is it PtrSafe?
Set Token = NextToken

If IsKw(Token, vPtrSafe) Then
Rem Just ignore it
Set Token = NextToken
End If

Rem Is it a Sub or a Function?
If IsKw(Token, vSub) Then
Rem It is a Sub
Dcl.IsSub = True

ElseIf IsKw(Token, vFunction) Then
Rem It is a Function
Dcl.IsSub = False 'Technically this is not needed.

Else
Rem It is not a Sub nor a Function
Fail Token, RULE, "Sub or Function"
End If

Rem Get its name.
Set Token = NextToken
If Not IsId(Token) Then Fail Token, RULE, "identifier"

Set Dcl.Name = Token

Rem Maybe there is a CDecl?
Set Token = NextToken

If IsKw(Token, vCDecl) Then
Dcl.IsCDecl = True
Set Token = NextToken
End If

Rem Discard Lib
If Not IsKw(Token, vLib) Then Fail Token, RULE, "Lib"

Rem Get Lib's name
Set Token = NextToken
If Token.Kind <> tkString Then Fail Token, RULE, "lib-string"
Dcl.LibName = Token.Text

Rem Maybe there is an Alias?
Set Token = NextToken

If IsKw(Token, vAlias) Then
Rem Get Alias' name
Set Token = NextToken
If Token.Kind <> tkString Then Fail Token, RULE, "alias-string"

Dcl.AliasName = Token.Text
Set Token = NextToken
End If

Rem Get its parameters.
If Token.Kind = tkLeftParenthesis Then _
Set Token = ParseParms(Entity, DeclareKind, Dcl.Parameters)

Rem Maybe there's an "As" clause?
If IsKw(Token, vAs) Then
Rem Can we have an "As" clause?
If Dcl.IsSub Then Fail Token, RULE, "line break"

If Token.Suffix <> vbNullChar Then
Fail Token, "Identifier cannot be assigned a new data type"
End If

Rem Get data type name
Set Token = NextToken

Select Case Token.Kind
Case tkIdentifier, tkEscapedIdentifier
Rem TODO: Identifier

Case tkKeyword
Select Case Token.Text
Case vBoolean, vByte, vInteger, vLong, vLongLong, vCurrency, _
vDecimal, vSingle, vDouble, vDate, vString, vLongPtr
Rem OK

Case Else
Fail Token, RULE, "data type"
End Select

Case Else
Fail Token, RULE, "data type"
End Select

Set Dcl.ReturnDataType = Token

Set Token = NextToken

Rem Maybe it returns an array?
If Token.Kind = tkLeftParenthesis Then
Set Token = NextToken

If Token.Kind <> tkRightParenthesis Then
Fail Token, RULE, "data type closing parenthesis"
End If

Dcl.ReturnsArray = True

Set Token = NextToken
End If
End If

If Dcl.IsSub Then
Dcl.ReturnDataType = New Token
Dcl.ReturnDataType.Kind = tkKeyword
Dcl.ReturnDataType.Text = vVoid

ElseIf Dcl.Name.Suffix <> vbNullChar And Dcl.ReturnDataType Is Nothing Then
Set Dcl.ReturnDataType = FromChar(Dcl.Name.Suffix)
End If

Rem Ensure it is not duplicated.
If Entity.Declares.Exists(Dcl.Name.Text) Then
Fail Dcl.Name, "Ambiguous name detected: " & Dcl.Name.Text
End If

Rem Must end with a line break
If Not IsBreak(Token) Then MustEatLineBreak

Entity.Declares.Add Dcl.Name.Text, Dcl
End Sub

You may have noticed a new "keyword", vVoid. We will use it as the return type to Subs, Property Lets, and Property Sets that does not return anything.
It is not really needed, but I don't like to have a non-instanciated property hanging around. It is too easy to forget it may be Nothing and get an unexpected error.

Here it is Void, in all its glory:

Public Property Get vVoid() As String
Rem Intentionally blank
End Property

Now, regarding parameters, they will need their proper class too:

Class Parameter
Public Index As Integer
Public IsOptional As Boolean
Public IsByVal As Boolean
Public IsParamArray As Boolean
Public Name As Token
Public IsArray As Boolean
Public DataType As Token
Public Init As Token
End Class

Finally, we'll implement ParseParms.
As we intend to use it to parse Subs', Functions', Propertys', Events' (and, in the future, Tuples') formal parameters, we will pass a flag to it so it can act accordingly:

Public Enum SignatureKind
SubKind = 1
FunctionKind
PropertyGetKind
PropertyLetKind
PropertySetKind
DeclareKind
EventKind
TupleKind
End Enum


Private Function ParseParms( _
ByVal Entity As Entity, _
ByVal SignatureKind As SignatureKind, _
ByVal Parms As Dictionary _
) As Token
Const RULE = "Rule: [[Optional] (ByVal | ByRef) | ParamArray] identifier[type-declaration-char][()] " & _
"[As data-type] [:= expression]"
Dim Count As Integer
Dim Index As Integer
Dim Name As String
Dim Token As Token
Dim LastParm As Parameter
Dim CurrParm As Parameter

Set LastParm = New Parameter
Set Token = NextToken
If Token.Kind = tkLeftParenthesis Then Set Token = NextToken

If Token.Kind <> tkRightParenthesis Then
Do
Set CurrParm = New Parameter
CurrParm.Index = Index
Index = Index + 1
If Index >= 60 Then Fail Token, "Too many formal parameters"

If IsKw(Token, vOptional) Then
If LastParm.IsParamArray Then Fail Token, "Cannot have both Optional and ParamArray parameters"
If SignatureKind = EventKind Or SignatureKind = TupleKind Then _
Fail Token, "Optional not allowed"

CurrParm.IsOptional = True
Set Token = NextToken

ElseIf IsKw(Token, vParamArray) Then
If LastParm.IsOptional Then _
Fail Token, "Cannot have both Optional and ParamArray parameters"

If SignatureKind = EventKind Or SignatureKind = TupleKind Then _
Fail Token, "ParamArray not allowed"

CurrParm.IsParamArray = True
Set Token = NextToken
End If

If Not CurrParm.IsParamArray Then
If IsKw(Token, vByVal) Then
If SignatureKind = TupleKind Then _
Fail Token, "ByVal not allowed"

CurrParm.IsByVal = True
Set Token = NextToken

ElseIf IsKw(Token, vByRef) Then
If SignatureKind = TupleKind Then _
Fail Token, "ByRef not allowed"

'CurrParm.IsByVal = False
Set Token = NextToken
End If
End If

If Not IsProperId(Token) Then Fail Token, RULE, "identifier"
Set CurrParm.Name = Token

Set Token = NextToken

If Token.Kind = tkLeftParenthesis Then
Set Token = NextToken
If Token.Kind <> tkRightParenthesis Then Fail Token, RULE, ")"
CurrParm.IsArray = True
Set Token = NextToken
End If

If CurrParm.IsParamArray And Not CurrParm.IsArray Then _
Fail CurrParm.Name, "ParamArray formal parameter must be an array"

If IsKw(Token, vAs) Then
If CurrParm.Name.Suffix <> vbNullChar Then _
Fail Token, "Identifier already has a type-declaration character"

Set Token = NextToken

If SignatureKind = DeclareKind Then
If Not IsData(Token) Then Fail Token, RULE, "data type"
Else
If Not IsProperData(Token) Then Fail Token, RULE, "data type"
End If

Set CurrParm.DataType = Token

If CurrParm.IsParamArray And CurrParm.DataType.Text = vVariant Then _
Fail Token, "ParamArray must be an array of Variants"

Set Token = NextToken

ElseIf CurrParm.Name.Suffix <> vbNullChar Then
Set CurrParm.DataType = FromChar(CurrParm.Name.Suffix)

Else
Set CurrParm.DataType = Entity.DefTypes(CurrParm.Name.Text)
End If

If IsOp(Token, "=") Then
If Not CurrParm.IsOptional Then Fail Token, "Parameter is not Optional"
If CurrParm.IsParamArray Then Fail Token, "ParamArray cannot have a default value"
Set CurrParm.Init = GetExpression
Set Token = NextToken
End If

If Not CurrParm.IsOptional And (LastParm.IsOptional Or LastParm.IsParamArray) Then
If SignatureKind <> PropertyLetKind And SignatureKind <> PropertySetKind Then _
Fail CurrParm.Name, RULE, "Optional"

GoSub AddParm
Set Token = NextToken
Exit Do
End If

GoSub AddParm
Set LastParm = CurrParm
If Token.Kind <> tkListSeparator Then Exit Do
Set Token = NextToken
Loop
End If

If SignatureKind = PropertyLetKind Or SignatureKind = PropertySetKind Then
If Parms.Count = 0 Then
Fail Token, "Property Let/Set should have at least one parameter"

ElseIf LastParm.IsOptional Or LastParm.IsParamArray Then
Fail LastParm, "Property Let/Set should have at least one non-optional parameter"
End If
End If

If Token.Kind <> tkRightParenthesis Then Fail Token, "Unclosed parenthesis"
Set ParseParms = NextToken
Exit Function

AddParm:
If Parms.Exists(CurrParm.Name.Text) Then
If SignatureKind <> DeclareKind Then Fail CurrParm.Name, "Duplicated declaration in current scope"
Count = 1

Do
Name = CurrParm.Name.Text & "_" & CStr(Count)
If Not Parms.Exists(Name) Then Exit Do
Count = Count + 1
Loop

CurrParm.Name.Text = Name
End If

Parms.Add CurrParm.Name.Text, CurrParm
Return
End Function


Private Function IsProperId(ByVal Token As Token) As Boolean
Const US = 95
Const ZERO = 46
Const NINE = 57
Dim Pos As Integer
Dim IsOK As Boolean
Dim Cp As Integer

If Token.Kind = tkIdentifier Then
IsProperId = True
Exit Function
End If

If Token.Kind <> tkEscapedIdentifier Then Exit Function

For Pos = 1 To Len(Token.Text)
Cp = AscW(Mid$(Token.Text, Pos, 1))
IsOK = Cp = US
If Not IsOK Then IsOK = Cp >= ZERO And Cp <= NINE
If Not IsOK Then IsOK = Scanner_.IsLetter(Cp)
If Not IsOK Then IsOK = Scanner_.IsSurrogate(Cp)
If Not IsOK Then Exit Function
Next

IsProperId = True
End Function

Private Function IsData(ByVal Token As Token) As Boolean
If Token.Suffix <> vbNullChar Then Exit Function

If Token.Kind = tkKeyword And Token.Text = vAny Then
IsData = True
Exit Function
End If

IsData = IsProperData(Token)
End Function


Private Function IsProperData(ByVal Token As Token) As Boolean
If Token.Suffix <> vbNullChar Then Exit Function

Select Case Token.Kind
Case tkIdentifier, tkEscapedIdentifier
IsProperData = IsProperId(Token)

Case tkKeyword
Select Case Token.Text
Case vBoolean, vByte, vInteger, vLong, vLongLong, vLongPtr, vCurrency, vDecimal, vSingle, vDouble, _
vDate, vString, vObject, vVariant
IsProperData = True
End Select
End Select
End Function

As you could see above, the differences in parsing are: We also introduced four new functions: IsProperId returns True if the provided token is an identifier or an escaped identifier - as long as it is not a crazy Enum-compatible one.
IsId if OK with Enum-compatible identifiers.

IsProperData returns True as long as the token is an identifier, a (non-crazy) escaped identifier, or a built-in type like Integer, for instance, except for Any.
IsData is OK with Any.

Next week we'll parse Events.

Andrej Biasic
2020-12-02