Forráskód Böngészése

Added support for embedded types. Fixes #216.

woollybah 8 éve
szülő
commit
6749e2d2ae
4 módosított fájl, 113 hozzáadás és 47 törlés
  1. 53 30
      ctranslator.bmx
  2. 54 15
      decl.bmx
  3. 1 1
      options.bmx
  4. 5 1
      parser.bmx

+ 53 - 30
ctranslator.bmx

@@ -958,7 +958,7 @@ t:+"NULLNULLNULL"
 	End Method
 
 	Method TransFunc$( decl:TFuncDecl,args:TExpr[],lhs:TExpr, sup:Int = False, scope:TScopeDecl = Null )
-'If decl.ident = "eventfilter" DebugStop
+
 		' for calling the super class method instead
 		Local tSuper:String
 		If sup Then
@@ -2850,7 +2850,7 @@ End Rem
 '		End If
 	End Method
 
-	Method EmitClassFuncProto( decl:TFuncDecl, isStruct:Int = False)
+	Method EmitClassFuncProto( decl:TFuncDecl, isStruct:Int = False, emitFuncProtos:Int = True)
 		'PushMungScope
 		BeginLocalScope
 
@@ -2919,15 +2919,18 @@ End Rem
 		'End If
 
 '		If Not proto Or (proto And Not odecl.IsExtern()) Then
+		'If emitFuncProtos
 			If Not TFunctionPtrType(decl.retType) Then
 				If Not odecl.castTo Then
 					If Not isStruct Then
 						Emit pre + TransType( decl.retType, "" )+" "+ Bra(api + "*" + id)+Bra( args ) + bk
 					End If
-					If decl.IsMethod() Then
-						Emit TransType(decl.retType, "") + " _" + decl.munged +Bra( args ) + bk
-					Else
-						Emit TransType(decl.retType, "") + api + " " + decl.munged +Bra( args ) + bk
+					If emitFuncProtos
+						If decl.IsMethod() Then
+							Emit TransType(decl.retType, "") + " _" + decl.munged +Bra( args ) + bk
+						Else
+							Emit TransType(decl.retType, "") + api + " " + decl.munged +Bra( args ) + bk
+						End If
 					End If
 				Else
 					If Not odecl.noCastGen Then
@@ -2936,10 +2939,12 @@ End Rem
 								Emit pre + odecl.castTo +" "+Bra(api + "*" + id)+Bra( args ) + bk
 							End If
 						End If
-						If decl.IsMethod() Then
-							Emit odecl.castTo + " _" + decl.munged +Bra( args ) + bk
-						Else
-							Emit odecl.castTo + " " + decl.munged +Bra( args ) + bk
+						If emitFuncProtos
+							If decl.IsMethod() Then
+								Emit odecl.castTo + " _" + decl.munged +Bra( args ) + bk
+							Else
+								Emit odecl.castTo + " " + decl.munged +Bra( args ) + bk
+							End If
 						End If
 					End If
 				End If
@@ -2964,7 +2969,7 @@ End Rem
 			For Local t$=EachIn argCasts
 				Emit t
 			Next
-'		End If
+		'End If
 
 		'PopMungScope
 		EndLocalScope
@@ -2987,8 +2992,15 @@ End Rem
 
 		MungDecl decl
 
-		' emit nested functions
+		' emit nested functions/classes
 		If Not proto Then
+			' emit nested classes
+			For Local cdecl:TClassDecl = EachIn decl._decls
+				MungDecl cdecl
+				EmitClassProto(cdecl, False)
+				EmitClassDecl(cdecl)
+			Next
+		
 			' emit nested protos
 			For Local fdecl:TFuncDecl = EachIn decl._decls
 				EmitFuncDecl(fdecl, True, classFunc)
@@ -3270,7 +3282,7 @@ End Rem
 
 	End Method
 
-	Method EmitClassProto( classDecl:TClassDecl )
+	Method EmitClassProto( classDecl:TClassDecl, emitFuncProtos:Int = True )
 	
 		If classDecl.args Then
 			Return
@@ -3284,24 +3296,26 @@ End Rem
 
 		'Emit "void _" + classid + "_New" + Bra(TransObject(classdecl) + " o") + ";"
 		
-		EmitClassDeclNewListProto(classDecl)
-		
-		If classHierarchyHasFunction(classDecl, "Delete") Then
-			Emit "void _" + classid + "_Delete" + Bra(TransObject(classdecl) + " o") + ";"
-		End If
+		If emitFuncProtos Then
+			EmitClassDeclNewListProto(classDecl)
 
-		If classHasFunction(classDecl, "ToString") Then
-			Emit "BBSTRING _" + classid + "_ToString" + Bra(TransObject(classdecl) + " o") + ";"
-		End If
-
-		If classHasFunction(classDecl, "Compare") Then
-			Emit "BBINT _" + classid + "_Compare(" + TransObject(classdecl) + " o, BBOBJECT otherObject);"
-		End If
+			If classHierarchyHasFunction(classDecl, "Delete") Then
+				Emit "void _" + classid + "_Delete" + Bra(TransObject(classdecl) + " o") + ";"
+			End If
+	
+			If classHasFunction(classDecl, "ToString") Then
+				Emit "BBSTRING _" + classid + "_ToString" + Bra(TransObject(classdecl) + " o") + ";"
+			End If
+	
+			If classHasFunction(classDecl, "Compare") Then
+				Emit "BBINT _" + classid + "_Compare(" + TransObject(classdecl) + " o, BBOBJECT otherObject);"
+			End If
+	
+			If classHasFunction(classDecl, "SendMessage") Then
+				Emit "BBOBJECT _" + classid + "_SendMessage(" + TransObject(classdecl) + " o, BBOBJECT message, BBOBJECT source);"
+			End If
 
-		If classHasFunction(classDecl, "SendMessage") Then
-			Emit "BBOBJECT _" + classid + "_SendMessage(" + TransObject(classdecl) + " o, BBOBJECT message, BBOBJECT source);"
 		End If
-
 		'Local reserved:String = ",New,Delete,ToString,Compare,SendMessage,_reserved1_,_reserved2_,_reserved3_,".ToLower()
 
 		classDecl.SemantParts()
@@ -3312,9 +3326,8 @@ End Rem
 
 			Local fdecl:TFuncDecl =TFuncDecl( decl )
 			If fdecl
-
 				If Not equalsBuiltInFunc(classDecl, fdecl) And Not equalsTorFunc(classDecl, fdecl) Then
-					EmitClassFuncProto( fdecl )
+					EmitClassFuncProto( fdecl, , emitFuncProtos )
 					Continue
 				End If
 			EndIf
@@ -3871,6 +3884,13 @@ End Rem
 
 
 		If Not classDecl.IsExtern() Then
+			' process nested classes
+			For Local cdecl:TClassDecl = EachIn classDecl._decls
+				MungDecl cdecl
+				EmitClassProto(cdecl, False)
+				EmitClassDecl(cdecl)
+			Next
+		
 			' process nested functions for new
 			Local decl:TFuncDecl = classDecl.FindFuncDecl("new",,,,,,SCOPE_CLASS_HEIRARCHY)
 			If decl And decl.scope = classDecl Then ' only our own New method, not any from superclasses
@@ -4512,6 +4532,9 @@ End Rem
 		
 		If fdecl.argDecls.Length Then
 			If classDecl = fdecl.scope Then
+				If Not fdecl.munged Then
+					MungDecl fdecl
+				End If
 				t :+ fdecl.munged
 			Else
 				t :+ classDecl.munged + "_" + fdecl.ident + MangleMethod(fdecl)

+ 54 - 15
decl.bmx

@@ -43,6 +43,8 @@ Const DECL_API_CDECL:Int=   $00000000
 Const DECL_API_STDCALL:Int= $10000000
 Const DECL_API_DEFAULT:Int=DECL_API_CDECL
 
+Const DECL_NESTED:Int=      $20000000
+
 Const CLASS_INTERFACE:Int=    $002000
 Const CLASS_THROWABLE:Int=    $004000
 Const CLASS_STRUCT:Int=       $008000
@@ -203,16 +205,16 @@ Type TDecl
 	
 	' find an owning scope of function, class or module
 	Method ParentScope:TScopeDecl()
-		Local _scope:TScopeDecl = scope.FuncScope()
-		If Not _scope Then
-			_scope = scope.ClassScope()
-		End If
-		
-		If Not _scope Then
-			_scope = scope.ModuleScope()
+		If scope Then
+			' func scope
+			If TFuncDecl( scope ) Return TFuncDecl( scope )
+			' class scope
+			If TClassDecl( scope ) Return TClassDecl( scope )
+			' module scope
+			If TModuleDecl( scope ) Return TModuleDecl( scope )
+
+			Return scope.ParentScope()
 		End If
-		
-		Return _scope
 	End Method
 	
 	Method CheckAccess:Int()
@@ -221,6 +223,7 @@ Type TDecl
 	End Method
 	
 	Method AssertAccess()
+If ident="abc" DebugStop
 		If Not CheckAccess()
 			If IsPrivate() Then
 				Err ToString() +" is private."
@@ -274,8 +277,8 @@ Type TDecl
 				'DebugLog "**** " + ident
 			Else
 			
-				' a nested function needs to be scoped to another function, class or module.
-				If attrs & FUNC_NESTED Then
+				' a nested function/class needs to be scoped to another function, class or module.
+				If attrs & FUNC_NESTED Or attrs & DECL_NESTED Then
 					Local sc:TScopeDecl = ParentScope()
 					
 					' if our scope isn't one of the above, let it be so.
@@ -284,7 +287,6 @@ Type TDecl
 						sc.InsertDecl(Self)
 					End If
 				End If
-			
 
 				scope._semanted.AddLast Self
 				
@@ -740,11 +742,38 @@ Type TFieldDecl Extends TVarDecl
 	End Method
 
 	Method CheckAccess:Int()
-		If IsPrivate() And ClassScope()<>_env.ClassScope() Return False
-		If IsProtected() And ClassScope() Then
+		Local cs:TClassDecl = ClassScope()
+
+		If IsPrivate() And cs Then
+			Local ec:TClassDecl = _env.ClassScope()
+			While ec
+				If cs = ec Then
+					Return True
+				End If
+				
+				ec = _env.scope.scope.ClassScope()
+			Wend
+			
+			If Not ec Then
+				Return False
+			End If
+		End If
+		If IsProtected() And cs Then
 			Local ec:TClassDecl = _env.ClassScope()
 			If Not ec Return False
-			If Not ec.ExtendsClass(ClassScope()) Return False
+			
+			While ec
+				If ec.ExtendsClass(cs) Then
+					Return True
+				End If
+				
+				ec = _env.scope.scope.ClassScope()
+			Wend
+			
+			If Not ec Then
+				Return False
+			End If
+			'If Not ec.ExtendsClass(ClassScope()) Return False
 		End If
 		Return True
 	End Method
@@ -1598,6 +1627,11 @@ Type TBlockDecl Extends TScopeDecl
 		For Local fdecl:TFuncDecl = EachIn _decls
 			fdecl.Semant
 		Next
+
+		' any nested classes?
+		For Local cdecl:TClassDecl = EachIn _decls
+			cdecl.Semant
+		Next
 		
 		For Local stmt:TStmt=EachIn stmts
 			stmt.Semant
@@ -2732,6 +2766,11 @@ End Rem
 			decl.Semant()
 		Next
 
+		' nested classes
+		For Local decl:TClassDecl = EachIn Decls()
+			decl.Semant()
+		Next
+
 	End Method
 	
 	'Ok, this dodgy looking beast 'resurrects' methods that may not currently be alive, but override methods that ARE.

+ 1 - 1
options.bmx

@@ -25,7 +25,7 @@ SuperStrict
 
 Import "base.configmap.bmx"
 
-Const version:String = "0.91"
+Const version:String = "0.92"
 
 Const BUILDTYPE_APP:Int = 0
 Const BUILDTYPE_MODULE:Int = 1

+ 5 - 1
parser.bmx

@@ -2248,6 +2248,8 @@ End Rem
 			' nested function - needs to get added to the "module"
 			Case "function"
 				_block.InsertDecl ParseFuncDecl( _toke,FUNC_NESTED)
+			Case "type"
+				_block.InsertDecl ParseClassDecl( _toke,DECL_NESTED)
 			Case "return"
 				ParseReturnStmt()
 			Case "exit"
@@ -2699,7 +2701,7 @@ End Rem
 				End If
 			'End If
 		EndIf
-		
+
 		' every branch in that nested If block up there contains the line "ty=ParseDeclType()";
 		' this already consumed all sets of parentheses and brackets belonging to this function declaration
 		' so we will now extract our actual return type and args from the result
@@ -3219,6 +3221,8 @@ End Rem
 				End If
 				Local decl:TFuncDecl=ParseFuncDecl( _toke,decl_attrs,classDecl )
 				classDecl.InsertDecl decl
+			Case "type"
+				classDecl.InsertDecl ParseClassDecl( _toke,DECL_NESTED)
 			Default
 				Err "Syntax error - expecting class member declaration, not '" + _toke + "'"
 			End Select