Namespace ActiveBasic
Namespace Core


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

	strNamespace As String
	name As String

Protected

	baseType As System.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 System.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 System.TypeInfo
		Return baseType
	End Function

	Sub SetBaseType( baseType As System.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 isReady = False

	Static Sub Add( typeInfo As TypeBaseImpl )
		pTypes = realloc( pTypes, ( count + 1 ) * SizeOf(*System.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 count As Long
	Static Sub Initialize()
		pTypes = GC_malloc( 1 )
		count = 0

		' 値型を初期化
		InitializeValueType()

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

		selfTypeInfo = _System_TypeBase.Search( "System", "TypeInfo" ) As System.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 System.TypeInfo

End Class


End Namespace
End Namespace

Function _System_TypeBase_Search( strNamespace As LPSTR, typeName As LPSTR ) As ActiveBasic.Core.TypeBaseImpl
	Return ActiveBasic.Core._System_TypeBase.Search( strNamespace, typeName )
End Function
