12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411 |
- ' Copyright (c) 2013-2024 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 )
- 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 )
- 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 )
- 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 )
- '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 )
- '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 )
- '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 )
- '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 )
- '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 )
- '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 )
- '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 )
- 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 )
- 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 )
- '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 )
- '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 )
- '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 )
- '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 )
- '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 )
- '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 )
- 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 )
- 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 )
- 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 )
- 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 )
- 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 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 )
- 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 )
- 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 )
- 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 )
- 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 )
- 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 (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 "Enum " + 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
|