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

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:
GetExpression can handle both the first and the last expressions, but we will have to deal with the "Is" expression differently.

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

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

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

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

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

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