Changeset 195 for Include/Classes/System/TypeInfo.ab

Timestamp:

Mar 30, 2007, 4:22:30 AM (17 years ago)

Author:

dai

Message:

オブジェクトの循環参照を許容した（構造体はダメ）。
抽象クラスをメンバの型に指定できるようにした。
メンバがオブジェクトだったとき、自動的にNewするのをやめ、初期値としてNothingを指定するようにした。

【ArrayListの改良】
・ArrayList_Elementを廃止し、実装をArrayListのprivateに置いた。
・一通りのパラメータを*ObjectからObjectへ変更した。

【その他】
・TypeInfo改良中...
・Objectクラスに実行時型情報用のtypeInfoメンバを追加した。

File:

• Include/Classes/System/TypeInfo.ab (modified) (11 diffs)

Include/Classes/System/TypeInfo.ab

@@ -1 +1 @@
 ' 実装中...
 '（※ まだ組み込んでいません）
+
+
+'Namespace System
+
 
 Class TypeInfo
@@ -35 +39 @@
 
 ' 中間的な実装（継承専用）
-Class TypeImpl
+Class TypeBaseImpl
     Inherits TypeInfo
 
@@ -46 +50 @@
 Protected
 
-    Sub TypeImpl()
+    Sub TypeBaseImpl()
         name = ""
         strNamespace = ""
@@ -52 +56 @@
     End Sub
 
-    Sub TypeImpl( name As String, strNamespace As String )
+    Sub TypeBaseImpl( name As String, strNamespace As String )
         This.name = name
         This.strNamespace = strNamespace
-        baseType = Nothing
-    End Sub
-
-    Sub TypeImpl( name As String, strNamespace As String, baseType As Type )
-        TypeImpl( name, strNamespace )
+        This.baseType = Nothing
+    End Sub
+
+    Sub TypeBaseImpl( name As String, strNamespace As String, baseType As TypeInfo )
+        This.name = name
+        This.strNamespace = strNamespace
         This.baseType = baseType
     End Sub
 
     /*
-    Sub TypeImpl( name As String, strNamespace As String, baseType As Type, interfaces As ... )
-        TypeImpl( name, strNamespace, baseType )
+    Sub TypeBaseImpl( name As String, strNamespace As String, baseType As Type, interfaces As ... )
+        TypeBaseImpl( name, strNamespace, baseType )
     End Sub
     */
@@ -131 +136 @@
 ' 値型を管理するためのクラス
 Class _System_TypeForValueType
-    Inherits TypeImpl
-Public
-    Sub _System_TypeForValueType( name )
+    Inherits TypeBaseImpl
+Public
+    Sub _System_TypeForValueType( name As String )
         TypeInfo( name, "" )
     End Sub
@@ -144 +149 @@
 ' クラスを管理するためのクラス
 Class _System_TypeForClass
-    Inherits TypeImpl
-Public
+    Inherits TypeBaseImpl
+Public
+    Sub _System_TypeForClass( name As String, strNamespace As String, baseType As TypeInfo )
+        TypeBaseImpl( name, strNamespace, baseType )
+    End Sub
+    Sub ~_System_TypeForClass()
+    End Sub
+    Override Function IsClass() As Boolean
+        Return True
+    End Function
 End Class
 
 ' インターフェイスを管理するためのクラス
 Class _System_TypeForInterface
-    Inherits TypeImpl
+    Inherits TypeBaseImpl
 Public
 End Class
@@ -156 +169 @@
 ' 列挙体を管理するためのクラス
 Class _System_TypeForEnum
-    Inherits TypeImpl
+    Inherits TypeBaseImpl
 Public
 End Class
@@ -162 +175 @@
 ' デリゲートを管理するためのクラス
 Class _System_TypeForDelegate
-    Inherits TypeImpl
+    Inherits TypeBaseImpl
 Public
 End Class
@@ -171 +184 @@
 '--------------------------------------------------------------------
 Class _System_TypeBase
-    ppTypes As *Type
+    pTypes As *TypeInfo
     count As Long
 
     Sub _System_TypeBase()
-        ppTypes = GC_malloc( 1 )
+        pTypes = GC_malloc( 1 )
         count = 0
     End Sub
     Sub ~_System_TypeBase()
-        Dim i As Long
-        For i=0 To ELM( count )
-            Delete ppTypes[i]
-        Next
+    End Sub
+
+    Sub _add( typeInfo As TypeInfo )
+        pTypes = realloc( pTypes, ( count + 1 ) * SizeOf(*TypeInfo) )
+        pTypes[count] = typeInfo
+        count++
     End Sub
 
@@ -190 +205 @@
 Public
 
-    Sub Add( pType As *Type )
-        ppTypes = realloc( ppTypes, ( count + 1 ) * SizeOf(*Type) )
-        ppTypes[count] = pType
-        count++
+    Static Sub Add( typeInfo As TypeInfo )
+        obj._add( typeInfo )
     End Sub
 
@@ -214 +227 @@
         obj.Add( New _System_TypeForValueType( "Double" ) )
     End Sub
-End Class
+
+    Static Sub InitializeUserTypes()
+        ' このメソッドの実装はコンパイラが自動生成する
+    End Sub
+
+    Static Sub Initialize()
+        ' 値型を初期化
+        InitializeValueType()
+
+        ' Class / Interface / Enum / Delegate を初期化
+        InitializeUserTypes()
+    End Sub
+End Class
+
+' End Namespace ' System