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

Last change on this file since 413 was 413, checked in by dai, 16 years ago

ポインタ型の型情報取得に対応した。
File size: 8.5 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 End Sub
243
244 Static Sub InitializeUserTypes()
245 ' このメソッドの実装はコンパイラが自動生成する
246
247 '例:
248 'Add( New _System_TypeForClass( "System", "String", "System.String", [__offsets...], __numOfOffsets ) )
249 '...
250 End Sub
251 Static Sub InitializeUserTypesForBaseType()
252 ' このメソッドの実装はコンパイラが自動生成する
253
254 '例:
255 'Search( "System.String" ).SetBaseType( Search( "System.Object" ) )
256 '...
257 End Sub
258
259Public
260 Static Sub Initialize()
261 ' 値型を初期化
262 InitializeValueType()
263
264 ' Class / Interface / Enum / Delegate を初期化
265 InitializeUserTypes()
266
267 isReady = True
268
269 ' 基底クラスを登録
270 InitializeUserTypesForBaseType()
271
272 selfTypeInfo = _System_TypeBase.Search( "System.TypeInfo" ) As System.TypeInfo
273
274 _System_DebugOnly_OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
275 End Sub
276
277 Static Sub _NextPointerForGC()
278 ' TODO: 実装
279 End Sub
280
281 Static Function Search( fullName As String ) As TypeBaseImpl
282 If Object.ReferenceEquals(types, Nothing) Then
283 Return Nothing
284 End If
285
286 If isReady = False Then
287 Return Nothing
288 End If
289
290 If fullName[0] = &H2A Then ' fullName[0] = '*'
291 Dim result = Search( fullName.Substring( 1 ) )
292 Return result.GetPtrType()
293 End If
294
295 Search = types.Item(fullName)
296
297 If Object.ReferenceEquals( Search, Nothing ) Then
298 OutputDebugString("TypeSearch Failed: ")
299 If Not ActiveBasic.IsNothing(fullName) Then
300 OutputDebugStringW(StrPtr(fullName) As PWSTR)
301 OutputDebugString(Ex"\r\n")
302 OutputDebugStringA(StrPtr(fullName) As PSTR)
303 End If
304 OutputDebugString(Ex"\r\n")
305 End If
306 End Function
307
308 Static Function IsReady() As Boolean
309 Return isReady
310 End Function
311
312 Static selfTypeInfo As System.TypeInfo
313
314End Class
315
316
317End Namespace
318End Namespace
319
320Function _System_TypeBase_Search( fullName As String ) As ActiveBasic.Core.TypeBaseImpl
321 Return ActiveBasic.Core._System_TypeBase.Search( fullName )
322End Function
Note: See TracBrowser for help on using the repository browser.