type.bmx 62 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411
  1. ' Copyright (c) 2013-2024 Bruce A Henderson
  2. '
  3. ' Based on the public domain Monkey "trans" by Mark Sibly
  4. '
  5. ' This software is provided 'as-is', without any express or implied
  6. ' warranty. In no event will the authors be held liable for any damages
  7. ' arising from the use of this software.
  8. '
  9. ' Permission is granted to anyone to use this software for any purpose,
  10. ' including commercial applications, and to alter it and redistribute it
  11. ' freely, subject to the following restrictions:
  12. '
  13. ' 1. The origin of this software must not be misrepresented; you must not
  14. ' claim that you wrote the original software. If you use this software
  15. ' in a product, an acknowledgment in the product documentation would be
  16. ' appreciated but is not required.
  17. '
  18. ' 2. Altered source versions must be plainly marked as such, and must not be
  19. ' misrepresented as being the original software.
  20. '
  21. ' 3. This notice may not be removed or altered from any source
  22. ' distribution.
  23. '
  24. SuperStrict
  25. Import "config.bmx"
  26. Include "translator.bmx"
  27. Include "decl.bmx"
  28. Include "expr.bmx"
  29. Include "stmt.bmx"
  30. Type TType
  31. Method ActualType:TType()
  32. Return Self
  33. End Method
  34. Method EqualsType:Int( ty:TType )
  35. Return False
  36. End Method
  37. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  38. Return EqualsType( ty )
  39. End Method
  40. Method WidensToType:Int( ty:TType )
  41. Return False
  42. End Method
  43. Method DistanceToType:Int(ty:TType)
  44. Return T_MAX_DISTANCE
  45. End Method
  46. Method Semant:TType(option:Int = False, callback:TCallback = Null)
  47. Return Self
  48. End Method
  49. Method GetClass:TClassDecl()
  50. Return Null
  51. End Method
  52. Method GetClassScope:TScopeDecl()
  53. Return GetClass()
  54. End Method
  55. Method ToString$()
  56. Return "??Type??"
  57. End Method
  58. Method GetSize:Int()
  59. Return WORD_SIZE
  60. End Method
  61. Method ArrayOf:TArrayType()
  62. If Not _arrayOf Then
  63. _arrayOf=New TArrayType.Create( Self )
  64. End If
  65. Return _arrayOf
  66. End Method
  67. Method OnCopy:TType() Abstract
  68. Global voidType:TVoidType=New TVoidType
  69. Global emptyArrayType:TArrayType=New TArrayType.Create( voidType )
  70. Global objectType:TIdentType=New TIdentType.Create( "brl.classes.object" )
  71. Global nullObjectType:TNullType=New TNullType
  72. Global stringType:TStringType=New TStringType
  73. Rem
  74. bbdoc: map to a pointer type
  75. End Rem
  76. Function MapToPointerType:TType(ty:TType)
  77. If ty = stringType Then
  78. ty = ty.Copy()
  79. End If
  80. Local flag:Int = T_POINTER & ty._flags
  81. If flag & T_PTR Then
  82. ty._flags :~ T_PTR
  83. ty._flags :| T_PTRPTR
  84. Return ty
  85. End If
  86. If flag & T_PTRPTR Then
  87. ty._flags :~ T_PTRPTR
  88. ty._flags :| T_PTRPTRPTR
  89. Return ty
  90. End If
  91. ty._flags :| T_PTR
  92. Return ty
  93. End Function
  94. Function MapToVarType:TType(ty:TType)
  95. If ty = stringType Then
  96. ty = ty.Copy()
  97. End If
  98. If Not (ty._flags & T_VAR) Then
  99. ty._flags :| T_VAR
  100. Return ty
  101. End If
  102. ' TODO : error if already mapped?
  103. Return ty
  104. End Function
  105. Rem
  106. bbdoc: map to a var pointer type
  107. End Rem
  108. Function MapToVarPointerType:TType(ty:TType)
  109. If ty = stringType Then
  110. ty = ty.Copy()
  111. End If
  112. If Not (ty._flags & T_VARPTR) Then
  113. ty._flags :| T_VARPTR
  114. Return ty
  115. End If
  116. Return Null
  117. End Function
  118. Rem
  119. bbdoc: map a var pointer to it's pointer equivalent (strip out var)
  120. End Rem
  121. Function MapVarPointerToPointerType:TType(ty:TType)
  122. If ty = stringType Then
  123. ty = ty.Copy()
  124. End If
  125. If (ty._flags & T_VARPTR) Then
  126. ty._flags :~ T_VARPTR
  127. Return MapToPointerType(ty)
  128. End If
  129. Return ty
  130. End Function
  131. Function MapPointerToPrim:TType(ty:TNumericType)
  132. Return MapFromPointer(ty)
  133. End Function
  134. Function MapFromPointer:TType(ty:TType)
  135. Local nty:TType = ty.Copy()
  136. If ty._flags & T_PTRPTRPTR Then
  137. nty._flags :~ T_PTRPTRPTR
  138. nty._flags :| T_PTRPTR
  139. Else If ty._flags & T_PTRPTR Then
  140. nty._flags :~ T_PTRPTR
  141. nty._flags :| T_PTR
  142. Else If ty._flags & T_PTR Then
  143. nty._flags :~ T_PTR
  144. End If
  145. Return nty
  146. End Function
  147. Field _arrayOf:TArrayType
  148. ' one or more of
  149. ' T_VAR, T_VARPTR, T_PTR, T_PTRPTR, T_PTRPTRPTR
  150. Field _flags:Int
  151. Const T_VAR:Int = $01
  152. Const T_VARPTR:Int = $02
  153. Const T_PTR:Int = $04
  154. Const T_PTRPTR:Int = $08
  155. Const T_PTRPTRPTR:Int = $10
  156. ' for strings
  157. Const T_CHAR_PTR:Int = $1000
  158. Const T_SHORT_PTR:Int = $2000
  159. Const T_POINTER:Int = T_PTR | T_PTRPTR | T_PTRPTRPTR
  160. Const T_BYTE:Int = $001
  161. Const T_SHORT:Int = $002
  162. Const T_INT:Int = $004
  163. Const T_LONG:Int = $008
  164. Const T_FLOAT:Int = $010
  165. Const T_DOUBLE:Int = $020
  166. Const T_STRING:Int = $040
  167. Const T_ARRAY:Int = $080
  168. Const T_FUNCTIONPTR:Int = $100
  169. Const T_SIZET:Int = $200
  170. Const T_UINT:Int = $400
  171. Const T_ULONG:Int = $800
  172. Const T_FLOAT64:Int = $1000
  173. Const T_INT128:Int = $2000
  174. Const T_FLOAT128:Int = $4000
  175. Const T_DOUBLE128:Int = $8000
  176. Const T_LPARAM:Int =$10000
  177. Const T_WPARAM:Int =$20000
  178. Const T_ENUM:Int =$40000
  179. Const T_LONGINT:Int =$80000
  180. Const T_ULONGINT:Int =$100000
  181. Const T_MAX_DISTANCE:Int = $FFFF
  182. Method Copy:TType()
  183. Local ty:TType = OnCopy()
  184. ty._flags = _flags
  185. ty._arrayOf = _arrayOf
  186. Return ty
  187. End Method
  188. Method ToStringParts:String()
  189. Local s:String
  190. If _flags & T_PTR Then
  191. s:+ " Ptr"
  192. Else If _flags & T_PTRPTR Then
  193. s:+ " Ptr Ptr"
  194. Else If _flags & T_PTRPTRPTR Then
  195. s:+ " Ptr Ptr Ptr"
  196. End If
  197. If _flags & T_VAR Then
  198. s:+ " Var"
  199. End If
  200. If _flags & T_VARPTR Then
  201. s:+ " VarPtr"
  202. End If
  203. Return s
  204. End Method
  205. Method IsFlagEquivalent:Int(ty:TType)
  206. Return _flags = ty._flags Or ..
  207. (Not IsPointerType(Self, 0, TType.T_POINTER) And (ty._flags & T_VAR)) Or ..
  208. (Not IsPointerType(ty, 0, TType.T_POINTER) And (_flags & T_VAR)) Or ..
  209. (IsPointerType(Self, 0, TType.T_POINTER) And (ty._flags & T_VARPTR)) Or ..
  210. (IsPointerType(ty, 0, TType.T_POINTER) And (_flags & T_VARPTR))
  211. End Method
  212. End Type
  213. Function NewType:TType(kind:Int = 0)
  214. Local ty:TType
  215. Select kind
  216. Case TType.T_BYTE
  217. ty = New TByteType
  218. Case TType.T_SHORT
  219. ty = New TShortType
  220. Case TType.T_INT
  221. ty = New TIntType
  222. Case TType.T_UINT
  223. ty = New TUIntType
  224. Case TType.T_LONG
  225. ty = New TLongType
  226. Case TType.T_ULONG
  227. ty = New TULongType
  228. Case TType.T_SIZET
  229. ty = New TSizeTType
  230. Case TType.T_INT128
  231. ty = New TInt128Type
  232. Case TType.T_FLOAT
  233. ty = New TFloatType
  234. Case TType.T_DOUBLE
  235. ty = New TDoubleType
  236. Case TType.T_FLOAT64
  237. ty = New TFloat64Type
  238. Case TType.T_FLOAT128
  239. ty = New TFloat128Type
  240. Case TType.T_DOUBLE128
  241. ty = New TDouble128Type
  242. Case TType.T_STRING
  243. ty = New TStringType
  244. Case TType.T_ARRAY
  245. ty = New TArrayType
  246. Case TType.T_FUNCTIONPTR
  247. ty = New TFunctionPtrType
  248. Case TType.T_ENUM
  249. ty = New TEnumType
  250. Case TType.T_LONGINT
  251. ty = New TLongIntType
  252. Case TType.T_ULONGINT
  253. ty = New TULongIntType
  254. Default
  255. Err "Don't have a pointer type for " + kind
  256. End Select
  257. Return ty
  258. End Function
  259. Function NewPointerType:TType(kind:Int = 0)
  260. Local ty:TType = NewType(kind)
  261. Return TType.MapToPointerType(ty)
  262. End Function
  263. Function IsPointerType:Int(ty:TType, kind:Int = 0, pType:Int = TType.T_PTR)
  264. ' TODO :
  265. If kind Then
  266. If IsType(ty, kind) Then
  267. Return ty._flags & pType
  268. Else
  269. Return False
  270. End If
  271. Else
  272. Return ty._flags & pType
  273. End If
  274. End Function
  275. Function IsNumericType:Int(ty:TType)
  276. Return (TNumericType(ty) <> Null) And Not IsPointerType(ty, 0, TType.T_POINTER)
  277. End Function
  278. Function IsType:Int(ty:TType, kind:Int)
  279. Select kind
  280. Case TType.T_BYTE
  281. Return TByteType(ty) <> Null
  282. Case TType.T_SHORT
  283. Return TShortType(ty) <> Null
  284. Case TType.T_INT
  285. Return TIntType(ty) <> Null
  286. Case TType.T_UINT
  287. Return TUIntType(ty) <> Null
  288. Case TType.T_LONG
  289. Return TLongType(ty) <> Null
  290. Case TType.T_ULONG
  291. Return TULongType(ty) <> Null
  292. Case TType.T_SIZET
  293. Return TSizeTType(ty) <> Null
  294. Case TType.T_INT128
  295. Return TInt128Type(ty) <> Null
  296. Case TType.T_FLOAT
  297. Return TFloatType(ty) <> Null
  298. Case TType.T_DOUBLE
  299. Return TDoubleType(ty) <> Null
  300. Case TType.T_FLOAT64
  301. Return TFloat64Type(ty) <> Null
  302. Case TType.T_FLOAT128
  303. Return TFloat128Type(ty) <> Null
  304. Case TType.T_DOUBLE128
  305. Return TDouble128Type(ty) <> Null
  306. Case TType.T_STRING
  307. Return TStringType(ty) <> Null
  308. Case TType.T_ARRAY
  309. Return TArrayType(ty) <> Null
  310. Case TType.T_FUNCTIONPTR
  311. Return TFunctionPtrType(ty) <> Null
  312. Case TType.T_ENUM
  313. Return TEnumType(ty) <> Null
  314. Case TType.T_LONGINT
  315. Return TLongIntType(ty) <> Null
  316. Case TType.T_ULONGINT
  317. Return TULongIntType(ty) <> Null
  318. End Select
  319. Return False
  320. End Function
  321. Type TVoidType Extends TType
  322. Method EqualsType:Int( ty:TType )
  323. If opt_issuperstrict Then
  324. Return TVoidType( ty )<>Null
  325. Else
  326. Return TVoidType( ty )<>Null Or TIntType( ty) <> Null
  327. End If
  328. End Method
  329. Method ToString$()
  330. Return "Void"
  331. End Method
  332. Method OnCopy:TType()
  333. Return New TVoidType
  334. End Method
  335. End Type
  336. Type TNullType Extends TType
  337. Method EqualsType:Int( ty:TType )
  338. Return False
  339. End Method
  340. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  341. Return True
  342. End Method
  343. Method ToString$()
  344. Return "NULL"
  345. End Method
  346. Method OnCopy:TType()
  347. Return New TNullType
  348. End Method
  349. End Type
  350. Type TBoolType Extends TType
  351. Method EqualsType:Int( ty:TType )
  352. Return TBoolType( ty )<>Null
  353. End Method
  354. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  355. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or TBoolType( ty )<>Null Or (Not noExtendString And TStringType( ty )<>Null)
  356. End Method
  357. Method WidensToType:Int( ty:TType )
  358. Return IsNumericType(ty)
  359. End Method
  360. Method DistanceToType:Int(ty:TType)
  361. If TBoolType(ty)<>Null Then
  362. Return 0
  363. End If
  364. If TIntType(ty)<>Null Then
  365. Return 1
  366. End If
  367. Return 4
  368. End Method
  369. Method ToString$()
  370. Return "Bool"
  371. End Method
  372. Method GetSize:Int()
  373. Return 4
  374. End Method
  375. Method OnCopy:TType()
  376. Return New TBoolType
  377. End Method
  378. End Type
  379. Type TNumericType Extends TType
  380. Method ToPointer:TType()
  381. Local ty:TType = Copy()
  382. Return MapToPointerType(ty)
  383. End Method
  384. End Type
  385. Type TIntegralType Extends TNumericType
  386. End Type
  387. Type TIntType Extends TIntegralType
  388. Method EqualsType:Int( ty:TType )
  389. Return TIntType( ty )<>Null And (_flags = ty._flags Or ..
  390. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  391. End Method
  392. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  393. 'If TObjectType( ty )
  394. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  395. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True,,,,SCOPE_CLASS_HEIRARCHY )
  396. ' Return ctor And ctor.IsCtor()
  397. 'EndIf
  398. If _flags & T_VARPTR And (TIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  399. 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)
  400. End Method
  401. Method WidensToType:Int( ty:TType )
  402. 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)
  403. End Method
  404. Method DistanceToType:Int(ty:TType)
  405. If IsPointerType(ty, 0, T_POINTER) Then
  406. If IsPointerType(Self, 0, T_POINTER) Then
  407. Return 0
  408. Else
  409. Return T_MAX_DISTANCE
  410. End If
  411. End If
  412. If TIntType(ty)<>Null Then
  413. Return 0
  414. End If
  415. If WORD_SIZE = 4 And TLParamType(ty)<>Null Then
  416. Return 1
  417. End If
  418. If TLongType(ty)<>Null Then
  419. Return 2
  420. End If
  421. If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
  422. Return 3
  423. End If
  424. If TFloatType(ty)<>Null Then
  425. Return 4
  426. End If
  427. If TDoubleType(ty)<>Null Then
  428. Return 6
  429. End If
  430. Return T_MAX_DISTANCE
  431. End Method
  432. Method OnCopy:TType()
  433. Return New TIntType
  434. End Method
  435. Method ToString$()
  436. Return "Int" + ToStringParts()
  437. End Method
  438. Method GetSize:Int()
  439. Return 4
  440. End Method
  441. End Type
  442. Type TUIntType Extends TIntegralType
  443. Method EqualsType:Int( ty:TType )
  444. Return TUIntType( ty )<>Null And (_flags = ty._flags Or ..
  445. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  446. End Method
  447. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  448. 'If TObjectType( ty )
  449. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  450. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  451. ' Return ctor And ctor.IsCtor()
  452. 'EndIf
  453. If _flags & T_VARPTR And (TUIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  454. 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))
  455. End Method
  456. Method WidensToType:Int( ty:TType )
  457. 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)
  458. End Method
  459. Method DistanceToType:Int(ty:TType)
  460. If IsPointerType(ty, 0, T_POINTER) Then
  461. If IsPointerType(Self, 0, T_POINTER) Then
  462. Return 0
  463. Else
  464. Return T_MAX_DISTANCE
  465. End If
  466. End If
  467. If TUIntType(ty)<>Null Then
  468. Return 0
  469. End If
  470. If WORD_SIZE = 4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  471. Return 1
  472. End If
  473. If TIntType(ty)<>Null Then
  474. Return 2
  475. End If
  476. If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  477. Return 3
  478. End If
  479. If TULongType(ty)<>Null Then
  480. Return 3
  481. End If
  482. If TLongType(ty)<>Null Then
  483. Return 4
  484. End If
  485. If TFloatType(ty)<>Null Then
  486. Return 5
  487. End If
  488. If TDoubleType(ty)<>Null Then
  489. Return 6
  490. End If
  491. Return T_MAX_DISTANCE
  492. End Method
  493. Method OnCopy:TType()
  494. Return New TUIntType
  495. End Method
  496. Method ToString$()
  497. Return "UInt" + ToStringParts()
  498. End Method
  499. Method GetSize:Int()
  500. Return 4
  501. End Method
  502. End Type
  503. Type TSizeTType Extends TIntegralType
  504. Method EqualsType:Int( ty:TType )
  505. Return TSizeTType( ty )<>Null And (_flags = ty._flags Or ..
  506. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  507. End Method
  508. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  509. 'If TObjectType( ty )
  510. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  511. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  512. ' Return ctor And ctor.IsCtor()
  513. 'EndIf
  514. If _flags & T_VARPTR And (TSizeTType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  515. 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)
  516. End Method
  517. Method WidensToType:Int( ty:TType )
  518. If WORD_SIZE = 4 Then
  519. 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
  520. Else
  521. 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
  522. End If
  523. End Method
  524. Method DistanceToType:Int(ty:TType)
  525. If IsPointerType(ty, 0, T_POINTER) Then
  526. If IsPointerType(Self, 0, T_POINTER) Then
  527. Return 0
  528. Else
  529. Return T_MAX_DISTANCE
  530. End If
  531. End If
  532. If TSizeTType(ty)<>Null Then
  533. Return 0
  534. End If
  535. If TWParamType(ty)<>Null Then
  536. Return 1
  537. End If
  538. If WORD_SIZE = 4 Then
  539. If TUIntType(ty)<>Null Then
  540. Return 1
  541. End If
  542. If TIntType(ty)<>Null Then
  543. Return 2
  544. End If
  545. If TLParamType(ty)<>Null Then
  546. Return 2
  547. End If
  548. If TULongType(ty)<>Null Then
  549. Return 3
  550. End If
  551. If TLongType(ty)<>Null Then
  552. Return 4
  553. End If
  554. If TFloatType(ty)<>Null Then
  555. Return 5
  556. End If
  557. If TDoubleType(ty)<>Null Then
  558. Return 6
  559. End If
  560. Else
  561. If TULongType(ty)<>Null Then
  562. Return 1
  563. End If
  564. If TLongType(ty)<>Null Then
  565. Return 2
  566. End If
  567. If TLParamType(ty)<>Null Then
  568. Return 2
  569. End If
  570. If TFloatType(ty)<>Null Then
  571. Return 4
  572. End If
  573. If TDoubleType(ty)<>Null Then
  574. Return 6
  575. End If
  576. If TFloat64Type(ty)<>Null Then
  577. Return 8
  578. End If
  579. End If
  580. Return T_MAX_DISTANCE
  581. End Method
  582. Method OnCopy:TType()
  583. Return New TSizeTType
  584. End Method
  585. Method ToString$()
  586. Return "size_t" + ToStringParts()
  587. End Method
  588. Method GetSize:Int()
  589. Return WORD_SIZE
  590. End Method
  591. End Type
  592. Type TByteType Extends TIntegralType
  593. Method EqualsType:Int( ty:TType )
  594. Return TByteType( ty )<>Null And (_flags = ty._flags Or ..
  595. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  596. End Method
  597. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  598. 'If TObjectType( ty )
  599. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  600. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  601. ' Return ctor And ctor.IsCtor()
  602. 'EndIf
  603. If (_flags & T_VARPTR) And (TByteType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  604. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TByteVarPtrType( ty )<> Null
  605. End Method
  606. Method WidensToType:Int( ty:TType )
  607. 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
  608. End Method
  609. Method DistanceToType:Int(ty:TType)
  610. If IsPointerType(ty, 0, T_POINTER) Then
  611. If IsPointerType(Self, 0, T_POINTER) Then
  612. Return 0
  613. Else
  614. Return T_MAX_DISTANCE
  615. End If
  616. End If
  617. If TByteType(ty)<>Null Then
  618. Return 0
  619. End If
  620. If TShortType(ty)<>Null Then
  621. Return 2
  622. End If
  623. If WORD_SIZE = 4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  624. Return 4
  625. End If
  626. If TUIntType(ty)<>Null Then
  627. Return 4
  628. End If
  629. If TIntType(ty)<>Null Then
  630. Return 5
  631. End If
  632. If WORD_SIZE = 4 And TLParamType(ty)<>Null Then
  633. Return 5
  634. End If
  635. If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  636. Return 6
  637. End If
  638. If TULongType(ty)<>Null Then
  639. Return 6
  640. End If
  641. If TLongType(ty)<>Null Then
  642. Return 7
  643. End If
  644. If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
  645. Return 7
  646. End If
  647. If TFloatType(ty)<>Null Then
  648. Return 8
  649. End If
  650. If TDoubleType(ty)<>Null Then
  651. Return 10
  652. End If
  653. Return T_MAX_DISTANCE
  654. End Method
  655. Method OnCopy:TType()
  656. Return New TByteType
  657. End Method
  658. Method ToString$()
  659. Return "Byte" + ToStringParts()
  660. End Method
  661. Method GetSize:Int()
  662. Return 1
  663. End Method
  664. End Type
  665. Type TShortType Extends TIntegralType
  666. Method EqualsType:Int( ty:TType )
  667. Return TShortType( ty )<>Null And (_flags = ty._flags Or ..
  668. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  669. End Method
  670. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  671. 'If TObjectType( ty )
  672. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  673. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  674. ' Return ctor And ctor.IsCtor()
  675. 'EndIf
  676. If _flags & T_VARPTR And (TShortType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  677. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TShortVarPtrType( ty )<> Null
  678. End Method
  679. Method WidensToType:Int( ty:TType )
  680. 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
  681. End Method
  682. Method DistanceToType:Int(ty:TType)
  683. If IsPointerType(ty, 0, T_POINTER) Then
  684. If IsPointerType(Self, 0, T_POINTER) Then
  685. Return 0
  686. Else
  687. Return T_MAX_DISTANCE
  688. End If
  689. End If
  690. If TShortType(ty)<>Null Then
  691. Return 0
  692. End If
  693. If WORD_SIZE = 4 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  694. Return 2
  695. End If
  696. If TUIntType(ty)<>Null Then
  697. Return 2
  698. End If
  699. If TIntType(ty)<>Null Then
  700. Return 3
  701. End If
  702. If WORD_SIZE = 4 And TLParamType(ty)<>Null Then
  703. Return 3
  704. End If
  705. If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  706. Return 4
  707. End If
  708. If TULongType(ty)<>Null Then
  709. Return 4
  710. End If
  711. If TLongType(ty)<>Null Then
  712. Return 5
  713. End If
  714. If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
  715. Return 5
  716. End If
  717. If TFloatType(ty)<>Null Then
  718. Return 6
  719. End If
  720. If TDoubleType(ty)<>Null Then
  721. Return 8
  722. End If
  723. Return T_MAX_DISTANCE
  724. End Method
  725. Method OnCopy:TType()
  726. Return New TShortType
  727. End Method
  728. Method ToString$()
  729. Return "Short" + ToStringParts()
  730. End Method
  731. Method GetSize:Int()
  732. Return 2
  733. End Method
  734. End Type
  735. Type TLongType Extends TIntegralType ' BaH Long
  736. Method EqualsType:Int( ty:TType )
  737. Return TLongType( ty )<>Null And (_flags = ty._flags Or ..
  738. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  739. End Method
  740. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  741. 'If TObjectType( ty )
  742. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  743. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  744. ' Return ctor And ctor.IsCtor()
  745. 'EndIf
  746. If _flags & T_VARPTR And (TLongType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  747. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TLongVarPtrType( ty )<> Null
  748. End Method
  749. Method WidensToType:Int( ty:TType )
  750. 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
  751. End Method
  752. Method DistanceToType:Int(ty:TType)
  753. If IsPointerType(ty, 0, T_POINTER) Then
  754. If IsPointerType(Self, 0, T_POINTER) Then
  755. Return 0
  756. Else
  757. Return T_MAX_DISTANCE
  758. End If
  759. End If
  760. If TLongType(ty)<>Null Then
  761. Return 0
  762. End If
  763. If WORD_SIZE = 8 And TLParamType(ty)<>Null Then
  764. Return 1
  765. End If
  766. If TFloatType(ty)<>Null Then
  767. Return 2
  768. End If
  769. If TDoubleType(ty)<>Null Then
  770. Return 4
  771. End If
  772. If TFloat64Type(ty)<>Null Then
  773. Return 6
  774. End If
  775. Return T_MAX_DISTANCE
  776. End Method
  777. Method OnCopy:TType()
  778. Return New TLongType
  779. End Method
  780. Method ToString$()
  781. Return "Long" + ToStringParts()
  782. End Method
  783. End Type
  784. Type TULongType Extends TIntegralType
  785. Method EqualsType:Int( ty:TType )
  786. Return TULongType( ty )<>Null And (_flags = ty._flags Or ..
  787. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  788. End Method
  789. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  790. 'If TObjectType( ty )
  791. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  792. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  793. ' Return ctor And ctor.IsCtor()
  794. 'EndIf
  795. If _flags & T_VARPTR And (TULongType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  796. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TLongVarPtrType( ty )<> Null
  797. End Method
  798. Method WidensToType:Int( ty:TType )
  799. 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
  800. End Method
  801. Method DistanceToType:Int(ty:TType)
  802. If IsPointerType(ty, 0, T_POINTER) Then
  803. If IsPointerType(Self, 0, T_POINTER) Then
  804. Return 0
  805. Else
  806. Return T_MAX_DISTANCE
  807. End If
  808. End If
  809. If TULongType(ty)<>Null Then
  810. Return 0
  811. End If
  812. If WORD_SIZE = 8 And (TSizeTType(ty)<>Null Or TWParamType(ty)<>Null) Then
  813. Return 1
  814. End If
  815. If TLongType(ty)<>Null Then
  816. Return 2
  817. End If
  818. If TFloatType(ty)<>Null Then
  819. Return 3
  820. End If
  821. If TDoubleType(ty)<>Null Then
  822. Return 4
  823. End If
  824. If TFloat64Type(ty)<>Null Then
  825. Return 6
  826. End If
  827. Return T_MAX_DISTANCE
  828. End Method
  829. Method OnCopy:TType()
  830. Return New TULongType
  831. End Method
  832. Method ToString$()
  833. Return "ULong" + ToStringParts()
  834. End Method
  835. End Type
  836. Type TLongIntType Extends TIntegralType
  837. Method EqualsType:Int( ty:TType )
  838. Return TLongIntType( ty )<>Null And (_flags = ty._flags Or ..
  839. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  840. End Method
  841. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  842. If _flags & T_VARPTR And (TLongIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  843. 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)
  844. End Method
  845. Method WidensToType:Int( ty:TType )
  846. 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)
  847. End Method
  848. Method DistanceToType:Int(ty:TType)
  849. If IsPointerType(ty, 0, T_POINTER) Then
  850. If IsPointerType(Self, 0, T_POINTER) Then
  851. Return 0
  852. Else
  853. Return T_MAX_DISTANCE
  854. End If
  855. End If
  856. If TLongIntType(ty)<>Null Then
  857. Return 0
  858. End If
  859. Local longIntSize:Int = GetSize()
  860. If longIntSize = 4 And TIntType(ty)<>Null Then
  861. Return 1
  862. End If
  863. If longIntSize = 4 And TLParamType(ty)<>Null Then
  864. Return 1
  865. End If
  866. If longIntSize = 4 And TLongType(ty)<>Null Then
  867. Return 2
  868. End If
  869. If longIntSize = 8 And TLParamType(ty)<>Null Then
  870. Return 3
  871. End If
  872. If longIntSize = 8 And TIntType(ty)<>Null Then
  873. Return 2
  874. End If
  875. If longIntSize = 8 And TLongType(ty)<>Null Then
  876. Return 1
  877. End If
  878. If TFloatType(ty)<>Null Then
  879. Return 4
  880. End If
  881. If TDoubleType(ty)<>Null Then
  882. Return 6
  883. End If
  884. Return T_MAX_DISTANCE
  885. End Method
  886. Method OnCopy:TType()
  887. Return New TLongIntType
  888. End Method
  889. Method ToString$()
  890. Return "LongInt" + ToStringParts()
  891. End Method
  892. Method GetSize:Int()
  893. If WORD_SIZE = 4 Then
  894. Return 4
  895. Else
  896. If opt_platform = "linux" or opt_platform = "macos" Then
  897. Return 8
  898. Else
  899. Return 4
  900. End If
  901. End If
  902. End Method
  903. End Type
  904. Type TULongIntType Extends TIntegralType
  905. Method EqualsType:Int( ty:TType )
  906. Return TULongIntType( ty )<>Null And (_flags = ty._flags Or ..
  907. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  908. End Method
  909. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  910. If _flags & T_VARPTR And (TULongIntType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  911. 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)
  912. End Method
  913. Method WidensToType:Int( ty:TType )
  914. 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)
  915. End Method
  916. Method DistanceToType:Int(ty:TType)
  917. If IsPointerType(ty, 0, T_POINTER) Then
  918. If IsPointerType(Self, 0, T_POINTER) Then
  919. Return 0
  920. Else
  921. Return T_MAX_DISTANCE
  922. End If
  923. End If
  924. If TULongIntType(ty)<>Null Then
  925. Return 0
  926. End If
  927. Local longIntSize:Int = GetSize()
  928. If longIntSize = 4 And TIntType(ty)<>Null Then
  929. Return 2
  930. End If
  931. If longIntSize = 4 And TUIntType(ty)<>Null Then
  932. Return 1
  933. End If
  934. If longIntSize = 4 And TLParamType(ty)<>Null Then
  935. Return 3
  936. End If
  937. If longIntSize = 4 And TLongType(ty)<>Null Then
  938. Return 4
  939. End If
  940. If longIntSize = 8 And TLParamType(ty)<>Null Then
  941. Return 3
  942. End If
  943. If longIntSize = 8 And TIntType(ty)<>Null Then
  944. Return 4
  945. End If
  946. If longIntSize = 8 And TUIntType(ty)<>Null Then
  947. Return 3
  948. End If
  949. If longIntSize = 8 And TLongType(ty)<>Null Then
  950. Return 1
  951. End If
  952. If longIntSize = 8 And TULongType(ty)<>Null Then
  953. Return 2
  954. End If
  955. If TFloatType(ty)<>Null Then
  956. Return 5
  957. End If
  958. If TDoubleType(ty)<>Null Then
  959. Return 6
  960. End If
  961. Return T_MAX_DISTANCE
  962. End Method
  963. Method OnCopy:TType()
  964. Return New TULongIntType
  965. End Method
  966. Method ToString$()
  967. Return "ULongInt" + ToStringParts()
  968. End Method
  969. Method GetSize:Int()
  970. If WORD_SIZE = 4 Then
  971. Return 4
  972. Else
  973. If opt_platform = "linux" or opt_platform = "macos" Then
  974. Return 8
  975. Else
  976. Return 4
  977. End If
  978. End If
  979. End Method
  980. End Type
  981. Type TDecimalType Extends TNumericType
  982. End Type
  983. Type TFloatType Extends TDecimalType
  984. Method EqualsType:Int( ty:TType )
  985. Return TFloatType( ty )<>Null And (_flags = ty._flags Or ..
  986. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  987. End Method
  988. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  989. 'If TObjectType( ty )
  990. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  991. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  992. ' Return ctor And ctor.IsCtor()
  993. 'EndIf
  994. If _flags & T_VARPTR And (TFloatType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  995. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TFloatVarPtrType( ty )<> Null
  996. End Method
  997. Method WidensToType:Int( ty:TType )
  998. 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
  999. End Method
  1000. Method DistanceToType:Int(ty:TType)
  1001. If IsPointerType(ty, 0, T_POINTER) Then
  1002. If IsPointerType(Self, 0, T_POINTER) Then
  1003. Return 0
  1004. Else
  1005. Return T_MAX_DISTANCE
  1006. End If
  1007. End If
  1008. If TFloatType(ty)<>Null Then
  1009. Return 0
  1010. End If
  1011. If TDoubleType(ty)<>Null Then
  1012. Return 2
  1013. End If
  1014. Return T_MAX_DISTANCE
  1015. End Method
  1016. Method OnCopy:TType()
  1017. Return New TFloatType
  1018. End Method
  1019. Method ToString$()
  1020. Return "Float" + ToStringParts()
  1021. End Method
  1022. Method GetSize:Int()
  1023. Return 4
  1024. End Method
  1025. End Type
  1026. Type TDoubleType Extends TDecimalType
  1027. Method EqualsType:Int( ty:TType )
  1028. Return TDoubleType( ty )<>Null And (_flags = ty._flags Or ..
  1029. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1030. End Method
  1031. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1032. 'If TObjectType( ty )
  1033. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  1034. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  1035. ' Return ctor And ctor.IsCtor()
  1036. 'EndIf
  1037. If _flags & T_VARPTR And (TDoubleType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1038. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
  1039. End Method
  1040. Method WidensToType:Int( ty:TType )
  1041. Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TDoubleType(ty)<>Null And (ty._flags & T_VAR))
  1042. End Method
  1043. Method DistanceToType:Int(ty:TType)
  1044. If IsPointerType(ty, 0, T_POINTER) Then
  1045. If IsPointerType(Self, 0, T_POINTER) Then
  1046. Return 0
  1047. Else
  1048. Return T_MAX_DISTANCE
  1049. End If
  1050. End If
  1051. If TDoubleType(ty)<>Null Then
  1052. Return 0
  1053. End If
  1054. Return T_MAX_DISTANCE
  1055. End Method
  1056. Method OnCopy:TType()
  1057. Return New TDoubleType
  1058. End Method
  1059. Method ToString$()
  1060. Return "Double" + ToStringParts()
  1061. End Method
  1062. End Type
  1063. Type TIntrinsicType Extends TNumericType
  1064. End Type
  1065. Type TInt128Type Extends TIntrinsicType
  1066. Method EqualsType:Int( ty:TType )
  1067. Return TInt128Type( ty )<>Null And (_flags = ty._flags Or ..
  1068. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1069. End Method
  1070. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1071. 'If TObjectType( ty )
  1072. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  1073. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  1074. ' Return ctor And ctor.IsCtor()
  1075. 'EndIf
  1076. If _flags & T_VARPTR And (TLongType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1077. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TLongVarPtrType( ty )<> Null
  1078. End Method
  1079. Method WidensToType:Int( ty:TType )
  1080. 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
  1081. End Method
  1082. Method DistanceToType:Int(ty:TType)
  1083. If IsPointerType(ty, 0, T_POINTER) Then
  1084. If IsPointerType(Self, 0, T_POINTER) Then
  1085. Return 0
  1086. Else
  1087. Return T_MAX_DISTANCE
  1088. End If
  1089. End If
  1090. If TInt128Type(ty)<>Null Then
  1091. Return 0
  1092. End If
  1093. If TFloat128Type(ty)<>Null Then
  1094. Return 2
  1095. End If
  1096. If TDouble128Type(ty)<>Null Then
  1097. Return 4
  1098. End If
  1099. Return T_MAX_DISTANCE
  1100. End Method
  1101. Method OnCopy:TType()
  1102. Return New TInt128Type
  1103. End Method
  1104. Method ToString$()
  1105. Return "Int128" + ToStringParts()
  1106. End Method
  1107. End Type
  1108. Type TFloat64Type Extends TIntrinsicType
  1109. Method EqualsType:Int( ty:TType )
  1110. Return TFloat64Type( ty )<>Null And (_flags = ty._flags Or ..
  1111. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1112. End Method
  1113. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1114. 'If TObjectType( ty )
  1115. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  1116. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  1117. ' Return ctor And ctor.IsCtor()
  1118. 'EndIf
  1119. If _flags & T_VARPTR And (TFloat64Type(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1120. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
  1121. End Method
  1122. Method WidensToType:Int( ty:TType )
  1123. Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TFloat64Type(ty)<>Null And (ty._flags & T_VAR))
  1124. End Method
  1125. Method DistanceToType:Int(ty:TType)
  1126. If IsPointerType(ty, 0, T_POINTER) Then
  1127. If IsPointerType(Self, 0, T_POINTER) Then
  1128. Return 0
  1129. Else
  1130. Return T_MAX_DISTANCE
  1131. End If
  1132. End If
  1133. If TFloat64Type(ty)<>Null Then
  1134. Return 0
  1135. End If
  1136. Return T_MAX_DISTANCE
  1137. End Method
  1138. Method OnCopy:TType()
  1139. Return New TFloat64Type
  1140. End Method
  1141. Method ToString$()
  1142. Return "Float64" + ToStringParts()
  1143. End Method
  1144. End Type
  1145. Type TFloat128Type Extends TIntrinsicType
  1146. Method EqualsType:Int( ty:TType )
  1147. Return TFloat128Type( ty )<>Null And (_flags = ty._flags Or ..
  1148. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1149. End Method
  1150. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1151. 'If TObjectType( ty )
  1152. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  1153. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  1154. ' Return ctor And ctor.IsCtor()
  1155. 'EndIf
  1156. If _flags & T_VARPTR And (TFloat128Type(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1157. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
  1158. End Method
  1159. Method WidensToType:Int( ty:TType )
  1160. 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
  1161. End Method
  1162. Method DistanceToType:Int(ty:TType)
  1163. If IsPointerType(ty, 0, T_POINTER) Then
  1164. If IsPointerType(Self, 0, T_POINTER) Then
  1165. Return 0
  1166. Else
  1167. Return T_MAX_DISTANCE
  1168. End If
  1169. End If
  1170. If TFloat128Type(ty)<>Null Then
  1171. Return 0
  1172. End If
  1173. If TDouble128Type(ty)<>Null Then
  1174. Return 2
  1175. End If
  1176. If TInt128Type(ty)<>Null Then
  1177. Return 4
  1178. End If
  1179. Return T_MAX_DISTANCE
  1180. End Method
  1181. Method OnCopy:TType()
  1182. Return New TFloat128Type
  1183. End Method
  1184. Method ToString$()
  1185. Return "Float128" + ToStringParts()
  1186. End Method
  1187. End Type
  1188. Type TDouble128Type Extends TIntrinsicType
  1189. Method EqualsType:Int( ty:TType )
  1190. Return TDouble128Type( ty )<>Null And (_flags = ty._flags Or ..
  1191. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1192. End Method
  1193. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1194. 'If TObjectType( ty )
  1195. ' Local expr:TExpr=New TConstExpr.Create( Self,"" ).Semant()
  1196. ' Local ctor:TFuncDecl=ty.GetClass().FindFuncDecl( "new",[expr],True )
  1197. ' Return ctor And ctor.IsCtor()
  1198. 'EndIf
  1199. If _flags & T_VARPTR And (TDouble128Type(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1200. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TDoubleVarPtrType( ty )<> Null
  1201. End Method
  1202. Method WidensToType:Int( ty:TType )
  1203. 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
  1204. End Method
  1205. Method DistanceToType:Int(ty:TType)
  1206. If IsPointerType(ty, 0, T_POINTER) Then
  1207. If IsPointerType(Self, 0, T_POINTER) Then
  1208. Return 0
  1209. Else
  1210. Return T_MAX_DISTANCE
  1211. End If
  1212. End If
  1213. If TDouble128Type(ty)<>Null Then
  1214. Return 0
  1215. End If
  1216. If TFloat128Type(ty)<>Null Then
  1217. Return 2
  1218. End If
  1219. If TInt128Type(ty)<>Null Then
  1220. Return 4
  1221. End If
  1222. Return T_MAX_DISTANCE
  1223. End Method
  1224. Method OnCopy:TType()
  1225. Return New TDouble128Type
  1226. End Method
  1227. Method ToString$()
  1228. Return "Double128" + ToStringParts()
  1229. End Method
  1230. End Type
  1231. Type TStringType Extends TType
  1232. Field cdecl:TClassDecl
  1233. Method EqualsType:Int( ty:TType )
  1234. Return TStringType( ty )<>Null And (_flags = ty._flags Or (_flags & T_VAR))
  1235. End Method
  1236. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1237. Return EqualsType( ty ) Or (TObjectType( ty ) And TObjectType( ty ).classDecl.ident="Object") Or (TStringType(ty) And (_flags & T_VAR)) ..
  1238. 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)) ..
  1239. Or IsPointerType(ty) Or (TStringType(ty) And (_flags & T_CHAR_PTR)) Or (TStringType(ty) And (_flags & T_SHORT_PTR))
  1240. End Method
  1241. Method GetClass:TClassDecl()
  1242. If cdecl Return cdecl
  1243. Local modid$="brl.classes"
  1244. Local mdecl:TModuleDecl=_env.FindModuleDecl( modid )
  1245. If Not mdecl Err "Module '"+modid+"' not found"
  1246. 'clsid=ident[i+1..] ' BaH
  1247. 'DebugStop
  1248. cdecl=TClassDecl(mdecl.FindDecl( "string" ))
  1249. 'Return _env.FindClassDecl( "brl.classes.string" )
  1250. Return cdecl
  1251. End Method
  1252. Method Semant:TType(option:Int = 0, callback:TCallback = Null)
  1253. GetClass()
  1254. Return Self
  1255. End Method
  1256. Method OnCopy:TType()
  1257. Local ty:TStringType = New TStringType
  1258. ty.cdecl = cdecl
  1259. If _flags & T_CHAR_PTR Then
  1260. ty._flags :| T_CHAR_PTR
  1261. End If
  1262. If _flags & T_SHORT_PTR Then
  1263. ty._flags :| T_SHORT_PTR
  1264. End If
  1265. Return ty
  1266. End Method
  1267. Method ToString$()
  1268. Return "String" + ToStringParts()
  1269. End Method
  1270. Method DistanceToType:Int(ty:TType)
  1271. If TStringType(ty) Then
  1272. Return 0
  1273. End If
  1274. ' prefer Object
  1275. If TObjectType(ty)
  1276. If TObjectType(ty).classDecl.ident = "Object" Then
  1277. Return $F
  1278. End If
  1279. End If
  1280. Return T_MAX_DISTANCE
  1281. End Method
  1282. End Type
  1283. Type TArrayType Extends TType
  1284. Field elemType:TType
  1285. Field dims:Int
  1286. Field isStatic:Int
  1287. Field length:String
  1288. Method Create:TArrayType( elemType:TType, dims:Int = 1, flags:Int = 0, isStatic:Int = False, length:Int = 0 )
  1289. Self.elemType=elemType
  1290. Self.dims = dims
  1291. Self._flags = flags
  1292. Self.isStatic = isStatic
  1293. Self.length = length
  1294. Return Self
  1295. End Method
  1296. Method ActualType:TType()
  1297. Local ty:TType=elemType.ActualType()
  1298. If ty=elemType Return Self
  1299. Return New TArrayType.Create( ty )
  1300. End Method
  1301. Method EqualsType:Int( ty:TType )
  1302. Local arrayType:TArrayType=TArrayType( ty )
  1303. Return arrayType And elemType.EqualsType( arrayType.elemType ) And dims = arrayType.dims And arrayType.isStatic = isStatic And arrayType.length = length
  1304. End Method
  1305. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1306. Local arrayType:TArrayType=TArrayType( ty )
  1307. Return (arrayType And dims = arrayType.dims And ..
  1308. (arrayType.isStatic = isStatic And arrayType.length = length) And ..
  1309. ( TVoidType( elemType ) ..
  1310. Or elemType.EqualsType( arrayType.elemType ) ..
  1311. Or ((TObjectType(elemType) Or TStringType(elemType) Or TArrayType(elemType)) And ..
  1312. (elemType.ExtendsType( arrayType.elemType ) ..
  1313. Or (TObjectType(arrayType.elemType) And TObjectType( arrayType.elemType ).classDecl.ident="Object") ..
  1314. ))) ..
  1315. ) ..
  1316. Or IsPointerType(ty, 0, TType.T_POINTER) <> Null Or (TObjectType( ty ) And TObjectType( ty ).classDecl.ident="Object")
  1317. End Method
  1318. Method Semant:TType(option:Int = False, callback:TCallback = Null)
  1319. Local ty:TType=elemType.Semant(option, callback)
  1320. If ty<>elemType Return New TArrayType.Create( ty, dims, _flags, isStatic, Int(length) )
  1321. Return Self
  1322. End Method
  1323. Method GetClass:TClassDecl()
  1324. 'Return _env.FindClassDecl( "array" )
  1325. Return TClassDecl( _env.FindDecl( "___array" ) )
  1326. End Method
  1327. Method OnCopy:TType()
  1328. Local ty:TArrayType = New TArrayType
  1329. ty.elemType = elemType
  1330. ty.dims = dims
  1331. ty.isStatic = isStatic
  1332. ty.length = length
  1333. Return ty
  1334. End Method
  1335. Method ToString$()
  1336. Local t:String = elemType.ToString()
  1337. If isStatic Then
  1338. t = "Static " + t + " Array[" + length + "]"
  1339. Else
  1340. t :+ " Array"
  1341. End If
  1342. Return t
  1343. End Method
  1344. Method DistanceToType:Int(ty:TType)
  1345. If TArrayType(ty) Then
  1346. Return 0
  1347. End If
  1348. ' prefer Object
  1349. If TObjectType(ty)
  1350. If TObjectType(ty).classDecl.ident = "Object" Then
  1351. Return $F
  1352. End If
  1353. End If
  1354. Return T_MAX_DISTANCE
  1355. End Method
  1356. End Type
  1357. Type TObjectType Extends TType
  1358. Field classDecl:TClassDecl
  1359. Field instance:Int
  1360. Method Create:TObjectType( classDecl:TClassDecl )
  1361. Self.classDecl=classDecl
  1362. Return Self
  1363. End Method
  1364. Method ActualType:TType()
  1365. If classDecl.actual=classDecl Return Self
  1366. Return New TObjectType.Create( TClassDecl(classDecl.actual) )
  1367. End Method
  1368. Method EqualsType:Int( ty:TType )
  1369. Local objty:TObjectType=TObjectType( ty )
  1370. 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
  1371. End Method
  1372. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1373. If classDecl.IsStruct() Then
  1374. If (_flags & T_VARPTR Or IsPointerType(Self, 0, T_POINTER)) And (TNumericType(ty) <> Null) And IsPointerType(ty, 0, T_POINTER) Then
  1375. Return True
  1376. End If
  1377. Return False
  1378. End If
  1379. Local objty:TObjectType=TObjectType( ty )
  1380. If objty Return classDecl.ExtendsClass( objty.classDecl )
  1381. If IsPointerType( ty, T_BYTE ) Return True
  1382. End Method
  1383. Method GetClass:TClassDecl()
  1384. Return classDecl
  1385. End Method
  1386. Method ToString$()
  1387. Return classDecl.ToTypeString() + ToStringParts()
  1388. End Method
  1389. Method OnCopy:TType()
  1390. Local ty:TObjectType = New TObjectType
  1391. ty.classDecl = classDecl
  1392. ty.instance = instance
  1393. Return ty
  1394. End Method
  1395. Method DistanceToType:Int(ty:TType)
  1396. If TObjectType(ty) Then
  1397. If classDecl = TObjectType(ty).classDecl Then
  1398. Return 0
  1399. End If
  1400. If classDecl.ExtendsClass(TObjectType(ty).classDecl) Then
  1401. Return $F
  1402. End If
  1403. End If
  1404. If classDecl.IsStruct() Then
  1405. If (_flags & T_VARPTR Or IsPointerType(Self, 0, T_POINTER)) And (TNumericType(ty) <> Null) And IsPointerType(ty, 0, T_POINTER) Then
  1406. Return $10
  1407. End If
  1408. End If
  1409. Return T_MAX_DISTANCE
  1410. End Method
  1411. End Type
  1412. Type TClassType Extends TType
  1413. Field classDecl:TClassDecl
  1414. Field instance:Int
  1415. Method Create:TClassType( classDecl:TClassDecl )
  1416. Self.classDecl=classDecl
  1417. Return Self
  1418. End Method
  1419. Method GetClass:TClassDecl()
  1420. Return classDecl
  1421. End Method
  1422. Method OnCopy:TType()
  1423. Local ty:TClassType = New TClassType
  1424. ty.classDecl = classDecl
  1425. ty.instance = instance
  1426. Return ty
  1427. End Method
  1428. Method ToString:String()
  1429. Return "Type"
  1430. End Method
  1431. End Type
  1432. Type TIdentType Extends TType
  1433. Field ident$
  1434. Field args:TType[]
  1435. Method Create:TIdentType( ident$,args:TType[] = Null )
  1436. Self.ident=ident
  1437. If args = Null Then
  1438. Self.args = New TType[0]
  1439. Else
  1440. Self.args=args
  1441. End If
  1442. Return Self
  1443. End Method
  1444. Method CopyToDest:TIdentType(dst:TIdentType)
  1445. dst.ident = ident
  1446. dst.args = args
  1447. Return dst
  1448. End Method
  1449. Method CopyToPointer:TIdentType(dst:TIdentType)
  1450. dst = TIdentType(MapToPointerType(dst))
  1451. dst.ident = ident
  1452. dst.args = args
  1453. Return dst
  1454. End Method
  1455. Method ActualType:TType()
  1456. InternalErr "TIdentType.ActualType"
  1457. End Method
  1458. Method EqualsType:Int( ty:TType )
  1459. InternalErr "TIdentType.EqualsType"
  1460. End Method
  1461. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1462. InternalErr "TIdentType.ExtendsType"
  1463. End Method
  1464. 'Method Semant:TType()
  1465. ' If ident Return New TObjectType.Create( FindClass() )
  1466. ' Return New TObjectType.Create( TClassDecl.nullObjectClass )
  1467. 'End Method
  1468. Method Semant:TType(ignoreNotFoundError:Int = 0, callback:TCallback = Null)
  1469. 'If ident="IPair" DebugStop
  1470. If Not ident Return TType.nullObjectType
  1471. Local targs:TType[args.Length]
  1472. For Local i:Int=0 Until args.Length
  1473. targs[i]=args[i].Semant(ignoreNotFoundError, callback)
  1474. Next
  1475. Local tyid$,ty:TType
  1476. Local i:Int=ident.FindLast( "." )
  1477. If i=-1
  1478. tyid=ident.ToLower()
  1479. If tyid = "self" Then
  1480. ' find owning class
  1481. Local scope:TClassDecl = _env.ClassScope()
  1482. If scope Then
  1483. tyid = scope.ident
  1484. ty = New TClassType.Create(scope)
  1485. ' test for method scope - self is already an instance
  1486. Local funcScope:TFuncDecl = _env.FuncScope()
  1487. If funcScope.IsAnyMethod() Then
  1488. TClassType(ty).instance = True
  1489. End If
  1490. Else
  1491. Err "'Self' can only be used within methods."
  1492. End If
  1493. End If
  1494. If Not ty Then
  1495. ty=_env.FindType( tyid,targs, callback )
  1496. End If
  1497. ' finally scan all modules for it
  1498. If Not ty Then
  1499. For Local mdecl:TModuleDecl = EachIn _appInstance.globalImports.Values()
  1500. ty=mdecl.FindType( tyid,targs, callback )
  1501. If ty Exit
  1502. Next
  1503. Else If TIdentType(ty) Then
  1504. ty = ty.Semant()
  1505. End If
  1506. Else
  1507. Local id:String = ident.ToLower()
  1508. i = id.Find( "." )
  1509. ' try scope search first
  1510. tyid=id[..i]
  1511. If tyid = "self" Then
  1512. ' find owning class
  1513. Local scope:TClassDecl = _env.ClassScope()
  1514. If scope Then
  1515. tyid = scope.ident
  1516. ty = New TClassType.Create(scope)
  1517. ' test for method scope - self is already an instance
  1518. Local funcScope:TFuncDecl = _env.FuncScope()
  1519. If funcScope.IsAnyMethod() Then
  1520. TClassType(ty).instance = True
  1521. End If
  1522. Else
  1523. Err "'Self' can only be used within methods."
  1524. End If
  1525. End If
  1526. If Not ty Then
  1527. ty=_env.FindType( tyid,targs, callback )
  1528. End If
  1529. If Not ty Then
  1530. i = id.FindLast( "." )
  1531. ' try scope search first
  1532. tyid=id[..i]
  1533. ty=_env.FindType( tyid,targs, callback )
  1534. If Not ty Then
  1535. ' no? now try module search
  1536. Local modid$=id[..i]
  1537. Local mdecl:TModuleDecl=_env.FindModuleDecl( modid )
  1538. If Not mdecl Err "Module '"+modid+"' not found"
  1539. tyid=id[i+1..]
  1540. ty=mdecl.FindType( tyid,targs, callback )
  1541. End If
  1542. End If
  1543. EndIf
  1544. If Not ty Then
  1545. If ignoreNotFoundError Then
  1546. Return Null
  1547. End If
  1548. Err "Type '"+tyid+"' not found"
  1549. End If
  1550. If (_flags & T_VAR) Then
  1551. If TObjectType(ty) Then
  1552. ty = New TObjectType.Create(TObjectType(ty).classDecl)
  1553. ty._flags :| T_VAR
  1554. Else If TEnumType(ty) Then
  1555. ty = New TEnumType.Create(TEnumType(ty).decl)
  1556. ty._flags :| T_VAR
  1557. Else
  1558. ty = ty.Copy()
  1559. ty._flags :| T_VAR
  1560. End If
  1561. End If
  1562. If (_flags & T_POINTER) And TObjectType(ty) Then
  1563. ' FIXME #200
  1564. 'If Not TObjectType(ty).classDecl.IsExtern() Then
  1565. ' Err "Invalid Pointer type."
  1566. 'End If
  1567. ty = New TObjectType.Create(TObjectType(ty).classDecl)
  1568. ty._flags :| (_flags & T_POINTER)
  1569. End If
  1570. Return ty
  1571. End Method
  1572. Method SemantClass:TClassDecl(callback:TCallback = Null)
  1573. Local ty:TObjectType=TObjectType( Semant(False, callback) )
  1574. If Not ty Err "Type is not a class"
  1575. Return ty.classDecl
  1576. End Method
  1577. Method ToString$()
  1578. Local t$
  1579. For Local arg:TIdentType=EachIn args
  1580. If t t:+","
  1581. t:+arg.ToString()
  1582. Next
  1583. If t Return "$"+ident+"<"+t.Replace("$","")+">"
  1584. Return "$"+ident
  1585. End Method
  1586. Method OnCopy:TType()
  1587. Local ty:TIdentType = New TIdentType
  1588. ty.ident = ident
  1589. ty.args = args
  1590. Return ty
  1591. End Method
  1592. End Type
  1593. Type TExternObjectType Extends TType
  1594. Field classDecl:TClassDecl
  1595. Method Create:TExternObjectType( classDecl:TClassDecl )
  1596. Self.classDecl=classDecl
  1597. Return Self
  1598. End Method
  1599. Method ActualType:TType()
  1600. If classDecl.actual=classDecl Return Self
  1601. Return New TExternObjectType.Create( TClassDecl(classDecl.actual) )
  1602. End Method
  1603. Method EqualsType:Int( ty:TType )
  1604. Local objty:TObjectType=TObjectType( ty )
  1605. Return TNullDecl(classDecl) <> Null Or (objty And (classDecl=objty.classDecl Or classDecl.ExtendsClass( objty.classDecl ))) Or TObjectType(ty)
  1606. End Method
  1607. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1608. Local objty:TObjectType=TObjectType( ty )
  1609. If objty Return classDecl.ExtendsClass( objty.classDecl )
  1610. If IsPointerType( ty, T_BYTE ) Return True
  1611. Local op$
  1612. If TBoolType( ty )
  1613. op="ToBool"
  1614. Else If TIntType( ty )
  1615. op="ToInt"
  1616. Else If TFloatType( ty )
  1617. op="ToFloat"
  1618. Else If TStringType( ty )
  1619. op="ToString"
  1620. Else If TLongType( ty ) ' BaH Long
  1621. op="ToLong"
  1622. Else
  1623. Return False
  1624. EndIf
  1625. Local fdecl:TFuncDecl=GetClass().FindFuncDecl( op,Null,True,,,,SCOPE_CLASS_HEIRARCHY )
  1626. Return fdecl And fdecl.IsMethod() And fdecl.retType.EqualsType( ty )
  1627. End Method
  1628. Method GetClass:TClassDecl()
  1629. Return classDecl
  1630. End Method
  1631. Method ToString$()
  1632. Return classDecl.ToTypeString()
  1633. End Method
  1634. Method OnCopy:TType()
  1635. Local ty:TExternObjectType = New TExternObjectType
  1636. ty.classDecl = classDecl
  1637. Return ty
  1638. End Method
  1639. End Type
  1640. Type TFunctionPtrType Extends TType
  1641. Field func:TFuncDecl
  1642. Method Create:TFunctionPtrType(func:TFuncDecl)
  1643. Self.func = func
  1644. Return Self
  1645. End Method
  1646. Method EqualsType:Int( ty:TType )
  1647. If Not TFunctionPtrType(ty) Then Return False
  1648. ' declared function pointer
  1649. Local tyfunc:TFuncDecl = TFunctionPtrType(ty).func
  1650. If Not tyfunc.retType.EqualsType(func.retType) Then Return False
  1651. If Not (tyfunc.argDecls.Length = func.argDecls.Length) Then Return False
  1652. For Local a:Int = 0 Until func.argDecls.Length
  1653. ' does our arg equal declared arg?
  1654. If Not func.argDecls[a].ty.EqualsType(tyfunc.argDecls[a].ty) Then Return False
  1655. Next
  1656. Return True
  1657. End Method
  1658. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1659. If TFunctionPtrType( ty )
  1660. ' declared function pointer
  1661. Local tyfunc:TFuncDecl = TFunctionPtrType(ty).func
  1662. If Not func.retType.ExtendsType(tyfunc.retType) Then Return False
  1663. If Not (func.argDecls.Length = tyfunc.argDecls.Length) Then Return False
  1664. For Local a:Int = 0 Until func.argDecls.Length
  1665. ' does declared arg extend our arg?
  1666. If Not tyfunc.argDecls[a].ty.ExtendsType(func.argDecls[a].ty) Then Return False
  1667. Next
  1668. Return True
  1669. EndIf
  1670. Return IsPointerType( ty, 0, T_POINTER )<>Null
  1671. End Method
  1672. Method equalsDecl:Int(fdecl:TFuncDecl)
  1673. func.Semant
  1674. fdecl.Semant
  1675. ' same number of args?
  1676. If func.argDecls.length <> fdecl.argDecls.length Then
  1677. Return False
  1678. End If
  1679. ' same arg types?
  1680. For Local i:Int = 0 Until func.argDecls.length
  1681. If Not func.argDecls[i].ty.equalsType(fdecl.argDecls[i].ty) Return False
  1682. Next
  1683. ' same return type?
  1684. If Not func.retType.equalsType(fdecl.retType) Then
  1685. ' if function pointer specifies Int return type, our function can specify void...
  1686. If TIntType(func.retType) And TVoidType(fdecl.retType) Then
  1687. Return True
  1688. End If
  1689. Return False
  1690. End If
  1691. Return True
  1692. End Method
  1693. Method ToString$()
  1694. Return func.ToTypeString()
  1695. End Method
  1696. Method OnCopy:TType()
  1697. Local ty:TFunctionPtrType = New TFunctionPtrType
  1698. ty.func = func
  1699. Return ty
  1700. End Method
  1701. Method Semant:TType(option:Int = False, callback:TCallback = Null)
  1702. func.Semant()
  1703. Return Self
  1704. End Method
  1705. End Type
  1706. ' a holder during parsing which becomes the "real" var ptr type during semanting
  1707. Type TVarPtrType Extends TType
  1708. Method OnCopy:TType()
  1709. Return New TVarPtrType
  1710. End Method
  1711. End Type
  1712. Type TParamType Extends TIntegralType
  1713. End Type
  1714. Type TWParamType Extends TParamType
  1715. Method EqualsType:Int( ty:TType )
  1716. Return TWParamType( ty )<>Null And (_flags = ty._flags Or ..
  1717. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1718. End Method
  1719. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1720. If _flags & T_VARPTR And (TWParamType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1721. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TIntVarPtrType( ty )<> Null
  1722. End Method
  1723. Method WidensToType:Int( ty:TType )
  1724. If WORD_SIZE = 4 Then
  1725. 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
  1726. Else
  1727. 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
  1728. End If
  1729. End Method
  1730. Method DistanceToType:Int(ty:TType)
  1731. If IsPointerType(ty, 0, T_POINTER) Then
  1732. If IsPointerType(Self, 0, T_POINTER) Then
  1733. Return 0
  1734. Else
  1735. Return T_MAX_DISTANCE
  1736. End If
  1737. End If
  1738. If TWParamType(ty)<>Null Then
  1739. Return 0
  1740. End If
  1741. If TSizeTType(ty)<>Null Then
  1742. Return 0
  1743. End If
  1744. If WORD_SIZE = 4 Then
  1745. If TUIntType(ty)<>Null Then
  1746. Return 0
  1747. End If
  1748. If TIntType(ty)<>Null Then
  1749. Return 2
  1750. End If
  1751. If TULongType(ty)<>Null Then
  1752. Return 3
  1753. End If
  1754. If TLongType(ty)<>Null Then
  1755. Return 4
  1756. End If
  1757. If TFloatType(ty)<>Null Then
  1758. Return 5
  1759. End If
  1760. If TDoubleType(ty)<>Null Then
  1761. Return 6
  1762. End If
  1763. Else
  1764. If TULongType(ty)<>Null Then
  1765. Return 0
  1766. End If
  1767. If TLongType(ty)<>Null Then
  1768. Return 2
  1769. End If
  1770. If TFloatType(ty)<>Null Then
  1771. Return 4
  1772. End If
  1773. If TDoubleType(ty)<>Null Then
  1774. Return 6
  1775. End If
  1776. If TFloat64Type(ty)<>Null Then
  1777. Return 8
  1778. End If
  1779. End If
  1780. Return T_MAX_DISTANCE
  1781. End Method
  1782. Method OnCopy:TType()
  1783. Return New TWParamType
  1784. End Method
  1785. Method ToString$()
  1786. Return "WPARAM" + ToStringParts()
  1787. End Method
  1788. Method GetSize:Int()
  1789. Return WORD_SIZE
  1790. End Method
  1791. End Type
  1792. Type TLParamType Extends TParamType
  1793. Method EqualsType:Int( ty:TType )
  1794. Return TLParamType( ty )<>Null And (_flags = ty._flags Or ..
  1795. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1796. End Method
  1797. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1798. If _flags & T_VARPTR And (TLParamType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1799. Return (widensTest And WidensToType(ty)) Or (Not widensTest And TNumericType( ty )<>Null) Or (Not noExtendString And TStringType( ty )<>Null) 'Or TIntVarPtrType( ty )<> Null
  1800. End Method
  1801. Method WidensToType:Int( ty:TType )
  1802. If WORD_SIZE = 4 Then
  1803. 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
  1804. Else
  1805. 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
  1806. End If
  1807. End Method
  1808. Method DistanceToType:Int(ty:TType)
  1809. If IsPointerType(ty, 0, T_POINTER) Then
  1810. If IsPointerType(Self, 0, T_POINTER) Then
  1811. Return 0
  1812. Else
  1813. Return T_MAX_DISTANCE
  1814. End If
  1815. End If
  1816. If TLParamType(ty)<>Null Then
  1817. Return 0
  1818. End If
  1819. If WORD_SIZE = 4 Then
  1820. If TIntType(ty)<>Null Then
  1821. Return 0
  1822. End If
  1823. If TLongType(ty)<>Null Then
  1824. Return 2
  1825. End If
  1826. If TFloatType(ty)<>Null Then
  1827. Return 4
  1828. End If
  1829. If TDoubleType(ty)<>Null Then
  1830. Return 6
  1831. End If
  1832. Else
  1833. If TLongType(ty)<>Null Then
  1834. Return 0
  1835. End If
  1836. If TFloatType(ty)<>Null Then
  1837. Return 2
  1838. End If
  1839. If TDoubleType(ty)<>Null Then
  1840. Return 4
  1841. End If
  1842. If TFloat64Type(ty)<>Null Then
  1843. Return 6
  1844. End If
  1845. End If
  1846. Return T_MAX_DISTANCE
  1847. End Method
  1848. Method OnCopy:TType()
  1849. Return New TLParamType
  1850. End Method
  1851. Method ToString$()
  1852. Return "LPARAM" + ToStringParts()
  1853. End Method
  1854. Method GetSize:Int()
  1855. Return WORD_SIZE
  1856. End Method
  1857. End Type
  1858. Type TEnumType Extends TType
  1859. Field decl:TEnumDecl
  1860. Method Create:TEnumType(decl:TEnumDecl)
  1861. Self.decl = decl
  1862. Return Self
  1863. End Method
  1864. Method EqualsType:Int( ty:TType )
  1865. Local ety:TEnumType = TEnumType(ty)
  1866. Return ety And decl = ety.decl And(_flags = ty._flags Or ..
  1867. (_flags & T_VARPTR And ty._flags & T_PTR) Or (ty._flags & T_VARPTR And _flags & T_PTR) Or (_flags & T_VAR))
  1868. End Method
  1869. Method ExtendsType:Int( ty:TType, noExtendString:Int = False, widensTest:Int = False )
  1870. If _flags & T_VARPTR And (TEnumType(ty) <> Null Or IsPointerType(ty, 0, T_POINTER)) Return True
  1871. Return (widensTest And WidensToType(ty))
  1872. End Method
  1873. Method WidensToType:Int( ty:TType )
  1874. Return (IsPointerType(ty, 0, T_POINTER) And IsPointerType(Self, 0, T_POINTER)) Or (TEnumType(ty)<>Null And (ty._flags & T_VAR))
  1875. End Method
  1876. Method OnCopy:TType()
  1877. Local ty:TEnumType = New TEnumType
  1878. ty.decl = decl
  1879. Return ty
  1880. End Method
  1881. Method IsFlags:Int()
  1882. Return decl.isFlags
  1883. End Method
  1884. Method Value:String(ordinal:Int)
  1885. Return decl.values[ordinal].Value()
  1886. End Method
  1887. Method ToString$()
  1888. Return "Enum " + decl.ident + " " + ToStringParts()
  1889. End Method
  1890. Method GetClassScope:TScopeDecl()
  1891. Return decl
  1892. End Method
  1893. End Type
  1894. Type TTemplateArg
  1895. Field ident:String
  1896. Field superTy:TType[]
  1897. Method ExtendsType(ty:TType)
  1898. If Not superTy Then
  1899. superTy = New TType[0]
  1900. End If
  1901. superTy :+ [ty]
  1902. End Method
  1903. Method ToString:String()
  1904. Local s:String = ident
  1905. If superTy Then
  1906. s :+ " Extends "
  1907. For Local i:Int = 0 Until superTy.length
  1908. If i Then
  1909. s:+ " And "
  1910. End If
  1911. s :+ superTy[i].ToString()
  1912. Next
  1913. End If
  1914. End Method
  1915. End Type