| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421 |
- ' Copyright (c) 2013-2025 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 "config.bmx"
- Include "translator.bmx"
- Include "decl.bmx"
- Include "expr.bmx"
- Include "stmt.bmx"
- Type TType
- Method ActualType:TType()
- Return Self
- End Method
- Method EqualsType:Int( ty:TType )
- Return False
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- Return EqualsType( ty )
- End Method
-
- Method WidensToType:Int( ty:TType )
- Return False
- End Method
-
- Method DistanceToType:Int(ty:TType)
- Return T_MAX_DISTANCE
- End Method
-
- Method Semant:TType(option:Int = False, callback:TCallback = Null)
- Return Self
- End Method
- Method GetClass:TClassDecl()
- Return Null
- End Method
-
- Method GetClassScope:TScopeDecl()
- Return GetClass()
- End Method
-
- Method ToString$()
- Return "??Type??"
- End Method
-
- Method GetSize:Int()
- Return WORD_SIZE
- End Method
- Method ArrayOf:TArrayType()
- If Not _arrayOf Then
- _arrayOf=New TArrayType.Create( Self )
- End If
- Return _arrayOf
- End Method
- Method OnCopy:TType() Abstract
-
- Global voidType:TVoidType=New TVoidType
- Global emptyArrayType:TArrayType=New TArrayType.Create( voidType )
- Global objectType:TIdentType=New TIdentType.Create( "brl.classes.object" )
- Global nullObjectType:TNullType=New TNullType
- Global stringType:TStringType=New TStringType
- Rem
- bbdoc: map to a pointer type
- End Rem
- Function MapToPointerType:TType(ty:TType)
- If ty = stringType Then
- ty = ty.Copy()
- End If
-
- Local flag:Int = T_POINTER & ty._flags
-
- If flag & T_PTR Then
- ty._flags :~ T_PTR
- ty._flags :| T_PTRPTR
- Return ty
- End If
- If flag & T_PTRPTR Then
- ty._flags :~ T_PTRPTR
- ty._flags :| T_PTRPTRPTR
- Return ty
- End If
- ty._flags :| T_PTR
- Return ty
-
- End Function
- Function MapToVarType:TType(ty:TType)
- If ty = stringType Then
- ty = ty.Copy()
- End If
-
- If Not (ty._flags & T_VAR) Then
- ty._flags :| T_VAR
- Return ty
- End If
-
- ' TODO : error if already mapped?
-
- Return ty
- End Function
- Rem
- bbdoc: map to a var pointer type
- End Rem
- Function MapToVarPointerType:TType(ty:TType)
- If ty = stringType Then
- ty = ty.Copy()
- End If
- If Not (ty._flags & T_VARPTR) Then
- ty._flags :| T_VARPTR
- Return ty
- End If
- Return Null
- End Function
- Rem
- bbdoc: map a var pointer to it's pointer equivalent (strip out var)
- End Rem
- Function MapVarPointerToPointerType:TType(ty:TType)
- If ty = stringType Then
- ty = ty.Copy()
- End If
- If (ty._flags & T_VARPTR) Then
- ty._flags :~ T_VARPTR
-
- Return MapToPointerType(ty)
- End If
- Return ty
- End Function
-
- Function MapPointerToPrim:TType(ty:TNumericType)
- Return MapFromPointer(ty)
- End Function
- Function MapFromPointer:TType(ty:TType)
- Local nty:TType = ty.Copy()
- If ty._flags & T_PTRPTRPTR Then
- nty._flags :~ T_PTRPTRPTR
- nty._flags :| T_PTRPTR
- Else If ty._flags & T_PTRPTR Then
- nty._flags :~ T_PTRPTR
- nty._flags :| T_PTR
- Else If ty._flags & T_PTR Then
- nty._flags :~ T_PTR
- End If
- Return nty
- End Function
- Field _arrayOf:TArrayType
-
- ' one or more of
- ' T_VAR, T_VARPTR, T_PTR, T_PTRPTR, T_PTRPTRPTR
- Field _flags:Int
-
- Const T_VAR:Int = $01
- Const T_VARPTR:Int = $02
- Const T_PTR:Int = $04
- Const T_PTRPTR:Int = $08
- Const T_PTRPTRPTR:Int = $10
- ' for strings
- Const T_CHAR_PTR:Int = $1000
- Const T_SHORT_PTR:Int = $2000
- Const T_POINTER:Int = T_PTR | T_PTRPTR | T_PTRPTRPTR
- Const T_BYTE:Int = $001
- Const T_SHORT:Int = $002
- Const T_INT:Int = $004
- Const T_LONG:Int = $008
- Const T_FLOAT:Int = $010
- Const T_DOUBLE:Int = $020
- Const T_STRING:Int = $040
- Const T_ARRAY:Int = $080
- Const T_FUNCTIONPTR:Int = $100
- Const T_SIZET:Int = $200
- Const T_UINT:Int = $400
- Const T_ULONG:Int = $800
- Const T_FLOAT64:Int = $1000
- Const T_INT128:Int = $2000
- Const T_FLOAT128:Int = $4000
- Const T_DOUBLE128:Int = $8000
- Const T_LPARAM:Int =$10000
- Const T_WPARAM:Int =$20000
- Const T_ENUM:Int =$40000
- Const T_LONGINT:Int =$80000
- Const T_ULONGINT:Int =$100000
- Const T_MAX_DISTANCE:Int = $FFFF
- Method Copy:TType()
- Local ty:TType = OnCopy()
- ty._flags = _flags
- ty._arrayOf = _arrayOf
- Return ty
- End Method
-
- Method ToStringParts:String()
- Local s:String
- If _flags & T_PTR Then
- s:+ " Ptr"
- Else If _flags & T_PTRPTR Then
- s:+ " Ptr Ptr"
- Else If _flags & T_PTRPTRPTR Then
- s:+ " Ptr Ptr Ptr"
- End If
- If _flags & T_VAR Then
- s:+ " Var"
- End If
- If _flags & T_VARPTR Then
- s:+ " VarPtr"
- End If
-
- Return s
- End Method
-
- Method IsFlagEquivalent:Int(ty:TType)
- Return _flags = ty._flags Or ..
- (Not IsPointerType(Self, 0, TType.T_POINTER) And (ty._flags & T_VAR)) Or ..
- (Not IsPointerType(ty, 0, TType.T_POINTER) And (_flags & T_VAR)) Or ..
- (IsPointerType(Self, 0, TType.T_POINTER) And (ty._flags & T_VARPTR)) Or ..
- (IsPointerType(ty, 0, TType.T_POINTER) And (_flags & T_VARPTR))
- End Method
-
- End Type
- Function NewType:TType(kind:Int = 0)
- Local ty:TType
-
- Select kind
- Case TType.T_BYTE
- ty = New TByteType
- Case TType.T_SHORT
- ty = New TShortType
- Case TType.T_INT
- ty = New TIntType
- Case TType.T_UINT
- ty = New TUIntType
- Case TType.T_LONG
- ty = New TLongType
- Case TType.T_ULONG
- ty = New TULongType
- Case TType.T_SIZET
- ty = New TSizeTType
- Case TType.T_INT128
- ty = New TInt128Type
- Case TType.T_FLOAT
- ty = New TFloatType
- Case TType.T_DOUBLE
- ty = New TDoubleType
- Case TType.T_FLOAT64
- ty = New TFloat64Type
- Case TType.T_FLOAT128
- ty = New TFloat128Type
- Case TType.T_DOUBLE128
- ty = New TDouble128Type
- Case TType.T_STRING
- ty = New TStringType
- Case TType.T_ARRAY
- ty = New TArrayType
- Case TType.T_FUNCTIONPTR
- ty = New TFunctionPtrType
- Case TType.T_ENUM
- ty = New TEnumType
- Case TType.T_LONGINT
- ty = New TLongIntType
- Case TType.T_ULONGINT
- ty = New TULongIntType
- Default
- Err "Don't have a pointer type for " + kind
- End Select
- Return ty
- End Function
- Function NewPointerType:TType(kind:Int = 0)
- Local ty:TType = NewType(kind)
- Return TType.MapToPointerType(ty)
- End Function
- Function IsPointerType:Int(ty:TType, kind:Int = 0, pType:Int = TType.T_PTR)
- ' TODO :
- If kind Then
- If IsType(ty, kind) Then
- Return ty._flags & pType
- Else
- Return False
- End If
- Else
- Return ty._flags & pType
- End If
-
- End Function
- Function IsNumericType:Int(ty:TType)
- Return (TNumericType(ty) <> Null) And Not IsPointerType(ty, 0, TType.T_POINTER)
- End Function
- Function IsType:Int(ty:TType, kind:Int)
- Select kind
- Case TType.T_BYTE
- Return TByteType(ty) <> Null
- Case TType.T_SHORT
- Return TShortType(ty) <> Null
- Case TType.T_INT
- Return TIntType(ty) <> Null
- Case TType.T_UINT
- Return TUIntType(ty) <> Null
- Case TType.T_LONG
- Return TLongType(ty) <> Null
- Case TType.T_ULONG
- Return TULongType(ty) <> Null
- Case TType.T_SIZET
- Return TSizeTType(ty) <> Null
- Case TType.T_INT128
- Return TInt128Type(ty) <> Null
- Case TType.T_FLOAT
- Return TFloatType(ty) <> Null
- Case TType.T_DOUBLE
- Return TDoubleType(ty) <> Null
- Case TType.T_FLOAT64
- Return TFloat64Type(ty) <> Null
- Case TType.T_FLOAT128
- Return TFloat128Type(ty) <> Null
- Case TType.T_DOUBLE128
- Return TDouble128Type(ty) <> Null
- Case TType.T_STRING
- Return TStringType(ty) <> Null
- Case TType.T_ARRAY
- Return TArrayType(ty) <> Null
- Case TType.T_FUNCTIONPTR
- Return TFunctionPtrType(ty) <> Null
- Case TType.T_ENUM
- Return TEnumType(ty) <> Null
- Case TType.T_LONGINT
- Return TLongIntType(ty) <> Null
- Case TType.T_ULONGINT
- Return TULongIntType(ty) <> Null
- End Select
- Return False
- End Function
- Type TVoidType Extends TType
- Method EqualsType:Int( ty:TType )
- If opt_issuperstrict Then
- Return TVoidType( ty )<>Null
- Else
- Return TVoidType( ty )<>Null Or TIntType( ty) <> Null
- End If
- End Method
-
- Method ToString$()
- Return "Void"
- End Method
- Method OnCopy:TType()
- Return New TVoidType
- End Method
- End Type
- Type TNullType Extends TType
- Method EqualsType:Int( ty:TType )
- Return False
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- Return True
- End Method
-
- Method ToString$()
- Return "NULL"
- End Method
- Method OnCopy:TType()
- Return New TNullType
- End Method
- End Type
- Type TBoolType Extends TType
- Method EqualsType:Int( ty:TType )
- Return TBoolType( ty )<>Null
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or TBoolType( ty )<>Null Or (Not noExtendString And TStringType( ty )<>Null)
- End Method
- Method WidensToType:Int( ty:TType )
- Return IsNumericType(ty)
- End Method
- Method DistanceToType:Int(ty:TType)
- If TBoolType(ty)<>Null Then
- Return 0
- End If
-
- If TIntType(ty)<>Null Then
- Return 1
- End If
-
- Return 4
- End Method
-
- Method ToString$()
- Return "Bool"
- End Method
- Method GetSize:Int()
- Return 4
- End Method
- Method OnCopy:TType()
- Return New TBoolType
- End Method
- End Type
- Type TNumericType Extends TType
- Method ToPointer:TType()
- Local ty:TType = Copy()
- Return MapToPointerType(ty)
- End Method
-
- End Type
- Type TIntegralType Extends TNumericType
- End Type
- Type TIntType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TIntType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True,,,,SCOPE_CLASS_HEIRARCHY )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) Or (WORD_SIZE=4 And TLParamType(ty)<>Null)
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TIntType(ty)<>Null And (ty._flags & T_VAR)) Or TLongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or (WORD_SIZE=8 And TLParamType(ty)<>Null)
- End Method
-
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TIntType(ty)<>Null Then
- Return 0
- End If
-
- If WORD_SIZE = 4 And TLParamType(ty)<>Null Then
- Return 1
- End If
-
- If TLongType(ty)<>Null Then
- Return 2
- End If
- If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
- Return 3
- End If
-
- If TFloatType(ty)<>Null Then
- Return 4
- End If
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TIntType
- End Method
- Method ToString$()
- Return "Int" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return 4
- End Method
- End Type
- Type TUIntType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TUIntType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TUIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) Or (WORD_SIZE=4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null))
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TUIntType(ty)<>Null And (ty._flags & T_VAR)) Or TIntType(ty)<> Null Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or (WORD_SIZE=8 And TWParamType(ty)<>Null)
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TUIntType(ty)<>Null Then
- Return 0
- End If
- If WORD_SIZE = 4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 1
- End If
-
- If TIntType(ty)<>Null Then
- Return 2
- End If
-
- If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 3
- End If
-
- If TULongType(ty)<>Null Then
- Return 3
- End If
- If TLongType(ty)<>Null Then
- Return 4
- End If
- If TFloatType(ty)<>Null Then
- Return 5
- End If
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TUIntType
- End Method
- Method ToString$()
- Return "UInt" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return 4
- End Method
- End Type
- Type TSizeTType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TSizeTType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TSizeTType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) Or (WORD_SIZE=4 And TUIntType(ty)<>Null) Or (WORD_SIZE=8 And TULongType(ty)<>Null)
- End Method
- Method WidensToType:Int( ty:TType )
- If WORD_SIZE = 4 Then
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or ((TSizeTType(ty)<>Null Or TUIntType(ty)<>Null) And (ty._flags & T_VAR)) Or TIntType(ty)<>Null Or TUIntType(ty)<>Null Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TWParamType(ty)<>Null Or TLParamType(ty)<>Null
- Else
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or ((TSizeTType(ty)<>Null Or TULongType(ty)<>Null) And (ty._flags & T_VAR)) Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TFloat64Type(ty)<>Null Or TWParamType(ty)<>Null Or TLParamType(ty)<>Null
- End If
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TSizeTType(ty)<>Null Then
- Return 0
- End If
- If TWParamType(ty)<>Null Then
- Return 1
- End If
- If WORD_SIZE = 4 Then
- If TUIntType(ty)<>Null Then
- Return 1
- End If
- If TIntType(ty)<>Null Then
- Return 2
- End If
-
- If TLParamType(ty)<>Null Then
- Return 2
- End If
- If TULongType(ty)<>Null Then
- Return 3
- End If
- If TLongType(ty)<>Null Then
- Return 4
- End If
- If TFloatType(ty)<>Null Then
- Return 5
- End If
-
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Else
- If TULongType(ty)<>Null Then
- Return 1
- End If
- If TLongType(ty)<>Null Then
- Return 2
- End If
- If TLParamType(ty)<>Null Then
- Return 2
- End If
- If TFloatType(ty)<>Null Then
- Return 4
- End If
-
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
- If TFloat64Type(ty)<>Null Then
- Return 8
- End If
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TSizeTType
- End Method
- Method ToString$()
- Return "size_t" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return WORD_SIZE
- End Method
- End Type
- Type TByteType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TByteType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If (_flags & T_VARPTR) And (TByteType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TByteVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TByteType(ty)<>Null And (ty._flags & T_VAR)) Or TShortType(ty)<>Null Or TIntType(ty)<>Null Or TUIntType(ty)<>Null Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TWParamType(ty)<>Null Or TLParamType(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TByteType(ty)<>Null Then
- Return 0
- End If
- If TShortType(ty)<>Null Then
- Return 2
- End If
- If WORD_SIZE = 4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 4
- End If
-
- If TUIntType(ty)<>Null Then
- Return 4
- End If
- If TIntType(ty)<>Null Then
- Return 5
- End If
- If WORD_SIZE = 4 And TLParamType(ty)<>Null Then
- Return 5
- End If
-
- If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 6
- End If
-
- If TULongType(ty)<>Null Then
- Return 6
- End If
- If TLongType(ty)<>Null Then
- Return 7
- End If
- If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
- Return 7
- End If
- If TFloatType(ty)<>Null Then
- Return 8
- End If
- If TDoubleType(ty)<>Null Then
- Return 10
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TByteType
- End Method
- Method ToString$()
- Return "Byte" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return 1
- End Method
- End Type
- Type TShortType Extends TIntegralType
- Method EqualsType:Int( ty:TType )
- Return TShortType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TShortType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TShortVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TShortType(ty)<>Null And (ty._flags & T_VAR)) Or TIntType(ty)<>Null Or TUIntType(ty)<>Null Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TWParamType(ty)<>Null Or TLParamType(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TShortType(ty)<>Null Then
- Return 0
- End If
- If WORD_SIZE = 4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 2
- End If
-
- If TUIntType(ty)<>Null Then
- Return 2
- End If
- If TIntType(ty)<>Null Then
- Return 3
- End If
- If WORD_SIZE = 4 And TLParamType(ty)<>Null Then
- Return 3
- End If
-
- If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 4
- End If
- If TULongType(ty)<>Null Then
- Return 4
- End If
- If TLongType(ty)<>Null Then
- Return 5
- End If
- If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
- Return 5
- End If
- If TFloatType(ty)<>Null Then
- Return 6
- End If
- If TDoubleType(ty)<>Null Then
- Return 8
- End If
-
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TShortType
- End Method
- Method ToString$()
- Return "Short" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return 2
- End Method
- End Type
- Type TLongType Extends TIntegralType ' BaH Long
-
- Method EqualsType:Int( ty:TType )
- Return TLongType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TLongType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TLongVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TLongType(ty)<>Null And (ty._flags & T_VAR)) Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TFloat64Type(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TLongType(ty)<>Null Then
- Return 0
- End If
-
- If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
- Return 1
- End If
- If TFloatType(ty)<>Null Then
- Return 2
- End If
- If TDoubleType(ty)<>Null Then
- Return 4
- End If
- If TFloat64Type(ty)<>Null Then
- Return 6
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TLongType
- End Method
- Method ToString$()
- Return "Long" + ToStringParts()
- End Method
- End Type
- Type TULongType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TULongType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TULongType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TLongVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TULongType(ty)<>Null And (ty._flags & T_VAR)) Or TDoubleType(ty)<>Null Or TFloat64Type(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TULongType(ty)<>Null Then
- Return 0
- End If
- If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
- Return 1
- End If
-
- If TLongType(ty)<>Null Then
- Return 2
- End If
- If TFloatType(ty)<>Null Then
- Return 3
- End If
- If TDoubleType(ty)<>Null Then
- Return 4
- End If
- If TFloat64Type(ty)<>Null Then
- Return 6
- End If
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TULongType
- End Method
- Method ToString$()
- Return "ULong" + ToStringParts()
- End Method
- End Type
- Type TLongIntType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TLongIntType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- If _flags & T_VARPTR And (TLongIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) Or (WORD_SIZE=4 And TLParamType(ty)<>Null)
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TLongIntType(ty)<>Null And (ty._flags & T_VAR)) Or TLongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or (WORD_SIZE=8 And TLParamType(ty)<>Null)
- End Method
-
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TLongIntType(ty)<>Null Then
- Return 0
- End If
- Local longIntSize:Int = GetSize()
- If longIntSize = 4 And TIntType(ty)<>Null Then
- Return 1
- End If
- If longIntSize = 4 And TLParamType(ty)<>Null Then
- Return 1
- End If
-
- If longIntSize = 4 And TLongType(ty)<>Null Then
- Return 2
- End If
- If longIntSize = 8 And TLParamType(ty)<>Null Then
- Return 3
- End If
- If longIntSize = 8 And TIntType(ty)<>Null Then
- Return 2
- End If
- If longIntSize = 8 And TLongType(ty)<>Null Then
- Return 1
- End If
- If TFloatType(ty)<>Null Then
- Return 4
- End If
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TLongIntType
- End Method
- Method ToString$()
- Return "LongInt" + ToStringParts()
- End Method
- Method GetSize:Int()
- If WORD_SIZE = 4 Then
- Return 4
- Else
- If opt_platform = "linux" or opt_platform = "macos" Then
- Return 8
- Else
- Return 4
- End If
- End If
- End Method
- End Type
- Type TULongIntType Extends TIntegralType
-
- Method EqualsType:Int( ty:TType )
- Return TULongIntType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- If _flags & T_VARPTR And (TULongIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) Or (WORD_SIZE=4 And TLParamType(ty)<>Null)
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TULongIntType(ty)<>Null And (ty._flags & T_VAR)) Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or (WORD_SIZE=8 And TLParamType(ty)<>Null)
- End Method
-
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TULongIntType(ty)<>Null Then
- Return 0
- End If
- Local longIntSize:Int = GetSize()
- If longIntSize = 4 And TIntType(ty)<>Null Then
- Return 2
- End If
- If longIntSize = 4 And TUIntType(ty)<>Null Then
- Return 1
- End If
- If longIntSize = 4 And TLParamType(ty)<>Null Then
- Return 3
- End If
-
- If longIntSize = 4 And TLongType(ty)<>Null Then
- Return 4
- End If
- If longIntSize = 8 And TLParamType(ty)<>Null Then
- Return 3
- End If
- If longIntSize = 8 And TIntType(ty)<>Null Then
- Return 4
- End If
- If longIntSize = 8 And TUIntType(ty)<>Null Then
- Return 3
- End If
- If longIntSize = 8 And TLongType(ty)<>Null Then
- Return 1
- End If
- If longIntSize = 8 And TULongType(ty)<>Null Then
- Return 2
- End If
- If TFloatType(ty)<>Null Then
- Return 5
- End If
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TULongIntType
- End Method
- Method ToString$()
- Return "ULongInt" + ToStringParts()
- End Method
- Method GetSize:Int()
- If WORD_SIZE = 4 Then
- Return 4
- Else
- If opt_platform = "linux" or opt_platform = "macos" Then
- Return 8
- Else
- Return 4
- End If
- End If
- End Method
- End Type
- Type TDecimalType Extends TNumericType
- End Type
- Type TFloatType Extends TDecimalType
-
- Method EqualsType:Int( ty:TType )
- Return TFloatType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TFloatType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TFloatVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TFloatType(ty)<>Null And (ty._flags & T_VAR)) Or TDoubleType(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TFloatType(ty)<>Null Then
- Return 0
- End If
- If TDoubleType(ty)<>Null Then
- Return 2
- End If
-
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TFloatType
- End Method
-
- Method ToString$()
- Return "Float" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return 4
- End Method
- End Type
- Type TDoubleType Extends TDecimalType
-
- Method EqualsType:Int( ty:TType )
- Return TDoubleType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TDoubleType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TDoubleType(ty)<>Null And (ty._flags & T_VAR))
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TDoubleType(ty)<>Null Then
- Return 0
- End If
-
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TDoubleType
- End Method
- Method ToString$()
- Return "Double" + ToStringParts()
- End Method
- End Type
- Type TIntrinsicType Extends TNumericType
- End Type
- Type TInt128Type Extends TIntrinsicType
-
- Method EqualsType:Int( ty:TType )
- Return TInt128Type( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TLongType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TLongVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TInt128Type(ty)<>Null And (ty._flags & T_VAR)) Or TFloat128Type(ty)<>Null Or TDouble128Type(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TInt128Type(ty)<>Null Then
- Return 0
- End If
- If TFloat128Type(ty)<>Null Then
- Return 2
- End If
- If TDouble128Type(ty)<>Null Then
- Return 4
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TInt128Type
- End Method
- Method ToString$()
- Return "Int128" + ToStringParts()
- End Method
- End Type
- Type TFloat64Type Extends TIntrinsicType
-
- Method EqualsType:Int( ty:TType )
- Return TFloat64Type( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TFloat64Type(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TFloat64Type(ty)<>Null And (ty._flags & T_VAR))
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TFloat64Type(ty)<>Null Then
- Return 0
- End If
-
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TFloat64Type
- End Method
- Method ToString$()
- Return "Float64" + ToStringParts()
- End Method
- End Type
- Type TFloat128Type Extends TIntrinsicType
-
- Method EqualsType:Int( ty:TType )
- Return TFloat128Type( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TFloat128Type(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TFloat128Type(ty)<>Null And (ty._flags & T_VAR)) Or TInt128Type(ty)<>Null Or TDouble128Type(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TFloat128Type(ty)<>Null Then
- Return 0
- End If
- If TDouble128Type(ty)<>Null Then
- Return 2
- End If
-
- If TInt128Type(ty)<>Null Then
- Return 4
- End If
-
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TFloat128Type
- End Method
- Method ToString$()
- Return "Float128" + ToStringParts()
- End Method
- End Type
- Type TDouble128Type Extends TIntrinsicType
-
- Method EqualsType:Int( ty:TType )
- Return TDouble128Type( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- 'If TObjectType( ty )
- ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
- ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
- ' Return ctor And ctor.IsCtor()
- 'EndIf
- If _flags & T_VARPTR And (TDouble128Type(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TDouble128Type(ty)<>Null And (ty._flags & T_VAR)) Or TInt128Type(ty)<>Null Or TFloat128Type(ty)<>Null
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TDouble128Type(ty)<>Null Then
- Return 0
- End If
- If TFloat128Type(ty)<>Null Then
- Return 2
- End If
- If TInt128Type(ty)<>Null Then
- Return 4
- End If
-
- Return T_MAX_DISTANCE
- End Method
- Method OnCopy:TType()
- Return New TDouble128Type
- End Method
- Method ToString$()
- Return "Double128" + ToStringParts()
- End Method
- End Type
- Type TStringType Extends TType
- Field cdecl:TClassDecl
- Method EqualsType:Int( ty:TType )
- Return TStringType( ty )<>Null And (_flags = ty._flags Or (_flags & T_VAR))
- End Method
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- Return EqualsType( ty ) Or (TObjectType( ty ) And TObjectType( ty ).classDecl.ident="Object") Or (TStringType(ty) And (_flags & T_VAR)) ..
- Or (TStringType(ty) And (ty._flags & T_VAR)) Or (TStringType(ty) And (ty._flags & T_CHAR_PTR)) Or (TStringType(ty) And (ty._flags & T_SHORT_PTR)) ..
- Or IsPointerType(ty) Or (TStringType(ty) And (_flags & T_CHAR_PTR)) Or (TStringType(ty) And (_flags & T_SHORT_PTR))
- End Method
- Method GetClass:TClassDecl()
- If cdecl Return cdecl
-
- Local modid$="brl.classes"
- Local mdecl:TModuleDecl=_env.FindModuleDecl( modid )
- If Not mdecl Err "Module '"+modid+"' not found"
- 'clsid=ident[i+1..] ' BaH
- 'DebugStop
- cdecl=TClassDecl(mdecl.FindDecl( "string" ))
- 'Return _env.FindClassDecl( "brl.classes.string" )
- Return cdecl
- End Method
-
- Method Semant:TType(option:Int = 0, callback:TCallback = Null)
- GetClass()
- Return Self
- End Method
- Method OnCopy:TType()
- Local ty:TStringType = New TStringType
- ty.cdecl = cdecl
- If _flags & T_CHAR_PTR Then
- ty._flags :| T_CHAR_PTR
- End If
- If _flags & T_SHORT_PTR Then
- ty._flags :| T_SHORT_PTR
- End If
- Return ty
- End Method
- Method ToString$()
- Return "String" + ToStringParts()
- End Method
-
- Method DistanceToType:Int(ty:TType)
- If TStringType(ty) Then
- Return 0
- End If
-
- ' prefer Object
- If TObjectType(ty)
- If TObjectType(ty).classDecl.ident = "Object" Then
- Return $F
- End If
- End If
- Return T_MAX_DISTANCE
- End Method
-
- End Type
- Type TArrayType Extends TType
- Field elemType:TType
- Field dims:Int
- Field isStatic:Int
- Field length:String
-
- Method Create:TArrayType( elemType:TType, dims:Int = 1, flags:Int = 0, isStatic:Int = False, length:Int = 0 )
- Self.elemType=elemType
- Self.dims = dims
- Self._flags = flags
- Self.isStatic = isStatic
- Self.length = length
- Return Self
- End Method
-
- Method ActualType:TType()
- Local ty:TType=elemType.ActualType()
- If ty=elemType Return Self
- Return New TArrayType.Create( ty )
- End Method
-
- Method EqualsType:Int( ty:TType )
- Local arrayType:TArrayType=TArrayType( ty )
- Return arrayType And elemType.EqualsType( arrayType.elemType ) And dims = arrayType.dims And arrayType.isStatic = isStatic And arrayType.length = length
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- Local arrayType:TArrayType=TArrayType( ty )
- Return (arrayType And dims = arrayType.dims And ..
- (arrayType.isStatic = isStatic And arrayType.length = length) And ..
- ( TVoidType( elemType ) ..
- Or elemType.EqualsType( arrayType.elemType ) ..
- Or ((TObjectType(elemType) Or TStringType(elemType) Or TArrayType(elemType)) And ..
- (elemType.ExtendsType( arrayType.elemType ) ..
- Or (TObjectType(arrayType.elemType) And TObjectType( arrayType.elemType ).classDecl.ident="Object") ..
- ))) ..
- ) ..
- Or IsPointerType(ty, 0, TType.T_POINTER) <> Null Or (TObjectType( ty ) And TObjectType( ty ).classDecl.ident="Object")
- End Method
-
- Method Semant:TType(option:Int = False, callback:TCallback = Null)
- Local ty:TType=elemType.Semant(option, callback)
- If ty<>elemType Return New TArrayType.Create( ty, dims, _flags, isStatic, Int(length) )
- Return Self
- End Method
-
- Method GetClass:TClassDecl()
- 'Return _env.FindClassDecl( "array" )
- Return TClassDecl( _env.FindDecl( "___array" ) )
- End Method
- Method OnCopy:TType()
- Local ty:TArrayType = New TArrayType
- ty.elemType = elemType
- ty.dims = dims
- ty.isStatic = isStatic
- ty.length = length
- Return ty
- End Method
- Method ToString$()
- Local t:String = elemType.ToString()
- If isStatic Then
- t = "Static " + t + " Array[" + length + "]"
- Else
- t :+ " Array"
- End If
- Return t
- End Method
-
- Method DistanceToType:Int(ty:TType)
- If TArrayType(ty) Then
- Return 0
- End If
-
- ' prefer Object
- If TObjectType(ty)
- If TObjectType(ty).classDecl.ident = "Object" Then
- Return $F
- End If
- End If
- Return T_MAX_DISTANCE
- End Method
- End Type
- Type TObjectType Extends TType
- Field classDecl:TClassDecl
- Field instance:Int
-
- Method Create:TObjectType( classDecl:TClassDecl )
- Self.classDecl=classDecl
- Return Self
- End Method
-
- Method ActualType:TType()
- If classDecl.actual=classDecl Return Self
- Return New TObjectType.Create( TClassDecl(classDecl.actual) )
- End Method
-
- Method EqualsType:Int( ty:TType )
- Local objty:TObjectType=TObjectType( ty )
- Return TNullDecl(classDecl) <> Null Or (objty And (classDecl=objty.classDecl) And (Not classDecl.IsStruct() Or IsFlagEquivalent(ty)))' Or classDecl.ExtendsClass( objty.classDecl ))) 'Or TObjectVarPtrType(ty) <> Null
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False )
- If classDecl.IsStruct() Then
- If (_flags & T_VARPTR Or IsPointerType(Self, 0, T_POINTER)) And (TNumericType(ty) <> Null) And IsPointerType(ty, 0, T_POINTER) Then
- Return True
- End If
- Return False
- End If
- Local objty:TObjectType=TObjectType( ty )
- If objty Return classDecl.ExtendsClass( objty.classDecl, ignoreObjectSubclasses )
- If IsPointerType( ty, T_BYTE ) Return True
- End Method
-
- Method GetClass:TClassDecl()
- Return classDecl
- End Method
-
- Method ToString$()
- Return classDecl.ToTypeString() + ToStringParts()
- End Method
- Method OnCopy:TType()
- Local ty:TObjectType = New TObjectType
- ty.classDecl = classDecl
- ty.instance = instance
- Return ty
- End Method
- Method DistanceToType:Int(ty:TType)
- If TObjectType(ty) Then
- If classDecl = TObjectType(ty).classDecl Then
- Return 0
- End If
-
- If classDecl.ExtendsClass(TObjectType(ty).classDecl) Then
- Return $F
- End If
- End If
-
- If classDecl.IsStruct() Then
- If (_flags & T_VARPTR Or IsPointerType(Self, 0, T_POINTER)) And (TNumericType(ty) <> Null) And IsPointerType(ty, 0, T_POINTER) Then
- Return $10
- End If
- End If
- Return T_MAX_DISTANCE
- End Method
- End Type
- Type TClassType Extends TType
- Field classDecl:TClassDecl
- Field instance:Int
-
- Method Create:TClassType( classDecl:TClassDecl )
- Self.classDecl=classDecl
- Return Self
- End Method
- Method GetClass:TClassDecl()
- Return classDecl
- End Method
- Method OnCopy:TType()
- Local ty:TClassType = New TClassType
- ty.classDecl = classDecl
- ty.instance = instance
- Return ty
- End Method
- Method ToString:String()
- Return "Type"
- End Method
-
- End Type
- Type TIdentType Extends TType
- Field ident$
- Field args:TType[]
-
- Method Create:TIdentType( ident$,args:TType[] = Null )
- Self.ident=ident
- If args = Null Then
- Self.args = New TType[0]
- Else
- Self.args=args
- End If
- Return Self
- End Method
-
- Method CopyToDest:TIdentType(dst:TIdentType)
- dst.ident = ident
- dst.args = args
- Return dst
- End Method
- Method CopyToPointer:TIdentType(dst:TIdentType)
- dst = TIdentType(MapToPointerType(dst))
- dst.ident = ident
- dst.args = args
- Return dst
- End Method
-
- Method ActualType:TType()
- InternalErr "TIdentType.ActualType"
- End Method
-
- Method EqualsType:Int( ty:TType )
- InternalErr "TIdentType.EqualsType"
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- InternalErr "TIdentType.ExtendsType"
- End Method
-
- 'Method Semant:TType()
- ' If ident Return New TObjectType.Create( FindClass() )
- ' Return New TObjectType.Create( TClassDecl.nullObjectClass )
- 'End Method
-
-
- Method Semant:TType(ignoreNotFoundError:Int = 0, callback:TCallback = Null)
- 'If ident="IPair" DebugStop
- If Not ident Return TType.nullObjectType
- Local targs:TType[args.Length]
- For Local i:Int=0 Until args.Length
- targs[i]=args[i].Semant(ignoreNotFoundError, callback)
- Next
-
- Local tyid$,ty:TType
- Local i:Int=ident.FindLast( "." )
-
- If i=-1
- tyid=ident.ToLower()
- If tyid = "self" Then
- ' find owning class
- Local scope:TClassDecl = _env.ClassScope()
- If scope Then
- tyid = scope.ident
- ty = New TClassType.Create(scope)
-
- ' test for method scope - self is already an instance
- Local funcScope:TFuncDecl = _env.FuncScope()
- If funcScope.IsAnyMethod() Then
- TClassType(ty).instance = True
- End If
- Else
- Err "'Self' can only be used within methods."
- End If
- End If
-
- If Not ty Then
- ty=_env.FindType( tyid,targs, callback )
- End If
- ' finally scan all modules for it
- If Not ty Then
- For Local mdecl:TModuleDecl = EachIn _appInstance.globalImports.Values()
- ty=mdecl.FindType( tyid,targs, callback )
- If ty Exit
- Next
- Else If TIdentType(ty) Then
- ty = ty.Semant()
- End If
- Else
- Local id:String = ident.ToLower()
- i = id.Find( "." )
-
- ' try scope search first
- tyid=id[..i]
-
- If tyid = "self" Then
- ' find owning class
- Local scope:TClassDecl = _env.ClassScope()
- If scope Then
- tyid = scope.ident
- ty = New TClassType.Create(scope)
-
- ' test for method scope - self is already an instance
- Local funcScope:TFuncDecl = _env.FuncScope()
- If funcScope.IsAnyMethod() Then
- TClassType(ty).instance = True
- End If
- Else
- Err "'Self' can only be used within methods."
- End If
- End If
-
- If Not ty Then
- ty=_env.FindType( tyid,targs, callback )
- End If
-
- If Not ty Then
- i = id.FindLast( "." )
-
- ' try scope search first
- tyid=id[..i]
- ty=_env.FindType( tyid,targs, callback )
- If Not ty Then
- ' no? now try module search
- Local modid$=id[..i]
- Local mdecl:TModuleDecl=_env.FindModuleDecl( modid )
- If Not mdecl Err "Module '"+modid+"' not found"
- tyid=id[i+1..]
- ty=mdecl.FindType( tyid,targs, callback )
- End If
- End If
- EndIf
- If Not ty Then
- If ignoreNotFoundError Then
- Return Null
- End If
- Err "Type '"+tyid+"' not found"
- End If
-
- If (_flags & T_VAR) Then
- If TObjectType(ty) Then
- ty = New TObjectType.Create(TObjectType(ty).classDecl)
- ty._flags :| T_VAR
- Else If TEnumType(ty) Then
- ty = New TEnumType.Create(TEnumType(ty).decl)
- ty._flags :| T_VAR
- Else
- ty = ty.Copy()
- ty._flags :| T_VAR
- End If
- End If
- If (_flags & T_POINTER) And TObjectType(ty) Then
- ' FIXME #200
- 'If Not TObjectType(ty).classDecl.IsExtern() Then
- ' Err "Invalid Pointer type."
- 'End If
- ty = New TObjectType.Create(TObjectType(ty).classDecl)
- ty._flags :| (_flags & T_POINTER)
- End If
-
- Return ty
- End Method
- Method SemantClass:TClassDecl(callback:TCallback = Null)
- Local ty:TObjectType=TObjectType( Semant(False, callback) )
- If Not ty Err "Type is not a class"
- Return ty.classDecl
- End Method
- Method ToString$()
- Local t$
- For Local arg:TIdentType=EachIn args
- If t t:+","
- t:+arg.ToString()
- Next
- If t Return "$"+ident+"<"+t.Replace("$","")+">"
- Return "$"+ident
- End Method
- Method AsString:String()
- Local t:String
- For Local arg:TIdentType=EachIn args
- If t t:+","
- t:+arg.ToString()
- Next
- If t Return ident+"<"+t.Replace("$","")+">"
- Return ident
- End Method
- Method OnCopy:TType()
- Local ty:TIdentType = New TIdentType
- ty.ident = ident
- ty.args = args
- Return ty
- End Method
- End Type
- Type TExternObjectType Extends TType
- Field classDecl:TClassDecl
-
- Method Create:TExternObjectType( classDecl:TClassDecl )
- Self.classDecl=classDecl
- Return Self
- End Method
-
- Method ActualType:TType()
- If classDecl.actual=classDecl Return Self
- Return New TExternObjectType.Create( TClassDecl(classDecl.actual) )
- End Method
-
- Method EqualsType:Int( ty:TType )
- Local objty:TObjectType=TObjectType( ty )
- Return TNullDecl(classDecl) <> Null Or (objty And (classDecl=objty.classDecl Or classDecl.ExtendsClass( objty.classDecl ))) Or TObjectType(ty)
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- Local objty:TObjectType=TObjectType( ty )
- If objty Return classDecl.ExtendsClass( objty.classDecl )
- If IsPointerType( ty, T_BYTE ) Return True
- Local op$
- If TBoolType( ty )
- op="ToBool"
- Else If TIntType( ty )
- op="ToInt"
- Else If TFloatType( ty )
- op="ToFloat"
- Else If TStringType( ty )
- op="ToString"
- Else If TLongType( ty ) ' BaH Long
- op="ToLong"
- Else
- Return False
- EndIf
- Local fdecl:TFuncDecl=GetClass().FindFuncDecl( op,Null,True,,,,SCOPE_CLASS_HEIRARCHY )
- Return fdecl And fdecl.IsMethod() And fdecl.retType.EqualsType( ty )
- End Method
-
- Method GetClass:TClassDecl()
- Return classDecl
- End Method
-
- Method ToString$()
- Return classDecl.ToTypeString()
- End Method
- Method OnCopy:TType()
- Local ty:TExternObjectType = New TExternObjectType
- ty.classDecl = classDecl
- Return ty
- End Method
- End Type
- Type TFunctionPtrType Extends TType
- Field func:TFuncDecl
-
- Method Create:TFunctionPtrType(func:TFuncDecl)
- Self.func = func
- Return Self
- End Method
- Method EqualsType:Int( ty:TType )
- If Not TFunctionPtrType(ty) Then Return False
- ' declared function pointer
- Local tyfunc:TFuncDecl = TFunctionPtrType(ty).func
- If Not tyfunc.retType.EqualsType(func.retType) Then Return False
- If Not (tyfunc.argDecls.Length = func.argDecls.Length) Then Return False
- For Local a:Int = 0 Until func.argDecls.Length
- ' does our arg equal declared arg?
- If Not func.argDecls[a].ty.EqualsType(tyfunc.argDecls[a].ty) Then Return False
- Next
- Return True
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- If TFunctionPtrType( ty )
- ' declared function pointer
- Local tyfunc:TFuncDecl = TFunctionPtrType(ty).func
- If Not func.retType.ExtendsType(tyfunc.retType) Then Return False
- If Not (func.argDecls.Length = tyfunc.argDecls.Length) Then Return False
- For Local a:Int = 0 Until func.argDecls.Length
- ' does declared arg extend our arg?
- If Not tyfunc.argDecls[a].ty.ExtendsType(func.argDecls[a].ty) Then Return False
- Next
- Return True
- EndIf
- Return IsPointerType( ty, 0, T_POINTER )<>Null
- End Method
-
- Method equalsDecl:Int(fdecl:TFuncDecl)
- func.Semant
- fdecl.Semant
-
- ' same number of args?
- If func.argDecls.length <> fdecl.argDecls.length Then
- Return False
- End If
-
- ' same arg types?
- For Local i:Int = 0 Until func.argDecls.length
- If Not func.argDecls[i].ty.equalsType(fdecl.argDecls[i].ty) Return False
- Next
-
- ' same return type?
- If Not func.retType.equalsType(fdecl.retType) Then
- ' if function pointer specifies Int return type, our function can specify void...
- If TIntType(func.retType) And TVoidType(fdecl.retType) Then
- Return True
- End If
- Return False
- End If
-
- Return True
- End Method
-
- Method ToString$()
- Return func.ToTypeString()
- End Method
- Method OnCopy:TType()
- Local ty:TFunctionPtrType = New TFunctionPtrType
- ty.func = func
- Return ty
- End Method
- Method Semant:TType(option:Int = False, callback:TCallback = Null)
- func.Semant()
- Return Self
- End Method
- End Type
- ' a holder during parsing which becomes the "real" var ptr type during semanting
- Type TVarPtrType Extends TType
- Method OnCopy:TType()
- Return New TVarPtrType
- End Method
- End Type
- Type TParamType Extends TIntegralType
- End Type
- Type TWParamType Extends TParamType
- Method EqualsType:Int( ty:TType )
- Return TWParamType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- If _flags & T_VARPTR And (TWParamType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TIntVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- If WORD_SIZE = 4 Then
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or ((TWParamType(ty)<>Null Or TSizeTType(ty)<>Null Or TUIntType(ty)<>Null) And (ty._flags & T_VAR)) Or TIntType(ty)<>Null Or TUIntType(ty)<>Null Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null
- Else
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or ((TWParamType(ty)<>Null Or TSizeTType(ty)<>Null Or TULongType(ty)<>Null) And (ty._flags & T_VAR)) Or TLongType(ty)<>Null Or TULongType(ty)<>Null Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TFloat64Type(ty)<>Null
- End If
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TWParamType(ty)<>Null Then
- Return 0
- End If
- If TSizeTType(ty)<>Null Then
- Return 0
- End If
- If WORD_SIZE = 4 Then
- If TUIntType(ty)<>Null Then
- Return 0
- End If
- If TIntType(ty)<>Null Then
- Return 2
- End If
- If TULongType(ty)<>Null Then
- Return 3
- End If
- If TLongType(ty)<>Null Then
- Return 4
- End If
- If TFloatType(ty)<>Null Then
- Return 5
- End If
-
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Else
- If TULongType(ty)<>Null Then
- Return 0
- End If
- If TLongType(ty)<>Null Then
- Return 2
- End If
- If TFloatType(ty)<>Null Then
- Return 4
- End If
-
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
- If TFloat64Type(ty)<>Null Then
- Return 8
- End If
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TWParamType
- End Method
- Method ToString$()
- Return "WPARAM" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return WORD_SIZE
- End Method
- End Type
- Type TLParamType Extends TParamType
- Method EqualsType:Int( ty:TType )
- Return TLParamType( ty )<>Null And (_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
-
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- If _flags & T_VARPTR And (TLParamType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TIntVarPtrType( ty )<> Null
- End Method
- Method WidensToType:Int( ty:TType )
- If WORD_SIZE = 4 Then
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or ((TIntType(ty)<>Null Or TLParamType(ty)<>Null) And (ty._flags & T_VAR)) Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TFloat64Type(ty)<>Null
- Else
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or ((TLongType(ty)<>Null Or TLParamType(ty)<>Null) And (ty._flags & T_VAR)) Or TFloatType(ty)<>Null Or TDoubleType(ty)<>Null Or TFloat64Type(ty)<>Null
- End If
- End Method
- Method DistanceToType:Int(ty:TType)
- If IsPointerType(ty, 0, T_POINTER) Then
- If IsPointerType(Self, 0, T_POINTER) Then
- Return 0
- Else
- Return T_MAX_DISTANCE
- End If
- End If
- If TLParamType(ty)<>Null Then
- Return 0
- End If
- If WORD_SIZE = 4 Then
-
- If TIntType(ty)<>Null Then
- Return 0
- End If
-
- If TLongType(ty)<>Null Then
- Return 2
- End If
-
- If TFloatType(ty)<>Null Then
- Return 4
- End If
-
- If TDoubleType(ty)<>Null Then
- Return 6
- End If
-
- Else
- If TLongType(ty)<>Null Then
- Return 0
- End If
-
- If TFloatType(ty)<>Null Then
- Return 2
- End If
-
- If TDoubleType(ty)<>Null Then
- Return 4
- End If
-
- If TFloat64Type(ty)<>Null Then
- Return 6
- End If
- End If
-
- Return T_MAX_DISTANCE
- End Method
-
- Method OnCopy:TType()
- Return New TLParamType
- End Method
- Method ToString$()
- Return "LPARAM" + ToStringParts()
- End Method
- Method GetSize:Int()
- Return WORD_SIZE
- End Method
-
- End Type
- Type TEnumType Extends TType
- Field decl:TEnumDecl
-
- Method Create:TEnumType(decl:TEnumDecl)
- Self.decl = decl
- Return Self
- End Method
- Method EqualsType:Int( ty:TType )
- Local ety:TEnumType = TEnumType(ty)
- Return ety And decl = ety.decl And(_flags = ty._flags Or ..
- (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
- End Method
- Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False, ignoreObjectSubclasses:Int = False)
- If _flags & T_VARPTR And (TEnumType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
- Return (widensTest And WidensToType(ty))
- End Method
- Method WidensToType:Int( ty:TType )
- Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TEnumType(ty)<>Null And TEnumType(ty).decl = decl And (ty._flags & T_VAR))
- End Method
-
- Method OnCopy:TType()
- Local ty:TEnumType = New TEnumType
- ty.decl = decl
- Return ty
- End Method
-
- Method IsFlags:Int()
- Return decl.isFlags
- End Method
-
- Method Value:String(ordinal:Int)
- Return decl.values[ordinal].Value()
- End Method
- Method ToString$()
- Return decl.ident ' + " " + ToStringParts()
- End Method
- Method GetClassScope:TScopeDecl()
- Return decl
- End Method
- End Type
- Type TTemplateArg
- Field ident:String
- Field superTy:TType[]
-
- Method ExtendsType(ty:TType)
- If Not superTy Then
- superTy = New TType[0]
- End If
-
- superTy :+ [ty]
- End Method
-
- Method ToString:String()
- Local s:String = ident
- If superTy Then
- s :+ " Extends "
- For Local i:Int = 0 Until superTy.length
- If i Then
- s:+ " And "
- End If
- s :+ superTy[i].ToString()
- Next
- End If
- End Method
- End Type
|