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

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

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