source: branch/egtra-gdiplus/Classes/System/TypeInfo.ab

Last change on this file was 220, checked in by dai, 18 years ago

Namespaceステートメントを実装した。
3番目に確保されるメモリオブジェクトが解放されないバグを修正。

File size: 6.5 KB
Line 
1' 実装中...
2'(※ まだ組み込んでいません)
3
4
5'Namespace System
6
7
8Class TypeInfo
9Public
10
11 Sub TypeInfo()
12 End Sub
13 Sub ~TypeInfo()
14 End Sub
15
16 Override Function GetType() As TypeInfo
17 Return _System_TypeBase.selfTypeInfo
18 End Function
19
20
21 '----------------------------------------------------------------
22 ' Public properties
23 '----------------------------------------------------------------
24
25 Abstract Function BaseType() As TypeInfo
26 Abstract Function FullName() As String
27 Abstract Function IsArray() As Boolean
28 Abstract Function IsByRef() As Boolean
29 Abstract Function IsClass() As Boolean
30 Abstract Function IsEnum() As Boolean
31 Abstract Function IsInterface() As Boolean
32 Abstract Function IsPointer() As Boolean
33 Abstract Function IsValueType() As Boolean
34 Abstract Function Name() As String
35 Abstract Function Namespace() As String
36
37
38
39 '----------------------------------------------------------------
40 ' Public methods
41 '----------------------------------------------------------------
42
43End Class
44
45
46' 中間的な実装(継承専用)
47Class TypeBaseImpl
48 Inherits TypeInfo
49
50 strNamespace As String
51 name As String
52
53Protected
54
55 baseType As TypeInfo
56 'interfaces As f(^^;;;
57
58 Sub TypeBaseImpl()
59 strNamespace = ""
60 name = ""
61 baseType = Nothing
62 End Sub
63
64 Sub TypeBaseImpl( strNamespace As String, name As String )
65 This.strNamespace = strNamespace
66 This.name = name
67 This.baseType = Nothing
68 End Sub
69
70 Sub TypeBaseImpl( strNamespace As String, name As String, baseType As TypeInfo )
71 This.strNamespace = strNamespace
72 This.name = name
73 This.baseType = baseType
74 End Sub
75
76 /*
77 Sub TypeBaseImpl( strNamespace As String, name As String, baseType As Type, interfaces As ... )
78 This.strNamespace = strNamespace
79 This.name = name
80 This.baseType = baseType
81 This.interfaces = interfaces
82 End Sub
83 */
84
85 Sub ~TypeBaseImpl()
86 End Sub
87
88Public
89
90
91 '----------------------------------------------------------------
92 ' Public properties
93 '----------------------------------------------------------------
94
95 Override Function BaseType() As TypeInfo
96 Return baseType
97 End Function
98
99 Sub SetBaseType( baseType As TypeInfo )
100 This.baseType = baseType
101 End Sub
102
103 Override Function FullName() As String
104 Return strNamespace + "." + name
105 End Function
106
107 Override Function IsArray() As Boolean
108 Return False
109 End Function
110
111 Override Function IsByRef() As Boolean
112 Return False
113 End Function
114
115 Override Function IsClass() As Boolean
116 Return False
117 End Function
118
119 Override Function IsEnum() As Boolean
120 Return False
121 End Function
122
123 Override Function IsInterface() As Boolean
124 Return False
125 End Function
126
127 Override Function IsPointer() As Boolean
128 Return False
129 End Function
130
131 Override Function IsValueType() As Boolean
132 Return False
133 End Function
134
135 Override Function Name() As String
136 Return name
137 End Function
138
139 Override Function Namespace() As String
140 Return strNamespace
141 End Function
142
143
144
145 '----------------------------------------------------------------
146 ' Public methods
147 '----------------------------------------------------------------
148
149End Class
150
151
152' 値型を管理するためのクラス
153Class _System_TypeForValueType
154 Inherits TypeBaseImpl
155Public
156 Sub _System_TypeForValueType( name As String )
157 TypeBaseImpl( "", name )
158 End Sub
159
160 Override Function IsValueType() As Boolean
161 Return True
162 End Function
163End Class
164
165' クラスを管理するためのクラス
166Class _System_TypeForClass
167 Inherits TypeBaseImpl
168
169Public
170 referenceOffsets As *Long
171 numOfReference As Long
172
173 Sub _System_TypeForClass( strNamespace As String, name As String, referenceOffsets As *Long, numOfReference As Long )
174 TypeBaseImpl( strNamespace, name )
175
176 This.referenceOffsets = referenceOffsets
177 This.numOfReference = numOfReference
178 End Sub
179 Sub _System_TypeForClass( strNamespace As String, name As String )
180 TypeBaseImpl( strNamespace, name )
181 End Sub
182 Sub ~_System_TypeForClass()
183 End Sub
184
185 Override Function IsClass() As Boolean
186 Return True
187 End Function
188End Class
189
190' インターフェイスを管理するためのクラス
191Class _System_TypeForInterface
192 Inherits TypeBaseImpl
193Public
194End Class
195
196' 列挙体を管理するためのクラス
197Class _System_TypeForEnum
198 Inherits TypeBaseImpl
199Public
200End Class
201
202' デリゲートを管理するためのクラス
203Class _System_TypeForDelegate
204 Inherits TypeBaseImpl
205Public
206End Class
207
208
209'--------------------------------------------------------------------
210' プロセスに存在するすべての型を管理する
211'--------------------------------------------------------------------
212Class _System_TypeBase
213 Static pTypes As *TypeBaseImpl
214 Static count As Long
215 Static isReady = False
216
217 Static Sub Add( typeInfo As TypeBaseImpl )
218 pTypes = realloc( pTypes, ( count + 1 ) * SizeOf(*TypeInfo) )
219 pTypes[count] = typeInfo
220 count++
221 End Sub
222
223 Static Sub InitializeValueType()
224 ' 値型の追加
225 Add( New _System_TypeForValueType( "Byte" ) )
226 Add( New _System_TypeForValueType( "SByte" ) )
227 Add( New _System_TypeForValueType( "Word" ) )
228 Add( New _System_TypeForValueType( "Integer" ) )
229 Add( New _System_TypeForValueType( "DWord" ) )
230 Add( New _System_TypeForValueType( "Long" ) )
231 Add( New _System_TypeForValueType( "QWord" ) )
232 Add( New _System_TypeForValueType( "Int64" ) )
233 Add( New _System_TypeForValueType( "Boolean" ) )
234 Add( New _System_TypeForValueType( "Single" ) )
235 Add( New _System_TypeForValueType( "Double" ) )
236 End Sub
237
238 Static Sub InitializeUserTypes()
239 ' このメソッドの実装はコンパイラが自動生成する
240
241 '例:
242 'Add( New _System_TypeForClass( "System", "String", [__offsets...], __numOfOffsets ) )
243 'Search( "System","String" ).SetBaseType( Search( "System","Object" ) )
244 End Sub
245
246Public
247
248 Static Sub Initialize()
249 pTypes = GC_malloc( 1 )
250 count = 0
251
252 ' 値型を初期化
253 InitializeValueType()
254
255 isReady = True
256 ' Class / Interface / Enum / Delegate を初期化
257 InitializeUserTypes()
258
259 selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As TypeInfo
260
261 OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
262 End Sub
263
264 Static Sub _NextPointerForGC()
265 ' TODO: 実装
266 End Sub
267
268 Static Function Search( strNamespace As LPSTR, typeName As LPSTR ) As TypeBaseImpl
269 ' TODO: 名前空間に対応する
270 Dim i As Long
271 For i = 0 To ELM( count )
272 If pTypes[i].Name = typeName Then
273 Return pTypes[i]
274 End If
275 Next
276
277 Return Nothing
278 End Function
279
280 Static Function IsReady() As Boolean
281 Return isReady
282 End Function
283
284 Static selfTypeInfo = Nothing As TypeInfo
285
286End Class
287
288
289' End Namespace ' System
Note: See TracBrowser for help on using the repository browser.