Interfaces for BlitzMax

Got an idea from the other thread about implementing Java-like interfaces using reflection and meta data.

Does this look in any way useful?

SuperStrict

Framework BRL.StandardIO

Import BRL.LinkedList

Import "Interface.bmx"

Type TBaseType
	
	'This would contain something that TSubType needs, but TAnotherType doesn't
	
End Type

Type TSubType Extends TBaseType { Implements ICallable }
	
	Method Call(message:Object)
		Print message.ToString()
	End Method
	
End Type

Type TAnotherType { Implements ICallable }
	
	Method Call(message:Object)
		Print "Got message: "+message.ToString()
	End Method
	
End Type

Type ICallable Extends TInterface
	
	Method Call(message:Object)
		_method "Call", [message]
	End Method
	
	Function Cast:ICallable(o:Object)
		Return ICallable(TInterface._cast(o, "ICallable"))
	End Function
	
End Type

'Sets up my interface implementation
TInterface.Setup()

'Create a couple of objects
Local s:TSubType = New TSubType
Local a:TAnotherType = New TAnotherType

'Add to a list
Local list:TList = New TList
list.AddLast s
list.AddLast a

'Enumerate the list as ICallables
For Local i:ICallable = EachIn ICallable.Cast( list )
	i.Call "Hello World!"
Next

'Cast the objects directly to ICallables
Local i:ICallable
i = ICallable.Cast(s)
i.Call "Hi!"
i = ICallable.Cast(a)
i.Call "Hi!"

Output:

Hello World!
Got message: Hello World!
Hi!
Got message: Hi!

Useful yes :-)

But reflection isn't very fast. So it's not the sort of thing you'd want to use if speed was important.

Yeah, it may be relatively slow.

Here's the code. A bit of a hack, but I tried to make it readable:

SuperStrict

Import BRL.Map
Import BRL.Reflection

'Interface base type
Type TInterface
	
	Field _object:Object
	Field _type:TTypeId
	Field _interface:TTypeId
	Field _enumerable:Object
	Field _enumerator:TMethod
	
	'Calls a method implemented by the interface
	Method _method(name:String, args:Object[])
		If Not _interface.FindMethod(name) RuntimeError "Interface "+_interface.Name()+" does not have method "+name
		
		If Not _object RuntimeError "Type "+_type.Name()+" does not implement "+_interface.Name()+"!"
		
		_type.FindMethod(name).Invoke _object, args
	End Method
	
	'For Eachin support
	Method ObjectEnumerator:TInterfaceEnum()
		Local e:TInterfaceEnum = New TInterfaceEnum
		e.SetObject Self
		Return e
	End Method
	
	Global interfaces:TMap = New TMap
	Global interfacesForType:TMap = New TMap
	
	Function Setup()
		'Find this type's TTypeId
		Local this:TTypeId = TTypeId.ForName("TInterface")
		
		'Create a map of interfaces
		For Local i:TTypeId = EachIn this.DerivedTypes()
			interfaces.Insert i.Name().ToLower(), i
		Next
		
		'Check that all types implement correct methods
		For Local t:TTypeId = EachIn TTypeId.EnumTypes()
			Local s:String = t.MetaData().ToLower()
			If Not s.Contains("implements") Continue
			
			s = s.Split("implements")[1][2..]
			
			Local l:TList = New TList
			For Local iname:String = EachIn s.split(" ")
				iname = iname.Trim()
				iname = iname[..iname.length-2]
				If Not iname Continue
				Local i:TTypeId = TTypeId( interfaces.ValueForKey(iname) )
				If Not i RuntimeError "Interface "+iname+" does not exist!"
				For Local m:TMethod = EachIn i.EnumMethods()
					If m.Name() = "_method" Or m.Name() = "ObjectEnumerator" Continue
					If Not t.FindMethod( m.Name() ) RuntimeError "Type "+t.Name()+" must implement "+m.Name()+"!"
					'TODO: compare signatures
				Next
				l.AddLast i
			Next
			
			interfacesForType.Insert t.Name().ToLower(), l
		Next
	End Function
	
	'Casts o to Interface iname
	Function _cast:TInterface(o:Object, iname:String, i:TTypeId=Null)
		'Check if the interface exists
		If Not i i = TTypeId(interfaces.ValueForKey(iname.ToLower()))
		If Not i RuntimeError "Interface "+iname+" does not exist!"
		
		'Check if the type implements the interface
		
		Local t:TTypeId = TTypeId.ForObject(o)
		Local l:TList = TList(  interfacesForType.ValueForKey( t.Name().ToLower() )  )
		If Not l Return _castenumerable(o, t, i)
		
		Local ii:TTypeId
		For Local j:TTypeId = EachIn l
			If i=j Then ii = i
		Next
		If Not ii Return _castenumerable(o, t, i)
		
		'Create an interface object
		Local casted:TInterface = TInterface( i.NewObject() )
		casted._object = o
		casted._type = t
		casted._interface = i
		
		Return casted
	End Function
	
	'Object does not implement the interface - is it a collection?
	Function _castenumerable:TInterface(o:Object, t:TTypeId, i:TTypeId)
		Local e:TMethod = t.FindMethod("ObjectEnumerator")
		If Not e RuntimeError "Type "+t.Name()+" does not implement "+i.Name()+"!"
		
		'Create an interface object
		Local casted:TInterface = TInterface( i.NewObject() )
		casted._enumerable = o
		casted._type = t
		casted._interface = i
		casted._enumerator = e
		
		Return casted
	End Function
	
End Type

'Enumerator for collection casts
Type TInterfaceEnum
	Field i:TInterface
	Field enum:Object, has:TMethod, get:TMethod
	
	'Associates the enumerator with an object, finds methods
	Method SetObject(ii:TInterface)
		i = ii
		
		'Find ObjectEnumerator
		Local m:TMethod = i._enumerator
		If Not m m = i._type.FindMethod("ObjectEnumerator")
		If Not m RuntimeError "Type "+i._type.Name()+" is not enumerable!"
		
		'Call it
		If i._object
			enum = m.Invoke(i._object, Null)
		Else
			enum = m.Invoke(i._enumerable, Null)
		End If
		
		'Find methods
		Local t:TTypeId = TTypeId.ForObject(enum)
		has = t.FindMethod("HasNext")
		get = t.FindMethod("NextObject")
	End Method
	
	Method HasNext%()
		Return Int(String(has.Invoke(enum,Null)))
	End Method
	
	Method NextObject:Object()
		Return TInterface._cast(get.Invoke(enum,Null), Null, i._interface)
	End Method
	
End Type