Let's build a transpiler! Part 30
This is the thirtieth post in a series of building a transpiler.You can find the previous ones here.
Last time I said we'd parse Select Cases.
As you may know, a Select Case has zero to many Cases and an optional Case Else.
Each Case can have one or more conditions, followed by a block of statements.
There are three types of conditions:
- Simple expressions like "1", or "A + 3"
- "Is" expressions, when we are not comparing for equality, like "Is > 12"
- "To" expressions, like "1 To 12"
First things first, let's enhance SelectConstruct class to hold Cases and the Case Else:
Public Class SelectConstruct
Option Explicit
Implements IStmt
Private Cases_ As KeyedList
Private CaseElse_ As KeyedList
Public Value As IExpression
Private Sub Class_Initialize()
Set Cases_ = New KeyedList
Set Cases_.T = NewValidator(TypeName(New CaseConstruct))
Set CaseElse_ = New KeyedList
Set CaseElse_.T = New StmtValidator
End Sub
Public Property Get Cases() As KeyedList
Set Cases = Cases_
End Property
Public Property Get CaseElse() As KeyedList
Set CaseElse = CaseElse_
End Property
Private Property Get IStmt_Kind() As StmtNumbers
IStmt_Kind = snSelect
End Property
End Class
Then, let's create a CaseConstruct class that will have a list of conditions and a body/block of statements:
Public Class CaseConstruct
Option Explicit
Private Conditions_ As KeyedList
Private Body_ As KeyedList
Private Sub Class_Initialize()
Set Conditions_ = New KeyedList
Set Conditions_.T = New ExprValidator
Set Body_ = New KeyedList
Set Body_.T = New StmtValidator
End Sub
Public Property Get Conditions() As KeyedList
Set Conditions = Conditions_
End Property
Public Property Get Body() As KeyedList
Set Body = Body_
End Property
End Class
Now we change ParseBody to account for Select Cases:
(...)
Case kwElseIf, kwElse
Exit Do
Case kwSelect
ParseSelect Entity, Body
Case Else
Stop
(...)
And create a ParseSelect procedure:
Private Sub ParseSelect(ByVal Entity As Entity, ByVal Body As KeyedList)
Dim Token As Token
Dim Expr As IExpression
Dim Xp As Expressionist
Dim Cs As CaseConstruct
Dim Sel As SelectConstruct
Dim IsExpr As BinaryExpression
Set Xp = New Expressionist
Xp.FullMode = True
Set Sel = New SelectConstruct
Set Token = NextToken
If Not Token.IsKeyword(kwCase) Then Fail Token, Msg091, NameBank.Keywords(kwCase)
Set Sel.Value = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Sel.Value Is Nothing Then Fail Token, Msg065
If Not IsBreak(Token) Then Fail Token, Msg031
Rem From now on we'll accept the "To" operator.
Xp.CanHaveTo = True
Do
Rem We can have a "look-ahead" token Case from ParseBody below.
Rem After parsing the statement block it may have stumbled upon "Case Else", for instance.
If Not Token.IsKeyword(kwCase) Then Set Token = SkipLineBreaks
Rem We will have this situation if there's an empty Select Case like:
Rem Select Case Abc
Rem End Select
If Token.IsKeyword(kwEnd) Then
Set Token = NextToken
If Not Token.IsKeyword(kwSelect) Then Exit Do
Fail Token, Msg085 & NameBank.Keywords(kwSelect)
End If
Set Cs = New CaseConstruct
Do
Set Expr = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If Expr Is Nothing Then
If Token.IsOperator(opIs) Then
Rem We have an "Is" expression
Set IsExpr = New BinaryExpression
'IsExpr.LHS will be Nothing
Set Token = NextToken
If Token.Kind <> tkOperator Then Fail Token, Msg092
Set IsExpr.Operator = NewOperator(Token)
If IsExpr.Operator.IsUnary Then Fail Token, Msg092
Set IsExpr.RHS = Xp.GetExpression(Me)
Set Token = Xp.LastToken
If IsExpr.RHS Is Nothing Then Fail Token, Msg065
Set Expr = IsExpr
ElseIf Token.IsKeyword(kwElse) Then
Rem We have a "Case Else".
Set Token = ParseBody(Entity, Sel.CaseElse)
If Not Token.IsKeyword(kwSelect) Then _
Fail Token, Msg085 & NameBank.Keywords(kwSelect)
Rem Cs must not be added after Loop.
Set Cs = Nothing
Exit Do
Else
Fail Token, Msg093
End If
End If
Cs.Conditions.Add Expr
If IsBreak(Token) Then
Set Token = ParseBody(Entity, Cs.Body)
Exit Do
End If
If Token.Kind <> tkListSeparator Then Fail Token, Msg027
Loop
If Not Cs Is Nothing Then Sel.Cases.Add Cs
Loop Until Token.IsKeyword(kwSelect)
Body.Add Sel
End Sub
Rem Add it to Messages
Public Property Get Msg091() As String
Msg091 = "Rule: Select Case expression"
End Property
Public Property Get Msg092() As String
Msg092 = "Expected: > or >= or = or < or <= or <>"
End Property
Public Property Get Msg093() As String
Msg093 = "Expected: Is or Else"
End Property
Please, note that the IsExpr binary expression will have its LHS member null/Nothing.
This is not good. Maybe we'll have to revisit it later.
Next week we'll parse implicit Let and Call statements.
Andrej Biasic
2021-03-24