source: Include/Classes/System/TypeInfo.ab@ 271

' 実装中...
'（※ まだ組み込んでいません）


'Namespace System


Class TypeInfo
Public

    Sub TypeInfo()
    End Sub
    Sub ~TypeInfo()
    End Sub

    Override Function GetType() As TypeInfo
        Return _System_TypeBase.selfTypeInfo
    End Function

    Override Function ToString() As String
        Return FullName()
    End Function


    '----------------------------------------------------------------
    ' Public properties
    '----------------------------------------------------------------

    Abstract Function BaseType() As TypeInfo
    Abstract Function FullName() As String
    Abstract Function IsArray() As Boolean
    Abstract Function IsByRef() As Boolean
    Abstract Function IsClass() As Boolean
    Abstract Function IsEnum() As Boolean
    Abstract Function IsInterface() As Boolean
    Abstract Function IsPointer() As Boolean
    Abstract Function IsValueType() As Boolean
    Abstract Function Name() As String
    Abstract Function Namespace() As String



    '----------------------------------------------------------------
    ' Public methods
    '----------------------------------------------------------------

End Class


' 中間的な実装（継承専用）
Class TypeBaseImpl
    Inherits TypeInfo

    strNamespace As String
    name As String

Protected

    baseType As TypeInfo
    'interfaces As f(^^;;;

    Sub TypeBaseImpl()
        strNamespace = ""
        name = ""
        baseType = Nothing
    End Sub

    Sub TypeBaseImpl( strNamespace As String, name As String )
        This.strNamespace = strNamespace
        This.name = name
        This.baseType = Nothing
    End Sub

    Sub TypeBaseImpl( strNamespace As String, name As String, baseType As TypeInfo )
        This.strNamespace = strNamespace
        This.name = name
        This.baseType = baseType
    End Sub

    /*
    Sub TypeBaseImpl( strNamespace As String, name As String, baseType As Type, interfaces As ... )
        This.strNamespace = strNamespace
        This.name = name
        This.baseType = baseType
        This.interfaces = interfaces
    End Sub
    */

    Sub ~TypeBaseImpl()
    End Sub

Public


    '----------------------------------------------------------------
    ' Public properties
    '----------------------------------------------------------------

    Override Function BaseType() As TypeInfo
        Return baseType
    End Function

    Sub SetBaseType( baseType As TypeInfo )
        This.baseType = baseType
    End Sub

    Override Function FullName() As String
        If strNamespace.Length > 0 Then
            Return strNamespace + "." + name
        End If
        Return name
    End Function

    Override Function IsArray() As Boolean
        Return False
    End Function

    Override Function IsByRef() As Boolean
        Return False
    End Function

    Override Function IsClass() As Boolean
        Return False
    End Function

    Override Function IsEnum() As Boolean
        Return False
    End Function

    Override Function IsInterface() As Boolean
        Return False
    End Function

    Override Function IsPointer() As Boolean
        Return False
    End Function

    Override Function IsValueType() As Boolean
        Return False
    End Function

    Override Function Name() As String
        Return name
    End Function

    Override Function Namespace() As String
        Return strNamespace
    End Function



    '----------------------------------------------------------------
    ' Public methods
    '----------------------------------------------------------------

End Class


' 値型を管理するためのクラス
Class _System_TypeForValueType
    Inherits TypeBaseImpl
Public
    Sub _System_TypeForValueType( name As String )
        TypeBaseImpl( "", name )
    End Sub

    Override Function IsValueType() As Boolean
        Return True
    End Function
End Class

' クラスを管理するためのクラス
Class _System_TypeForClass
    Inherits TypeBaseImpl

Public
    referenceOffsets As *Long
    numOfReference As Long

    Sub _System_TypeForClass( strNamespace As String, name As String, referenceOffsets As *Long, numOfReference As Long )
        TypeBaseImpl( strNamespace, name )

        This.referenceOffsets = referenceOffsets
        This.numOfReference = numOfReference
    End Sub
    Sub _System_TypeForClass( strNamespace As String, name As String )
        TypeBaseImpl( strNamespace, name )
    End Sub
    Sub ~_System_TypeForClass()
    End Sub

    Override Function IsClass() As Boolean
        Return True
    End Function
End Class

' インターフェイスを管理するためのクラス
Class _System_TypeForInterface
    Inherits TypeBaseImpl
Public
End Class

' 列挙体を管理するためのクラス
Class _System_TypeForEnum
    Inherits TypeBaseImpl
Public
End Class

' デリゲートを管理するためのクラス
Class _System_TypeForDelegate
    Inherits TypeBaseImpl
Public
End Class


'--------------------------------------------------------------------
' プロセスに存在するすべての型を管理する
'--------------------------------------------------------------------
Class _System_TypeBase
    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
        count++
    End Sub

    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", [__offsets...], __numOfOffsets ) )
        'Search( "System","String" ).SetBaseType( Search( "System","Object" ) )
    End Sub

Public

    Static Sub Initialize()
        pTypes = GC_malloc( 1 )
        count = 0

        ' 値型を初期化
        InitializeValueType()

        isReady = True
        ' Class / Interface / Enum / Delegate を初期化
        InitializeUserTypes()

        selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As TypeInfo

        _System_DebugOnly_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
        For i = 0 To ELM( count )
            If pTypes[i].Name = typeName Then
                Return pTypes[i]
            End If
        Next

        Return Nothing
    End Function

    Static Function IsReady() As Boolean
        Return isReady
    End Function

    Static selfTypeInfo = Nothing As TypeInfo

End Class


' End Namespace ' System