forked from bmx-ng/bcc
-
Notifications
You must be signed in to change notification settings - Fork 0
/
parser.bmx
4184 lines (3443 loc) · 106 KB
/
parser.bmx
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
' Copyright (c) 2013-2016 Bruce A Henderson
'
' Based on the public domain Monkey "trans" by Mark Sibly
'
' This software is provided 'as-is', without any express or implied
' warranty. In no event will the authors be held liable for any damages
' arising from the use of this software.
'
' Permission is granted to anyone to use this software for any purpose,
' including commercial applications, and to alter it and redistribute it
' freely, subject to the following restrictions:
'
' 1. The origin of this software must not be misrepresented; you must not
' claim that you wrote the original software. If you use this software
' in a product, an acknowledgment in the product documentation would be
' appreciated but is not required.
'
' 2. Altered source versions must be plainly marked as such, and must not be
' misrepresented as being the original software.
'
' 3. This notice may not be removed or altered from any source
' distribution.
'
SuperStrict
Import BRL.MaxUtil
Import "toker.bmx"
Import "iparser.bmx"
Global FILE_EXT$="bmx"
Type TForEachinStmt Extends TLoopStmt
Field varid$
Field varty:TType
Field varlocal:Int
Field expr:TExpr
Field block:TBlockDecl
Field varExpr:TExpr
Field stmts:TList=New TList
Method Create:TForEachinStmt( varid$,varty:TType,varlocal:Int,expr:TExpr,block:TBlockDecl,loopLabel:TLoopLabelDecl,varExpr:TExpr )
Self.varid=varid
Self.varty=varty
Self.varlocal=varlocal
Self.expr=expr
Self.block=block
block.extra = Self
Self.loopLabel=loopLabel
Self.varExpr = varExpr
Return Self
End Method
Method OnCopy:TStmt( scope:TScopeDecl )
Return New TForEachinStmt.Create( varid,varty,varlocal,expr.Copy(),block.CopyBlock( scope ),TLoopLabelDecl(loopLabel.Copy()), varExpr.Copy() )
End Method
Method OnSemant()
expr=expr.Semant()
If TArrayType( expr.exprType ) Or TStringType( expr.exprType )
Local exprTmp:TLocalDecl=New TLocalDecl.Create( "",Null,expr,,True )
Local indexTmp:TLocalDecl=New TLocalDecl.Create( "",Null,New TConstExpr.Create( New TUIntType,"0" ),,True )
Local lenExpr:TExpr=New TIdentExpr.Create( "Length",New TVarExpr.Create( exprTmp ) )
Local cmpExpr:TExpr=New TBinaryCompareExpr.Create( "<",New TVarExpr.Create( indexTmp ),lenExpr )
Local indexExpr:TExpr=New TIndexExpr.Create( New TVarExpr.Create( exprTmp ),[New TVarExpr.Create( indexTmp )] )
Local addExpr:TExpr=New TBinaryMathExpr.Create( "+",New TVarExpr.Create( indexTmp ),New TConstExpr.Create( New TIntType,"1" ) )
Local cont:TContinueStmt
If varlocal
' array of object ?
If TArrayType( expr.exprType ) And TObjectType(TArrayType( expr.exprType ).elemType) And (Not TObjectType(TArrayType( expr.exprType ).elemType).classdecl.IsExtern() ..
Or (TObjectType(TArrayType( expr.exprType ).elemType).classdecl.IsExtern() ..
And IsPointerType(TArrayType( expr.exprType ).elemType))) Then
Local cExpr:TExpr
If TIdentType(varty) And TIdentType(varty).ident = "Object" Then
cExpr = indexExpr
Else
cExpr = New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT )
End If
' local variable
Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,cExpr )
' local var as expression
Local expr:TExpr=New TVarExpr.Create( varTmp )
' var = Null
expr=New TBinaryCompareExpr.Create( "=",expr, New TNullExpr.Create(TType.nullObjectType))
' then continue
Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
cont = New TContinueStmt
thenBlock.AddStmt cont
block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr )
block.stmts.AddFirst New TDeclStmt.Create( varTmp )
Else
Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,indexExpr )
block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr, True )
block.stmts.AddFirst New TDeclStmt.Create( varTmp, True )
End If
Else
If TArrayType( expr.exprType ) And TObjectType(TArrayType( expr.exprType ).elemType) Then
' var = Null
If Not varty Then
varExpr = varExpr.Semant()
varty = varExpr.exprType
'Local decl:TValDecl = block.scope.FindValDecl(varid.ToLower())
'If decl Then
' decl.Semant()
'
' varty = decl.ty.Copy()
'End If
End If
' expr=New TBinaryCompareExpr.Create( "=",New TIdentExpr.Create( varid ), New TNullExpr.Create(TType.nullObjectType))
expr=New TBinaryCompareExpr.Create( "=",varExpr, New TNullExpr.Create(TType.nullObjectType))
' then continue
Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
cont = New TContinueStmt
thenBlock.AddStmt cont
block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
'block.stmts.AddFirst New TDeclStmt.Create( varTmp )
block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr, True )
' block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT ), True )
block.stmts.AddFirst New TAssignStmt.Create( "=",varExpr,New TCastExpr.Create( varty, indexExpr,CAST_EXPLICIT ), True )
Else
block.stmts.AddFirst New TAssignStmt.Create( "=",New TVarExpr.Create( indexTmp ),addExpr, True )
' block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),indexExpr, True )
block.stmts.AddFirst New TAssignStmt.Create( "=",varExpr,indexExpr, True )
End If
EndIf
Local whileStmt:TWhileStmt=New TWhileStmt.Create( cmpExpr,block,loopLabel, True )
block=New TBlockDecl.Create( block.scope, True )
block.AddStmt New TDeclStmt.Create( exprTmp, True )
block.AddStmt New TDeclStmt.Create( indexTmp, True )
block.AddStmt whileStmt
If cont Then
cont.loop = whileStmt
End If
Else If TObjectType( expr.exprType )
Local tmpDecl:TDeclStmt
If TInvokeExpr(expr) Or TInvokeMemberExpr(expr) Then
Local tmpVar:TLocalDecl=New TLocalDecl.Create( "",expr.exprType,expr,,True )
tmpVar.Semant()
tmpDecl = New TDeclStmt.Create( tmpVar, True )
expr = New TVarExpr.Create( tmpVar )
End If
Local enumerInit:TExpr=New TFuncCallExpr.Create( New TIdentExpr.Create( "ObjectEnumerator",expr ) )
Local enumerTmp:TLocalDecl=New TLocalDecl.Create( "",Null,enumerInit,,True )
Local hasNextExpr:TExpr=New TFuncCallExpr.Create( New TIdentExpr.Create( "HasNext",New TVarExpr.Create( enumerTmp ) ) )
Local nextObjExpr:TExpr=New TFuncCallExpr.Create( New TIdentExpr.Create( "NextObject",New TVarExpr.Create( enumerTmp ) ) )
Local cont:TContinueStmt
If varlocal
' Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,nextObjExpr )
' block.stmts.AddFirst New TDeclStmt.Create( varTmp )
Local cExpr:TExpr
If TIdentType(varty) And TIdentType(varty).ident = "Object" Then
cExpr = nextObjExpr
Else
cExpr = New TCastExpr.Create( varty, nextObjExpr,CAST_EXPLICIT )
End If
' local variable
Local varTmp:TLocalDecl=New TLocalDecl.Create( varid,varty,cExpr)
' local var as expression
Local expr:TExpr=New TVarExpr.Create( varTmp )
' var = Null
expr=New TBinaryCompareExpr.Create( "=",expr, New TNullExpr.Create(TType.nullObjectType))
' then continue
Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True )
Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope, True )
cont = New TContinueStmt.Create(Null, True)
thenBlock.AddStmt cont
block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock, True )
block.stmts.AddFirst New TDeclStmt.Create( varTmp, True )
Else
If Not varty Then
varExpr = varExpr.Semant()
varty = varExpr.exprType
End If
' If Not varty Then
' Local decl:TValDecl = block.scope.FindValDecl(varid.ToLower())
'
' If decl Then
' decl.Semant()
'
' varty = decl.ty.Copy()
' End If
' End If
' var = Null
' Local expr:TExpr=New TBinaryCompareExpr.Create( "=",New TIdentExpr.Create( varid ), New TNullExpr.Create(TType.nullObjectType))
Local expr:TExpr=New TBinaryCompareExpr.Create( "=",varExpr, New TNullExpr.Create(TType.nullObjectType))
' then continue
Local thenBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
Local elseBlock:TBlockDecl=New TBlockDecl.Create( block.scope )
cont = New TContinueStmt
thenBlock.AddStmt cont
block.stmts.AddFirst New TIfStmt.Create( expr,thenBlock,elseBlock )
'block.stmts.AddFirst New TDeclStmt.Create( varTmp )
' block.stmts.AddFirst New TAssignStmt.Create( "=",New TIdentExpr.Create( varid ),New TCastExpr.Create( varty, nextObjExpr,CAST_EXPLICIT ))
block.stmts.AddFirst New TAssignStmt.Create( "=",varExpr,New TCastExpr.Create( varty, nextObjExpr,CAST_EXPLICIT ))
EndIf
Local whileStmt:TWhileStmt=New TWhileStmt.Create( hasNextExpr,block, loopLabel, True )
block=New TBlockDecl.Create( block.scope, True )
If tmpDecl Then
block.AddStmt tmpDecl
End If
block.AddStmt New TDeclStmt.Create( enumerTmp, True )
block.AddStmt whileStmt
If cont Then
cont.loop = whileStmt
End If
Else
InternalErr
EndIf
block.Semant
End Method
Method Trans$()
_trans.EmitBlock block
End Method
End Type
Type TIncbin
Field file:String
Field path:String
Field id:Int
Field length:Int
Global count:Int
Method Create:TIncbin(file:String, source:String)
count :+ 1
Self.file = file
' find the file
If Not FileType(file) Then
' maybe relative to source
Local dir:String = ExtractDir(source) + "/" + file
If FileType(dir) = FILETYPE_FILE Then
path = RealPath(dir)
Else
Return Null
End If
Else
path = RealPath(file)
End If
id = count
Return Self
End Method
End Type
'***** Parser *****
Type TParser
Field _toker:TToker
Field _toke:String
Field _tokeType:Int
'Ronny: _tokerStack is unused
'Field _tokerStack:TList=New TList'<TToker>
Field _block:TBlockDecl
Field _blockStack:TList=New TList'<TBlockDecl>
Field _errStack:TStringList=New TStringList
Field _app:TAppDecl
Field _module:TModuleDecl
Field _externCasts:TMap = New TMap
Method SetErr(toker:TToker = Null)
Local t:TToker = _toker
If toker Then
t = toker
End If
If t.Path()
_errInfo=FormatError(t.Path(),t.Line(),0)
EndIf
End Method
Method DoErr(error:String, toker:TToker = Null)
SetErr(toker)
Err error
End Method
Method PushBlock( block:TBlockDecl )
If _block <> Null Then
_blockStack.AddLast _block
End If
_errStack.AddLast _errInfo
_block=block
End Method
Method PopBlock()
_block=TBlockDecl(_blockStack.RemoveLast())
_errInfo=String(_errStack.RemoveLast())
End Method
Method RealPath$( path$ )
Local popDir$=CurrentDir()
ChangeDir ExtractDir( _toker.Path() )
path=BRL.FileSystem.RealPath( path )
ChangeDir popDir
Return path
End Method
Method ActualPath:String(path:String)
Local dir:String = ExtractDir(path)
Local origFile:String = StripDir(path)
Local lowerFile:String = origFile.ToLower()
Local actualDir:String = ExtractDir(RealPath(path))
Local files:String[] = LoadDir(actualDir)
For Local file:String = EachIn files
If file.ToLower() = lowerFile Then
If file <> origFile Then
' we could raise as a warning instead, but an error encourages the user to fix their code ;-)
Err "Actual file '" + file + "' differs in case with import '" + origFile + "'"
' what we might do were we to warn instead...
If dir Then
Return dir + "/" + file
Else
Return file
End If
End If
Exit
End If
Next
Return path
End Method
Method NextToke$()
Local toke$=_toke
Repeat
_toke=_toker.NextToke()
_tokeType=_toker.TokeType()
Until _tokeType<>TOKE_SPACE
If _tokeType=TOKE_KEYWORD _toke=_toker._tokeLower
If toke="," SkipEols
Return _toke
End Method
Method NextTokeToker$(toker:TToker)
' Local toke$=toker._toke
Repeat
toker.NextToke()
Until toker.tokeType()<>TOKE_SPACE
Return toker._toke
End Method
Method DescribeToke:String( toke:String )
Select toke
Case "~n"
Return "end-of-line"
End Select
Return toke
End Method
Method CParse:Int( toke$ )
If _toke.ToLower()<>toke
Return False
EndIf
NextToke
Return True
End Method
Method CParseToker:Int( toker:TToker, toke$ )
If toker._toke.ToLower()<>toke
Return False
EndIf
NextTokeToker(toker)
Return True
End Method
Method Parse( toke$ )
If Not CParse( toke )
DoErr "Syntax error - expecting '"+toke+"'."
EndIf
End Method
Method ParseToker( toker:TToker, toke$ )
If Not CParseToker( toker, toke )
DoErr "Syntax error - expecting '"+toke+"'.", toker
EndIf
End Method
Method AtEos:Int()
Return _toke="" Or _toke=";" Or _toke="~n" Or _toke="else"
End Method
Method SkipEols()
While CParse( "~n" ) Or CParse(";")
Wend
SetErr
End Method
Method SkipEolsToker(toker:TToker)
While CParseToker( toker, "~n" )
Wend
SetErr
End Method
Method ParseStringLit$()
If _tokeType<>TOKE_STRINGLIT Err "Expecting string literal."
Local str$=BmxUnquote( _toke )
NextToke
Return str
End Method
Method ParseIdent$()
Select _toke
Case "@" NextToke
Case "string","object", "self"
Default
If _tokeType<>TOKE_IDENT Err "Syntax error - expecting identifier."
End Select
Local id$=_toke
NextToke
Return id
End Method
Method ParseIdentType:TIdentType()
Local id$=ParseIdent()
'DebugLog "ParseIdentType : " + id
If CParse( "." ) id:+"."+ParseIdent()
If CParse( "." ) id:+"."+ParseIdent()
Local args:TIdentType[]
If CParse( "<" )
Local nargs:Int
Repeat
Local arg:TIdentType=ParseIdentType()
If args.Length=nargs args=args+ New TIdentType[10]
args[nargs]=arg
nargs:+1
Until Not CParse(",")
args=args[..nargs]
Parse ">"
EndIf
Return New TIdentType.Create( id,args )
End Method
Method CParseIdentType:TIdentType( inner:Int=False )
If _tokeType<>TOKE_IDENT Return Null
Local id$=ParseIdent()
While CParse( "." )
If _tokeType<>TOKE_IDENT Return Null
id:+"."+ParseIdent()
Wend
If Not CParse( "<" )
If inner Return New TIdentType.Create( id,Null )
Return Null
EndIf
Local args:TType[]
Local nargs:Int
Repeat
Local arg:TType=CParsePrimitiveType()
If Not arg
arg=CParseIdentType( True )
If Not arg Return Null
EndIf
While IsArrayDef()
arg = ParseArrayType(arg)
Wend
' While CParse( "[]" )
' arg=arg.ArrayOf()
' Wend
args = args + [arg]
nargs :+ 1
Until Not CParse(",")
If Not CParse( ">" ) Return Null
Return New TIdentType.Create( id,args )
End Method
Method CParsePrimitiveType:TType()
If CParse( "string" ) Return TType.stringType
If CParse( "object" ) Return New TIdentType.Create( "brl.classes.object" )
Local ty:TType
If CParse( "short" )
ty = New TShortType
Else If CParse( "byte" )
ty = New TByteType
Else If CParse( "int" )
ty = New TIntType
Else If CParse( "uint" )
ty = New TUIntType
Else If CParse( "float" )
ty = New TFloatType
Else If CParse( "long" )
ty = New TLongType
Else If CParse( "ulong" )
ty = New TULongType
Else If CParse( "double" )
ty = New TDoubleType
Else If CParse( "size_t" )
ty = New TSizeTType
Else If CParse( "int128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
ty = New TInt128Type
Else If CParse( "float128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
ty = New TFloat128Type
Else If CParse( "double128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
ty = New TDouble128Type
Else If CParse( "float64" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
ty = New TFloat64Type
Else If CParse( "wparam" ) Then
If opt_platform <> "win32" Err "WParam types only available on Win32"
ty = New TWParamType
Else If CParse( "lparam" ) Then
If opt_platform <> "win32" Err "LParam types only available on Win32"
ty = New TLParamType
End If
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Return ty
End Method
Method CParsePrimitiveNumberType:TType()
If CParse( "short" ) Return New TShortType
If CParse( "byte" ) Return New TByteType
If CParse( "int" ) Return New TIntType
If CParse( "uint" ) Return New TUIntType
If CParse( "float" ) Return New TFloatType
If CParse( "long" ) Return New TLongType
If CParse( "ulong" ) Return New TULongType
If CParse( "double" ) Return New TDoubleType
If CParse( "size_t" ) Return New TSizeTType
If CParse( "int128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TInt128Type
End If
If CParse( "float128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TFloat128Type
End If
If CParse( "double128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TDouble128Type
End If
If CParse( "float64" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TFloat64Type
End If
If CParse( "wparam" ) Then
If opt_platform <> "win32" Err "WParam types only available on Win32"
Return New TWParamType
End If
If CParse( "lparam" ) Then
If opt_platform <> "win32" Err "LParam types only available on Win32"
Return New TLParamType
End If
End Method
Method ParseNewType:TType()
If CParse( "void" ) Return New TVoidType
If CParse( "short" ) Return New TShortType
If CParse( "byte" ) Return New TByteType
If CParse( "int" ) Return New TIntType
If CParse( "uint" ) Return New TUIntType
If CParse( "float" ) Return New TFloatType
If CParse( "string" ) Return TType.stringType
If CParse( "object" ) Return New TIdentType.Create( "brl.classes.object" )
If CParse( "long" ) Return New TLongType
If CParse( "ulong" ) Return New TULongType
If CParse( "double" ) Return New TDoubleType
If CParse( "size_t" ) Return New TSizeTType
If CParse( "int128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TInt128Type
End If
If CParse( "float128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TFloat128Type
End If
If CParse( "double128" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TDouble128Type
End If
If CParse( "float64" ) Then
If opt_arch <> "x64" Err "Intrinsic types only available on x64"
Return New TFloat64Type
End If
If CParse( "wparam" ) Then
If opt_platform <> "win32" Err "WParam types only available on Win32"
Return New TWParamType
End If
If CParse( "lparam" ) Then
If opt_platform <> "win32" Err "LParam types only available on Win32"
Return New TLParamType
End If
Return ParseIdentType()
End Method
Method ParseType:TType()
Local ty:TType=CParsePrimitiveType()
If ty Return ty
Return ParseIdentType()
End Method
Method ParseConstNumberType:TType()
Local ty:TType
Select _toke
Case "@"
NextToke
ty=New TByteType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "@@"
NextToke
ty=New TShortType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "%"
NextToke
ty=New TIntType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "#"
NextToke
ty=New TFloatType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "$"
NextToke
ty=New TStringType
Case "!"
NextToke
ty=New TDoubleType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "%%"
NextToke
ty=New TLongType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case ":"
NextToke
ty=CParsePrimitiveNumberType()
If Not ty Then
If CParse("string") Then
ty=New TStringType
Else
ty = ParseIdentType()
End If
Else
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
End If
End Select
While IsArrayDef()
ty = ParseArrayType(ty)
Wend
'While CParse( "[]" )
' ty=New TArrayType.Create( ty )
'Wend
Return ty
End Method
Method ParseDeclType:TType()
Local ty:TType
Select _toke
Case "@"
NextToke
ty=New TByteType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "@@"
NextToke
ty=New TShortType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "%"
NextToke
ty=New TIntType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "%%"
NextToke
ty=New TLongType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case "#"
NextToke
ty=New TFloatType
If CParse("ptr") Then
ty = TType.MapToPointerType(ty)
End If
Case "$"
NextToke
ty=New TStringType
If CParse("z") Then
ty._flags :| TType.T_CHAR_PTR
Else If CParse("w") Then
ty._flags :| TType.T_SHORT_PTR
End If
Case "!"
NextToke
ty=New TDoubleType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
Case ":"
NextToke
ty=ParseType()
If CParse("ptr") Then
' FIXME #200
'If TStringType(ty) = Null And (TObjectType(ty) = Null Or (TObjectType(ty) <> Null And TObjectType(ty).classDecl.IsExtern())) And TArrayType(ty) = Null Then
ty = TType.MapToPointerType(ty)
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
'Else
' ty = Null
'End If
If Not ty DoErr "Invalid Pointer type."
End If
Case "("
' for Strict code, void will be converted to Int during semanting.
ty=New TVoidType
Default
If _module.IsSuperStrict() Err "Illegal type expression."
ty=New TIntType
While CParse("ptr")
ty = TType.MapToPointerType(ty)
Wend
End Select
' array or function pointer?
Repeat
If (_toke = "[" Or _toke = "[]") And IsArrayDef()
ty = ParseArrayType(ty)
Else If _toke = "(" Then
ty = New TFunctionPtrType.Create(New TFuncDecl.CreateF("", ty, ParseFuncParamDecl(), FUNC_PTR))
Else
Exit
End If
Forever
Return ty
End Method
Method ParseArrayExpr:TArrayExpr()
Parse "["
Local args:TExpr[],nargs:Int
Repeat
Local arg:TExpr=ParseExpr()
If args.Length=nargs args=args + New TExpr[10]
args[nargs]=arg
nargs:+1
Until Not CParse(",")
args=args[..nargs]
Parse "]"
Return New TArrayExpr.Create( args )
End Method
' replaces While CParse( "[]" ) sections, with support for multi-dimension arrays
Method ParseArrayType:TType(ty:TType)
While True
Local dims:Int = 1
If CParse("[]") Then
ty=New TArrayType.Create( ty )
Exit
End If
If Not CParse("[") Then
Exit
End If
While CParse( ",")
dims :+ 1
Wend
Parse "]"
ty=New TArrayType.Create( ty, dims )
Exit
Wend
Return ty
End Method
Method IsArrayDef:Int()
Local isDef:Int = True
Local toker:TToker=New TToker.Copy(_toker)
While True
'Local dims:Int = 1
If CParseToker(toker, "[]") Then
Exit
End If
If Not CParseToker(toker, "[") Then
isDef = False
Exit
End If
While CParseToker(toker, ",")
'dims :+ 1
Wend
If Not CParseToker(toker, "]") Then
isDef = False
Exit
End If
Exit
Wend
Return isDef
End Method
Method ParseArgs:TExpr[]( stmt:Int )
Local args:TExpr[]
If stmt
If AtEos() Return args
Else
If _toke<>"(" Return args
EndIf
Local nargs:Int,eat:Int
If _toke="("
If stmt
Local toker:TToker=New TToker.Copy(_toker),bra:Int=1
Repeat
toker.NextToke
toker.SkipSpace
Select toker.Toke().ToLower()
Case "","else"
Err "Parenthesis mismatch error."
Case "(","["
bra:+1
Case "]",")"
bra:-1
If bra Continue
toker.NextToke
toker.SkipSpace
Select toker.Toke().ToLower()
Case ".","(","[","",";","~n","else"
eat=True
End Select
Exit
Case ","
If bra<>1 Continue
eat=True
Exit
End Select
Forever
Else
eat=True
EndIf
If eat And NextToke()=")"
NextToke
Return args
EndIf
EndIf
Repeat
Local arg:TExpr
If _toke And _toke<>"," arg=ParseExpr()
If args.Length=nargs args=args + New TExpr[10]
args[nargs]=arg
nargs:+1
Until Not CParse(",")
args=args[..nargs]
If eat Parse ")"
Return args
End Method
Method ParsePrimaryExpr:TExpr( stmt:Int )
Local expr:TExpr
Select _toke.ToLower()
Case "("
NextToke
expr=ParseExpr()
Parse ")"
Case "["
expr=ParseArrayExpr()
Case "[]"
NextToke
expr=New TConstExpr.Create( TType.emptyArrayType,"" )
Case "."
expr=New TScopeExpr.Create( _module )
Case "new"
NextToke
If _toke = "(" Then
' call constructor
expr=New TNewExpr.Create( ParseArgs(stmt) )
Else
Local ty:TType=ParseType()
While CParse("ptr")