Compiler exceptions

This commit is contained in:
Michael Schimmel
2025-11-25 15:51:04 +01:00
parent 4e508d90a5
commit 0a1df4e9fe
9 changed files with 194 additions and 303 deletions
+30 -95
View File
@@ -9,10 +9,6 @@ uses
Myc.Data.Keyword;
type
// Exception for atomic type errors (promotion failures, invalid operations)
// Inherits from Exception directly to keep Types unit independent of Nodes/AST.
ETypeException = class(Exception);
IStaticType = interface;
// Defines the categories of types available in the language.
@@ -68,8 +64,6 @@ type
property ElementType: IStaticType read GetElementType;
// The signatures (if Kind = stMethod).
// This array contains one entry for simple methods,
// and multiple entries for overloaded functions (like RTL).
property Signatures: TArray<IMethodSignature> read GetSignatures;
// The definition (if Kind = stRecord or stRecordSeries)
@@ -84,7 +78,6 @@ type
end;
// Factory and Flyweight access for static types.
// Use this record to create or access all IStaticType instances.
TTypes = record
private
class var
@@ -105,7 +98,7 @@ type
FKeyword: IStaticType;
class constructor Create;
public
// Flyweight accessors for simple types
// Flyweight accessors
class property Unknown: IStaticType read FUnknown;
class property Void: IStaticType read FVoid;
class property Ordinal: IStaticType read FOrdinal;
@@ -115,7 +108,7 @@ type
class property Text: IStaticType read FText;
class property Keyword: IStaticType read FKeyword;
// Factory functions for complex types
// Factory functions
class function CreateSeries(const AElementType: IStaticType): IStaticType; static;
class function CreateMethod(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType): IStaticType; static;
class function CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType; static;
@@ -129,14 +122,16 @@ type
// Defines the rules of the type system.
TTypeRules = record
public
// Returns the common type (promotion) or nil if incompatible.
class function Promote(const A, B: IStaticType): IStaticType; static;
// Checks if a value of type 'Source' can be assigned to 'Target'.
class function CanAssign(const Target, Source: IStaticType): Boolean; static;
// Determines the result type of a binary operation.
// Raises ETypeException on failure.
// Determines the result type of a binary operation. Returns nil on failure.
class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static;
// Determines the result type of a unary operation.
// Determines the result type of a unary operation. Returns nil on failure.
class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static;
end;
@@ -185,7 +180,6 @@ end;
type
TAbstractStaticType = class(TInterfacedObject, IStaticType)
protected
// IStaticType (default implementations for non-applicable properties)
function GetKind: TStaticTypeKind; virtual; abstract;
function GetElementType: IStaticType; virtual;
function GetSignatures: TArray<IMethodSignature>; virtual;
@@ -208,7 +202,6 @@ end;
function TAbstractStaticType.GetDefinition: IScalarRecordDefinition;
begin
// Return an empty/invalid definition
Result := Default(IScalarRecordDefinition);
end;
@@ -219,8 +212,6 @@ end;
function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean;
begin
// Default implementation: types are equal if their kinds are equal.
// Complex types (Series, Record, Method) MUST override this.
if not Assigned(Other) then
exit(False);
Result := (GetKind = Other.Kind);
@@ -256,7 +247,6 @@ end;
function TSimpleStaticType.GetHashCode: Integer;
begin
// Simple types only hash their kind
Result := Ord(FKind);
end;
@@ -298,11 +288,9 @@ end;
function TSeriesType.GetHashCode: Integer;
begin
// Consistent with IsEqual
Result := Ord(stSeries);
if Assigned(FElementType) then
begin
// Combine hash of stSeries with hash of element type
var hash := FElementType.GetHashCode;
Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result);
end;
@@ -336,7 +324,6 @@ function TMethodSignature.GetHashCode: Integer;
var
i: Integer;
begin
// Consistent with TMethodType.IsEqual
Result := 0;
if Assigned(FReturnType) then
Result := FReturnType.GetHashCode;
@@ -409,11 +396,6 @@ begin
if Length(Self.FSignatures) <> Length(otherSigs) then
exit(False);
// This is complex. For now, assume equality means identical sets,
// which requires comparing O(N^2) signatures if order doesn't matter.
// Let's assume order *does* matter for equality to keep this simple (O(N)).
// Note: A better IsEqual would compare hashes of signatures.
for i := 0 to High(Self.FSignatures) do
begin
var sig1 := Self.FSignatures[i];
@@ -438,7 +420,6 @@ function TMethodType.GetHashCode: Integer;
var
sig: IMethodSignature;
begin
// Consistent with IsEqual
Result := Ord(stMethod);
for sig in FSignatures do
begin
@@ -461,7 +442,6 @@ begin
end
else
begin
// Handle overloaded methods
sb := TStringBuilder.Create;
try
sb.Append('Method{');
@@ -471,7 +451,7 @@ begin
sb.Append(SignatureToString(sig));
sb.Append('), ');
end;
sb.Remove(sb.Length - 2, 2); // Remove last ', '
sb.Remove(sb.Length - 2, 2);
sb.Append('}');
Result := sb.ToString;
finally
@@ -482,7 +462,6 @@ end;
// ---
type
// Represents stRecord and stRecordSeries (Scalar Records)
TRecordType = class(TAbstractStaticType)
private
FKind: TStaticTypeKind;
@@ -523,14 +502,13 @@ begin
var otherDef := Other.Definition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False); // Should not happen if Kind is equal, but defensive check
exit(False);
if Length(Self.FDefinition.Fields) <> Length(otherDef.Fields) then
exit(False);
for i := 0 to High(Self.FDefinition.Fields) do
begin
// Use fast interface comparison for Keys
if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key) or (Self.FDefinition.Fields[i].Value <> otherDef.Fields[i].Value) then
exit(False);
end;
@@ -542,16 +520,13 @@ function TRecordType.GetHashCode: Integer;
var
field: TPair<IKeyword, TScalar.TKind>;
begin
// Consistent with IsEqual
Result := Ord(GetKind);
if Assigned(FDefinition) then
begin
for field in FDefinition.Fields do
begin
// Hash the Keyword pointer (fast, from flyweight)
var hash := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result);
// Hash the TScalar.TKind value
var data := Ord(field.Value);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result);
end;
@@ -621,7 +596,6 @@ begin
for i := 0 to High(Self.FDefinition.Fields) do
begin
// Compare keys (fast) and static types (must use IsEqual)
if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key)
or (not Self.FDefinition.Fields[i].Value.IsEqual(otherDef.Fields[i].Value)) then
exit(False);
@@ -634,16 +608,13 @@ function TGenericRecordType.GetHashCode: Integer;
var
field: TPair<IKeyword, IStaticType>;
begin
// Consistent with IsEqual
Result := Ord(stGenericRecord);
if Assigned(FDefinition) then
begin
for field in FDefinition.Fields do
begin
// Hash the Keyword pointer (fast, from flyweight)
var data := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result);
// Hash the IStaticType value
if Assigned(field.Value) then
begin
var hash := field.Value.GetHashCode;
@@ -674,7 +645,6 @@ end;
class constructor TTypes.Create;
begin
// Create the flyweight singletons
FUnknown := TSimpleStaticType.Create(stUnknown);
FVoid := TSimpleStaticType.Create(stVoid);
FOrdinal := TSimpleStaticType.Create(stOrdinal);
@@ -690,7 +660,6 @@ var
sig: IMethodSignature;
sigs: TArray<IMethodSignature>;
begin
// This is now a convenience helper for CreateMethodSet
sig := TMethodSignature.Create(AParamTypes, AReturnType);
SetLength(sigs, 1);
sigs[0] := sig;
@@ -699,7 +668,6 @@ end;
class function TTypes.CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType;
begin
// This is the new primary factory for method types
Result := TMethodType.Create(ASignatures);
end;
@@ -732,7 +700,8 @@ begin
TScalar.TKind.Boolean: Result := FBoolean;
TScalar.TKind.DateTime: Result := FDateTime;
else
raise ETypeException.Create('Cannot convert invalid TScalar.TKind to TStaticType.');
Assert(False, 'Invalid Scalar Kind');
Result := nil;
end;
end;
@@ -740,39 +709,30 @@ end;
class function TTypeRules.CanAssign(const Target, Source: IStaticType): Boolean;
begin
// Basic nil-check for safety.
if (not Assigned(Target)) or (not Assigned(Source)) then
exit(False);
// During inference, allow assignment involving Unknown
if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then
exit(True);
// Types are always assignable to themselves (identity).
if Target.IsEqual(Source) then
exit(True);
// Allow assigning an integer (Ordinal) to a float variable.
if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then
exit(True);
// Allow assigning Boolean to Ordinal (0/1)
if (Target.Kind = stOrdinal) and (Source.Kind = stBoolean) then
exit(True);
// Allow assigning DateTime to Float (TDateTime is Double)
if (Target.Kind = stFloat) and (Source.Kind = stDateTime) then
exit(True);
// Allow discarding the return value of a method (e.g., in a 'do' block).
if (Target.Kind = stVoid) and (Source.Kind = stMethod) then
exit(True);
// Allow implicit conversion from Keyword (internally an index) to Ordinal.
if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then
exit(True);
// Default: Assignment is not allowed if no specific rule matches.
Result := False;
end;
@@ -798,17 +758,12 @@ begin
if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then
exit(TTypes.Ordinal);
// Implicit DateTime/Boolean logic via Ordinal/Float mapping?
// If types are identical (incl. Keyword, Text, Boolean, DateTime), return that type.
// If types are identical, return that type.
if A.IsEqual(B) then
exit(A);
// Cannot promote stGenericRecord or stRecord with anything other than itself/unknown
if (A.Kind in [stRecord, stGenericRecord]) or (B.Kind in [stRecord, stGenericRecord]) then
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
// Cannot promote other combinations
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
// No promotion possible
Result := nil;
end;
class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType;
@@ -816,65 +771,48 @@ var
promotedType: IStaticType;
promotedKind: TStaticTypeKind;
begin
// 1. Determine the effective type after promotion, handling Unknown.
try
promotedType := Promote(Left, Right);
except
// If promotion fails (e.g., Text and Ordinal), the operation is invalid.
on E: ETypeException do
raise ETypeException.CreateFmt(
'Operator %s cannot be applied to %s and %s (promotion failed: %s)',
[Op.ToString, Left.ToString, Right.ToString, E.Message]);
end;
promotedType := Promote(Left, Right);
// Mismatch during promotion
if not Assigned(promotedType) then
exit(nil);
// If promotion results in Unknown, the result type is also Unknown for now.
if promotedType.Kind = stUnknown then
exit(TTypes.Unknown);
// 2. Check if the operator is valid for the promoted type.
promotedKind := promotedType.Kind;
case Op of
TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply:
begin
// Numeric operations require Ordinal, Float, or DateTime(as Float)
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
raise ETypeException
.CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]);
Result := promotedType; // Result has the promoted type
exit(nil);
Result := promotedType;
end;
TScalar.TBinaryOp.Divide:
begin
// Division requires Ordinal or Float, but *always* results in Float
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
raise ETypeException
.CreateFmt('Operator %s requires Ordinal or Float, but got %s after promotion', [Op.ToString, promotedType.ToString]);
exit(nil);
Result := TTypes.Float;
end;
TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual:
begin
// Allow equality checks for Ordinal, Float, Keyword, Boolean, DateTime
if not (promotedKind in [stOrdinal, stFloat, stKeyword, stBoolean, stDateTime]) then
raise ETypeException.CreateFmt(
'Comparison operator %s requires scalar type, but got %s after promotion',
[Op.ToString, promotedType.ToString]);
// Result is always Boolean
exit(nil);
Result := TTypes.Boolean;
end;
TScalar.TBinaryOp.Less, TScalar.TBinaryOp.Greater, TScalar.TBinaryOp.LessOrEqual, TScalar.TBinaryOp.GreaterOrEqual:
begin
// Comparison requires Ordinal or Float (Keywords are not ordered)
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
raise ETypeException.CreateFmt(
'Comparison operator %s requires ordered type (Ordinal, Float, DateTime), but got %s after promotion',
[Op.ToString, promotedType.ToString]);
exit(nil);
Result := TTypes.Boolean;
end;
else
raise ETypeException.Create('Unknown binary operator for type resolution.');
// Operation not supported at the AST level (might need folding later, but here it implies invalid usage)
Result := nil;
end;
end;
@@ -884,28 +822,25 @@ var
begin
rightKind := Right.Kind;
// If operand is Unknown, result is Unknown.
if rightKind = stUnknown then
exit(TTypes.Unknown);
case Op of
TScalar.TUnaryOp.Negate:
begin
// Negation requires Ordinal or Float
if not (rightKind in [stOrdinal, stFloat]) then
raise ETypeException.CreateFmt('Unary negation cannot be applied to %s', [Right.ToString]);
Result := Right; // Negation preserves type
exit(nil);
Result := Right;
end;
TScalar.TUnaryOp.Not:
begin
// Logical not only applies to Boolean (or Ordinal if treated as bool)
if not (rightKind in [stOrdinal, stBoolean]) then
raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]);
exit(nil);
Result := TTypes.Boolean;
end;
else
raise ETypeException.Create('Unknown unary operator for type resolution.');
Result := nil;
end;
end;