reflection.bmx 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878
  1. Strict
  2. Rem
  3. bbdoc: BASIC/Reflection
  4. End Rem
  5. Module BRL.Reflection
  6. ModuleInfo "Version: 1.02"
  7. ModuleInfo "Author: Mark Sibly"
  8. ModuleInfo "License: zlib/libpng"
  9. ModuleInfo "Copyright: Blitz Research Ltd"
  10. ModuleInfo "Modserver: BRL"
  11. ModuleInfo "History: 1.02 Release"
  12. ModuleInfo "History: Added Brucey's size fix to GetArrayElement()/SetArrayElement()."
  13. ModuleInfo "History: 1.01 Release"
  14. ModuleInfo "History: Fixed NewArray using temp type name"
  15. Import BRL.LinkedList
  16. Import BRL.Map
  17. Import "reflection.cpp"
  18. Private
  19. Extern
  20. Function bbObjectNew:Object( class:Byte Ptr )
  21. ?x86
  22. Function bbObjectRegisteredTypes:Int Ptr( count Var )
  23. ?x64
  24. Function bbObjectRegisteredTypes:Long Ptr( count Var )
  25. ?
  26. Function bbArrayNew1D:Object( typeTag:Byte Ptr,length )
  27. Function bbRefArrayClass()
  28. Function bbRefStringClass()
  29. Function bbRefObjectClass()
  30. Function bbRefArrayLength( _array:Object, dim:Int = 0 )
  31. Function bbRefArrayTypeTag$( _array:Object )
  32. Function bbRefArrayDimensions:Int( _array:Object )
  33. Function bbRefArrayCreate:Object( typeTag:Byte Ptr,dims:Int[] )
  34. Function bbRefFieldPtr:Byte Ptr( obj:Object,index )
  35. Function bbRefMethodPtr:Byte Ptr( obj:Object,index )
  36. Function bbRefArrayElementPtr:Byte Ptr( sz,_array:Object,index )
  37. Function bbRefGetObject:Object( p:Byte Ptr )
  38. Function bbRefPushObject( p:Byte Ptr,obj:Object )
  39. Function bbRefInitObject( p:Byte Ptr,obj:Object )
  40. Function bbRefAssignObject( p:Byte Ptr,obj:Object )
  41. Function bbRefGetObjectClass:Byte Ptr( obj:Object )
  42. Function bbRefGetSuperClass:Byte Ptr( class:Byte Ptr )
  43. End Extern
  44. Type TClass
  45. Method Compare( with:Object )
  46. Return _class-TClass( with )._class
  47. End Method
  48. Method SetClass:TClass( class:Byte Ptr )
  49. _class=class
  50. Return Self
  51. End Method
  52. Field _class:Byte Ptr
  53. End Type
  54. Function _Get:Object( p:Byte Ptr,typeId:TTypeId )
  55. Select typeId
  56. Case ByteTypeId
  57. Return String.FromInt( (Byte Ptr p)[0] )
  58. Case ShortTypeId
  59. Return String.FromInt( (Short Ptr p)[0] )
  60. Case IntTypeId
  61. Return String.FromInt( (Int Ptr p)[0] )
  62. Case LongTypeId
  63. Return String.FromLong( (Long Ptr p)[0] )
  64. Case FloatTypeId
  65. Return String.FromFloat( (Float Ptr p)[0] )
  66. Case DoubleTypeId
  67. Return String.FromDouble( (Double Ptr p)[0] )
  68. Default
  69. Return bbRefGetObject( p )
  70. End Select
  71. End Function
  72. Function _Push:Byte Ptr( sp:Byte Ptr,typeId:TTypeId,value:Object )
  73. Select typeId
  74. Case ByteTypeId,ShortTypeId,IntTypeId
  75. (Int Ptr sp)[0]=value.ToString().ToInt()
  76. Return sp+4
  77. Case LongTypeId
  78. (Long Ptr sp)[0]=value.ToString().ToLong()
  79. Return sp+8
  80. Case FloatTypeId
  81. (Float Ptr sp)[0]=value.ToString().ToFloat()
  82. Return sp+4
  83. Case DoubleTypeId
  84. (Double Ptr sp)[0]=value.ToString().ToDouble()
  85. Return sp+8
  86. Case StringTypeId
  87. If Not value value=""
  88. bbRefPushObject sp,value
  89. Return sp+4
  90. Default
  91. If value
  92. Local c:Byte Ptr=typeId._class
  93. Local t:Byte Ptr=bbRefGetObjectClass( value )
  94. While t And t<>c
  95. t=bbRefGetSuperClass( t )
  96. Wend
  97. If Not t Throw "ERROR"
  98. EndIf
  99. bbRefPushObject sp,value
  100. Return sp+4
  101. End Select
  102. End Function
  103. Function _Assign( p:Byte Ptr,typeId:TTypeId,value:Object )
  104. Select typeId
  105. Case ByteTypeId
  106. (Byte Ptr p)[0]=value.ToString().ToInt()
  107. Case ShortTypeId
  108. (Short Ptr p)[0]=value.ToString().ToInt()
  109. Case IntTypeId
  110. (Int Ptr p)[0]=value.ToString().ToInt()
  111. Case LongTypeId
  112. (Long Ptr p)[0]=value.ToString().ToLong()
  113. Case FloatTypeId
  114. (Float Ptr p)[0]=value.ToString().ToFloat()
  115. Case DoubleTypeId
  116. (Double Ptr p)[0]=value.ToString().ToDouble()
  117. Case StringTypeId
  118. If Not value value=""
  119. bbRefAssignObject p,value
  120. Default
  121. If value
  122. Local c:Byte Ptr=typeId._class
  123. Local t:Byte Ptr=bbRefGetObjectClass( value )
  124. While t And t<>c
  125. t=bbRefGetSuperClass( t )
  126. Wend
  127. If Not t Throw "ERROR"
  128. EndIf
  129. bbRefAssignObject p,value
  130. End Select
  131. End Function
  132. Function _Call:Object( p:Byte Ptr,typeId:TTypeId,obj:Object,args:Object[],argTypes:TTypeId[] )
  133. Local q[10],sp:Byte Ptr=q
  134. bbRefPushObject sp,obj
  135. sp:+4
  136. If typeId=LongTypeId sp:+8
  137. For Local i=0 Until args.length
  138. If Int Ptr(sp)>=Int Ptr(q)+8 Throw "ERROR"
  139. sp=_Push( sp,argTypes[i],args[i] )
  140. Next
  141. If Int Ptr(sp)>Int Ptr(q)+8 Throw "ERROR"
  142. Select typeId
  143. Case ByteTypeId,ShortTypeId,IntTypeId
  144. Local f(p0,p1,p2,p3,p4,p5,p6,p7)=p
  145. Return String.FromInt( f( q[0],q[1],q[2],q[3],q[4],q[5],q[6],q[7] ) )
  146. Case LongTypeId
  147. Throw "TODO"
  148. Case FloatTypeId
  149. Local f:Float(p0,p1,p2,p3,p4,p5,p6,p7)=p
  150. Return String.FromFloat( f( q[0],q[1],q[2],q[3],q[4],q[5],q[6],q[7] ) )
  151. Case DoubleTypeId
  152. Local f:Double(p0,p1,p2,p3,p4,p5,p6,p7)=p
  153. Return String.FromDouble( f( q[0],q[1],q[2],q[3],q[4],q[5],q[6],q[7] ) )
  154. Case VoidTypeId
  155. Local f(p0,p1,p2,p3,p4,p5,p6,p7)=p
  156. f( q[0],q[1],q[2],q[3],q[4],q[5],q[6],q[7] )
  157. Default
  158. Local f:Object(p0,p1,p2,p3,p4,p5,p6,p7)=p
  159. Return f( q[0],q[1],q[2],q[3],q[4],q[5],q[6],q[7] )
  160. End Select
  161. End Function
  162. Function TypeTagForId$( id:TTypeId )
  163. If id.ExtendsType( ArrayTypeId )
  164. Return "[]"+TypeTagForId( id.ElementType() )
  165. EndIf
  166. If id.ExtendsType( ObjectTypeId )
  167. Return ":"+id.Name()
  168. EndIf
  169. Select id
  170. Case ByteTypeId Return "b"
  171. Case ShortTypeId Return "s"
  172. Case IntTypeId Return "i"
  173. Case LongTypeId Return "l"
  174. Case FloatTypeId Return "f"
  175. Case DoubleTypeId Return "d"
  176. Case StringTypeId Return "$"
  177. End Select
  178. Throw "ERROR"
  179. End Function
  180. Function TypeIdForTag:TTypeId( ty$ )
  181. If ty.StartsWith( "[" )
  182. Local dims:Int = ty.split(",").length
  183. ty=ty[ty.Find("]")+1..]
  184. Local id:TTypeId = TypeIdForTag( ty )
  185. If id Then
  186. id._arrayType = Null
  187. id=id.ArrayType(dims)
  188. End If
  189. Return id
  190. EndIf
  191. If ty.StartsWith( ":" )
  192. ty=ty[1..]
  193. Local i=ty.FindLast( "." )
  194. If i<>-1 ty=ty[i+1..]
  195. Return TTypeId.ForName( ty )
  196. EndIf
  197. Select ty
  198. Case "b" Return ByteTypeId
  199. Case "s" Return ShortTypeId
  200. Case "i" Return IntTypeId
  201. Case "l" Return LongTypeId
  202. Case "f" Return FloatTypeId
  203. Case "d" Return DoubleTypeId
  204. Case "$" Return StringTypeId
  205. Case "" Return VoidTypeId
  206. End Select
  207. End Function
  208. Function ExtractMetaData$( meta$,key$ )
  209. If Not key Return meta
  210. Local i=0
  211. While i<meta.length
  212. Local e=meta.Find( "=",i )
  213. If e=-1 Throw "Malformed meta data"
  214. Local k$=meta[i..e],v$
  215. i=e+1
  216. If i<meta.length And meta[i]=Asc("~q")
  217. i:+1
  218. Local e=meta.Find( "~q",i )
  219. If e=-1 Throw "Malformed meta data"
  220. v=meta[i..e]
  221. i=e+1
  222. Else
  223. Local e=meta.Find( " ",i )
  224. If e=-1 e=meta.length
  225. v=meta[i..e]
  226. i=e
  227. EndIf
  228. If k=key Return v
  229. If i<meta.length And meta[i]=Asc(" ") i:+1
  230. Wend
  231. End Function
  232. Public
  233. Rem
  234. bbdoc: Primitive byte type
  235. End Rem
  236. Global ByteTypeId:TTypeId=New TTypeId.Init( "Byte",1 )
  237. Rem
  238. bbdoc: Primitive short type
  239. End Rem
  240. Global ShortTypeId:TTypeId=New TTypeId.Init( "Short",2 )
  241. Rem
  242. bbdoc: Primitive int type
  243. End Rem
  244. Global IntTypeId:TTypeId=New TTypeId.Init( "Int",4 )
  245. Rem
  246. bbdoc: Primitive long type
  247. End Rem
  248. Global LongTypeId:TTypeId=New TTypeId.Init( "Long",8 )
  249. Rem
  250. bbdoc: Primitive float type
  251. End Rem
  252. Global FloatTypeId:TTypeId=New TTypeId.Init( "Float",4 )
  253. Rem
  254. bbdoc: Primitive double type
  255. End Rem
  256. Global DoubleTypeId:TTypeId=New TTypeId.Init( "Double",8 )
  257. Rem
  258. bbdoc: Primitive object type
  259. End Rem
  260. ?x86
  261. Global ObjectTypeId:TTypeId=New TTypeId.Init( "Object",4,bbRefObjectClass() )
  262. ?x64
  263. Global ObjectTypeId:TTypeId=New TTypeId.Init( "Object",8,bbRefObjectClass() )
  264. ?
  265. Rem
  266. bbdoc: Primitive string type
  267. End Rem
  268. ?x86
  269. Global StringTypeId:TTypeId=New TTypeId.Init( "String",4,bbRefStringClass(),ObjectTypeId )
  270. ?x64
  271. Global StringTypeId:TTypeId=New TTypeId.Init( "String",8,bbRefStringClass(),ObjectTypeId )
  272. ?
  273. Rem
  274. bbdoc: Primitive array type
  275. End Rem
  276. ?x86
  277. Global ArrayTypeId:TTypeId=New TTypeId.Init( "Null[]",4,bbRefArrayClass(),ObjectTypeId )
  278. ?x64
  279. Global ArrayTypeId:TTypeId=New TTypeId.Init( "Null[]",8,bbRefArrayClass(),ObjectTypeId )
  280. ?
  281. ' Void Type
  282. ' Only used For Function/Method Return types
  283. Global VoidTypeId:TTypeId=New TTypeId.Init( "Void",0 )
  284. Rem
  285. bbdoc: Type member - field or method.
  286. End Rem
  287. Type TMember
  288. Rem
  289. bbdoc: Get member name
  290. End Rem
  291. Method Name$()
  292. Return _name
  293. End Method
  294. Rem
  295. bbdoc: Get member type
  296. End Rem
  297. Method TypeId:TTypeId()
  298. Return _typeId
  299. End Method
  300. Rem
  301. bbdoc: Get member meta data
  302. End Rem
  303. Method MetaData$( key$="" )
  304. Return ExtractMetaData( _meta,key )
  305. End Method
  306. Field _name$,_typeId:TTypeId,_meta$
  307. End Type
  308. Rem
  309. bbdoc: Type field
  310. End Rem
  311. Type TField Extends TMember
  312. Method Init:TField( name$,typeId:TTypeId,meta$,index )
  313. _name=name
  314. _typeId=typeId
  315. _meta=meta
  316. _index=index
  317. Return Self
  318. End Method
  319. Rem
  320. bbdoc: Get field value
  321. End Rem
  322. Method Get:Object( obj:Object )
  323. Return _Get( bbRefFieldPtr( obj,_index ),_typeId )
  324. End Method
  325. Rem
  326. bbdoc: Get int field value
  327. End Rem
  328. Method GetInt:Int( obj:Object )
  329. Return GetString( obj ).ToInt()
  330. End Method
  331. Rem
  332. bbdoc: Get long field value
  333. End Rem
  334. Method GetLong:Long( obj:Object )
  335. Return GetString( obj ).ToLong()
  336. End Method
  337. Rem
  338. bbdoc: Get float field value
  339. End Rem
  340. Method GetFloat:Float( obj:Object )
  341. Return GetString( obj ).ToFloat()
  342. End Method
  343. Rem
  344. bbdoc: Get double field value
  345. End Rem
  346. Method GetDouble:Double( obj:Object )
  347. Return GetString( obj ).ToDouble()
  348. End Method
  349. Rem
  350. bbdoc: Get string field value
  351. End Rem
  352. Method GetString$( obj:Object )
  353. Return String( Get( obj ) )
  354. End Method
  355. Rem
  356. bbdoc: Set field value
  357. End Rem
  358. Method Set( obj:Object,value:Object )
  359. _Assign bbRefFieldPtr( obj,_index ),_typeId,value
  360. End Method
  361. Rem
  362. bbdoc: Set int field value
  363. End Rem
  364. Method SetInt( obj:Object,value:Int )
  365. SetString obj,String.FromInt( value )
  366. End Method
  367. Rem
  368. bbdoc: Set long field value
  369. End Rem
  370. Method SetLong( obj:Object,value:Long )
  371. SetString obj,String.FromLong( value )
  372. End Method
  373. Rem
  374. bbdoc: Set float field value
  375. End Rem
  376. Method SetFloat( obj:Object,value:Float )
  377. SetString obj,String.FromFloat( value )
  378. End Method
  379. Rem
  380. bbdoc: Set double field value
  381. End Rem
  382. Method SetDouble( obj:Object,value:Double )
  383. SetString obj,String.FromDouble( value )
  384. End Method
  385. Rem
  386. bbdoc: Set string field value
  387. End Rem
  388. Method SetString( obj:Object,value$ )
  389. Set obj,value
  390. End Method
  391. Field _index
  392. End Type
  393. Rem
  394. bbdoc: Type method
  395. End Rem
  396. Type TMethod Extends TMember
  397. Method Init:TMethod( name$,typeId:TTypeId,meta$,selfTypeId:TTypeId,ref:Byte Ptr,argTypes:TTypeId[] )
  398. _name=name
  399. _typeId=typeId
  400. _meta=meta
  401. _selfTypeId=selfTypeId
  402. _ref=ref
  403. _argTypes=argTypes
  404. Return Self
  405. End Method
  406. Rem
  407. bbdoc: Get method arg types
  408. End Rem
  409. Method ArgTypes:TTypeId[]()
  410. Return _argTypes
  411. End Method
  412. Rem
  413. bbdoc: Invoke method
  414. End Rem
  415. Method Invoke:Object( obj:Object,args:Object[] )
  416. 'If _index<65536
  417. ' Return _Call( bbRefMethodPtr( obj,_index ),_typeId,obj,args,_argTypes )
  418. 'EndIf
  419. Return _Call( _ref,_typeId,obj,args,_argTypes )
  420. End Method
  421. Field _selfTypeId:TTypeId
  422. Field _ref:Byte Ptr
  423. Field _argTypes:TTypeId[]
  424. End Type
  425. Rem
  426. bbdoc: Type id
  427. End Rem
  428. Type TTypeId
  429. Rem
  430. bbdoc: Get name of type
  431. End Rem
  432. Method Name$()
  433. Return _name
  434. End Method
  435. Rem
  436. bbdoc: Get type meta data
  437. End Rem
  438. Method MetaData$( key$="" )
  439. Return ExtractMetaData( _meta,key )
  440. End Method
  441. Rem
  442. bbdoc: Get super type
  443. End Rem
  444. Method SuperType:TTypeId()
  445. Return _super
  446. End Method
  447. Rem
  448. bbdoc: Get array type
  449. End Rem
  450. Method ArrayType:TTypeId(dims:Int = 1)
  451. If Not _arrayType
  452. Local dim:String
  453. If dims > 1 Then
  454. For Local i:Int = 1 Until dims
  455. dim :+ ","
  456. Next
  457. End If
  458. ?x86
  459. _arrayType=New TTypeId.Init( _name+"[" + dim + "]",4,bbRefArrayClass() )
  460. ?x64
  461. _arrayType=New TTypeId.Init( _name+"[" + dim + "]",8,bbRefArrayClass() )
  462. ?
  463. _arrayType._elementType=Self
  464. If _super
  465. _arrayType._super=_super.ArrayType()
  466. Else
  467. _arrayType._super=ArrayTypeId
  468. EndIf
  469. EndIf
  470. Return _arrayType
  471. End Method
  472. Rem
  473. bbdoc: Get element type
  474. End Rem
  475. Method ElementType:TTypeId()
  476. Return _elementType
  477. End Method
  478. Rem
  479. bbdoc: Determine if type extends a type
  480. End Rem
  481. Method ExtendsType( typeId:TTypeId )
  482. If Self=typeId Return True
  483. If _super Return _super.ExtendsType( typeId )
  484. End Method
  485. Rem
  486. bbdoc: Get list of derived types
  487. End Rem
  488. Method DerivedTypes:TList()
  489. If Not _derived _derived=New TList
  490. Return _derived
  491. End Method
  492. Rem
  493. bbdoc: Create a new object
  494. End Rem
  495. Method NewObject:Object()
  496. If Not _class Throw "Unable to create new object"
  497. Return bbObjectNew( _class )
  498. End Method
  499. Rem
  500. bbdoc: Get list of fields
  501. about: Only returns fields declared in this type, not in super types.
  502. End Rem
  503. Method Fields:TList()
  504. Return _fields
  505. End Method
  506. Rem
  507. bbdoc: Get list of methods
  508. about: Only returns methods declared in this type, not in super types.
  509. End Rem
  510. Method Methods:TList()
  511. Return _methods
  512. End Method
  513. Rem
  514. bbdoc: Find a field by name
  515. about: Searchs type hierarchy for field called @name.
  516. End Rem
  517. Method FindField:TField( name$ )
  518. name=name.ToLower()
  519. For Local t:TField=EachIn _fields
  520. If t.Name().ToLower()=name Return t
  521. Next
  522. If _super Return _super.FindField( name )
  523. End Method
  524. Rem
  525. bbdoc: Find a method by name
  526. about: Searchs type hierarchy for method called @name.
  527. End Rem
  528. Method FindMethod:TMethod( name$ )
  529. name=name.ToLower()
  530. For Local t:TMethod=EachIn _methods
  531. If t.Name().ToLower()=name Return t
  532. Next
  533. If _super Return _super.FindMethod( name )
  534. End Method
  535. Rem
  536. bbdoc: Enumerate all fields
  537. about: Returns a list of all fields in type hierarchy
  538. End Rem
  539. Method EnumFields:TList( list:TList=Null )
  540. If Not list list=New TList
  541. If _super _super.EnumFields list
  542. For Local t:TField=EachIn _fields
  543. list.AddLast t
  544. Next
  545. Return list
  546. End Method
  547. Rem
  548. bbdoc: Enumerate all methods
  549. about: Returns a list of all methods in type hierarchy - TO DO: handle overrides!
  550. End Rem
  551. Method EnumMethods:TList( list:TList=Null )
  552. If Not list list=New TList
  553. If _super _super.EnumMethods list
  554. For Local t:TMethod=EachIn _methods
  555. list.AddLast t
  556. Next
  557. Return list
  558. End Method
  559. Rem
  560. bbdoc: Create a new array
  561. End Rem
  562. Method NewArray:Object( length, dims:Int[] = Null )
  563. If Not _elementType Throw "TypeID is not an array type"
  564. Local tag:Byte Ptr=_elementType._typeTag
  565. If Not tag
  566. tag=TypeTagForId( _elementType ).ToCString()
  567. _elementType._typeTag=tag
  568. EndIf
  569. If Not dims Then
  570. Return bbArrayNew1D( tag,length )
  571. Else
  572. Return bbRefArrayCreate( tag, dims )
  573. End If
  574. End Method
  575. Rem
  576. bbdoc: Get array length
  577. End Rem
  578. Method ArrayLength( _array:Object, dim:Int = 0 )
  579. If Not _elementType Throw "TypeID is not an array type"
  580. Return bbRefArrayLength( _array, dim )
  581. End Method
  582. Rem
  583. bbdoc: Get the number of dimensions
  584. End Rem
  585. Method ArrayDimensions:Int( _array:Object )
  586. If Not _elementType Throw "TypeID is not an array type"
  587. Return bbRefArrayDimensions( _array )
  588. End Method
  589. Rem
  590. bbdoc: Get an array element
  591. End Rem
  592. Method GetArrayElement:Object( _array:Object,index )
  593. If Not _elementType Throw "TypeID is not an array type"
  594. Local p:Byte Ptr=bbRefArrayElementPtr( _elementType._size,_array,index )
  595. Return _Get( p,_elementType )
  596. End Method
  597. Rem
  598. bbdoc: Set an array element
  599. End Rem
  600. Method SetArrayElement( _array:Object,index,value:Object )
  601. If Not _elementType Throw "TypeID is not an array type"
  602. Local p:Byte Ptr=bbRefArrayElementPtr( _elementType._size,_array,index )
  603. _Assign p,_elementType,value
  604. End Method
  605. Rem
  606. bbdoc: Get Type by name
  607. End Rem
  608. Function ForName:TTypeId( name$ )
  609. _Update
  610. If name.EndsWith( "]" )
  611. ' TODO
  612. name=name[..name.length-2]
  613. Return TTypeId( _nameMap.ValueForKey( name.ToLower() ) ).ArrayType()
  614. Else
  615. Return TTypeId( _nameMap.ValueForKey( name.ToLower() ) )
  616. EndIf
  617. End Function
  618. Rem
  619. bbdoc: Get Type by object
  620. End Rem
  621. Function ForObject:TTypeId( obj:Object )
  622. _Update
  623. Local class:Byte Ptr=bbRefGetObjectClass( obj )
  624. If class=ArrayTypeId._class
  625. If Not bbRefArrayLength( obj ) Return ArrayTypeId
  626. Return TypeIdForTag( bbRefArrayTypeTag( obj ) ).ArrayType()
  627. Else
  628. Return TTypeId( _classMap.ValueForKey( New TClass.SetClass( class ) ) )
  629. EndIf
  630. End Function
  631. Rem
  632. bbdoc: Get list of all types
  633. End Rem
  634. Function EnumTypes:TList()
  635. _Update
  636. Local list:TList=New TList
  637. For Local t:TTypeId=EachIn _nameMap.Values()
  638. list.AddLast t
  639. Next
  640. Return list
  641. End Function
  642. '***** PRIVATE *****
  643. Method Init:TTypeId( name$,size,class:Byte Ptr=Null,supor:TTypeId=Null )
  644. _name=name
  645. _size=size
  646. _class=class
  647. _super=supor
  648. _fields=New TList
  649. _methods=New TList
  650. _nameMap.Insert _name.ToLower(),Self
  651. If class _classMap.Insert New TClass.SetClass( class ),Self
  652. Return Self
  653. End Method
  654. Method SetClass:TTypeId( class:Byte Ptr )
  655. ?x86
  656. Local debug:Int=(Int Ptr class)[2]
  657. Local name$=String.FromCString( Byte Ptr( (Int Ptr debug)[1] ) )
  658. ?x64
  659. Local debug:Long=(Long Ptr class)[2]
  660. Local name$=String.FromCString( Byte Ptr( (Long Ptr debug)[1] ) )
  661. ?
  662. Local meta$
  663. Local i=name.Find( "{" )
  664. If i<>-1
  665. meta=name[i+1..name.length-1]
  666. name=name[..i]
  667. EndIf
  668. _name=name
  669. _meta=meta
  670. _class=class
  671. _nameMap.Insert _name.ToLower(),Self
  672. _classMap.Insert New TClass.SetClass( class ),Self
  673. Return Self
  674. End Method
  675. Function _Update()
  676. Local count:Int
  677. ?x86
  678. Local p:Int Ptr Ptr=bbObjectRegisteredTypes( count )
  679. ?x64
  680. Local p:Long Ptr Ptr=bbObjectRegisteredTypes( count )
  681. ?
  682. If count=_count Return
  683. Local list:TList=New TList
  684. For Local i=_count Until count
  685. Local ty:TTypeId=New TTypeId.SetClass( p[i] )
  686. list.AddLast ty
  687. Next
  688. _count=count
  689. For Local t:TTypeId=EachIn list
  690. t._Resolve
  691. Next
  692. End Function
  693. Method _Resolve()
  694. If _fields Or Not _class Return
  695. _fields=New TList
  696. _methods=New TList
  697. ?x86
  698. _super=TTypeId( _classMap.ValueForKey( New TClass.SetClass( (Int Ptr _class)[0] ) ) )
  699. ?x64
  700. _super=TTypeId( _classMap.ValueForKey( New TClass.SetClass( (Long Ptr _class)[0] ) ) )
  701. ?
  702. If Not _super _super=ObjectTypeId
  703. If Not _super._derived _super._derived=New TList
  704. _super._derived.AddLast Self
  705. ?x86
  706. Local debug:Int Ptr=(Int Ptr Ptr _class)[2]
  707. Local p:Int Ptr=debug+2
  708. ?x64
  709. Local debug:Long=(Long Ptr _class)[2]
  710. Local p:Long Ptr=(Long Ptr debug)+2
  711. ?
  712. While p[0]
  713. Local id$=String.FromCString( Byte Ptr p[1] )
  714. Local ty$=String.FromCString( Byte Ptr p[2] )
  715. Local meta$
  716. Local i=ty.Find( "{" )
  717. If i<>-1
  718. meta=ty[i+1..ty.length-1]
  719. ty=ty[..i]
  720. EndIf
  721. Select p[0]
  722. Case 3 'field
  723. Local typeId:TTypeId=TypeIdForTag( ty )
  724. If typeId _fields.AddLast New TField.Init( id,typeId,meta,p[3] )
  725. Case 6 'method
  726. Local t$[]=ty.Split( ")" )
  727. Local retType:TTypeId=TypeIdForTag( t[1] )
  728. If retType
  729. Local argTypes:TTypeId[]
  730. If t[0].length>1
  731. Local i,b,q$=t[0][1..],args:TList=New TList
  732. While i<q.length
  733. Select q[i]
  734. Case Asc( "," )
  735. args.AddLast q[b..i]
  736. i:+1
  737. b=i
  738. Case Asc( "[" )
  739. i:+1
  740. While i<q.length And q[i]=Asc(",")
  741. i:+1
  742. Wend
  743. Default
  744. i:+1
  745. End Select
  746. Wend
  747. If b<q.length args.AddLast q[b..q.length]
  748. argTypes=New TTypeId[args.Count()]
  749. i=0
  750. For Local arg$=EachIn args
  751. argTypes[i]=TypeIdForTag( arg )
  752. If Not argTypes[i] retType=Null
  753. i:+1
  754. Next
  755. EndIf
  756. If retType
  757. _methods.AddLast New TMethod.Init( id,retType,meta,Self,Byte Ptr p[3],argTypes )
  758. EndIf
  759. EndIf
  760. End Select
  761. p:+4
  762. Wend
  763. End Method
  764. Field _name$
  765. Field _meta$
  766. Field _class:Byte Ptr
  767. Field _size=4
  768. Field _fields:TList
  769. Field _methods:TList
  770. Field _super:TTypeId
  771. Field _derived:TList
  772. Field _arrayType:TTypeId
  773. Field _elementType:TTypeId
  774. Field _typeTag:Byte Ptr
  775. Global _count,_nameMap:TMap=New TMap,_classMap:TMap=New TMap
  776. End Type