source: trunk/Include/Classes/ActiveBasic/Core/TypeInfo.ab@ 450

Last change on this file since 450 was 450, checked in by dai, 17 years ago

VoidPtr型の動的型情報を追加。
File size: 8.6 KB
Line 
1Namespace ActiveBasic
2Namespace Core
3
4
5' 中間的な実装（継承専用）
6Class TypeBaseImpl
7 Inherits System.TypeInfo
8
9 strNamespace As String
10 name As String
11 fullName As String
12
13 ptrType As TypeBaseImpl
14 ptrLevel As Long
15
16 ' メンバ情報
17 memberNames As *String ' 名前リスト
18 memberTypeFullNames As *String ' 型名リスト
19 memberCounts As Long ' 個数
20 memberInfosCache As System.Collections.Generic.List<System.Reflection.MemberInfo>
21
22Protected
23
24 baseType As System.TypeInfo
25 'interfaces As f(^^;;;
26
27 Sub TypeBaseImpl( strNamespace As String, name As String, fullName As String )
28 This.strNamespace = strNamespace
29 This.name = name
30 This.fullName = fullName
31 This.baseType = Nothing
32
33 ptrType = Nothing
34 ptrLevel = 0
35 End Sub
36
37 Sub ~TypeBaseImpl()
38 End Sub
39
40 Sub PtrLevelUp()
41 ptrLevel ++
42 fullName = "*" + fullName
43 End Sub
44
45 Function Clone() As TypeBaseImpl
46 Dim result = New TypeBaseImpl( strNamespace, name, fullName )
47 result.SetBaseType( baseType )
48 result.SetMembers( memberNames, memberTypeFullNames, memberCounts )
49 result.memberInfosCache = This.memberInfosCache
50 result.ptrLevel = This.ptrLevel
51 Return result
52 End Function
53
54Public
55
56 Sub SetMembers( memberNames As *String, memberTypeFullNames As *String, num As Long )
57 This.memberNames = memberNames
58 This.memberTypeFullNames = memberTypeFullNames
59 This.memberCounts = num
60
61 /*
62 OutputDebugString( Ex"\r\n" )
63 Dim i As Long
64 For i=0 To ELM(num)
65 OutputDebugString( memberNames[i] )
66 OutputDebugString( ", " )
67 OutputDebugString( memberTypeFullNames[i] )
68 OutputDebugString( Ex"\r\n" )
69 Next
70 */
71 End Sub
72
73 Function GetPtrType() As TypeBaseImpl
74 If Object.ReferenceEquals( ptrType, Nothing ) Then
75 Dim clone = This.Clone()
76
77 ptrType = clone
78 ptrType.PtrLevelUp()
79 End If
80 Return ptrType
81 End Function
82
83
84 '----------------------------------------------------------------
85 ' Public properties
86 '----------------------------------------------------------------
87
88 Override Function BaseType() As System.TypeInfo
89 Return baseType
90 End Function
91
92 Sub SetBaseType( baseType As System.TypeInfo )
93 This.baseType = baseType
94 End Sub
95
96 Override Function FullName() As String
97 Return fullName
98 End Function
99
100 Override Function IsArray() As Boolean
101 Return False
102 End Function
103
104 Override Function IsByRef() As Boolean
105 Return False
106 End Function
107
108 Override Function IsClass() As Boolean
109 Return False
110 End Function
111
112 Override Function IsEnum() As Boolean
113 Return False
114 End Function
115
116 Override Function IsInterface() As Boolean
117 Return False
118 End Function
119
120 Override Function IsPointer() As Boolean
121 Return ( ptrLevel > 0 )
122 End Function
123
124 Override Function IsValueType() As Boolean
125 Return False
126 End Function
127
128 Override Function Name() As String
129 Return name
130 End Function
131
132 Override Function Namespace() As String
133 Return strNamespace
134 End Function
135
136
137
138 '----------------------------------------------------------------
139 ' Public methods
140 '----------------------------------------------------------------
141
142 Override Function GetMembers() As System.Collections.Generic.List<System.Reflection.MemberInfo>
143 If Object.ReferenceEquals( memberInfosCache, Nothing ) Then
144 ' キャッシュにないときは生成する
145 memberInfosCache = New System.Collections.Generic.List
146 Dim i As Long
147 For i=0 To ELM(memberCounts)
148 memberInfosCache.Add( New System.Reflection.MemberInfo( memberNames[i], _System_TypeBase_Search( memberTypeFullNames[i] ) ) )
149 Next
150 End If
151
152 Return memberInfosCache
153 End Function
154
155End Class
156
157
158' 値型を管理するためのクラス
159Class _System_TypeForValueType
160 Inherits TypeBaseImpl
161Public
162 Sub _System_TypeForValueType( name As String )
163 TypeBaseImpl( "", name, name )
164 End Sub
165
166 Override Function IsValueType() As Boolean
167 Return True
168 End Function
169End Class
170
171' クラスを管理するためのクラス
172Class _System_TypeForClass
173 Inherits TypeBaseImpl
174
175Public
176 referenceOffsets As *Long
177 numOfReference As Long
178
179 Sub _System_TypeForClass( strNamespace As String, name As String, fullName As String, referenceOffsets As *Long, numOfReference As Long )
180 TypeBaseImpl( strNamespace, name, fullName )
181
182 This.referenceOffsets = referenceOffsets
183 This.numOfReference = numOfReference
184 End Sub
185 Sub _System_TypeForClass( strNamespace As String, name As String, fullName As String )
186 TypeBaseImpl( strNamespace, name, fullName )
187 End Sub
188 Sub ~_System_TypeForClass()
189 End Sub
190
191 Override Function IsClass() As Boolean
192 Return True
193 End Function
194End Class
195
196' インターフェイスを管理するためのクラス
197Class _System_TypeForInterface
198 Inherits TypeBaseImpl
199Public
200End Class
201
202' 列挙体を管理するためのクラス
203Class _System_TypeForEnum
204 Inherits TypeBaseImpl
205Public
206End Class
207
208' デリゲートを管理するためのクラス
209Class _System_TypeForDelegate
210 Inherits TypeBaseImpl
211Public
212End Class
213
214
215'--------------------------------------------------------------------
216' プロセスに存在するすべての型を管理する
217'--------------------------------------------------------------------
218Class _System_TypeBase
219 Static types As System.Collections.Generic.Dictionary<String, TypeBaseImpl>
220
221 Static isReady = False
222
223 Static Sub Add( typeInfo As TypeBaseImpl )
224 types.Add( typeInfo.FullName, typeInfo )
225 End Sub
226
227 Static Sub InitializeValueType()
228 types = New System.Collections.Generic.Dictionary<String, TypeBaseImpl>(8191)
229
230 ' 値型の追加
231 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Byte", fullName = "Byte" ] )
232 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "SByte", fullName = "SByte" ] )
233 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Word", fullName = "Word" ] )
234 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Integer", fullName = "Integer" ] )
235 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "DWord", fullName = "DWord" ] )
236 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Long", fullName = "Long" ] )
237 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "QWord", fullName = "QWord" ] )
238 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Int64", fullName = "Int64" ] )
239 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Boolean", fullName = "Boolean" ] )
240 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Single", fullName = "Single" ] )
241 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "Double", fullName = "Double" ] )
242 Add( _System_Static_New _System_TypeForValueType[ strNamespace = "", name = "VoidPtr", fullName = "VoidPtr" ] )
243 End Sub
244
245 Static Sub InitializeUserTypes()
246 ' このメソッドの実装はコンパイラが自動生成する
247
248 '例:
249 'Add( New _System_TypeForClass( "System", "String", "System.String", [__offsets...], __numOfOffsets ) )
250 '...
251 End Sub
252 Static Sub InitializeUserTypesForBaseType()
253 ' このメソッドの実装はコンパイラが自動生成する
254
255 '例:
256 'Search( "System.String" ).SetBaseType( Search( "System.Object" ) )
257 '...
258 End Sub
259
260Public
261 Static Sub Initialize()
262 ' 値型を初期化
263 InitializeValueType()
264
265 ' Class / Interface / Enum / Delegate を初期化
266 InitializeUserTypes()
267
268 isReady = True
269
270 ' 基底クラスを登録
271 InitializeUserTypesForBaseType()
272
273 selfTypeInfo = _System_TypeBase.Search( "System.TypeInfo" ) As System.TypeInfo
274
275 _System_DebugOnly_OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
276 End Sub
277
278 Static Sub _NextPointerForGC()
279 ' TODO: 実装
280 End Sub
281
282 Static Function Search( fullName As String ) As TypeBaseImpl
283 If Object.ReferenceEquals(types, Nothing) Then
284 Return Nothing
285 End If
286
287 If isReady = False Then
288 Return Nothing
289 End If
290
291 If fullName[0] = &H2A Then ' fullName[0] = '*'
292 Dim result = Search( fullName.Substring( 1 ) )
293 Return result.GetPtrType()
294 End If
295
296 Search = types.Item(fullName)
297
298 If Object.ReferenceEquals( Search, Nothing ) Then
299 OutputDebugString("TypeSearch Failed: ")
300 If Not ActiveBasic.IsNothing(fullName) Then
301 OutputDebugStringW(StrPtr(fullName) As PWSTR)
302 OutputDebugString(Ex"\r\n")
303 OutputDebugStringA(StrPtr(fullName) As PSTR)
304 End If
305 OutputDebugString(Ex"\r\n")
306 End If
307 End Function
308
309 Static Function IsReady() As Boolean
310 Return isReady
311 End Function
312
313 Static selfTypeInfo As System.TypeInfo
314
315End Class
316
317
318End Namespace
319End Namespace
320
321Function _System_TypeBase_Search( fullName As String ) As ActiveBasic.Core.TypeBaseImpl
322 Return ActiveBasic.Core._System_TypeBase.Search( fullName )
323End Function
Note: See TracBrowser for help on using the repository browser.