Let's build a transpiler! Part 17

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

Last time I said we would parse Deftypes.
There are three ways to define a type of a variable or parameter, or for the return of a function or property get:

Type-declaration characters. I mentioned them before.
Using As <data-type>. Pretty mundane.
Using Deftypes. With them, you define that any variable, parameter, function, or property get with a name starting with the letter or between a range of letters will default to some data type.
Example: DefDbl D-F states that any variable, parameter, function, or property get with a name starting from D to F will default to Double.
All letters not covered by an explicit Deftype default to Variant.

First, we'll need to define two consts to cover LongLongs and LongPtrs:

Public Const vbLongLong = 20
Public Const vbLongPtr = 37

Then we'll create a class to manage Deftypes.

Class Deftype
Const LAST_INDEX = 25

Private A_Z_ As Boolean
Private Letters_(0 To LAST_INDEX) As Token

Public Default Property Get Item(ByVal Letter As String) As Token
Static DfType As Token
Dim Index As Integer

If DfType Is Nothing Then
Set DfType = New Token
DfType.Kind = tkKeyword
DfType.Text = "Variant"
End If

Index = ToIndex(Letter)

If A_Z_ Then
Set Item = Letters_(0)

ElseIf Index = -1 Or Letters_(Index) Is Nothing Then
Set Item = DfType

Else
Set Item = Letters_(Index)
End If
End Property

Public Sub SetRange( _
ByVal FirstLetter As String, _
ByVal LastLetter As String, _
ByVal VariableType As Integer _
)
Dim First As Integer
Dim Last As Integer
Dim Letter As Integer
Dim Token As Token

First = ToIndex(FirstLetter)
Last = ToIndex(LastLetter)

If First > Last Then
Letter = First
First = Last
Last = Letter
End If

A_Z_ = First = 0 And Last = LAST_INDEX

Set Token = New Token
Token.Kind = tkKeyword

Select Case VariableType
Case vbBoolean
Token.Text = "Boolean"

Case vbByte
Token.Text = "Byte"

Case vbInteger
Token.Text = "Integer"

Case vbLong
Token.Text = "Long"

Case vbLongLong
Token.Text = "LongLong"

Case vbLongPtr
Token.Text = "LongPtr"

Case vbCurrency
Token.Text = "Currency"

Case vbDecimal
Token.Text = "Decimal"

Case vbSingle
Token.Text = "Single"

Case vbDouble
Token.Text = "Double"

Case vbDate
Token.Text = "Date

Case vbString
Token.Text = "String"

Case vbObject
Token.Text = "Object"

Case vbVariant
Token.Text = "Variant"

Case Else
Debug.Assert False
End Select

For Letter = First To Last
If Not Letters_(Letter) Is Nothing Then
If Letters_(Letter).Text <> Token.Text Then Err.Raise 0
End If

Set Letters_(Letter) = Token
Next
End Sub

Private Function ToIndex(ByVal Letter As String) As Integer
Const CAPITAL_A = 65
Const CAPITAL_Z = 90
Const SMALL_A = 97
Dim Result As Integer

Result = AscW(Left$(Letter, 1))
If Result >= SMALL_A Then Result = Result - SMALL_A + CAPITAL_A
If Result < CAPITAL_A Or Result > CAPITAL_Z Then Result = CAPITAL_A - 1
Result = Result - CAPITAL_A
ToIndex = Result
End Function
End Class

After that, we'll add a DefTypes property to Entity class.

Public Property Get DefTypes() As DefType
Static Hidden As New DefType

Set DefTypes = Hidden
End Property
Next, we'll change ParseDeclarationArea to deal with Deftypes.
Paste the code below in the proper places.

Const RULE = "Rule: [Public | Private] identifier"

(...)

ElseIf IsKw(Token, "DefBool") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbBoolean, Entity

ElseIf IsKw(Token, "DefByte") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbByte, Entity

ElseIf IsKw(Token, "DefInt") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbInteger, Entity

ElseIf IsKw(Token, "DefLng") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbLong, Entity

ElseIf IsKw(Token, "DefLngLng") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbLongLong, Entity

ElseIf IsKw(Token, "DefLngPtr") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbLongPtr, Entity

ElseIf IsKw(Token, "DefCur") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbCurrency, Entity

ElseIf IsKw(Token, "DefDec") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbDecimal, Entity

ElseIf IsKw(Token, "DefSng") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbSingle, Entity

ElseIf IsKw(Token, "DefDbl") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbDouble, Entity

ElseIf IsKw(Token, "DefDate") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbDate, Entity

ElseIf IsKw(Token, "DefStr") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbString, Entity

ElseIf IsKw(Token, "DefObj") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbObject, Entity

ElseIf IsKw(Token, "DefVar") Then
If Access <> AccessLocal Then Fail Token, RULE, "identifier"
ParseDef vbVariant, Entity

Finally, we'll implement ParseDef.

Private Sub ParseDef(ByVal VariableType As Integer, ByVal Entity As Entity)
Const RULE = "Rule: Def<type> first[-last] [, ...] line break"
Dim First As String
Dim Last As String
Dim Token As Token
Dim Mark As Token

On Error GoTo ErrHandler

Do
Set Token = NextToken
Set Mark = Token

If Token.Kind <> tkIdentifier Or Token.Suffix <> vbNullChar Then _
Fail Token, RULE, "first"

First = Token.Text

Set Token = NextToken

If IsOp(Token, "-") Then
Set Token = NextToken

If Token.Kind <> tkIdentifier Or Token.Suffix <> vbNullChar Then _
Fail Token, RULE, "last"

Last = Token.Text
Set Token = NextToken
Else
Last = First
End If

Entity.DefTypes.SetRange First, Last, VariableType

If Token.Kind = tkSoftLineBreak Or Token.Kind = tkHardLineBreak Then Exit Do
If Token.Kind <> tkListSeparator Then Fail Token, RULE, ","
Loop

Exit Sub

ErrHandler:
Fail Mark, "Duplicate Deftype statement"
End Sub

Private Function IsOp(ByVal Token As Token, ByVal Text As String) As Boolean
If Token.Kind <> tkOperator Then Exit Function
IsOp = StrComp(Token.Text, Text, vbTextCompare) = 0
End Function
Next week we'll parse Consts and keep all keywords in a single place.

Andrej Biasic
2020-11-11