Implemented Inheritance on Cells (NOT: Polymorphism)

Inheritance is specified via colon as in the following example:

TYPE NewCellType = CELL:OldCellType {<Properties>} (<added ports>);
Properties can be overwritten. Ports cannot be overwritten, modified or removed.

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

source/FoxGlobal.Mod

@@ -329,12 +329,21 @@ TYPE
 		END GenerateRecordOffsets;
 
 		PROCEDURE GenerateCellOffsets(x: SyntaxTree.CellType): BOOLEAN;
-		VAR baseType: SyntaxTree.RecordType; offset,size: LONGINT; alignment, thisAlignment: LONGINT; variable: SyntaxTree.Variable;
+		VAR baseType: SyntaxTree.Type; offset,size: LONGINT; alignment, thisAlignment: LONGINT; variable: SyntaxTree.Variable;
 		BEGIN
-			baseType :=x.GetBaseRecord();
-			IF (baseType  # NIL) & (baseType.sizeInBits < 0) THEN
-				IF~ GenerateRecordOffsets(baseType) THEN RETURN FALSE END;
+			baseType := x.baseType;
+			IF (baseType # NIL) THEN
+				baseType := baseType.resolved;
+				IF baseType IS SyntaxTree.PointerType THEN
+					baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved
+				END;
+				IF (baseType IS SyntaxTree.CellType) THEN
+					IF~ GenerateCellOffsets(baseType(SyntaxTree.CellType)) THEN RETURN FALSE END;
+				ELSE ASSERT (baseType IS SyntaxTree.RecordType);
+					IF~GenerateRecordOffsets(baseType(SyntaxTree.RecordType)) THEN RETURN FALSE END;
+				END;
 			END;
+
 			IF baseType # NIL THEN
 				offset := baseType.sizeInBits; 
 				alignment := baseType.alignmentInBits;
@@ -376,8 +385,7 @@ TYPE
 			ELSIF scope IS SyntaxTree.CellScope THEN
 				RETURN GenerateCellOffsets(scope(SyntaxTree.CellScope).ownerCell);
 			ELSE (* module scope or procedure scope: decreasing indices *)
-				ASSERT((scope IS SyntaxTree.ModuleScope) OR (scope IS SyntaxTree.ProcedureScope) OR (scope IS SyntaxTree.CellScope)
-				);
+				ASSERT((scope IS SyntaxTree.ModuleScope) OR (scope IS SyntaxTree.ProcedureScope));
 				offset := 0;
 				IF scope IS SyntaxTree.ProcedureScope THEN
 					parameterOffset := scope(SyntaxTree.ProcedureScope).ownerProcedure.type(SyntaxTree.ProcedureType).parameterOffset

source/FoxIntermediateBackend.Mod

@@ -7171,6 +7171,17 @@ TYPE
 			END;
 		END AppendModifiers;
 		
+		PROCEDURE AppendCellTypeModifiers(VAR to: SyntaxTree.Modifier; c: SyntaxTree.CellType);
+		VAR base: SyntaxTree.Type; 
+		BEGIN
+			AppendModifiers(to, c.modifiers);
+			base := c.GetBaseValueType();
+			IF (base # NIL) & (base IS SyntaxTree.CellType) THEN
+				AppendCellTypeModifiers(to, base(SyntaxTree.CellType))
+			END;
+		END AppendCellTypeModifiers;
+		
+		
 		PROCEDURE PushPort(p: SyntaxTree.Expression);
 		VAR op: Operand;
 		BEGIN
@@ -8285,7 +8296,8 @@ TYPE
 						AppendModifiers(modifier, p0(SyntaxTree.SymbolDesignator).symbol(SyntaxTree.Variable).modifiers );
 						(* AddModifiers(baseType(SyntaxTree.CellType), temporaryVariable, modifier);*)
 					END;
-					AppendModifiers(modifier, baseType(SyntaxTree.CellType).modifiers);
+					AppendCellTypeModifiers(modifier, baseType(SyntaxTree.CellType));
+					
 					(*
 					modifier := baseType(SyntaxTree.CellType).modifiers;
 					AddProperties(baseType(SyntaxTree.CellType), temporaryVariable, baseType(SyntaxTree.CellType).firstProperty);
@@ -11435,6 +11447,7 @@ TYPE
 				rfByte = 1X; rfBoolean = 2X; rfChar8=3X; rfShortint=04X; rfInteger = 05X; rfLongint = 06X;
 				rfReal = 07X; rfLongreal = 08X; rfSet = 09X; rfDelegate = 0EX;  rfString = 0FH; rfPointer = 0DX; rfHugeint = 10X;
 				rfChar16=11X; rfChar32=12X; rfAll=13X; rfSame=14X; rfRange=15X; rfRecord=16X; rfComplex = 17X; rfLongcomplex = 18X; 
+				rfPort = 19X;
 				rfRecordPointer=1DX;
 				rfArrayFlag = 80X;
 
@@ -11473,6 +11486,7 @@ TYPE
 					ELSIF type IS SyntaxTree.PointerType THEN char := rfPointer
 					ELSIF type IS SyntaxTree.ProcedureType THEN char := rfDelegate
 					ELSIF type IS SyntaxTree.RangeType THEN char := rfRange
+					ELSIF type IS SyntaxTree.PortType THEN char := rfPort
 					ELSE (*ASSERT(arrayOf);*) char := rfPointer; (*RETURN (* ARRAY OF unknown (record): do not write anything *)*)
 					END;
 					RETURN char
@@ -11584,6 +11598,8 @@ TYPE
 						MathArrayType(type(SyntaxTree.MathArrayType));
 					ELSIF type IS SyntaxTree.CellType THEN
 						Char(section, BaseType(module.system.anyType));
+					ELSIF type IS SyntaxTree.PortType THEN
+						Char(section, rfPort);
 					ELSE HALT(200)
 					END;
 				END Type;

source/FoxParser.Mod

@@ -1294,6 +1294,8 @@ TYPE
 			cellType: SyntaxTree.CellType;
 			cellScope: SyntaxTree.CellScope;
 			modifiers: SyntaxTree.Modifier;
+			qualifiedIdentifier: SyntaxTree.QualifiedIdentifier;
+			qualifiedType: SyntaxTree.Type;
 		BEGIN
 			IF Trace THEN S( "CellType" ) END;
 			(* symbol cell already consumed *)
@@ -1302,7 +1304,12 @@ TYPE
 			cellType := SyntaxTree.NewCellType( position, parentScope,cellScope);
 			cellType.IsCellNet(isCellNet);
 			cellScope.SetOwnerCell(cellType);
-
+			
+			IF Optional(Scanner.Colon) THEN
+				qualifiedIdentifier := QualifiedIdentifier();
+				qualifiedType := SyntaxTree.NewQualifiedType(qualifiedIdentifier.position, parentScope, qualifiedIdentifier );
+				cellType.SetBaseType( qualifiedType );
+			END;
 
 			IF Optional(Scanner.LeftBrace) THEN
 				modifiers := Flags();

source/FoxSemanticChecker.Mod

@@ -1056,13 +1056,17 @@ TYPE
 			IF TypeNeedsResolution(x) THEN
 				recordBase := NIL;
 				IF cellsAreObjects THEN
-					qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(x.position, SyntaxTree.NewIdentifier("ActiveCellsRuntime"), SyntaxTree.NewIdentifier("Cell"));
-					ImportModule(qualifiedIdentifier.prefix, x.position);
-					x.SetBaseType(SyntaxTree.NewQualifiedType(x.position, currentScope, qualifiedIdentifier));
-					x.SetBaseType(ResolveType(x.baseType));
-					recordBase := x.GetBaseRecord();
-					IF recordBase = NIL THEN
-						Error(x.position,Diagnostics.Invalid,"ActiveCellsRuntime.Cell not present");
+					IF x.baseType = NIL THEN 
+						qualifiedIdentifier := SyntaxTree.NewQualifiedIdentifier(x.position, SyntaxTree.NewIdentifier("ActiveCellsRuntime"), SyntaxTree.NewIdentifier("Cell"));
+						ImportModule(qualifiedIdentifier.prefix, x.position);
+						x.SetBaseType(SyntaxTree.NewQualifiedType(x.position, currentScope, qualifiedIdentifier));
+						x.SetBaseType(ResolveType(x.baseType));
+						recordBase := x.GetBaseRecord();
+						IF recordBase = NIL THEN
+							Error(x.position,Diagnostics.Invalid,"ActiveCellsRuntime.Cell not present");
+						END;
+					ELSE
+						x.SetBaseType(ResolveType(x.baseType));
 					END;
 				END;
 				
@@ -7297,7 +7301,7 @@ TYPE
 				IF (left.type.resolved IS SyntaxTree.PortType) & CheckPortType(left, outPort) THEN (* send *)
 					IF outPort.direction # SyntaxTree.OutPort THEN
 						Error(left.position,Diagnostics.Invalid,"not an out-port")
-					ELSIF outPort.sizeInBits # system.SizeOf(right.type) THEN
+					ELSIF outPort.sizeInBits < system.SizeOf(right.type) THEN
 						Error(left.position,Diagnostics.Invalid,"incompatible to port type");
 					ELSE
 						right := NewConversion(communication.position,right,left.type.resolved,NIL);
@@ -7317,7 +7321,7 @@ TYPE
 			ELSIF (communication.op = Scanner.ExclamationMark)  & CheckPortType(left,outPort)  THEN
 				IF outPort.direction # SyntaxTree.OutPort THEN
 					Error(left.position,Diagnostics.Invalid,"not an out-port")
-				ELSIF outPort.sizeInBits # system.SizeOf(right.type) THEN
+				ELSIF outPort.sizeInBits < system.SizeOf(right.type) THEN
 					Error(left.position,Diagnostics.Invalid,"incompatible to port type");
 				ELSE
 					right := NewConversion(communication.position,right,left.type.resolved,NIL);
@@ -8103,9 +8107,51 @@ TYPE
 			symbol: SyntaxTree.Symbol;
 			prevPhase: LONGINT;
 			prevError : BOOLEAN;
-			property: SyntaxTree.Property;
 			type: SyntaxTree.Type;
 			atype : SyntaxTree.ArrayType;
+			
+			PROCEDURE DeclareCell(type: SyntaxTree.CellType);
+			VAR baseType: SyntaxTree.Type; property, prop: SyntaxTree.Property; variable: SyntaxTree.Variable;
+			BEGIN
+				IF type.baseType # NIL THEN 
+					baseType := type.baseType.resolved; 
+					IF baseType IS SyntaxTree.PointerType THEN
+						baseType := baseType(SyntaxTree.PointerType).pointerBase.resolved;
+					END;
+					IF baseType IS SyntaxTree.CellType THEN
+						DeclareCell(baseType(SyntaxTree.CellType));
+					END;
+				END;
+				parameter := type.firstParameter;
+				WHILE(parameter # NIL) DO (* duplicates forbidden *)
+					variable := SyntaxTree.NewVariable(parameter.position, parameter.name);
+					variable.SetType(parameter.type);
+					variable.SetAccess(SyntaxTree.Hidden);
+					variable.SetModifiers(parameter.modifiers);
+					currentScope.PushVariable(variable);
+					(*
+					Register(parameter,scope, FALSE); 
+					*)
+					parameter := parameter.nextParameter;
+				END;
+				
+				property := type.firstProperty;
+				WHILE (property # NIL) DO (* duplicates allowed : overwrite *)
+					variable := currentScope.FindVariable(property.name);
+					IF (variable # NIL) & (variable IS SyntaxTree.Property) THEN (* overwrite *)
+						prop := variable(SyntaxTree.Property); 
+					ELSE (* add, duplicate symbols detection later *)
+						prop := SyntaxTree.NewProperty(property.position, property.name);
+						currentScope.PushVariable(prop);
+					END;
+					prop.SetType(property.type);
+					prop.SetValue(property.value);
+					prop.SetAccess(SyntaxTree.Hidden);
+					property := property.nextProperty;
+				END;
+			END DeclareCell;
+			
+			
 		BEGIN
 			prevError := error;
 			prevPhase := phase;
@@ -8137,25 +8183,7 @@ TYPE
 				parameter := scope(SyntaxTree.ProcedureScope).ownerProcedure.type.resolved(SyntaxTree.ProcedureType).returnParameter;
 				IF parameter # NIL THEN Register(parameter, currentScope, FALSE); END;
 			ELSIF scope IS SyntaxTree.CellScope THEN
-				parameter := scope(SyntaxTree.CellScope).ownerCell.firstParameter;
-				WHILE(parameter # NIL) DO
-					variable := SyntaxTree.NewVariable(parameter.position, parameter.name);
-					variable.SetType(parameter.type);
-					variable.SetAccess(SyntaxTree.Hidden);
-					variable.SetModifiers(parameter.modifiers);
-					currentScope.PushVariable(variable);
-					(*
-					Register(parameter,scope, FALSE); 
-					*)
-					parameter := parameter.nextParameter;
-				END;
-				
-				property := scope(SyntaxTree.CellScope).ownerCell.firstProperty;
-				WHILE (property # NIL) DO
-					property.SetAccess(SyntaxTree.Hidden);
-					currentScope.PushVariable(property);
-					property := property.nextProperty;
-				END;
+				DeclareCell(scope(SyntaxTree.CellScope).ownerCell);
 			END;
 			IF error THEN RETURN END;
 

source/FoxSyntaxTree.Mod

@@ -1589,10 +1589,23 @@ TYPE
 			baseType := base;
 		END SetBaseType;
 		
+		PROCEDURE GetBaseValueType*(): Type;
+		BEGIN
+			IF baseType = NIL THEN 
+				RETURN NIL
+			ELSIF baseType.resolved IS PointerType THEN
+				RETURN baseType.resolved(PointerType).pointerBase.resolved
+			ELSE 
+				RETURN baseType.resolved; 
+			END;
+		END GetBaseValueType;
+		
 		PROCEDURE GetBaseRecord*():RecordType;
 		BEGIN
 			IF baseType = NIL THEN RETURN NIL; END;
-			IF baseType.resolved IS RecordType THEN
+			IF baseType.resolved IS CellType THEN
+				RETURN baseType.resolved(CellType).GetBaseRecord();
+			ELSIF baseType.resolved IS RecordType THEN
 				RETURN baseType.resolved(RecordType);
 			ELSIF baseType.resolved IS PointerType THEN
 				IF baseType.resolved(PointerType).pointerBase.resolved # NIL THEN
@@ -1621,16 +1634,28 @@ TYPE
 		PROCEDURE FindParameter*(identifier: Identifier): Parameter;
 		VAR p: Parameter;
 		BEGIN
-			p := firstParameter;
-			WHILE(p#NIL) & (p.name # identifier) DO p := p.nextParameter END;
+			p := NIL;
+			IF (baseType # NIL) & (baseType.resolved IS CellType) THEN
+				p := baseType.resolved(CellType).FindParameter(identifier);
+			END;
+			IF p = NIL THEN 
+				p := firstParameter;
+				WHILE(p#NIL) & (p.name # identifier) DO p := p.nextParameter END;
+			END;
 			RETURN p;
 		END FindParameter;
 
 		PROCEDURE FindProperty*(identifier: Identifier): Property;
 		VAR p: Property;
 		BEGIN
-			p := firstProperty;
-			WHILE(p#NIL) & (p.name # identifier) DO p := p.nextProperty END;
+			p := NIL;
+			IF (baseType # NIL) & (baseType.resolved IS CellType) THEN
+				p := baseType.resolved(CellType).FindProperty(identifier);
+			END;
+			IF p = NIL THEN 
+				p := firstProperty;
+				WHILE(p#NIL) & (p.name # identifier) DO p := p.nextProperty END;
+			END;
 			RETURN p;
 		END FindProperty;
 
@@ -4807,7 +4832,7 @@ TYPE
 		END SetConstructor;
 		
 		PROCEDURE FindSymbol*(identifier: Identifier): Symbol;
-		VAR p: Symbol; base: RecordType;
+		VAR p: Symbol; base: Type;
 		BEGIN
 			p := FindSymbol^(identifier);
 			IF p = NIL THEN
@@ -4815,6 +4840,22 @@ TYPE
 					RETURN ownerCell.FindProperty(identifier);
 				END;
 			END;
+			IF p = NIL THEN
+				base := ownerCell.baseType;
+				IF (base # NIL) THEN
+					base := base.resolved;
+					IF base IS PointerType THEN 
+						base := base(PointerType).pointerBase.resolved;
+					END;
+					WITH base: CellType DO
+						p := base.cellScope.FindSymbol(identifier)
+					|base: RecordType DO
+						p := base.recordScope.FindSymbol(identifier)
+						
+					END;
+				END;
+			END;
+
 			RETURN p;
 		END FindSymbol;