Merge pull request #317 from bmx-ng/bcc_gen

Generics improvements.

bcc.bmx

@@ -47,6 +47,8 @@ If opt_buildtype = BUILDTYPE_MODULE Then
 	End If
 End If
 
+TGenProcessor.processor = New TParser
+
 Local app:TAppDecl 
 Local trans:TCTranslator 
 Try

config.bmx

@@ -472,6 +472,19 @@ Type TTemplateRecord
 	End Function
 End Type
 
+Type TGenProcessor Abstract
+
+	Global processor:TGenProcessor
+
+	Method ParseGeneric:Object(templ:TTemplateRecord)
+	End Method
+	
+End Type
+
+Type TCallback
+	Method Callback(obj:Object) Abstract
+End Type
+
 Extern
 	Function strlen_:Int(s:Byte Ptr)="strlen"
 End Extern

ctranslator.bmx

@@ -4327,6 +4327,10 @@ End Rem
 			' field initialisation
 			For Local decl:TFieldDecl=EachIn classDecl.Decls()
 			
+				If Not decl.IsSemanted() Then
+					decl.Semant()
+				End If
+			
 				Local fld:String
 	
 				' ((int*)((char*)o + 5))[0] =

decl.bmx

@@ -401,7 +401,7 @@ Type TValDecl Extends TDecl
 					End If
 				End If
 			End If
-			
+
 			ty=declTy.Semant()
 
 			If Not deferInit Then
@@ -1129,7 +1129,7 @@ Type TScopeDecl Extends TDecl
 		Return decl
 	End Method
 
-	Method FindType:TType( ident$,args:TType[] )
+	Method FindType:TType( ident$,args:TType[], callback:TCallback = Null )
 'DebugLog Self.ident + "::FindType::" + ident
 		Local decl:Object=(GetDecl( ident ))
 		If decl Then
@@ -1145,13 +1145,13 @@ Type TScopeDecl Extends TDecl
 			If cdecl
 				cdecl.AssertAccess
 				If Not cdecl.instanceof Then
-					cdecl=cdecl.GenClassInstance( args )
+					cdecl=cdecl.GenClassInstance( args, False, callback )
 					cdecl.Semant
 				End If
 				Return cdecl.objectType
 			EndIf
 		EndIf
-		If scope Return scope.FindType( ident,args )
+		If scope Return scope.FindType( ident,args, callback )
 	End Method
 	
 	Method FindScopeDecl:TScopeDecl( ident$ )
@@ -1900,7 +1900,6 @@ Type TFuncDecl Extends TBlockDecl
 					End If
 				End If
 			End If
-		
 			retType=retTypeExpr.Semant()
 			
 			' for Strict code, a void return type becomes Int
@@ -2153,6 +2152,16 @@ Type TNullDecl Extends TClassDecl
 
 End Type
 
+' used to handle recursive generics
+' by setting the superclass as soon as we know it,
+' which allows the semanting of the instance to complete.
+Type TClassDeclCallback Extends TCallback
+	Field decl:TClassDecl
+	Method callback(obj:Object)
+		decl.superClass = TClassDecl(obj)
+	End Method
+End Type
+
 Type TClassDecl Extends TScopeDecl
 
 	Field lastOffset:Int
@@ -2277,7 +2286,7 @@ Rem
 		Return inst
 	End Method
 End Rem
-	Method GenClassInstance:TClassDecl( instArgs:TType[], declImported:Int = False )
+	Method GenClassInstance:TClassDecl( instArgs:TType[], declImported:Int = False, callback:TCallback = Null )
 
 		If instanceof InternalErr
 		
@@ -2306,7 +2315,13 @@ End Rem
 			If equal Return inst
 		Next
 
-		Local inst:TClassDecl=New TClassDecl.Create( ident,Null,superTy,impltys, attrs )
+		Local inst:TClassDecl = TClassDecl(TGenProcessor.processor.ParseGeneric(templateSource))
+		inst.ident=ident
+		inst.args=Null
+		inst.instances = Null
+		inst.superTy=superTy
+		inst.impltys=impltys
+		inst.attrs=attrs
 
 		inst.attrs:&~DECL_SEMANTED
 
@@ -2320,26 +2335,52 @@ End Rem
 		
 		inst.declImported = declImported
 
+		If callback Then
+			callback.callback(inst)
+		End If
+
+		PushEnv inst
+		
+		' install aliases
+		For Local i:Int=0 Until args.Length
+			inst.InsertDecl New TAliasDecl.Create( args[i].ident,instArgs[i],0 )
+		Next
+
+		' process parameter types
 		For Local i:Int=0 Until args.Length
 		
+			Local arg:TTemplateArg = args[i]
+
 			' ensure parameter types are compatible
-			If args[i].superTy Then
-				args[i].superTy = args[i].superTy.Semant()
-				If Not instArgs[i].EqualsType(args[i].superTy) And Not instArgs[i].ExtendsType(args[i].superTy) Then
-					Err "Type parameter '" + instArgs[i].ToString() + "' is not within its bound; should extend '" + args[i].superTy.ToString() + "'"
+			If arg.superTy Then
+
+				'If Not instArgs[i].IsSemanted() Then
+				If TObjectType(instArgs[i]) Then
+					TObjectType(instArgs[i]).classDecl.Semant()
 				End If
+				'End If
+			
+				For Local n:Int = 0 Until arg.superTy.length
+
+					arg.superTy[n] = arg.superTy[n].Semant()
+
+					If Not instArgs[i].EqualsType(arg.superTy[n]) And Not instArgs[i].ExtendsType(arg.superTy[n]) Then
+						Err "Type parameter '" + instArgs[i].ToString() + "' is not within its bound; should extend '" + arg.superTy[n].ToString() + "'"
+					End If
+				Next
 			End If
 		
-			inst.InsertDecl New TAliasDecl.Create( args[i].ident,instArgs[i],0 )
 		Next
+		
+		PopEnv
 
-		For Local decl:TDecl=EachIn _decls
-			If TClassDecl(decl) Then
-				inst.InsertDecl TClassDecl(decl).GenClassInstance(instArgs, declImported), True
-			Else
-				inst.InsertDecl decl.Copy(), True
-			End If
-		Next
+'		For Local decl:TDecl=EachIn _decls
+'			If TClassDecl(decl) Then
+'				inst.InsertDecl TClassDecl(decl).GenClassInstance(instArgs, declImported), True
+'			Else
+'				inst.InsertDecl decl.Copy(), True
+'			End If
+'		Next
 
 		If Not declImported Then
 			inst.scope = _env.ModuleScope()
@@ -2657,9 +2698,11 @@ End Rem
 
 		'Semant superclass		
 		If superTy
-			'superClass=superTy.FindClass()
+			Local cb:TClassDeclCallback = New TClassDeclCallback
+			cb.decl = Self
+			
 			attrs :| DECL_CYCLIC
-			superClass=superTy.SemantClass()
+			superClass=superTy.SemantClass(cb)
 			attrs :~ DECL_CYCLIC
 			If superClass.IsInterface() Then
 				If Not IsExtern() Or Not superClass.IsExtern() Err superClass.ToString()+" is an interface, not a class."

expr.bmx

@@ -201,6 +201,7 @@ Type TExpr
 				If TObjectType(rhs) And TObjectType(rhs).classDecl.ident = "Object" Then
 					Return rhs
 				End If
+				Return New TStringType
 			Else
 				Return New TStringType
 			End If

parser.bmx

@@ -336,7 +336,7 @@ Type TIncbin
 End Type
 
 '***** Parser *****
-Type TParser
+Type TParser Extends TGenProcessor
 
 	Field _toker:TToker
 	Field _toke:String
@@ -514,7 +514,7 @@ Type TParser
 
 	Method ParseIdentType:TIdentType()
 		Local id$=ParseIdent()
-'DebugLog "ParseIdentType : " + id
+
 		If CParse( "." ) id:+"."+ParseIdent()
 		If CParse( "." ) id:+"."+ParseIdent()
 
@@ -522,8 +522,19 @@ Type TParser
 		If CParse( "<" )
 			Local nargs:Int
 			Repeat
-				'Local arg:TIdentType=ParseIdentType()
 				Local arg:TType = ParseType()
+				
+				Repeat
+					If (_toke = "[" Or _toke = "[]") And IsArrayDef()
+						arg = ParseArrayType(arg)
+					Else If _toke = "(" Then
+						Local argDecls:TArgDecl[] = ParseFuncParamDecl()
+						arg = New TFunctionPtrType.Create(New TFuncDecl.CreateF("", arg, argDecls, FUNC_PTR))
+					Else
+						Exit
+					End If
+				Forever
+				
 				If args.Length=nargs args=args+ New TType[10]
 				args[nargs]=arg
 				nargs:+1
@@ -2980,9 +2991,9 @@ End Rem
 				Local arg:TTemplateArg = New TTemplateArg
 				arg.ident = ParseIdent()
 				
-				If CParse("extends") Then
-					arg.superTy = ParseIdentType()
-				End If
+'				If CParse("extends") Then
+'					arg.superTy = ParseIdentType()
+'				End If
 				
 				args.AddLast arg
 
@@ -2990,6 +3001,34 @@ End Rem
 			'args=args[..nargs]
 
 			Parse ">"
+
+			If CParse( "where" ) Then
+'DebugStop
+				Repeat
+					Local argIdent:String = ParseIdent()
+					
+					Parse("extends")
+					
+					Local found:Int
+					For Local arg:TTemplateArg = EachIn args
+						If arg.ident = argIdent Then
+						
+							Repeat
+							
+								arg.ExtendsType(ParseIdentType())
+							
+							Until Not CParse("and")
+						
+							found = True
+							Exit
+						EndIf
+					Next
+					If Not found Then
+						Err "Use of undeclared type '" + argIdent + "'."
+					End If
+					
+				Until Not CParse(",")
+			End If
 		EndIf
 
 		If CParse( "extends" )
@@ -3681,6 +3720,24 @@ End Rem
 		Return attrs
 	End Method
 
+	Method ParseGeneric:Object(templateSource:TTemplateRecord)
+		Local toker:TToker = New TToker.Create(templateSource.file, templateSource.source, False, templateSource.start)
+		Local parser:TParser = New TParser.Create( toker, _appInstance )
+		
+		Local m:TModuleDecl = New TModuleDecl
+		parser._module = m
+		
+		Local cdecl:TClassDecl = Null
+		
+		Select parser._toke
+		Case "type"
+			cdecl = parser.ParseClassDecl(parser._toke,0)
+		Case "interface"
+			cdecl = parser.ParseClassDecl(parser._toke, CLASS_INTERFACE|DECL_ABSTRACT )
+		End Select
+		
+		Return cdecl
+	End Method
 
 	Method ParseMain()
 

toker.bmx

@@ -49,7 +49,7 @@ Type TToker
 		"and,or,shl,shr,sar,end,if,then,else,elseif,endif,while,wend,repeat,until,forever,for,to,step," + ..
 		"next,return,alias,rem,endrem,throw,assert,try,catch,nodebug,incbin,endselect,endmethod," + ..
 		"endfunction,endtype,endextern,endtry,endwhile,pi,release,defdata,readdata,restoredata,interface," + ..
-		"endinterface,implements,size_t,uint,ulong,struct,endstruct,operator"
+		"endinterface,implements,size_t,uint,ulong,struct,endstruct,operator,where"
 	Global _keywords:TMap
 
 	Field _path$

type.bmx

@@ -52,7 +52,7 @@ Type TType
 		Return T_MAX_DISTANCE
 	End Method
 	
-	Method Semant:TType(option:Int = False)
+	Method Semant:TType(option:Int = False, callback:TCallback = Null)
 		Return Self
 	End Method
 
@@ -1352,7 +1352,7 @@ Type TStringType Extends TType
 		Return cdecl
 	End Method
 	
-	Method Semant:TType(option:Int = 0)
+	Method Semant:TType(option:Int = 0, callback:TCallback = Null)
 		GetClass()
 		Return Self
 	End Method
@@ -1400,8 +1400,8 @@ Type TArrayType Extends TType
 		Return (arrayType And dims = arrayType.dims And ( TVoidType( elemType ) Or (TObjectType(elemType) And elemType.EqualsType( arrayType.elemType ) Or elemType.ExtendsType( arrayType.elemType )))) Or IsPointerType(ty, 0, TType.T_POINTER) <> Null Or (TObjectType( ty ) And TObjectType( ty ).classDecl.ident="Object")
 	End Method
 	
-	Method Semant:TType(option:Int = False)
-		Local ty:TType=elemType.Semant()
+	Method Semant:TType(option:Int = False, callback:TCallback = Null)
+		Local ty:TType=elemType.Semant(option, callback)
 		If ty<>elemType Return New TArrayType.Create( ty, dims )
 		Return Self
 	End Method
@@ -1538,13 +1538,13 @@ Type TIdentType Extends TType
 	'End Method
 	
 	
-	Method Semant:TType(ignoreNotFoundError:Int = 0)
+	Method Semant:TType(ignoreNotFoundError:Int = 0, callback:TCallback = Null)
 'If ident="IPair" DebugStop
 		If Not ident Return TType.nullObjectType
 
 		Local targs:TType[args.Length]
 		For Local i:Int=0 Until args.Length
-			targs[i]=args[i].Semant()
+			targs[i]=args[i].Semant(ignoreNotFoundError, callback)
 		Next
 		
 		Local tyid$,ty:TType
@@ -1571,13 +1571,13 @@ Type TIdentType Extends TType
 			End If
 			
 			If Not ty Then
-				ty=_env.FindType( tyid,targs )
+				ty=_env.FindType( tyid,targs, callback )
 			End If
 
 			' finally scan all modules for it
 			If Not ty Then
 				For Local mdecl:TModuleDecl = EachIn _appInstance.globalImports.Values()
-					ty=mdecl.FindType( tyid,targs )
+					ty=mdecl.FindType( tyid,targs, callback )
 					If ty Exit
 				Next
 			End If
@@ -1606,7 +1606,7 @@ Type TIdentType Extends TType
 			End If
 			
 			If Not ty Then
-				ty=_env.FindType( tyid,targs )
+				ty=_env.FindType( tyid,targs, callback )
 			End If
 			
 			If Not ty Then
@@ -1614,7 +1614,7 @@ Type TIdentType Extends TType
 		
 				' try scope search first
 				tyid=id[..i]
-				ty=_env.FindType( tyid,targs )				
+				ty=_env.FindType( tyid,targs, callback )				
 
 				If Not ty Then
 					' no? now try module search
@@ -1622,7 +1622,7 @@ Type TIdentType Extends TType
 					Local mdecl:TModuleDecl=_env.FindModuleDecl( modid )
 					If Not mdecl Err "Module '"+modid+"' not found"
 					tyid=id[i+1..]
-					ty=mdecl.FindType( tyid,targs )
+					ty=mdecl.FindType( tyid,targs, callback )
 				End If
 			End If
 		EndIf
@@ -1650,8 +1650,8 @@ Type TIdentType Extends TType
 		Return ty
 	End Method
 
-	Method SemantClass:TClassDecl()
-		Local ty:TObjectType=TObjectType( Semant() )
+	Method SemantClass:TClassDecl(callback:TCallback = Null)
+		Local ty:TObjectType=TObjectType( Semant(False, callback) )
 		If Not ty Err "Type is not a class"
 		Return ty.classDecl
 	End Method
@@ -1804,7 +1804,7 @@ Type TFunctionPtrType Extends TType
 		Return ty
 	End Method
 
-	Method Semant:TType(option:Int = False)
+	Method Semant:TType(option:Int = False, callback:TCallback = Null)
 		func.Semant()
 		Return Self
 	End Method
@@ -2012,12 +2012,26 @@ End Type
 
 Type TTemplateArg
 	Field ident:String
-	Field superTy:TType
+	Field superTy:TType[]
+	
+	Method ExtendsType(ty:TType)
+		If Not superTy Then
+			superTy = New TType[0]
+		End If
+		
+		superTy :+ [ty]
+	End Method
 	
 	Method ToString:String()
 		Local s:String = ident
 		If superTy Then
-			s :+ " Extends " + superTy.ToString()
+			s :+ " Extends "
+			For Local i:Int = 0 Until superTy.length
+				If i Then
+					s:+ " And "
+				End If
+				s :+ superTy[i].ToString()
+			Next
 		End If
 	End Method
 End Type