fist working version for dynamic calls within methods in record scope (Oberon2 style)

note that if you use methods within a record, it is assumed that SELF is passed as VAR par (being incompatible to CONST)
if you need CONST, use type bound procedures



git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@8412 8c9fc860-2736-0410-a75d-ab315db34111

source/FoxIntermediateBackend.Mod

@@ -5987,24 +5987,37 @@ TYPE
 			ELSE
 				symbol := x.left(SyntaxTree.SymbolDesignator).symbol;
 			END;
+			
+			IF procedureType.selfParameter # NIL THEN (* type bound procedure in a record *)
+				Designate(x.left(SyntaxTree.Designator).left, operand); 
+				Emit(Push(position, operand.tag)); 
+				Emit(Push(position, operand.op)); 
+				Symbol(symbol, operand); 
+				LoadValue(operand, symbol.type);
+				(*
+				PushParameter(x.left(SyntaxTree.Designator).left, procedureType.selfParameter, callingConvention, FALSE, dummy,-1);
+				Evaluate(x.left, operand);
+				*)
+			ELSE
 
-			Evaluate(x.left, operand);
+				Evaluate(x.left, operand);
 
-			IF symbol IS SyntaxTree.Procedure THEN
-				IF (procedureType.selfParameter # NIL) THEN
-					Emit(Push(position,operand.tag));
-				ELSIF x.left IS SyntaxTree.SupercallDesignator THEN
-					Emit(Push(position,operand.tag));
-				ELSIF (procedureType.isDelegate) THEN
-					Emit(Push(position,operand.tag));
-				END;
-			ELSIF (symbol IS SyntaxTree.Variable) OR (symbol IS SyntaxTree.Parameter) THEN
-				IF (procedureType.selfParameter # NIL) THEN
-					Emit(Push(position,operand.tag));
-				ELSIF (procedureType.isDelegate) THEN (* push self pointer only if procedure is a method *)
-					Emit(Push(position,operand.tag));
+				IF symbol IS SyntaxTree.Procedure THEN
+					IF (procedureType.selfParameter # NIL) THEN
+						Emit(Push(position,operand.tag));
+					ELSIF x.left IS SyntaxTree.SupercallDesignator THEN
+						Emit(Push(position,operand.tag));
+					ELSIF (procedureType.isDelegate) THEN
+						Emit(Push(position,operand.tag));
+					END;
+				ELSIF (symbol IS SyntaxTree.Variable) OR (symbol IS SyntaxTree.Parameter) THEN
+					IF (procedureType.selfParameter # NIL) THEN
+						Emit(Push(position,operand.tag));
+					ELSIF (procedureType.isDelegate) THEN (* push self pointer only if procedure is a method *)
+						Emit(Push(position,operand.tag));
+					END;
+				ELSE HALT(200);
 				END;
-			ELSE HALT(200);
 			END;
 			
 			ReleaseIntermediateOperand(operand.tag);
@@ -9967,7 +9980,7 @@ TYPE
 					result.tag := nil;
 				END;
 			(* tag for pointer type computed not here but during dereferencing *)
-			ELSIF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType= NIL) & (x.kind IN {SyntaxTree.VarParameter, SyntaxTree.ConstParameter}) & ~(x.selfParameter) THEN
+			ELSIF (type IS SyntaxTree.RecordType) & (type(SyntaxTree.RecordType).pointerType= NIL) & (x.kind IN {SyntaxTree.VarParameter, SyntaxTree.ConstParameter}) (* & ~(x.selfParameter) *) THEN
 				ReleaseIntermediateOperand(result.tag);
 				result.tag := basereg;
 				IntermediateCode.AddOffset(result.tag,ToMemoryUnits(system,x.offsetInBits+system.addressSize));

source/FoxSemanticChecker.Mod

@@ -3618,6 +3618,11 @@ TYPE
 		BEGIN
 			(* check if in record scope *)
 			scope := currentScope;
+			IF (scope IS SyntaxTree.ProcedureScope) & (scope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).selfParameter # NIL) THEN
+				resolvedExpression := 
+					NewSymbolDesignator(x.position, NIL, scope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).selfParameter); RETURN; 
+			END; 
+			
 			WHILE (scope # NIL) & ~(scope IS SyntaxTree.RecordScope) &~(scope IS SyntaxTree.CellScope) DO
 				scope := scope.outerScope;
 			END;
@@ -3633,6 +3638,7 @@ TYPE
 					x.SetType(type);
 				ELSE
 					x.SetType(record);
+					x.SetAssignable(TRUE); (* var parameter *)
 				END;
 			END;
 			resolvedExpression := x;
@@ -7025,6 +7031,17 @@ TYPE
 							selfParameter.SetType(qualifiedType);
 						END;
 						selfParameter.SetAccess(SyntaxTree.Hidden);
+					ELSIF (procedureType.selfParameter = NIL) THEN
+						selfParameter := SyntaxTree.NewParameter(procedure.position,procedureType,Global.SelfParameterName,SyntaxTree.VarParameter);
+						IF (record.typeDeclaration = NIL) THEN
+							selfParameter.SetType(record);
+						ELSE
+							qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(procedure.position,SyntaxTree.invalidIdentifier,record.typeDeclaration.name);
+							qualifiedType := SyntaxTree.NewQualifiedType(procedure.position,procedure.scope,qualifiedIdentifier);
+							qualifiedType.SetResolved(record);
+							selfParameter.SetType(qualifiedType);
+						END;
+						procedureType.SetSelfParameter(selfParameter);
 					END;
 
 					(*! constructor information is redundant, we can remove "isConstructor" and repplace by constructor procedure reference *)