-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathclsRStatement.vb
1071 lines (969 loc) · 60.3 KB
/
clsRStatement.vb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Imports System.Text.RegularExpressions
''' <summary> TODO Add class summary. </summary>
Public Class clsRStatement
''' <summary> If true, then when this R statement is converted to a script, then it will be
''' terminated with a newline (else if false then a semicolon)
''' </summary>
Public bTerminateWithNewline As Boolean = True
''' <summary> The assignment operator used in this statement (e.g. '=' in the statement 'a=b').
''' If there is no assignment (e.g. as in 'myFunction(a)' then set to 'nothing'. </summary>
Public strAssignmentOperator As String
''' <summary> If this R statement is converted to a script, then contains the formatting
''' string that will prefix the assignment operator.
''' This is typically used to insert spaces before the assignment operator to line
''' up the assignment operators in a list of assignments. For example:
''' <code>
''' shortName = 1 <para>
''' veryLongName = 2 </para></code>
''' </summary>
Public strAssignmentPrefix As String
''' <summary> If this R statement is converted to a script, then contains the formatting
''' string that will be placed at the end of the statement.
''' This is typically used to insert a comment at the end of the statement.
''' For example:
''' <code>
''' a = b * 2 # comment1</code>
''' </summary>
Public strSuffix As String
''' <summary> The element assigned to by the statement (e.g. 'a' in the statement 'a=b').
''' If there is no assignment (e.g. as in 'myFunction(a)' then set to 'nothing'. </summary>
Public clsAssignment As clsRElement = Nothing
''' <summary> The element assigned in the statement (e.g. 'b' in the statement 'a=b').
''' If there is no assignment (e.g. as in 'myFunction(a)' then set to the top-
''' level element in the statement (e.g. 'myFunction'). </summary>
Public clsElement As clsRElement
''' <summary> The relative precedence of the R operators. This is a two-dimensional array
''' because the operators are stored in groups together with operators that
''' have the same precedence.</summary>
Private ReadOnly arrOperatorPrecedence(19)() As String
'Constants for operator precedence groups that have special characteristics (e.g. must be unary)
Private ReadOnly iOperatorsBrackets As Integer = 2
Private ReadOnly iOperatorsUnaryOnly As Integer = 4
Private ReadOnly iOperatorsUserDefined As Integer = 6
Private ReadOnly iOperatorsTilda As Integer = 14
Private ReadOnly iOperatorsRightAssignment As Integer = 15
Private ReadOnly iOperatorsLeftAssignment1 As Integer = 16
Private ReadOnly iOperatorsLeftAssignment2 As Integer = 17
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Constructs an object representing a valid R statement.<para>
''' Processes the tokens from <paramref name="lstTokens"/> from position <paramref name="iPos"/>
''' to the end of statement, end of script or end of list (whichever comes first).</para></summary>
'''
''' <param name="lstTokens"> The list of R tokens to process </param>
''' <param name="iPos"> [in,out] The position in the list to start processing </param>
'''--------------------------------------------------------------------------------------------
Public Sub New(lstTokens As List(Of clsRToken), ByRef iPos As Integer, dctAssignments As Dictionary(Of String, clsRStatement))
'if nothing to process then exit
If lstTokens.Count <= 0 Then
Exit Sub
End If
arrOperatorPrecedence(0) = New String() {"::", ":::"}
arrOperatorPrecedence(1) = New String() {"$", "@"}
arrOperatorPrecedence(iOperatorsBrackets) = New String() {"[", "[["} 'bracket operators
arrOperatorPrecedence(3) = New String() {"^"} 'right to left precedence
arrOperatorPrecedence(iOperatorsUnaryOnly) = New String() {"-", "+"} 'unary operarors
arrOperatorPrecedence(5) = New String() {":"}
arrOperatorPrecedence(iOperatorsUserDefined) = New String() {"%"} 'any operator that starts with '%' (including user-defined operators)
arrOperatorPrecedence(7) = New String() {"|>"}
arrOperatorPrecedence(8) = New String() {"*", "/"}
arrOperatorPrecedence(9) = New String() {"+", "-"}
arrOperatorPrecedence(10) = New String() {"<", ">", "<>", "<=", ">=", "==", "!="}
arrOperatorPrecedence(11) = New String() {"!"}
arrOperatorPrecedence(12) = New String() {"&", "&&"}
arrOperatorPrecedence(13) = New String() {"|", "||"}
arrOperatorPrecedence(iOperatorsTilda) = New String() {"~"} 'unary or binary
arrOperatorPrecedence(iOperatorsRightAssignment) = New String() {"->", "->>"}
arrOperatorPrecedence(iOperatorsLeftAssignment1) = New String() {"<-", "<<-"}
arrOperatorPrecedence(iOperatorsLeftAssignment2) = New String() {"="}
arrOperatorPrecedence(18) = New String() {"?", "??"}
'create list of tokens for this statement
Dim lstStatementTokens As List(Of clsRToken) = New List(Of clsRToken)
While iPos < lstTokens.Count
lstStatementTokens.Add(lstTokens.Item(iPos))
If lstTokens.Item(iPos).enuToken = clsRToken.typToken.REndStatement OrElse 'we don't add this termination condition to the while statement
lstTokens.Item(iPos).enuToken = clsRToken.typToken.REndScript Then ' because we also want the token that terminates the statement
iPos += 1 ' to be part of the statement's list of tokens
Exit While
End If
iPos += 1
End While
'restructure the list into a token tree
Dim lstTokenPresentation As List(Of clsRToken) = GetLstPresentation(lstStatementTokens, 0)
Dim lstTokenBrackets As List(Of clsRToken) = GetLstTokenBrackets(lstTokenPresentation, 0)
Dim lstTokenFunctionBrackets As List(Of clsRToken) = GetLstTokenFunctionBrackets(lstTokenBrackets)
Dim lstTokenFunctionCommas As List(Of clsRToken) = GetLstTokenFunctionCommas(lstTokenFunctionBrackets, 0)
Dim lstTokenTree As List(Of clsRToken) = GetLstTokenOperators(lstTokenFunctionCommas)
'if the tree does not include at least one token, then raise development error
If lstTokenTree.Count < 1 Then
Throw New Exception("The token tree must contain at least one token.")
End If
'if the statement includes an assignment, then construct the assignment element
If lstTokenTree.Item(0).enuToken = clsRToken.typToken.ROperatorBinary AndAlso
lstTokenTree.Item(0).lstTokens.Count > 1 Then
Dim clsTokenChildLeft As clsRToken = lstTokenTree.Item(0).lstTokens.Item(lstTokenTree.Item(0).lstTokens.Count - 2)
Dim clsTokenChildRight As clsRToken = lstTokenTree.Item(0).lstTokens.Item(lstTokenTree.Item(0).lstTokens.Count - 1)
'if the statement has a left assignment (e.g. 'x<-value', 'x<<-value' or 'x=value')
If arrOperatorPrecedence(iOperatorsLeftAssignment1).Contains(lstTokenTree.Item(0).strTxt) OrElse
arrOperatorPrecedence(iOperatorsLeftAssignment2).Contains(lstTokenTree.Item(0).strTxt) Then
clsAssignment = GetRElement(clsTokenChildLeft, dctAssignments)
clsElement = GetRElement(clsTokenChildRight, dctAssignments)
ElseIf arrOperatorPrecedence(iOperatorsRightAssignment).Contains(lstTokenTree.Item(0).strTxt) Then
'else if the statement has a right assignment (e.g. 'value->x' or 'value->>x')
clsAssignment = GetRElement(clsTokenChildRight, dctAssignments)
clsElement = GetRElement(clsTokenChildLeft, dctAssignments)
End If
End If
'if there was an assigment then set the assignment operator and its presentation information
If Not IsNothing(clsAssignment) Then
strAssignmentOperator = lstTokenTree.Item(0).strTxt
strAssignmentPrefix = If(lstTokenTree.Item(0).lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation,
lstTokenTree.Item(0).lstTokens.Item(0).strTxt, "")
Else 'if there was no assignment, then build the main element from the token tree's top element
clsElement = GetRElement(lstTokenTree.Item(0), dctAssignments)
End If
'if statement ends with a semicolon or newline
Dim clsTokenEndStatement As clsRToken = lstTokenTree.Item(lstTokenTree.Count - 1)
If clsTokenEndStatement.enuToken = clsRToken.typToken.REndStatement OrElse clsTokenEndStatement.enuToken = clsRToken.typToken.REndScript Then
If clsTokenEndStatement.strTxt = ";" Then
bTerminateWithNewline = False
Else 'store any remaining presentation data associated with the newline
strSuffix = If(clsTokenEndStatement.lstTokens.Count > 0 AndAlso
clsTokenEndStatement.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation,
clsTokenEndStatement.lstTokens.Item(0).strTxt, "")
'do not include any trailing newlines
strSuffix = If(strSuffix.EndsWith(vbLf), strSuffix.Substring(0, strSuffix.Length - 1), strSuffix)
End If
End If
End Sub
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Returns this object as a valid, executable R statement. <para>
''' The script may contain formatting information such as spaces, comments and extra new lines.
''' If this object was created by analysing original R script, then the returned script's
''' formatting will be as close as possible to the original.</para><para>
''' The script may vary slightly because some formatting information is lost in the object
''' model. For lost formatting, the formatting will be done according to the guidelines in
''' https://style.tidyverse.org/syntax.html </para><para>
''' The returned script will always show:</para><list type="bullet"><item>
''' No spaces before commas</item><item>
''' No spaces before brackets</item><item>
''' No spaces before package ('::') and object ('$') operators</item><item>
''' One space before parameter assignments ('=')</item><item>
''' For example, 'pkg ::obj1 $obj2$fn1 (a ,b=1, c = 2 )' will be returned as
''' 'pkg::obj1$obj2$fn1(a, b =1, c = 2)'</item>
''' </list></summary>
'''
''' <param name="bIncludeFormatting"> If True, then include all formatting information in
''' returned string (comments, indents, padding spaces, extra line breaks etc.). </param>
'''
''' <returns> The current state of this object as a valid, executable R statement. </returns>
'''--------------------------------------------------------------------------------------------
Public Function GetAsExecutableScript(Optional bIncludeFormatting As Boolean = True) As String
Dim strScript As String
Dim strElement As String = GetScriptElement(clsElement, bIncludeFormatting)
'if there is no assignment, then just process the statement's element
If IsNothing(clsAssignment) OrElse String.IsNullOrEmpty(strAssignmentOperator) Then
strScript = strElement
Else 'else if the statement has an assignment
Dim strAssignment As String = GetScriptElement(clsAssignment, bIncludeFormatting)
Dim strAssignmentPrefixTmp = If(bIncludeFormatting, strAssignmentPrefix, "")
'if the statement has a left assignment (e.g. 'x<-value', 'x<<-value' or 'x=value')
If arrOperatorPrecedence(iOperatorsLeftAssignment1).Contains(strAssignmentOperator) OrElse
arrOperatorPrecedence(iOperatorsLeftAssignment2).Contains(strAssignmentOperator) Then
strScript = strAssignment & strAssignmentPrefixTmp & strAssignmentOperator & strElement
ElseIf arrOperatorPrecedence(iOperatorsRightAssignment).Contains(strAssignmentOperator) Then
'else if the statement has a right assignment (e.g. 'value->x' or 'value->>x')
strScript = strElement & strAssignmentPrefixTmp & strAssignmentOperator & strAssignment
Else
Throw New Exception("The statement's assignment operator is an unknown type.")
End If
End If
If bIncludeFormatting Then
strScript &= strSuffix
strScript &= If(bTerminateWithNewline, vbLf, ";")
End If
Return strScript
End Function
'''--------------------------------------------------------------------------------------------
''' <summary> Returns <paramref name="clsElement"/> as an executable R script. </summary>
'''
''' <param name="clsElement"> The R element to convert to an executable R script.
''' The R element may be a function, operator, constant,
''' syntactic name, key word etc. </param>
'''
''' <param name="bIncludeFormatting"> If True, then include all formatting information in
''' returned string (comments, indents, padding spaces, extra line breaks etc.). </param>
'''
''' <returns> <paramref name="clsElement"/> as an executable R script. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetScriptElement(clsElement As Object, Optional bIncludeFormatting As Boolean = True) As String
If IsNothing(clsElement) Then
Return ""
End If
Dim strScript As String = ""
Dim strElementPrefix As String = If(bIncludeFormatting, clsElement.strPrefix, "")
strScript &= If(clsElement.bBracketed, "(", "")
Select Case clsElement.GetType()
Case GetType(clsRElementFunction)
strScript &= GetScriptElementProperty(clsElement, bIncludeFormatting)
strScript &= "("
If Not IsNothing(clsElement.lstParameters) Then
Dim bPrefixComma As Boolean = False
For Each clsRParameter In clsElement.lstParameters
strScript &= If(bPrefixComma, ",", "")
bPrefixComma = True
Dim strParameterPrefix As String = If(bIncludeFormatting, clsRParameter.strPrefix, "")
strScript &= If(String.IsNullOrEmpty(clsRParameter.strArgName), "", strParameterPrefix & clsRParameter.strArgName + " =")
strScript &= GetScriptElement(clsRParameter.clsArgValue, bIncludeFormatting)
Next
End If
strScript &= ")"
Case GetType(clsRElementProperty)
strScript &= GetScriptElementProperty(clsElement, bIncludeFormatting)
Case GetType(clsRElementOperator)
If clsElement.strTxt = "[" OrElse clsElement.strTxt = "[[" Then
Dim bOperatorAppended As Boolean = False
For Each clsRParameter In clsElement.lstParameters
strScript &= GetScriptElement(clsRParameter.clsArgValue, bIncludeFormatting)
strScript &= If(bOperatorAppended, "", strElementPrefix & clsElement.strTxt)
bOperatorAppended = True
Next
Select Case clsElement.strTxt
Case "["
strScript &= "]"
Case "[["
strScript &= "]]"
End Select
Else
Dim bPrefixOperator As Boolean = clsElement.bFirstParamOnRight
For Each clsRParameter In clsElement.lstParameters
strScript &= If(bPrefixOperator, strElementPrefix & clsElement.strTxt, "")
bPrefixOperator = True
strScript &= GetScriptElement(clsRParameter.clsArgValue, bIncludeFormatting)
Next
strScript &= If(clsElement.lstParameters.Count = 1 AndAlso Not clsElement.bFirstParamOnRight, strElementPrefix & clsElement.strTxt, "")
End If
Case GetType(clsRElementKeyWord) 'TODO add key word functionality
Case GetType(clsRElement), GetType(clsRElementAssignable)
strScript &= strElementPrefix & clsElement.strTxt
End Select
strScript &= If(clsElement.bBracketed, ")", "")
Return strScript
End Function
'''--------------------------------------------------------------------------------------------
''' <summary> Returns <paramref name="clsElement"/> as an executable R script. </summary>
'''
''' <param name="clsElement"> The R element to convert to an executable R script. The R element
''' may have an associated package name, and a list of associated
''' objects e.g. 'pkg::obj1$obj2$fn1(a)'. </param>
'''
''' <param name="bIncludeFormatting"> If True, then include all formatting information in
''' returned string (comments, indents, padding spaces, extra line breaks etc.). </param>
'''
''' <returns> <paramref name="clsElement"/> as an executable R script. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetScriptElementProperty(clsElement As clsRElementProperty, Optional bIncludeFormatting As Boolean = True) As String
Dim strScript As String = If(bIncludeFormatting, clsElement.strPrefix, "") &
If(String.IsNullOrEmpty(clsElement.strPackageName), "", clsElement.strPackageName & "::")
If Not IsNothing(clsElement.lstObjects) AndAlso clsElement.lstObjects.Count > 0 Then
For Each clsObject In clsElement.lstObjects
strScript &= GetScriptElement(clsObject, bIncludeFormatting)
strScript &= "$"
Next
End If
strScript &= clsElement.strTxt
Return strScript
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Iterates through the tokens in <paramref name="lstTokens"/>, from position
''' <paramref name="iPos"/> and makes each presentation element a child of the next
''' non-presentation element.
''' <para>
''' A presentation element is an element that has no functionality and is only used to make
''' the script easier to read. It may be a block of spaces, a comment or a newline that does
''' not end a statement.
''' </para><para>
''' For example, the list of tokens representing the following block of script:
''' </para><code>
''' # comment1 <para>
''' a =b # comment2 </para></code><para>
''' </para><para>
''' Will be structured as:</para><code><para>
''' a</para><para>
''' .."# comment1\n"</para><para>
''' =</para><para>
''' .." "</para><para>
''' b</para><para>
''' (endStatement)</para><para>
''' .." # comment2"</para><para>
''' </para></code></summary>
'''
''' <param name="lstTokens"> The list of tokens to process. </param>
''' <param name="iPos"> The position in the list to start processing </param>
'''
''' <returns> A token tree where presentation information is stored as a child of the next
''' non-presentation element. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetLstPresentation(lstTokens As List(Of clsRToken), iPos As Integer) As List(Of clsRToken)
If lstTokens.Count < 1 Then
Return New List(Of clsRToken)
End If
Dim lstTokensNew As List(Of clsRToken) = New List(Of clsRToken)
Dim clsToken As clsRToken
Dim strPrefix As String = ""
While iPos < lstTokens.Count
clsToken = lstTokens.Item(iPos)
iPos += 1
Select Case clsToken.enuToken
Case clsRToken.typToken.RSpace, clsRToken.typToken.RComment, clsRToken.typToken.RNewLine
strPrefix &= clsToken.strTxt
Case Else
If Not String.IsNullOrEmpty(strPrefix) Then
clsToken.lstTokens.Add(New clsRToken(strPrefix, clsRToken.typToken.RPresentation))
End If
lstTokensNew.Add(clsToken.CloneMe)
strPrefix = ""
End Select
End While
'Edge case: if there is still presentation information not yet added to a tree element
' (this may happen if the last statement in the script is not terminated
' with a new line or '}')
If Not String.IsNullOrEmpty(strPrefix) Then
'add a new end statement token that contains the presentation information
clsToken = New clsRToken("", clsRToken.typToken.REndStatement)
clsToken.lstTokens.Add(New clsRToken(strPrefix, clsRToken.typToken.RPresentation))
lstTokensNew.Add(clsToken)
End If
Return lstTokensNew
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Iterates through the tokens in <paramref name="lstTokens"/> from position
''' <paramref name="iPos"/>. If the token is a '(' then it makes everything inside the brackets a
''' child of the '(' token. If the '(' belongs to a function then makes the '(' a child of the
''' function. Brackets may be nested. For example, '(a*(b+c))' is structured as:<code>
''' (<para>
''' ..a</para><para>
''' ..*</para><para>
''' ..(</para><para>
''' ....b</para><para>
''' ....+</para><para>
''' ....c</para><para>
''' ....)</para><para>
''' ..)</para></code></summary>
'''
''' <param name="lstTokens"> The token tree to restructure. </param>
''' <param name="iPos"> [in,out] The position in the list to start processing </param>
'''
''' <returns> A token tree restructured for round brackets. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetLstTokenBrackets(lstTokens As List(Of clsRToken), ByRef iPos As Integer) As List(Of clsRToken)
If lstTokens.Count <= 0 Then
Return New List(Of clsRToken)
End If
Dim lstTokensNew As List(Of clsRToken) = New List(Of clsRToken)
Dim clsToken As clsRToken
While iPos < lstTokens.Count
clsToken = lstTokens.Item(iPos)
iPos += 1
Select Case clsToken.strTxt
Case "("
Dim lstTokensTmp As List(Of clsRToken) = GetLstTokenBrackets(lstTokens, iPos)
For Each clsTokenChild As clsRToken In lstTokensTmp
If IsNothing(clsTokenChild) Then
Throw New Exception("Token has illegal empty child.")
End If
clsToken.lstTokens.Add(clsTokenChild.CloneMe)
Next
Case ")"
lstTokensNew.Add(clsToken.CloneMe)
Return lstTokensNew
End Select
lstTokensNew.Add(clsToken.CloneMe)
End While
Return lstTokensNew
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Traverses the tree of tokens in <paramref name="lstTokens"/>. If the token is a function name then it
''' makes the subsequent '(' a child of the function name token. </summary>
'''
''' <param name="lstTokens"> The token tree to restructure. </param>
'''
''' <returns> A token tree restructured for function names. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetLstTokenFunctionBrackets(lstTokens As List(Of clsRToken)) As List(Of clsRToken)
If lstTokens.Count <= 0 Then
Return New List(Of clsRToken)
End If
Dim lstTokensNew As List(Of clsRToken) = New List(Of clsRToken)
Dim clsToken As clsRToken
Dim iPos As Integer = 0
While iPos < lstTokens.Count
clsToken = lstTokens.Item(iPos)
If clsToken.enuToken = clsRToken.typToken.RFunctionName Then
'if next steps will go out of bounds, then throw developer error
If iPos > lstTokens.Count - 2 Then
Throw New Exception("The function's parameters have an unexpected format and cannot be processed.")
Exit While
End If
'make the function's open bracket a child of the function name
iPos += 1
clsToken.lstTokens.Add(lstTokens.Item(iPos).CloneMe)
End If
clsToken.lstTokens = GetLstTokenFunctionBrackets(clsToken.CloneMe.lstTokens)
lstTokensNew.Add(clsToken.CloneMe)
iPos += 1
End While
Return lstTokensNew
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Traverses the tree of tokens in <paramref name="lstTokens"/>. If the token is a ',' that
''' separates function parameters, then it makes everything up to the next ',' or ')' a child
''' of the ',' token. Parameters between function commas are optional. For example,
''' `myFunction(a,,b)` is structured as: <code>
''' myFunction<para>
''' ..(</para><para>
''' ....a</para><para>
''' ....,</para><para>
''' ....,</para><para>
''' ......b</para><para>
''' ......)</para></code>
''' Commas used within square brackets (e.g. `a[b,c]`, `a[b,]` etc.) are ignored.
''' </summary>
'''
''' <param name="lstTokens"> The token tree to restructure. </param>
''' <param name="iPos"> [in,out] The position in the list to start processing </param>
''' <param name="bProcessingComma"> (Optional) True if function called when already processing
''' a comma (prevents commas being nested inside each other). </param>
'''
''' <returns> A token tree restructured for function commas. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetLstTokenFunctionCommas(lstTokens As List(Of clsRToken),
ByRef iPos As Integer,
Optional bProcessingComma As Boolean = False) As List(Of clsRToken)
Dim lstTokensNew As List(Of clsRToken) = New List(Of clsRToken)
Dim clsToken As clsRToken
Dim lstOpenBrackets As New List(Of String) From {"[", "[["}
Dim lstCloseBrackets As New List(Of String) From {"]", "]]"}
Dim iNumOpenBrackets As Integer = 0
While iPos < lstTokens.Count
clsToken = lstTokens.Item(iPos)
'only process commas that separate function parameters,
' ignore commas inside square bracket (e.g. `a[b,c]`)
iNumOpenBrackets += If(lstOpenBrackets.Contains(clsToken.strTxt), 1, 0)
iNumOpenBrackets -= If(lstCloseBrackets.Contains(clsToken.strTxt), 1, 0)
If iNumOpenBrackets = 0 AndAlso clsToken.strTxt = "," Then
If bProcessingComma Then
iPos -= 1 'ensure this comma is processed in the level above
Return lstTokensNew
Else
iPos += 1
clsToken.lstTokens = clsToken.lstTokens.Concat(GetLstTokenFunctionCommas(lstTokens, iPos, True)).ToList()
End If
Else
clsToken.lstTokens = GetLstTokenFunctionCommas(clsToken.CloneMe.lstTokens, 0)
End If
lstTokensNew.Add(clsToken)
iPos += 1
End While
Return lstTokensNew
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Iterates through all the possible operators in order of precedence. For each operator,
''' traverses the tree of tokens in <paramref name="lstTokens"/>. If the operator is found then
''' the operator's parameters (typically the tokens to the left and right of the operator) are
''' made children of the operator. For example, 'a*b+c' is structured as:<code>
''' +<para>
''' ..*</para><para>
''' ....a</para><para>
''' ....b</para><para>
''' ..c</para></code></summary>
'''
''' <param name="lstTokens"> The token tree to restructure. </param>
'''
''' <returns> A token tree restructured for all the possible operators. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetLstTokenOperators(lstTokens As List(Of clsRToken)) As List(Of clsRToken)
If lstTokens.Count <= 0 Then
Return New List(Of clsRToken)
End If
Dim lstTokensNew As List(Of clsRToken) = New List(Of clsRToken)
For iPosOperators As Integer = 0 To UBound(arrOperatorPrecedence) - 1
'restructure the tree for the next group of operators in the precedence list
lstTokensNew = GetLstTokenOperatorGroup(lstTokens, iPosOperators)
'clone the new tree before restructuring for the next operator
lstTokens = New List(Of clsRToken)
For Each clsTokenTmp As clsRToken In lstTokensNew
lstTokens.Add(clsTokenTmp.CloneMe)
Next
Next
Return lstTokensNew
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Traverses the tree of tokens in <paramref name="lstTokens"/>. If one of the operators in
''' the <paramref name="iPosOperators"/> group is found, then the operator's parameters
''' (typically the tokens to the left and right of the operator) are made children of the
''' operator. For example, 'a*b+c' is structured as:<code>
''' +<para>
''' ..*</para><para>
''' ....a</para><para>
''' ....b</para><para>
''' ..c</para></code>
'''
''' Edge case: This function cannot process the case where a binary operator is immediately
''' followed by a unary operator with the same or a lower precedence (e.g. 'a^-b', 'a+~b',
''' 'a~~b' etc.). This is because of the R default precedence rules. The workaround is to
''' enclose the unary operator in brackets (e.g. 'a^(-b)', 'a+(~b)', 'a~(~b)' etc.).
''' </summary>
''' <param name="lstTokens"> The token tree to restructure. </param>
''' <param name="iPosOperators"> The group of operators to search for in the tree. </param>
'''
''' <returns> A token tree restructured for the specified group of operators. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetLstTokenOperatorGroup(lstTokens As List(Of clsRToken), iPosOperators As Integer) As List(Of clsRToken)
If lstTokens.Count < 1 Then
Return New List(Of clsRToken)
End If
Dim lstTokensNew As List(Of clsRToken) = New List(Of clsRToken)
Dim clsToken As clsRToken
Dim clsTokenPrev As clsRToken = Nothing
Dim bPrevTokenProcessed As Boolean = False
Dim iPosTokens As Integer = 0
While iPosTokens < lstTokens.Count
clsToken = lstTokens.Item(iPosTokens).CloneMe
'if the token is the operator we are looking for and it has not been processed already
'Edge case: if the operator already has (non-presentation) children then it means
' that it has already been processed. This happens when the child is in the
' same precedence group as the parent but was processed first in accordance
' with the left to right rule (e.g. 'a/b*c').
If (arrOperatorPrecedence(iPosOperators).Contains(clsToken.strTxt) OrElse
iPosOperators = iOperatorsUserDefined AndAlso Regex.IsMatch(clsToken.strTxt, "^%.*%$")) AndAlso
(clsToken.lstTokens.Count = 0 OrElse (clsToken.lstTokens.Count = 1 AndAlso
clsToken.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation)) Then
Select Case clsToken.enuToken
Case clsRToken.typToken.ROperatorBracket 'handles '[' and '[['
If iPosOperators <> iOperatorsBrackets Then
Exit Select
End If
'make the previous and next tokens (up to the corresponding close bracket), the children of the current token
clsToken.lstTokens.Add(clsTokenPrev.CloneMe)
bPrevTokenProcessed = True
iPosTokens += 1
Dim strCloseBracket = If(clsToken.strTxt = "[", "]", "]]")
Dim iNumOpenBrackets As Integer = 1
While iPosTokens < lstTokens.Count
iNumOpenBrackets += If(lstTokens.Item(iPosTokens).strTxt = clsToken.strTxt, 1, 0)
iNumOpenBrackets -= If(lstTokens.Item(iPosTokens).strTxt = strCloseBracket, 1, 0)
'discard the terminating cloe bracket
If iNumOpenBrackets = 0 Then
Exit While
End If
clsToken.lstTokens.Add(lstTokens.Item(iPosTokens).CloneMe)
iPosTokens += 1
End While
Case clsRToken.typToken.ROperatorBinary
'edge case: if we are looking for unary '+' or '-' and we found a binary '+' or '-'
If iPosOperators = iOperatorsUnaryOnly Then
'do not process (binary '+' and '-' have a lower precedence and will be processed later)
Exit Select
ElseIf IsNothing(clsTokenPrev) Then
Throw New Exception("The binary operator has no parameter on its left.")
End If
'make the previous and next tokens, the children of the current token
clsToken.lstTokens.Add(clsTokenPrev.CloneMe)
bPrevTokenProcessed = True
clsToken.lstTokens.Add(GetNextToken(lstTokens, iPosTokens))
iPosTokens += 1
'while next token is the same operator (e.g. 'a+b+c+d...'),
' then keep making the next token, the child of the current operator token
Dim clsTokenNext As clsRToken
While iPosTokens < lstTokens.Count - 1
clsTokenNext = GetNextToken(lstTokens, iPosTokens)
If Not clsToken.enuToken = clsTokenNext.enuToken OrElse
Not clsToken.strTxt = clsTokenNext.strTxt Then
Exit While
End If
iPosTokens += 1
clsToken.lstTokens.Add(GetNextToken(lstTokens, iPosTokens))
iPosTokens += 1
End While
Case clsRToken.typToken.ROperatorUnaryRight
'edge case: if we found a unary '+' or '-', but we are not currently processing the unary '+'and '-' operators
If arrOperatorPrecedence(iOperatorsUnaryOnly).Contains(clsToken.strTxt) AndAlso
Not iPosOperators = iOperatorsUnaryOnly Then
Exit Select
End If
'make the next token, the child of the current operator token
clsToken.lstTokens.Add(GetNextToken(lstTokens, iPosTokens))
iPosTokens += 1
Case clsRToken.typToken.ROperatorUnaryLeft
If IsNothing(clsTokenPrev) OrElse Not iPosOperators = iOperatorsTilda Then
Throw New Exception("Illegal unary left operator ('~' is the only valid unary left operator).")
End If
'make the previous token, the child of the current operator token
clsToken.lstTokens.Add(clsTokenPrev.CloneMe)
bPrevTokenProcessed = True
Case Else
Throw New Exception("The token has an unknown operator type.")
End Select
End If
'if token was not the operator we were looking for
' (or we were looking for a unary right operator)
If Not bPrevTokenProcessed _
AndAlso Not IsNothing(clsTokenPrev) Then
'add the previous token to the tree
lstTokensNew.Add(clsTokenPrev)
End If
'process the current token's children
clsToken.lstTokens = GetLstTokenOperatorGroup(clsToken.CloneMe.lstTokens, iPosOperators)
clsTokenPrev = clsToken.CloneMe
bPrevTokenProcessed = False
iPosTokens += 1
End While
If IsNothing(clsTokenPrev) Then
Throw New Exception("Expected that there would still be a token to add to the tree.")
End If
lstTokensNew.Add(clsTokenPrev.CloneMe)
Return lstTokensNew
End Function
'''--------------------------------------------------------------------------------------------
''' <summary> Returns a clone of the next token in the <paramref name="lstTokens"/> list,
''' after <paramref name="iPosTokens"/>. If there is no next token then throws
''' an error.</summary>
'''
''' <param name="lstTokens"> The list of tokens. </param>
''' <param name="iPosTokens"> The position of the current token in the list. </param>
'''
''' <returns> A clone of the next token in the <paramref name="lstTokens"/> list. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetNextToken(lstTokens As List(Of clsRToken), iPosTokens As Integer) As clsRToken
If iPosTokens >= (lstTokens.Count - 1) Then
Throw New Exception("Token list ended unexpectedly.")
End If
Return lstTokens.Item(iPosTokens + 1).CloneMe
End Function
'''--------------------------------------------------------------------------------------------
''' <summary> Returns an R element object constructed from the <paramref name="clsToken"/>
''' token. </summary>
'''
''' <param name="clsToken"> The token to convert into an R element object. </param>
''' <param name="dctAssignments"> Dictionary containing all the current existing assignments.
''' The key is the name of the variable. The value is a reference
''' to the R statement that performed the assignment. </param>
''' <param name="bBracketedNew"> (Optional) True if the token is enclosed in brackets. </param>
''' <param name="strPackageName"> (Optional) The package name associated with the token. </param>
''' <param name="strPackagePrefix"> (Optional) The formatting string that prefixes the package
''' name (e.g. spaces or comment lines). </param>
''' <param name="lstObjects"> (Optional) The list of objects associated with the token
''' (e.g. 'obj1$obj2$myFn()'). </param>
'''
''' <returns> An R element object constructed from the <paramref name="clsToken"/>
''' token. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetRElement(clsToken As clsRToken,
dctAssignments As Dictionary(Of String, clsRStatement),
Optional bBracketedNew As Boolean = False,
Optional strPackageName As String = "",
Optional strPackagePrefix As String = "",
Optional lstObjects As List(Of clsRElement) = Nothing) As clsRElement
If IsNothing(clsToken) Then
Throw New ArgumentException("Cannot create an R element from an empty token.")
End If
Select Case clsToken.enuToken
Case clsRToken.typToken.RBracket
'if text is a round bracket, then return the bracket's child
If clsToken.strTxt = "(" Then
'an open bracket must have at least one child
If clsToken.lstTokens.Count < 1 OrElse clsToken.lstTokens.Count > 3 Then
Throw New Exception("Open bracket token has " & clsToken.lstTokens.Count &
" children. An open bracket must have exactly one child (plus an " &
"optional presentation child and/or an optional close bracket).")
End If
Return GetRElement(GetChildPosNonPresentation(clsToken), dctAssignments, True)
End If
Return New clsRElement(clsToken)
Case clsRToken.typToken.RFunctionName
Dim clsFunction As New clsRElementFunction(clsToken, bBracketedNew, strPackageName, strPackagePrefix, lstObjects)
'Note: Function tokens are structured as a tree.
' For example 'f(a,b,c=d)' is structured as:
' f
' ..(
' ....a
' ....,
' ......b
' ....,
' ......=
' ........c
' ........d
' ........)
'
If clsToken.lstTokens.Count < 1 OrElse clsToken.lstTokens.Count > 2 Then
Throw New Exception("Function token has " & clsToken.lstTokens.Count &
" children. A function token must have 1 child (plus an optional presentation child).")
End If
'process each parameter
Dim bFirstParam As Boolean = True
For Each clsTokenParam In clsToken.lstTokens.Item(clsToken.lstTokens.Count - 1).lstTokens
'if list item is a presentation element, then ignore it
If clsTokenParam.enuToken = clsRToken.typToken.RPresentation Then
If bFirstParam Then
Continue For
End If
Throw New Exception("Function parameter list contained an unexpected presentation element.")
End If
Dim clsParameter As clsRParameter = GetRParameterNamed(clsTokenParam, dctAssignments)
If Not IsNothing(clsParameter) Then
If bFirstParam AndAlso IsNothing(clsParameter.clsArgValue) Then
clsFunction.lstParameters.Add(clsParameter) 'add extra empty parameter for case 'f(,)'
End If
clsFunction.lstParameters.Add(clsParameter)
End If
bFirstParam = False
Next
Return clsFunction
Case clsRToken.typToken.ROperatorUnaryLeft
If clsToken.lstTokens.Count < 1 OrElse clsToken.lstTokens.Count > 2 Then
Throw New Exception("Unary left operator token has " & clsToken.lstTokens.Count &
" children. A Unary left operator must have 1 child (plus an optional presentation child).")
End If
Dim clsOperator As New clsRElementOperator(clsToken, bBracketedNew)
clsOperator.lstParameters.Add(GetRParameter(clsToken.lstTokens.Item(clsToken.lstTokens.Count - 1), dctAssignments))
Return clsOperator
Case clsRToken.typToken.ROperatorUnaryRight
If clsToken.lstTokens.Count < 1 OrElse clsToken.lstTokens.Count > 2 Then
Throw New Exception("Unary right operator token has " & clsToken.lstTokens.Count &
" children. A Unary right operator must have 1 child (plus an optional presentation child).")
End If
Dim clsOperator As New clsRElementOperator(clsToken, bBracketedNew, True)
clsOperator.lstParameters.Add(GetRParameter(clsToken.lstTokens.Item(clsToken.lstTokens.Count - 1), dctAssignments))
Return clsOperator
Case clsRToken.typToken.ROperatorBinary
If clsToken.lstTokens.Count < 2 Then
Throw New Exception("Binary operator token has " & clsToken.lstTokens.Count &
" children. A binary operator must have at least 2 children (plus an optional presentation child).")
End If
'if object operator
Select Case clsToken.strTxt
Case "$"
Dim strPackagePrefixNew As String = ""
Dim strPackageNameNew As String = ""
Dim lstObjectsNew As New List(Of clsRElement)
'add each object parameter to the object list (except last parameter)
Dim startPos As Integer = If(clsToken.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation, 1, 0)
For iPos As Integer = startPos To clsToken.lstTokens.Count - 2
Dim clsTokenObject As clsRToken = clsToken.lstTokens.Item(iPos)
'if the first parameter is a package operator ('::'), then make this the package name for the returned element
If iPos = startPos AndAlso
clsTokenObject.enuToken = clsRToken.typToken.ROperatorBinary AndAlso
clsTokenObject.strTxt = "::" Then
'get the package name and any package presentation information
strPackageNameNew = GetTokenPackageName(clsTokenObject).strTxt
strPackagePrefixNew = GetPackagePrefix(clsTokenObject)
'get the object associated with the package, and add it to the object list
lstObjectsNew.Add(GetRElement(clsTokenObject.lstTokens.Item(clsTokenObject.lstTokens.Count - 1), dctAssignments))
Continue For
End If
lstObjectsNew.Add(GetRElement(clsTokenObject, dctAssignments))
Next
'the last item in the parameter list is the element we need to return
Return GetRElement(clsToken.lstTokens.Item(clsToken.lstTokens.Count - 1),
dctAssignments, bBracketedNew, strPackageNameNew,
strPackagePrefixNew, lstObjectsNew)
Case "::"
'the '::' operator parameter list contains:
' - the presentation string (optional)
' - the package name
' - the element associated with the package
Return GetRElement(clsToken.lstTokens.Item(clsToken.lstTokens.Count - 1),
dctAssignments, bBracketedNew,
GetTokenPackageName(clsToken).strTxt,
GetPackagePrefix(clsToken))
Case Else 'else if not an object or package operator, then add each parameter to the operator
Dim clsOperator As New clsRElementOperator(clsToken, bBracketedNew)
Dim startPos As Integer = If(clsToken.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation, 1, 0)
For iPos As Integer = startPos To clsToken.lstTokens.Count - 1
clsOperator.lstParameters.Add(GetRParameter(clsToken.lstTokens.Item(iPos), dctAssignments))
Next
Return clsOperator
End Select
Case clsRToken.typToken.ROperatorBracket
If clsToken.lstTokens.Count < 1 Then
Throw New Exception("Square bracket operator token has no children. A binary " _
& "operator must have at least 1 child (plus an optional " _
& "presentation child).")
End If
Dim clsBracketOperator As New clsRElementOperator(clsToken, bBracketedNew)
Dim startPos As Integer = If(clsToken.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation, 1, 0)
For iPos As Integer = startPos To clsToken.lstTokens.Count - 1
clsBracketOperator.lstParameters.Add(GetRParameter(clsToken.lstTokens.Item(iPos), dctAssignments))
Next
Return clsBracketOperator
Case clsRToken.typToken.RSyntacticName, clsRToken.typToken.RConstantString
'if element has a package name or object list, then return a property element
If Not String.IsNullOrEmpty(strPackageName) OrElse Not IsNothing(lstObjects) Then
Return New clsRElementProperty(clsToken, bBracketedNew, strPackageName, strPackagePrefix, lstObjects)
End If
'if element was assigned in a previous statement, then return an assigned element
Dim clsStatement As clsRStatement = If(dctAssignments.ContainsKey(clsToken.strTxt), dctAssignments(clsToken.strTxt), Nothing)
If Not IsNothing(clsStatement) Then
Return New clsRElementAssignable(clsToken, clsStatement, bBracketedNew)
End If
'else just return a regular element
Return New clsRElement(clsToken, bBracketedNew)
Case clsRToken.typToken.RSeparator 'a comma within a square bracket, e.g. `a[b,c]`
'just return a regular element
Return New clsRElement(clsToken, bBracketedNew)
Case clsRToken.typToken.REndStatement
Return Nothing
Case Else
Throw New Exception("The token has an unexpected type.")
End Select
Throw New Exception("It should be impossible for the code to reach this point.")
End Function
'''--------------------------------------------------------------------------------------------
''' <summary> Returns the package name token associated with the <paramref name="clsToken"/>
''' package operator. </summary>
'''
''' <param name="clsToken"> Package operator ('::') token. </param>
'''
''' <returns> The package name associated with the <paramref name="clsToken"/> package
''' operator. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetTokenPackageName(clsToken As clsRToken) As clsRToken
If IsNothing(clsToken) Then
Throw New ArgumentException("Cannot return a package name from an empty token.")
End If
If clsToken.lstTokens.Count < 2 OrElse clsToken.lstTokens.Count > 3 Then
Throw New Exception("The package operator '::' has " & clsToken.lstTokens.Count &
" parameters. It must have 2 parameters (plus an optional presentation parameter).")
End If
Return clsToken.lstTokens.Item(clsToken.lstTokens.Count - 2)
End Function
'''--------------------------------------------------------------------------------------------
''' <summary> Returns the formatting prefix (spaces or comment lines) associated with the
''' <paramref name="clsToken"/> package operator. If the package operator has no
''' associated formatting, then returns an empty string.</summary>
'''
''' <param name="clsToken"> Package operator ('::') token. </param>
'''
''' <returns> The formatting prefix (spaces or comment lines) associated with the
''' <paramref name="clsToken"/> package operator. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetPackagePrefix(clsToken As clsRToken) As String
If IsNothing(clsToken) Then
Throw New ArgumentException("Cannot return a package prefix from an empty token.")
End If
Dim clsTokenPackageName As clsRToken = GetTokenPackageName(clsToken)
Return If(clsTokenPackageName.lstTokens.Count > 0 AndAlso clsTokenPackageName.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation,
clsTokenPackageName.lstTokens.Item(0).strTxt, "")
End Function
'''--------------------------------------------------------------------------------------------
''' <summary>
''' Returns a named parameter element constructed from the <paramref name="clsToken"/> token
''' tree. The top-level element in the token tree may be:<list type="bullet"><item>
''' 'value' e.g. for fn(a)</item><item>
''' '=' e.g. for 'fn(a=1)'</item><item>
''' ',' e.g. for 'fn(a,b) or 'fn(a=1,b,,c,)'</item><item>
''' ')' indicates the end of the parameter list, returns nothing</item>
''' </list></summary>
'''
''' <param name="clsToken"> The token tree to convert into a named parameter element. </param>
''' <param name="dctAssignments"> Dictionary containing all the current existing assignments.
''' The key is the name of the variable. The value is a reference
''' to the R statement that performed the assignment. </param>
'''
''' <returns> A named parameter element constructed from the <paramref name="clsToken"/> token
''' tree. </returns>
'''--------------------------------------------------------------------------------------------
Private Function GetRParameterNamed(clsToken As clsRToken, dctAssignments As Dictionary(Of String, clsRStatement)) As clsRParameter
If IsNothing(clsToken) Then
Throw New ArgumentException("Cannot create a named parameter from an empty token.")
End If
Select Case clsToken.strTxt
Case "="
If clsToken.lstTokens.Count < 2 Then
Throw New Exception("Named parameter token has " & clsToken.lstTokens.Count &
" children. Named parameter must have at least 2 children (plus an optional presentation child).")
End If
Dim clsTokenArgumentName = clsToken.lstTokens.Item(clsToken.lstTokens.Count - 2)
Dim clsParameter As New clsRParameter With {
.strArgName = clsTokenArgumentName.strTxt}
clsParameter.clsArgValue = GetRElement(clsToken.lstTokens.Item(clsToken.lstTokens.Count - 1), dctAssignments)
'set the parameter's formatting prefix to the prefix of the parameter name
' Note: if the equals sign has any formatting information then this information
' will be lost.
clsParameter.strPrefix =
If(clsTokenArgumentName.lstTokens.Count > 0 AndAlso
clsTokenArgumentName.lstTokens.Item(0).enuToken = clsRToken.typToken.RPresentation,