-
Notifications
You must be signed in to change notification settings - Fork 7
Expand file tree
/
Copy pathcKscope.cls
More file actions
1496 lines (1411 loc) · 50.9 KB
/
cKscope.cls
File metadata and controls
1496 lines (1411 loc) · 50.9 KB
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
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "cKscope"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Auto-generated on 5.3.2019 16:44:40
Option Explicit
DefObj A-Z
'=========================================================================
' API
'=========================================================================
Private Const LOCALE_USER_DEFAULT As Long = &H400
Private Const NORM_IGNORECASE As Long = 1
Private Const CSTR_EQUAL As Long = 2
Private Declare Function CompareStringW Lib "kernel32" (ByVal Locale As Long, ByVal dwCmpFlags As Long, lpString1 As Any, ByVal cchCount1 As Long, lpString2 As Any, ByVal cchCount2 As Long) As Long
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Function ArrPtr Lib "vbe7" Alias "VarPtr" (Ptr() As Any) As LongPtr
Private Const NULL_PTR As LongPtr = 0
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Const NULL_PTR As Long = 0
#End If
#If Win64 Then
Private Const PTR_SIZE As Long = 8
#Else
Private Const PTR_SIZE As Long = 4
#End If
Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
#If VBA7 Then
pvData As LongPtr
#Else
pvData As Long
#End If
cElements As Long
lLbound As Long
End Type
'=========================================================================
' Constants and member variables
'=========================================================================
Private Const LNG_MAXINT As Long = 2 ^ 31 - 1
'= generated enum ========================================================
Private Enum UcsParserActionsEnum
ucsAct_3_start
ucsAct_2_start
ucsAct_1_start
ucsAct_1_definition
ucsAct_1_extern
ucsAct_1_prototype
ucsAct_2_prototype
ucsAct_1_binopproto
ucsAct_1_UNOP
ucsAct_3_param_list
ucsAct_2_param_list
ucsAct_1_param_list
ucsAct_1_IDENT
ucsAct_1_BINOP
ucsAct_1_NUMBER
ucsAct_2_binexpr
ucsAct_1_binexpr
ucsAct_1_unexpr
ucsAct_1_DOUBLE
ucsAct_1_invokeexpr
ucsAct_1_ifexpr
ucsAct_1_forexpr
ucsAct_1_varexpr
ucsAct_3_arg_list
ucsAct_2_arg_list
ucsAct_1_arg_list
ucsAct_3_var_list
ucsAct_2_var_list
ucsAct_1_var_list
ucsAct_1_var_decl
ucsActVarAlloc = -1
ucsActVarSet = -2
ucsActResultClear = -3
ucsActResultSet = -4
End Enum
Private Type UcsParserThunkType
Action As Long
CaptureBegin As Long
CaptureEnd As Long
End Type
Private Type UcsParserType
Contents As String
BufArray As SAFEARRAY1D
BufData() As Integer
BufPos As Long
BufSize As Long
ThunkData() As UcsParserThunkType
ThunkPos As Long
CaptureBegin As Long
CaptureEnd As Long
LastExpected As String
LastError As String
LastBufPos As Long
UserData As Variant
VarResult As Variant
VarStack() As Variant
VarPos As Long
End Type
Private m_oBinopInfo As Scripting.Dictionary
Private m_lBinopMinPrec As Long
Private ctx As UcsParserType
'=========================================================================
' Properties
'=========================================================================
Property Get LastError() As String
LastError = ctx.LastError
End Property
Property Get LastOffset() As Long
LastOffset = ctx.LastBufPos + 1
End Property
Property Get ParserVersion() As String
ParserVersion = "5.3.2019 16:44:40"
End Property
Property Get Contents(Optional ByVal lOffset As Long = 1, Optional ByVal lSize As Long = LNG_MAXINT) As String
Contents = Mid$(ctx.Contents, lOffset, lSize)
End Property
'=========================================================================
' Methods
'=========================================================================
Public Function Match(sSubject As String, Optional ByVal StartPos As Long, Optional UserData As Variant, Optional Result As Variant) As Long
If BeginMatch(sSubject, StartPos, UserData) Then
If Parsestart() Then
Match = EndMatch(Result)
Else
With ctx
If LenB(.LastError) = 0 Then
If LenB(.LastExpected) = 0 Then
.LastError = "Fail"
Else
.LastError = "Expected " & Join(Split(Mid$(.LastExpected, 2, Len(.LastExpected) - 2), vbNullChar), " or ")
End If
End If
End With
End If
End If
End Function
Public Function BeginMatch(sSubject As String, Optional ByVal StartPos As Long, Optional UserData As Variant) As Boolean
With ctx
.LastBufPos = 0
If LenB(sSubject) = 0 Then
.LastError = "Cannot match empty input"
Exit Function
End If
Call CopyMemory(ByVal VarPtr(.Contents), ByVal VarPtr(sSubject), PTR_SIZE)
With .BufArray
.cDims = 1
.fFeatures = 1 ' FADF_AUTO
.cbElements = 2
.pvData = StrPtr(sSubject)
.cElements = Len(sSubject) + 2 '-- look-ahead chars
End With
Call CopyMemory(ByVal ArrPtr(.BufData), VarPtr(.BufArray), PTR_SIZE)
.BufPos = StartPos
.BufSize = Len(sSubject)
ReDim .ThunkData(0 To 4) As UcsParserThunkType
.ThunkPos = 0
.CaptureBegin = 0
.CaptureEnd = 0
If IsObject(UserData) Then
Set .UserData = UserData
Else
.UserData = UserData
End If
End With
BeginMatch = True
End Function
Public Function EndMatch(Optional Result As Variant) As Long
Dim lIdx As Long
With ctx
ReDim .VarStack(0 To 1024) As Variant
For lIdx = 0 To .ThunkPos - 1
Select Case .ThunkData(lIdx).Action
Case ucsActVarAlloc
.VarPos = .VarPos + .ThunkData(lIdx).CaptureBegin
Case ucsActVarSet
If IsObject(.VarResult) Then
Set .VarStack(.VarPos - .ThunkData(lIdx).CaptureBegin) = .VarResult
Else
.VarStack(.VarPos - .ThunkData(lIdx).CaptureBegin) = .VarResult
End If
Case ucsActResultClear
.VarResult = Empty
Case ucsActResultSet
With .ThunkData(lIdx)
ctx.VarResult = Mid$(ctx.Contents, .CaptureBegin + 1, .CaptureEnd - .CaptureBegin)
End With
Case Else
With .ThunkData(lIdx)
pvImplAction .Action, .CaptureBegin + 1, .CaptureEnd - .CaptureBegin
End With
End Select
Next
If IsObject(.VarResult) Then
Set Result = .VarResult
Else
Result = .VarResult
End If
EndMatch = .BufPos + 1
Call CopyMemory(ByVal VarPtr(.Contents), NULL_PTR, PTR_SIZE)
Call CopyMemory(ByVal ArrPtr(.BufData), NULL_PTR, PTR_SIZE)
.BufPos = 0
.BufSize = 0
Erase .ThunkData
.ThunkPos = 0
.CaptureBegin = 0
.CaptureEnd = 0
End With
End Function
Private Sub pvPushThunk(ByVal eAction As UcsParserActionsEnum, Optional ByVal lBegin As Long, Optional ByVal lEnd As Long)
With ctx
If UBound(.ThunkData) < .ThunkPos Then
ReDim Preserve .ThunkData(0 To 2 * UBound(.ThunkData)) As UcsParserThunkType
End If
With .ThunkData(.ThunkPos)
.Action = eAction
.CaptureBegin = lBegin
.CaptureEnd = lEnd
End With
.ThunkPos = .ThunkPos + 1
End With
End Sub
Private Function pvMatchString(sText As String, Optional ByVal CmpFlags As Long) As Boolean
With ctx
If .BufPos + Len(sText) <= .BufSize Then
pvMatchString = CompareStringW(LOCALE_USER_DEFAULT, CmpFlags, ByVal StrPtr(sText), Len(sText), .BufData(.BufPos), Len(sText)) = CSTR_EQUAL
End If
End With
End Function
Private Sub pvSetAdvance()
With ctx
If .BufPos > .LastBufPos Then
.LastExpected = vbNullString
.LastError = vbNullString
.LastBufPos = .BufPos
End If
End With
End Sub
'= generated functions ===================================================
Public Function Parsestart() As Boolean
Dim i14 As Long
Dim p12 As Long
Dim q12 As Long
With ctx
pvPushThunk ucsActVarAlloc, 2
pvPushThunk ucsActResultClear
Call Parse_
pvPushThunk ucsActVarSet, 1
pvPushThunk ucsAct_1_start, .CaptureBegin, .CaptureEnd
For i14 = 0 To LNG_MAXINT
p12 = .BufPos
q12 = .ThunkPos
pvPushThunk ucsActResultClear
If Parsestmt() Then
pvPushThunk ucsActVarSet, 2
Else
.BufPos = p12
.ThunkPos = q12
Exit For
End If
pvPushThunk ucsAct_2_start, .CaptureBegin, .CaptureEnd
Next
If i14 <> 0 Then
pvPushThunk ucsAct_3_start, .CaptureBegin, .CaptureEnd
pvPushThunk ucsActVarAlloc, -2
Parsestart = True
End If
End With
End Function
Private Sub Parse_()
Dim p417 As Long
With ctx
Do
p417 = .BufPos
If Not (ParseLineComment()) Then
.BufPos = p417
Select Case .BufData(.BufPos)
Case 32, 9, 13, 10 ' [ \t\r\n]
.BufPos = .BufPos + 1
Case Else
.BufPos = p417
Exit Do
End Select
End If
Loop
Call pvSetAdvance
End With
End Sub
Private Function Parsestmt() As Boolean
Dim p27 As Long
Dim q27 As Long
Dim p19 As Long
Dim q19 As Long
Dim p24 As Long
Dim q24 As Long
Dim p30 As Long
Dim q30 As Long
With ctx
p27 = .BufPos
q27 = .ThunkPos
If Parsedefinition() Then
p19 = .BufPos
q19 = .ThunkPos
If Not (ParseSEMI()) Then
.BufPos = p19
.ThunkPos = q19
End If
GoTo L3
End If
.BufPos = p27
.ThunkPos = q27
If Parseextern() Then
p24 = .BufPos
q24 = .ThunkPos
If Not (ParseSEMI()) Then
.BufPos = p24
.ThunkPos = q24
End If
GoTo L3
End If
.BufPos = p27
.ThunkPos = q27
If Parseexpr() Then
p30 = .BufPos
q30 = .ThunkPos
If Not (ParseSEMI()) Then
.BufPos = p30
.ThunkPos = q30
End If
GoTo L3
End If
.BufPos = p27
.ThunkPos = q27
If ParseSEMI() Then
GoTo L3
End If
.BufPos = p27
.ThunkPos = q27
Exit Function
L3:
Parsestmt = True
End With
End Function
Private Function Parsedefinition() As Boolean
With ctx
pvPushThunk ucsActVarAlloc, 2
If pvMatchString("def") Then ' "def"
.BufPos = .BufPos + 3
If Parsens() Then
pvPushThunk ucsActResultClear
If Parseprototype() Then
pvPushThunk ucsActVarSet, 1
pvPushThunk ucsActResultClear
If Parseexpr() Then
pvPushThunk ucsActVarSet, 2
pvPushThunk ucsAct_1_definition, .CaptureBegin, .CaptureEnd
pvPushThunk ucsActVarAlloc, -2
Call pvSetAdvance
Parsedefinition = True
End If
End If
End If
End If
End With
End Function
Private Function ParseSEMI() As Boolean
With ctx
If .BufData(.BufPos) = 59 Then ' ";"
.BufPos = .BufPos + 1
Call Parse_
Call pvSetAdvance
ParseSEMI = True
End If
End With
End Function
Private Function Parseextern() As Boolean
With ctx
pvPushThunk ucsActVarAlloc, 1
If pvMatchString("extern") Then ' "extern"
.BufPos = .BufPos + 6
If Parsens() Then
pvPushThunk ucsActResultClear
If Parseprototype() Then
pvPushThunk ucsActVarSet, 1
pvPushThunk ucsAct_1_extern, .CaptureBegin, .CaptureEnd
pvPushThunk ucsActVarAlloc, -1
Call pvSetAdvance
Parseextern = True
End If
End If
End If
End With
End Function
Private Function Parseexpr() As Boolean
With ctx
'--- clear min precedence
m_lBinopMinPrec = 0
If Parsebinexpr() Then
Parseexpr = True
End If
End With
End Function
Private Function Parsens() As Boolean
Dim p420 As Long
With ctx
p420 = .BufPos
Select Case .BufData(.BufPos)
Case 97 To 122, 65 To 90, 95, 48 To 57 ' [a-zA-Z_0-9]
'--- do nothing
Case Else
.BufPos = p420
Call Parse_
Call pvSetAdvance
Parsens = True
End Select
End With
End Function
Private Function Parseprototype() As Boolean
Dim p79 As Long
Dim q79 As Long
Dim p82 As Long
Dim q82 As Long
Dim e82 As String
With ctx
pvPushThunk ucsActVarAlloc, 2
p79 = .BufPos
q79 = .ThunkPos
If Parsebinopproto() Then
GoTo L15
End If
.BufPos = p79
.ThunkPos = q79
If pvMatchString("unary") Then ' "unary"
.BufPos = .BufPos + 5
If Parsens() Then
pvPushThunk ucsActResultClear
If ParseUNOP() Then
pvPushThunk ucsActVarSet, 1
If ParseLPAREN() Then
pvPushThunk ucsActResultClear
If Parseparam_list() Then
pvPushThunk ucsActVarSet, 2
If ParseRPAREN() Then
pvPushThunk ucsAct_1_prototype, .CaptureBegin, .CaptureEnd
GoTo L15
End If
.BufPos = p79
.ThunkPos = q79
Else
.BufPos = p79
.ThunkPos = q79
End If
Else
.BufPos = p79
.ThunkPos = q79
End If
Else
.BufPos = p79
.ThunkPos = q79
End If
Else
.BufPos = p79
.ThunkPos = q79
End If
End If
p82 = .BufPos
q82 = .ThunkPos
e82 = .LastExpected
If ParseKEYWORD() Then
.BufPos = p79
.ThunkPos = q79
Else
.BufPos = p82
.ThunkPos = q82
.LastExpected = e82
pvPushThunk ucsActResultClear
If ParseIDENT() Then
pvPushThunk ucsActVarSet, 1
If ParseLPAREN() Then
pvPushThunk ucsActResultClear
If Parseparam_list() Then
pvPushThunk ucsActVarSet, 2
If ParseRPAREN() Then
pvPushThunk ucsAct_2_prototype, .CaptureBegin, .CaptureEnd
GoTo L15
End If
.BufPos = p79
.ThunkPos = q79
Else
.BufPos = p79
.ThunkPos = q79
End If
Else
.BufPos = p79
.ThunkPos = q79
End If
Else
.BufPos = p79
.ThunkPos = q79
End If
End If
Exit Function
L15:
pvPushThunk ucsActVarAlloc, -2
Call pvSetAdvance
Parseprototype = True
End With
End Function
Private Function Parsebinopproto() As Boolean
With ctx
pvPushThunk ucsActVarAlloc, 3
Dim sBinOp As String
Dim lOpPrec As Long
Dim lOpAssoc As Long
If pvMatchString("binary") Then ' "binary"
.BufPos = .BufPos + 6
If Parsens() Then
pvPushThunk ucsActResultClear
If ParseBINOP() Then
pvPushThunk ucsActVarSet, 1
'-- collect local binop info for use on success
sBinOp = Mid$(.Contents, .CaptureBegin + 1, .CaptureEnd - .CaptureBegin)
pvPushThunk ucsActResultClear
If ParseNUMBER() Then
pvPushThunk ucsActVarSet, 2
lOpPrec = C_Lng(Mid$(.Contents, .CaptureBegin + 1, .CaptureEnd - .CaptureBegin))
lOpAssoc = 1
If ParseLPAREN() Then
pvPushThunk ucsActResultClear
If Parseparam_list() Then
pvPushThunk ucsActVarSet, 3
If ParseRPAREN() Then
'--- on match immediately update parser binop info
SetBinopInfo sBinOp, lOpPrec, lOpAssoc
pvPushThunk ucsAct_1_binopproto, .CaptureBegin, .CaptureEnd
pvPushThunk ucsActVarAlloc, -3
Call pvSetAdvance
Parsebinopproto = True
End If
End If
End If
End If
End If
End If
End If
End With
End Function
Private Function ParseUNOP() As Boolean
Dim lCaptureBegin As Long
Dim lCaptureEnd As Long
With ctx
lCaptureBegin = .BufPos
Select Case .BufData(.BufPos)
Case 45, 43, 33, 126 ' [-+!~]
.BufPos = .BufPos + 1
lCaptureEnd = .BufPos
.CaptureBegin = lCaptureBegin
.CaptureEnd = lCaptureEnd
pvPushThunk ucsAct_1_UNOP, lCaptureBegin, lCaptureEnd
Call pvSetAdvance
ParseUNOP = True
End Select
End With
End Function
Private Function ParseLPAREN() As Boolean
With ctx
If .BufData(.BufPos) = 40 Then ' "("
.BufPos = .BufPos + 1
Call Parse_
Call pvSetAdvance
ParseLPAREN = True
End If
End With
End Function
Private Function Parseparam_list() As Boolean
Dim p271 As Long
Dim q271 As Long
Dim p265 As Long
Dim q265 As Long
With ctx
pvPushThunk ucsActVarAlloc, 2
pvPushThunk ucsActResultClear
If ParseIDENT() Then
pvPushThunk ucsActVarSet, 1
pvPushThunk ucsAct_1_param_list, .CaptureBegin, .CaptureEnd
Do
p271 = .BufPos
q271 = .ThunkPos
p265 = .BufPos
q265 = .ThunkPos
If Not (ParseCOMMA()) Then
.BufPos = p265
.ThunkPos = q265
End If
pvPushThunk ucsActResultClear
If ParseIDENT() Then
pvPushThunk ucsActVarSet, 2
Else
.BufPos = p271
.ThunkPos = q271
Exit Do
End If
pvPushThunk ucsAct_2_param_list, .CaptureBegin, .CaptureEnd
Loop
pvPushThunk ucsAct_3_param_list, .CaptureBegin, .CaptureEnd
pvPushThunk ucsActVarAlloc, -2
Parseparam_list = True
End If
End With
End Function
Private Function ParseRPAREN() As Boolean
With ctx
If .BufData(.BufPos) = 41 Then ' ")"
.BufPos = .BufPos + 1
Call Parse_
Call pvSetAdvance
ParseRPAREN = True
End If
End With
End Function
Private Function ParseKEYWORD() As Boolean
Dim p335 As Long
With ctx
If pvMatchString("def") Then ' "def"
.BufPos = .BufPos + 3
GoTo L25
End If
If pvMatchString("extern") Then ' "extern"
.BufPos = .BufPos + 6
GoTo L25
End If
If .BufData(.BufPos) = 105 And .BufData(.BufPos + 1) = 102 Then ' "if"
.BufPos = .BufPos + 2
GoTo L25
End If
If pvMatchString("then") Then ' "then"
.BufPos = .BufPos + 4
GoTo L25
End If
If pvMatchString("else") Then ' "else"
.BufPos = .BufPos + 4
GoTo L25
End If
If pvMatchString("unary") Then ' "unary"
.BufPos = .BufPos + 5
GoTo L25
End If
If pvMatchString("for") Then ' "for"
.BufPos = .BufPos + 3
GoTo L25
End If
If pvMatchString("binary") Then ' "binary"
.BufPos = .BufPos + 6
GoTo L25
End If
If .BufData(.BufPos) = 105 And .BufData(.BufPos + 1) = 110 Then ' "in"
.BufPos = .BufPos + 2
GoTo L25
End If
If pvMatchString("var") Then ' "var"
.BufPos = .BufPos + 3
GoTo L25
End If
Exit Function
L25:
p335 = .BufPos
Select Case .BufData(.BufPos)
Case 97 To 122, 65 To 90, 95, 48 To 57 ' [a-zA-Z_0-9]
'--- do nothing
Case Else
.BufPos = p335
Call pvSetAdvance
ParseKEYWORD = True
End Select
End With
End Function
Private Function ParseIDENT() As Boolean
Dim lCaptureBegin As Long
Dim lCaptureEnd As Long
With ctx
lCaptureBegin = .BufPos
Select Case .BufData(.BufPos)
Case 97 To 122, 65 To 90, 95 ' [a-zA-Z_]
.BufPos = .BufPos + 1
Do
Select Case .BufData(.BufPos)
Case 97 To 122, 65 To 90, 95, 48 To 57 ' [a-zA-Z_0-9]
.BufPos = .BufPos + 1
Case Else
Exit Do
End Select
Loop
lCaptureEnd = .BufPos
Call Parse_
.CaptureBegin = lCaptureBegin
.CaptureEnd = lCaptureEnd
pvPushThunk ucsAct_1_IDENT, lCaptureBegin, lCaptureEnd
Call pvSetAdvance
ParseIDENT = True
End Select
End With
End Function
Private Function ParseBINOP() As Boolean
Dim lCaptureBegin As Long
Dim lCaptureEnd As Long
With ctx
lCaptureBegin = .BufPos
Select Case .BufData(.BufPos)
Case 45, 43, 42, 47, 60, 62, 61, 58, 124, 38 ' [-+*/<>=:|&]
.BufPos = .BufPos + 1
If .BufData(.BufPos) = 61 Then ' "="
.BufPos = .BufPos + 1
End If
lCaptureEnd = .BufPos
Call Parse_
.CaptureBegin = lCaptureBegin
.CaptureEnd = lCaptureEnd
pvPushThunk ucsAct_1_BINOP, lCaptureBegin, lCaptureEnd
Call pvSetAdvance
ParseBINOP = True
End Select
End With
End Function
Private Function ParseNUMBER() As Boolean
Dim lCaptureBegin As Long
Dim i375 As Long
Dim lCaptureEnd As Long
With ctx
lCaptureBegin = .BufPos
For i375 = 0 To LNG_MAXINT
Select Case .BufData(.BufPos)
Case 48 To 57 ' [0-9]
.BufPos = .BufPos + 1
Case Else
Exit For
End Select
Next
If i375 <> 0 Then
lCaptureEnd = .BufPos
Call Parse_
.CaptureBegin = lCaptureBegin
.CaptureEnd = lCaptureEnd
pvPushThunk ucsAct_1_NUMBER, lCaptureBegin, lCaptureEnd
Call pvSetAdvance
ParseNUMBER = True
End If
End With
End Function
Private Function Parsebinexpr() As Boolean
Dim p133 As Long
Dim q133 As Long
With ctx
pvPushThunk ucsActVarAlloc, 3
Dim lMinPrec As Long
Dim vOpInfo As Variant
lMinPrec = m_lBinopMinPrec
pvPushThunk ucsActResultClear
If Parseunexpr() Then
pvPushThunk ucsActVarSet, 1
Do
p133 = .BufPos
q133 = .ThunkPos
pvPushThunk ucsActResultClear
If ParseBINOP() Then
pvPushThunk ucsActVarSet, 2
Else
.BufPos = p133
.ThunkPos = q133
Exit Do
End If
'--- get current binop prec & assoc
vOpInfo = GetBinopInfo(Mid$(.Contents, .CaptureBegin + 1, .CaptureEnd - .CaptureBegin))
If Not (vOpInfo(0) >= lMinPrec) Then
.BufPos = p133
.ThunkPos = q133
Exit Do
End If
'--- set next min precedence based on binop prec & assoc
m_lBinopMinPrec = vOpInfo(0) + vOpInfo(1)
pvPushThunk ucsActResultClear
If Parsebinexpr() Then
pvPushThunk ucsActVarSet, 3
Else
.BufPos = p133
.ThunkPos = q133
Exit Do
End If
pvPushThunk ucsAct_1_binexpr, .CaptureBegin, .CaptureEnd
Loop
pvPushThunk ucsAct_2_binexpr, .CaptureBegin, .CaptureEnd
pvPushThunk ucsActVarAlloc, -3
Parsebinexpr = True
End If
End With
End Function
Private Function Parseunexpr() As Boolean
Dim p155 As Long
Dim q155 As Long
With ctx
pvPushThunk ucsActVarAlloc, 2
p155 = .BufPos
q155 = .ThunkPos
pvPushThunk ucsActResultClear
If ParseUNOP() Then
pvPushThunk ucsActVarSet, 1
pvPushThunk ucsActResultClear
If Parseunexpr() Then
pvPushThunk ucsActVarSet, 2
pvPushThunk ucsAct_1_unexpr, .CaptureBegin, .CaptureEnd
GoTo L31
End If
.BufPos = p155
.ThunkPos = q155
Else
.BufPos = p155
.ThunkPos = q155
End If
If Parseprimary() Then
GoTo L31
End If
.BufPos = p155
.ThunkPos = q155
Exit Function
L31:
pvPushThunk ucsActVarAlloc, -2
Parseunexpr = True
End With
End Function
Private Function Parseprimary() As Boolean
Dim p162 As Long
Dim q162 As Long
With ctx
p162 = .BufPos
q162 = .ThunkPos
If ParseDOUBLE() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
If ParseLPAREN() Then
If Parseexpr() Then
If ParseRPAREN() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
Else
.BufPos = p162
.ThunkPos = q162
End If
Else
.BufPos = p162
.ThunkPos = q162
End If
If Parseinvokeexpr() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
If Parseifexpr() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
If Parseforexpr() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
If Parsevarexpr() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
If ParseIDENT() Then
GoTo L33
End If
.BufPos = p162
.ThunkPos = q162
Exit Function
L33:
Parseprimary = True
End With
End Function
Private Function ParseDOUBLE() As Boolean
Dim lCaptureBegin As Long
Dim p394 As Long
Dim i382 As Long
Dim i393 As Long
Dim lCaptureEnd As Long
With ctx
lCaptureBegin = .BufPos
p394 = .BufPos
For i382 = 0 To LNG_MAXINT
Select Case .BufData(.BufPos)
Case 48 To 57 ' [0-9]
.BufPos = .BufPos + 1
Case Else
Exit For
End Select
Next
If i382 <> 0 Then
If .BufData(.BufPos) = 46 Then ' "."
.BufPos = .BufPos + 1
End If
Do
Select Case .BufData(.BufPos)
Case 48 To 57 ' [0-9]
.BufPos = .BufPos + 1
Case Else
Exit Do
End Select
Loop
GoTo L36
End If
.BufPos = p394
Do
Select Case .BufData(.BufPos)
Case 48 To 57 ' [0-9]
.BufPos = .BufPos + 1
Case Else
Exit Do