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

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

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