Added support for set types of different sizes

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

source/FoxGlobal.Mod

@@ -201,6 +201,7 @@ VAR
 	Integer8-, Integer16-, Integer32-, Integer64-: SyntaxTree.IntegerType;
 	Unsigned8-, Unsigned16-, Unsigned32-, Unsigned64-: SyntaxTree.IntegerType;
 	Character8-, Character16-, Character32-: SyntaxTree.CharacterType;
+	Set8-, Set16-, Set32-, Set64-: SyntaxTree.SetType;
 	Float32-, Float64-: SyntaxTree.FloatType;
 	Complex64-, Complex128-: SyntaxTree.ComplexType;
 	Byte8: SyntaxTree.ByteType;
@@ -851,6 +852,11 @@ TYPE
 		DeclareType(system.anyType,"ANY",system.globalScope);
 		DeclareType(system.objectType,"OBJECT",system.globalScope);
 
+		DeclareType(Set8, "SET8", system.globalScope);
+		DeclareType(Set16, "SET16", system.globalScope);
+		DeclareType(Set32, "SET32", system.globalScope);
+		DeclareType(Set64, "SET64", system.globalScope);
+
 		(* global functions *)
 		NewBuiltin(Abs,"ABS",system.globalScope,TRUE);
 		NewBuiltin(Ash,"ASH",system.globalScope,TRUE);
@@ -1448,6 +1454,11 @@ TYPE
 		IF system.SizeOf(type) = 32 THEN RETURN MIN(REAL) ELSE RETURN MIN(LONGREAL) END;
 	END MinFloat;
 
+	PROCEDURE ConvertSet*(this: SET; bits: LONGINT): SET;
+	BEGIN
+		RETURN this * {0 .. MIN (bits, MAX (SET)) - 1};
+	END ConvertSet;
+
 	PROCEDURE IsUnsignedInteger*(this: HUGEINT; sizeInBits: LONGINT): BOOLEAN;
 	VAR m: HUGEINT;
 	BEGIN
@@ -1520,12 +1531,21 @@ TYPE
 		value.SetType(system.booleanType);
 		RETURN value
 	END NewBooleanValue;
+	
+	PROCEDURE GetSetType*(system: System; this: SET): SyntaxTree.SetType;
+	BEGIN
+		IF this * {0 .. 7} = this THEN RETURN Set8
+		ELSIF this * { 0 .. 15 } = this THEN RETURN Set16
+		ELSIF this * { 0 .. 31 } = this THEN RETURN Set32
+		ELSE RETURN Set64
+		END
+	END GetSetType;
 
 	PROCEDURE NewSetValue*(system: System; position: Position; s: SET): SyntaxTree.Value;
 	VAR value: SyntaxTree.SetValue;
 	BEGIN
 		value := SyntaxTree.NewSetValue(position,s);
-		value.SetType(system.setType);
+		value.SetType(GetSetType(system,s));
 		RETURN value
 	END NewSetValue;
 
@@ -1777,6 +1797,10 @@ TYPE
 		Character8 := SyntaxTree.NewCharacterType(8);
 		Character16 := SyntaxTree.NewCharacterType(16);
 		Character32 := SyntaxTree.NewCharacterType(32);
+		Set8 := SyntaxTree.NewSetType(8);
+		Set16 := SyntaxTree.NewSetType(16);
+		Set32 := SyntaxTree.NewSetType(32);
+		Set64 := SyntaxTree.NewSetType(64);
 	END Init;
 
 BEGIN

source/FoxIntermediateBackend.Mod

@@ -3730,6 +3730,7 @@ TYPE
 				Evaluate(x.left,left);
 				Evaluate(x.right,right);
 				Convert(left.op,setType);
+				Convert(right.op,setType);
 				ReuseCopy(temp.op,right.op);
 				Emit(Shr(position,temp.op,temp.op,left.op));
 				ReleaseOperand(right); ReleaseOperand(left);
@@ -7658,15 +7659,15 @@ TYPE
 			|Global.Excl,Global.Incl:
 				Evaluate(p0,s0);
 				Evaluate(p1,s1);
-				Convert(s1.op,setType);
+				Convert(s1.op,s0.op.type);
 				IF (s1.op.mode # IntermediateCode.ModeImmediate) & ~isUnchecked THEN
-					TrapC(BrltL,s1.op,IntermediateCode.Immediate(setType,setType.sizeInBits),IndexCheckTrap);
+					TrapC(BrltL,s1.op,IntermediateCode.Immediate(s0.op.type,p0.type.resolved.sizeInBits),IndexCheckTrap);
 				END;
 				ReuseCopy(res,s0.op);
 				ReleaseOperand(s0);
 				Reuse1(tmp,s1.op);
 				ReleaseOperand(s1);
-				Emit(Shl(position,tmp,IntermediateCode.Immediate(setType,1),s1.op));
+				Emit(Shl(position,tmp,IntermediateCode.Immediate(s0.op.type,1),s1.op));
 				IF x.id = Global.Excl THEN
 					Emit(Not(position,tmp,tmp));
 					Emit(And(position,res,res,tmp));
@@ -7675,7 +7676,7 @@ TYPE
 				END;
 				ReleaseIntermediateOperand(tmp);
 				Designate(p0,s0);
-				ToMemory(s0.op,setType,0);
+				ToMemory(s0.op,s0.op.type,0);
 				Emit(Mov(position,s0.op,res));
 				ReleaseOperand(s0); ReleaseIntermediateOperand(res);
 			(* ---- DISPOSE ----- *)

source/FoxSemanticChecker.Mod

@@ -2046,15 +2046,16 @@ TYPE
 				END;
 			END;
 			IF constant THEN
-				value := SyntaxTree.NewSetValue(set.position,s);
-				value.SetType(system.setType);
+				value := Global.NewSetValue(system,set.position,s);
 				result.SetResolved(value);
+				result.SetType(value.type);
+			ELSE
+				result.SetType(system.setType);
 			END;
 			(* optimization possible
 				convert {a,b,1,2,3,4,c,d} into {a,b,c,d} + {1,2,3,4}
 				left this to the programmer...
 			*)
-			result.SetType(system.setType);
 			resolvedExpression := result;
 		END VisitSet;
 
@@ -2254,7 +2255,7 @@ TYPE
 						IF IsSetValue(left,set) THEN
 							value := SyntaxTree.NewSetValue(unaryExpression.position,-set);
 							result.SetResolved(value);
-							type := left.type;
+							type := Global.GetSetType(system,-set);
 							value.SetType(type);
 						ELSE
 							type := left.type;
@@ -2509,6 +2510,10 @@ TYPE
 					result.SetType(type);
 				ELSIF (type IS SyntaxTree.PortType) THEN
 					result := ConvertValue(position, expression, system.integerType);
+				ELSIF (type IS SyntaxTree.SetType) THEN
+					set := Global.ConvertSet(set,system.SizeOf(type));
+					result := SyntaxTree.NewSetValue(expression.position,set);
+					result.SetType(type);
 				ELSE
 					Error(position, "set value cannot be converted");
 					result := SyntaxTree.invalidExpression;
@@ -2909,10 +2914,9 @@ TYPE
 
 			PROCEDURE NewSet(v: SET);
 			BEGIN
-				value := SyntaxTree.NewSetValue(binaryExpression.position,v);
-				value.SetType(system.setType);
+				value := Global.NewSetValue(system,binaryExpression.position,v);
 				result.SetResolved(value);
-				type := system.setType;
+				type := value.type;
 			END NewSet;
 
 			PROCEDURE NewInteger(v: HUGEINT; t: SyntaxTree.Type);
@@ -8985,7 +8989,7 @@ TYPE
 						result := Global.BasicTypeDistance(system,this(SyntaxTree.BasicType),to(SyntaxTree.BasicType)) < Infinity;
 					END
 				ELSIF (to IS SyntaxTree.SetType) & (this IS SyntaxTree.SetType) THEN
-					result := to.sizeInBits = this.sizeInBits;
+					result := to.sizeInBits >= this.sizeInBits;
 				ELSIF (to IS SyntaxTree.IntegerType) & (this IS SyntaxTree.AddressType) THEN
 					result := to.sizeInBits >= this.sizeInBits; (* weak compatibility: (unsigned) address may be assigned to signed integer of same (or greater) size *)
 				ELSIF (to IS SyntaxTree.IntegerType) & (this IS SyntaxTree.SizeType) THEN

source/FoxSyntaxTree.Mod

@@ -758,11 +758,11 @@ TYPE
 		END InitSetType;
 
 		PROCEDURE SameType*(this: Type): BOOLEAN;
-		BEGIN RETURN (this IS SetType)
+		BEGIN RETURN (this = SELF) OR (this IS SetType) & (this.sizeInBits = sizeInBits);
 		END SameType;
 
 		PROCEDURE CompatibleTo*(to: Type): BOOLEAN;
-		BEGIN RETURN (to IS SetType)
+		BEGIN RETURN (to IS SetType) & (to.sizeInBits >= sizeInBits)
 		END CompatibleTo;
 
 		PROCEDURE Accept*(v: Visitor);