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

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

動的型情報にメンバ情報を持たせた

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