Changeset 207 for Include/Classes

Timestamp:

Apr 7, 2007, 3:03:38 PM (17 years ago)

Author:

dai

Message:

動的型情報（Object.GetType）に対応。
戻り値やクラスメンバがオブジェクトだったとき、その初期値をNothingにした（※戻り値として関数名を使っている部分、要注意！！）。

Location:

Include/Classes/System

Files:

• Collections/ArrayList.ab (modified) (1 diff)
• DateTime.ab (modified) (4 diffs)
• Diagnostics/base.ab (modified) (1 diff)
• Object.ab (modified) (2 diffs)
• String.ab (modified) (1 diff)
• TypeInfo.ab (modified) (10 diffs)

Include/Classes/System/Collections/ArrayList.ab

@@ -304 +304 @@
     End Sub
 
-    /*Override*/ Virtual Function ToString() As String
+    /*Override*/ Override Function ToString() As String
         Return "System.Collections.ArrayList"
     End Function

Include/Classes/System/DateTime.ab

@@ -272 +272 @@
         End If
 
-        AddTicks.Ticks = ticks + value
-        AddTicks.Kind = Kind
+        Return New DateTime( ticks + value, Kind )
     End Function
 
@@ -315 +314 @@
         End If
         
-        AddYears.Ticks = ticks
-        AddYears.Kind = Kind
+        Return New DateTime( ticks, Kind )
     End Function
 
@@ -363 +361 @@
             .wDayOfWeek = DayOfWeek() As Word
         End With
+
+        GetDateTimeFormats = New String()
 
         Dim size As Long
@@ -481 +481 @@
         ElseIf dateData = &H03 Then
             Return DateTimeKind.Utc
+        Else
+            ' どれにも該当しなかったときはどうなるんでしょうか？？
+            Return DateTimeKind.Local
         End If
     End Function

Include/Classes/System/Diagnostics/base.ab

@@ -12 +12 @@
     ' コンストラクタ
     Sub _System_TraceBase()
-        Dim defaultTraceListener As DefaultTraceListener
-        listeners.Add( defaultTraceListener )
+        listeners = New TraceListenerCollection
+        listeners.Add( New DefaultTraceListener() )
 
         indentLevel = 0

Include/Classes/System/Object.ab

@@ -1 +1 @@
 Class Object
-
-    ' 実行時型情報
-    typeInfo As TypeInfo
 
 Public
@@ -37 +34 @@
     End Function
 */
+
+
+    '----------------------------------------------------------------
+    ' 実行時型情報
+    '----------------------------------------------------------------
+
+Private
+    typeInfo As TypeInfo
+
+Public
+    Sub _System_SetType( typeInfo As TypeInfo )
+        If _System_TypeBase.IsReady() = False Then
+            Return
+        End If
+
+        This.typeInfo = typeInfo
+    End Sub
+
+    Function GetType() As TypeInfo
+        Return typeInfo
+    End Function
+
 End Class
+Dim aaa As Long

Include/Classes/System/String.ab

@@ -345 +345 @@
 Private
     Static Function ConcatStrChar(text1 As *StrChar, text1Length As Long, text2 As *StrChar, text2Length As Long) As String
+        ConcatStrChar = New String()
         With ConcatStrChar
             .AllocStringBuffer(text1Length + text2Length)

Include/Classes/System/TypeInfo.ab

@@ -10 +10 @@
 
     Sub TypeInfo()
+    End Sub
+    Sub ~TypeInfo()
     End Sub
 
@@ -45 +47 @@
     name As String
 
+Protected
+
     baseType As TypeInfo
     'interfaces As f(^^;;;
-
-Protected
 
     Sub TypeBaseImpl()
@@ -77 +79 @@
     */
 
+    Sub ~TypeBaseImpl()
+    End Sub
+
 Public
 
@@ -88 +93 @@
     End Function
 
+    Sub SetBaseType( baseType As TypeInfo )
+        This.baseType = baseType
+    End Sub
+
     Override Function FullName() As String
         Return strNamespace + "." + name
@@ -142 +151 @@
 Public
     Sub _System_TypeForValueType( name As String )
-        TypeInfo( "", name )
+        TypeBaseImpl( "", name )
     End Sub
 
@@ -154 +163 @@
     Inherits TypeBaseImpl
 Public
-    Sub _System_TypeForClass( strNamespace As String, name As String, baseType As TypeInfo )
-        TypeBaseImpl( strNamespace, name, baseType )
+    Sub _System_TypeForClass( strNamespace As String, name As String )
+        TypeBaseImpl( strNamespace, name )
     End Sub
     Sub ~_System_TypeForClass()
@@ -162 +171 @@
         Return True
     End Function
-
-    Sub SetBaseType( baseType As TypeInfo )
-        This.baseType = baseType
-    End Sub
 End Class
 
@@ -188 +193 @@
 
 '--------------------------------------------------------------------
-' プロセスに存在するすべての型を管理する（シングルトン クラス）
+' プロセスに存在するすべての型を管理する
 '--------------------------------------------------------------------
 Class _System_TypeBase
-    pTypes As *TypeInfo
-    count As Long
-
-    Sub _System_TypeBase()
-        pTypes = GC_malloc( 1 )
-        count = 0
-    End Sub
-    Sub ~_System_TypeBase()
-    End Sub
-
-    Sub Add( typeInfo As TypeInfo )
+    Static pTypes As *TypeBaseImpl
+    Static count As Long
+    Static isReady = False
+
+    Static Sub Add( typeInfo As TypeBaseImpl )
         pTypes = realloc( pTypes, ( count + 1 ) * SizeOf(*TypeInfo) )
         pTypes[count] = typeInfo
@@ -207 +206 @@
     End Sub
 
-    Function Search( strNamespace As String, typeName As String ) As TypeInfo
+    Static Sub InitializeValueType()
+        ' 値型の追加
+        Add( New _System_TypeForValueType( "Byte" ) )
+        Add( New _System_TypeForValueType( "SByte" ) )
+        Add( New _System_TypeForValueType( "Word" ) )
+        Add( New _System_TypeForValueType( "Integer" ) )
+        Add( New _System_TypeForValueType( "DWord" ) )
+        Add( New _System_TypeForValueType( "Long" ) )
+        Add( New _System_TypeForValueType( "QWord" ) )
+        Add( New _System_TypeForValueType( "Int64" ) )
+        Add( New _System_TypeForValueType( "Boolean" ) )
+        Add( New _System_TypeForValueType( "Single" ) )
+        Add( New _System_TypeForValueType( "Double" ) )
+    End Sub
+
+    Static Sub InitializeUserTypes()
+        ' このメソッドの実装はコンパイラが自動生成する
+
+        '例:
+        'Add( New _System_TypeForClass( "System", "String" ) )
+        'Search( "String" ).SetBaseType( Search( "Object" ) )
+    End Sub
+
+Public
+
+    Static Sub Initialize()
+        pTypes = GC_malloc( 1 )
+        count = 0
+
+        ' 値型を初期化
+        InitializeValueType()
+
+        isReady = True
+        ' Class / Interface / Enum / Delegate を初期化
+        InitializeUserTypes()
+
+
+        OutputDebugString( Ex"ready dynamic meta datas!\r\n" )
+    End Sub
+
+    Static Sub _NextPointerForGC()
+        ' TODO: 実装
+    End Sub
+
+    Static Function Search( strNamespace As LPSTR, typeName As LPSTR ) As TypeBaseImpl
+
         ' TODO: 名前空間に対応する
         Dim i As Long
@@ -215 +259 @@
             End If
         Next
+
         Return Nothing
     End Function
 
-    ' シングルトン オブジェクト
-    Static obj As _System_TypeBase
-
-    Static Sub InitializeValueType()
-        ' 値型の追加
-        obj.Add( New _System_TypeForValueType( "Byte" ) )
-        obj.Add( New _System_TypeForValueType( "SByte" ) )
-        obj.Add( New _System_TypeForValueType( "Word" ) )
-        obj.Add( New _System_TypeForValueType( "Integer" ) )
-        obj.Add( New _System_TypeForValueType( "DWord" ) )
-        obj.Add( New _System_TypeForValueType( "Long" ) )
-        obj.Add( New _System_TypeForValueType( "QWord" ) )
-        obj.Add( New _System_TypeForValueType( "Int64" ) )
-        obj.Add( New _System_TypeForValueType( "Boolean" ) )
-        obj.Add( New _System_TypeForValueType( "Single" ) )
-        obj.Add( New _System_TypeForValueType( "Double" ) )
-    End Sub
-
-    Static Sub InitializeUserTypes()
-        ' このメソッドの実装はコンパイラが自動生成する
-
-#generate InitializeUserTypes
-
-        '例:
-        'obj.Add( New _System_TypeForClass( "System", "String" ) )
-        'obj.Search( "String" ).SetBaseType( Search( "Object" ) )
-    End Sub
-
-Public
-
-    Static Sub _NextPointerForGC()
-        ' TODO: 実装
-    End Sub
-
-    Static Sub Initialize()
-        ' 値型を初期化
-        InitializeValueType()
-
-        ' Class / Interface / Enum / Delegate を初期化
-        InitializeUserTypes()
-    End Sub
-End Class
+    Static Function IsReady() As Boolean
+        Return isReady
+    End Function
+
+End Class
+
 
 ' End Namespace ' System