Files
MycLib/Src/AST/Myc.Ast.Types.pas
T
Michael Schimmel 0b015fe4e7 Reverting Ast Stream
2025-12-17 12:41:26 +01:00

856 lines
25 KiB
ObjectPascal

unit Myc.Ast.Types;
interface
uses
System.SysUtils,
System.Generics.Collections,
Myc.Data.Scalar,
Myc.Data.Keyword;
type
IStaticType = interface;
// Defines the categories of types available in the language.
TStaticTypeKind = (
stUnknown, // Used during inference before a type is known
stVoid,
stOrdinal, // Int64
stFloat, // Double
stBoolean,
stDateTime,
stText,
stKeyword,
stMethod,
stSeries,
stRecord,
stRecordSeries,
stGenericRecord
);
TStaticTypeKindHelper = record helper for TStaticTypeKind
public
function ToString: string;
end;
// Defines the signature of a method
IMethodSignature = interface
{$region 'private'}
function GetParamTypes: TArray<IStaticType>;
function GetReturnType: IStaticType;
{$endregion}
property ParamTypes: TArray<IStaticType> read GetParamTypes;
property ReturnType: IStaticType read GetReturnType;
function GetHashCode: Integer;
end;
// Defines a mapping for generic record fields (Key -> StaticType)
IGenericRecordDefinition = IKeywordMapping<IStaticType>;
TGenericRecordRegistry = TKeywordMappingRegistry<IStaticType>;
// Represents a complete static type definition.
IStaticType = interface
{$region 'private'}
function GetKind: TStaticTypeKind;
function GetElementType: IStaticType;
function GetSignatures: TArray<IMethodSignature>;
function GetDefinition: IScalarRecordDefinition;
function GetGenericDefinition: IGenericRecordDefinition;
{$endregion}
// The kind of type (e.g., Ordinal, Series, etc.)
property Kind: TStaticTypeKind read GetKind;
// The element type (if Kind = stSeries)
property ElementType: IStaticType read GetElementType;
// The signatures (if Kind = stMethod).
property Signatures: TArray<IMethodSignature> read GetSignatures;
// The definition (if Kind = stRecord or stRecordSeries)
property Definition: IScalarRecordDefinition read GetDefinition;
// The definition (if Kind = stGenericRecord)
property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition;
// Checks for type equality
function IsEqual(const Other: IStaticType): Boolean;
function ToString: string;
function GetHashCode: Integer;
end;
// Factory and Flyweight access for static types.
TTypes = record
private
class var
FUnknown: IStaticType;
class var
FVoid: IStaticType;
class var
FOrdinal: IStaticType;
class var
FFloat: IStaticType;
class var
FBoolean: IStaticType;
class var
FDateTime: IStaticType;
class var
FText: IStaticType;
class var
FKeyword: IStaticType;
class constructor Create;
public
// Flyweight accessors
class property Unknown: IStaticType read FUnknown;
class property Void: IStaticType read FVoid;
class property Ordinal: IStaticType read FOrdinal;
class property Float: IStaticType read FFloat;
class property Boolean: IStaticType read FBoolean;
class property DateTime: IStaticType read FDateTime;
class property Text: IStaticType read FText;
class property Keyword: IStaticType read FKeyword;
// 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;
class function CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; static;
class function CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType; static;
class function CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType; static;
class function FromScalarKind(AKind: TScalar.TKind): IStaticType; static;
end;
// 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. Returns nil on failure.
class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static;
// Determines the result type of a unary operation. Returns nil on failure.
class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static;
end;
TMethodSignature = class(TInterfacedObject, IMethodSignature)
private
FParamTypes: TArray<IStaticType>;
FReturnType: IStaticType;
function GetParamTypes: TArray<IStaticType>;
function GetReturnType: IStaticType;
public
constructor Create(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType);
function GetHashCode: Integer; override;
end;
implementation
uses
System.Generics.Defaults,
System.Hash;
{ TStaticTypeKindHelper }
function TStaticTypeKindHelper.ToString: string;
begin
case Self of
stUnknown: Result := 'Unknown';
stVoid: Result := 'Void';
stOrdinal: Result := 'Ordinal';
stFloat: Result := 'Float';
stBoolean: Result := 'Boolean';
stDateTime: Result := 'DateTime';
stText: Result := 'Text';
stKeyword: Result := 'Keyword';
stMethod: Result := 'Method';
stSeries: Result := 'Series';
stRecord: Result := 'Record';
stRecordSeries: Result := 'RecordSeries';
stGenericRecord: Result := 'GenericRecord';
else
Result := 'ErrorType';
end;
end;
// --- Abstract Base Implementation ---
type
TAbstractStaticType = class(TInterfacedObject, IStaticType)
protected
function GetKind: TStaticTypeKind; virtual; abstract;
function GetElementType: IStaticType; virtual;
function GetSignatures: TArray<IMethodSignature>; virtual;
function GetDefinition: IScalarRecordDefinition; virtual;
function GetGenericDefinition: IGenericRecordDefinition; virtual;
function IsEqual(const Other: IStaticType): Boolean; virtual;
function GetHashCode: Integer; override; abstract;
function ToString: string; override;
end;
function TAbstractStaticType.GetElementType: IStaticType;
begin
Result := nil;
end;
function TAbstractStaticType.GetSignatures: TArray<IMethodSignature>;
begin
Result := nil;
end;
function TAbstractStaticType.GetDefinition: IScalarRecordDefinition;
begin
Result := Default(IScalarRecordDefinition);
end;
function TAbstractStaticType.GetGenericDefinition: IGenericRecordDefinition;
begin
Result := nil;
end;
function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean;
begin
if not Assigned(Other) then
exit(False);
Result := (GetKind = Other.Kind);
end;
function TAbstractStaticType.ToString: string;
begin
Result := GetKind.ToString;
end;
// --- Simple (Flyweight) Type Implementations ---
type
TSimpleStaticType = class(TAbstractStaticType)
private
FKind: TStaticTypeKind;
public
constructor Create(AKind: TStaticTypeKind);
function GetKind: TStaticTypeKind; override;
function GetHashCode: Integer; override;
end;
constructor TSimpleStaticType.Create(AKind: TStaticTypeKind);
begin
inherited Create;
FKind := AKind;
end;
function TSimpleStaticType.GetKind: TStaticTypeKind;
begin
Result := FKind;
end;
function TSimpleStaticType.GetHashCode: Integer;
begin
Result := Ord(FKind);
end;
// --- Complex Type Implementations ---
type
TSeriesType = class(TAbstractStaticType)
private
FElementType: IStaticType;
public
constructor Create(AElementType: IStaticType);
function GetKind: TStaticTypeKind; override;
function GetElementType: IStaticType; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
constructor TSeriesType.Create(AElementType: IStaticType);
begin
inherited Create;
FElementType := AElementType;
end;
function TSeriesType.GetKind: TStaticTypeKind;
begin
Result := stSeries;
end;
function TSeriesType.GetElementType: IStaticType;
begin
Result := FElementType;
end;
function TSeriesType.IsEqual(const Other: IStaticType): Boolean;
begin
Result := (Assigned(Other)) and (Other.Kind = stSeries) and (Self.FElementType.IsEqual(Other.ElementType));
end;
function TSeriesType.GetHashCode: Integer;
begin
Result := Ord(stSeries);
if Assigned(FElementType) then
begin
var hash := FElementType.GetHashCode;
Result := THashBobJenkins.GetHashValue(Hash, SizeOf(Integer), Result);
end;
end;
function TSeriesType.ToString: string;
begin
Result := 'Series<' + FElementType.ToString + '>';
end;
{ TMethodSignature }
constructor TMethodSignature.Create(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType);
begin
inherited Create;
FParamTypes := AParamTypes;
FReturnType := AReturnType;
end;
function TMethodSignature.GetParamTypes: TArray<IStaticType>;
begin
Result := FParamTypes;
end;
function TMethodSignature.GetReturnType: IStaticType;
begin
Result := FReturnType;
end;
function TMethodSignature.GetHashCode: Integer;
var
i: Integer;
begin
Result := 0;
if Assigned(FReturnType) then
Result := FReturnType.GetHashCode;
for i := 0 to High(FParamTypes) do
begin
if Assigned(FParamTypes[i]) then
begin
var hash := FParamTypes[i].GetHashCode;
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result);
end;
end;
end;
// ---
type
TMethodType = class(TAbstractStaticType)
private
FSignatures: TArray<IMethodSignature>;
function SignatureToString(const Sig: IMethodSignature): string;
public
constructor Create(const ASignatures: TArray<IMethodSignature>);
function GetKind: TStaticTypeKind; override;
function GetSignatures: TArray<IMethodSignature>; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
constructor TMethodType.Create(const ASignatures: TArray<IMethodSignature>);
begin
inherited Create;
Assert(Length(ASignatures) > 0, 'Cannot create a method type with zero signatures');
FSignatures := ASignatures;
end;
function TMethodType.GetKind: TStaticTypeKind;
begin
Result := stMethod;
end;
function TMethodType.GetSignatures: TArray<IMethodSignature>;
begin
Result := FSignatures;
end;
function TMethodType.SignatureToString(const Sig: IMethodSignature): string;
var
i: Integer;
paramStr: string;
begin
paramStr := '';
for i := 0 to High(Sig.ParamTypes) do
begin
paramStr := paramStr + Sig.ParamTypes[i].ToString;
if i < High(Sig.ParamTypes) then
paramStr := paramStr + ', ';
end;
Result := Format('Method(%s): %s', [paramStr, Sig.ReturnType.ToString]);
end;
function TMethodType.IsEqual(const Other: IStaticType): Boolean;
var
i, j: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> stMethod) then
exit(False);
var otherSigs := Other.Signatures;
if Length(Self.FSignatures) <> Length(otherSigs) then
exit(False);
for i := 0 to High(Self.FSignatures) do
begin
var sig1 := Self.FSignatures[i];
var sig2 := otherSigs[i];
if not sig1.ReturnType.IsEqual(sig2.ReturnType) then
exit(False);
if Length(sig1.ParamTypes) <> Length(sig2.ParamTypes) then
exit(False);
for j := 0 to High(sig1.ParamTypes) do
begin
if not sig1.ParamTypes[j].IsEqual(sig2.ParamTypes[j]) then
exit(False);
end;
end;
Result := True;
end;
function TMethodType.GetHashCode: Integer;
var
sig: IMethodSignature;
begin
Result := Ord(stMethod);
for sig in FSignatures do
begin
if Assigned(sig) then
begin
var hash := sig.GetHashCode;
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result);
end;
end;
end;
function TMethodType.ToString: string;
var
sb: TStringBuilder;
sig: IMethodSignature;
begin
if Length(FSignatures) = 1 then
begin
Result := SignatureToString(FSignatures[0]);
end
else
begin
sb := TStringBuilder.Create;
try
sb.Append('Method{');
for sig in FSignatures do
begin
sb.Append('(');
sb.Append(SignatureToString(sig));
sb.Append('), ');
end;
sb.Remove(sb.Length - 2, 2);
sb.Append('}');
Result := sb.ToString;
finally
sb.Free;
end;
end;
end;
// ---
type
TRecordType = class(TAbstractStaticType)
private
FKind: TStaticTypeKind;
FDefinition: IScalarRecordDefinition;
public
constructor Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition);
function GetKind: TStaticTypeKind; override;
function GetDefinition: IScalarRecordDefinition; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
constructor TRecordType.Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition);
begin
inherited Create;
Assert(AKind in [stRecord, stRecordSeries]);
FKind := AKind;
FDefinition := ADef;
end;
function TRecordType.GetKind: TStaticTypeKind;
begin
Result := FKind;
end;
function TRecordType.GetDefinition: IScalarRecordDefinition;
begin
Result := FDefinition;
end;
function TRecordType.IsEqual(const Other: IStaticType): Boolean;
var
i: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> GetKind) then
exit(False);
var otherDef := Other.Definition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False);
if Self.FDefinition.Count <> otherDef.Count then
exit(False);
for i := 0 to Self.FDefinition.Count - 1 do
begin
if (Self.FDefinition[i].Key <> otherDef[i].Key) or (Self.FDefinition[i].Value <> otherDef[i].Value) then
exit(False);
end;
Result := True;
end;
function TRecordType.GetHashCode: Integer;
var
i: Integer;
field: TPair<IKeyword, TScalar.TKind>;
begin
Result := Ord(GetKind);
if Assigned(FDefinition) then
begin
for i := 0 to FDefinition.Count - 1 do
begin
field := FDefinition[i];
var hash := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Pointer), Result);
var data := Ord(field.Value);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Byte), Result);
end;
end;
end;
function TRecordType.ToString: string;
var
i: Integer;
field: TPair<IKeyword, TScalar.TKind>;
begin
Result := GetKind.ToString + '{';
if Assigned(FDefinition) then
begin
for i := 0 to FDefinition.Count - 1 do
begin
field := FDefinition[i];
Result := Result + field.Key.Name + ': ' + field.Value.ToString;
if i < FDefinition.Count - 1 then
Result := Result + ', ';
end;
end;
Result := Result + '}';
end;
// ---
type
TGenericRecordType = class(TAbstractStaticType)
private
FDefinition: IGenericRecordDefinition;
public
constructor Create(const ADef: IGenericRecordDefinition);
function GetKind: TStaticTypeKind; override;
function GetGenericDefinition: IGenericRecordDefinition; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function GetHashCode: Integer; override;
function ToString: string; override;
end;
constructor TGenericRecordType.Create(const ADef: IGenericRecordDefinition);
begin
inherited Create;
FDefinition := ADef;
end;
function TGenericRecordType.GetKind: TStaticTypeKind;
begin
Result := stGenericRecord;
end;
function TGenericRecordType.GetGenericDefinition: IGenericRecordDefinition;
begin
Result := FDefinition;
end;
function TGenericRecordType.IsEqual(const Other: IStaticType): Boolean;
var
i: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> stGenericRecord) then
exit(False);
var otherDef := Other.GenericDefinition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False);
if Self.FDefinition.Count <> otherDef.Count then
exit(False);
for i := 0 to Self.FDefinition.Count - 1 do
begin
if (Self.FDefinition[i].Key <> otherDef[i].Key) or (not Self.FDefinition[i].Value.IsEqual(otherDef[i].Value)) then
exit(False);
end;
Result := True;
end;
function TGenericRecordType.GetHashCode: Integer;
var
i: Integer;
field: TPair<IKeyword, IStaticType>;
begin
Result := Ord(stGenericRecord);
if Assigned(FDefinition) then
begin
for i := 0 to FDefinition.Count - 1 do
begin
field := FDefinition[i];
var data := TEqualityComparer<IKeyword>.Default.GetHashCode(field.Key);
Result := THashBobJenkins.GetHashValue(data, SizeOf(Pointer), Result);
if Assigned(field.Value) then
begin
var hash := field.Value.GetHashCode;
Result := THashBobJenkins.GetHashValue(hash, SizeOf(Integer), Result);
end;
end;
end;
end;
function TGenericRecordType.ToString: string;
var
i: Integer;
field: TPair<IKeyword, IStaticType>;
begin
Result := GetKind.ToString + '{';
if Assigned(FDefinition) then
begin
for i := 0 to FDefinition.Count - 1 do
begin
field := FDefinition[i];
Result := Result + field.Key.Name + ': ' + field.Value.ToString;
if i < FDefinition.Count - 1 then
Result := Result + ', ';
end;
end;
Result := Result + '}';
end;
{ TTypes (Factory) }
class constructor TTypes.Create;
begin
FUnknown := TSimpleStaticType.Create(stUnknown);
FVoid := TSimpleStaticType.Create(stVoid);
FOrdinal := TSimpleStaticType.Create(stOrdinal);
FFloat := TSimpleStaticType.Create(stFloat);
FBoolean := TSimpleStaticType.Create(stBoolean);
FDateTime := TSimpleStaticType.Create(stDateTime);
FText := TSimpleStaticType.Create(stText);
FKeyword := TSimpleStaticType.Create(stKeyword);
end;
class function TTypes.CreateMethod(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType): IStaticType;
var
sig: IMethodSignature;
sigs: TArray<IMethodSignature>;
begin
sig := TMethodSignature.Create(AParamTypes, AReturnType);
SetLength(sigs, 1);
sigs[0] := sig;
Result := TMethodType.Create(sigs);
end;
class function TTypes.CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType;
begin
Result := TMethodType.Create(ASignatures);
end;
class function TTypes.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType;
begin
Result := TRecordType.Create(stRecord, ADef);
end;
class function TTypes.CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType;
begin
Result := TRecordType.Create(stRecordSeries, ADef);
end;
class function TTypes.CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType;
begin
Result := TGenericRecordType.Create(ADef);
end;
class function TTypes.CreateSeries(const AElementType: IStaticType): IStaticType;
begin
Result := TSeriesType.Create(AElementType);
end;
class function TTypes.FromScalarKind(AKind: TScalar.TKind): IStaticType;
begin
case AKind of
TScalar.TKind.Ordinal: Result := FOrdinal;
TScalar.TKind.Float: Result := FFloat;
TScalar.TKind.Keyword: Result := FKeyword;
TScalar.TKind.Boolean: Result := FBoolean;
TScalar.TKind.DateTime: Result := FDateTime;
else
Assert(False, 'Invalid Scalar Kind');
Result := nil;
end;
end;
{ TTypeRules }
class function TTypeRules.CanAssign(const Target, Source: IStaticType): Boolean;
begin
if (not Assigned(Target)) or (not Assigned(Source)) then
exit(False);
if (Target.Kind = stUnknown) or (Source.Kind = stUnknown) then
exit(True);
if Target.IsEqual(Source) then
exit(True);
if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then
exit(True);
if (Target.Kind = stOrdinal) and (Source.Kind = stBoolean) then
exit(True);
if (Target.Kind = stFloat) and (Source.Kind = stDateTime) then
exit(True);
if (Target.Kind = stVoid) and (Source.Kind = stMethod) then
exit(True);
if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then
exit(True);
Result := False;
end;
class function TTypeRules.Promote(const A, B: IStaticType): IStaticType;
begin
// Handle Unknown: If one is Unknown, the result is the other type.
if A.Kind = stUnknown then
exit(B);
if B.Kind = stUnknown then
exit(A);
// all operations involving void result void
if (A.Kind = stVoid) or (B.Kind = stVoid) then
exit(TTypes.Void);
// Standard Numeric promotion rule: Float wins
if (A.Kind = stFloat) and (B.Kind = stFloat) then
exit(TTypes.Float);
if (A.Kind = stFloat) and (B.Kind = stOrdinal) then
exit(TTypes.Float);
if (A.Kind = stOrdinal) and (B.Kind = stFloat) then
exit(TTypes.Float);
if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then
exit(TTypes.Ordinal);
// If types are identical, return that type.
if A.IsEqual(B) then
exit(A);
// No promotion possible
Result := nil;
end;
class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType;
var
promotedType: IStaticType;
promotedKind: TStaticTypeKind;
begin
promotedType := Promote(Left, Right);
// Mismatch during promotion
if not Assigned(promotedType) then
exit(nil);
if promotedType.Kind = stUnknown then
exit(TTypes.Unknown);
promotedKind := promotedType.Kind;
case Op of
TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply:
begin
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
exit(nil);
Result := promotedType;
end;
TScalar.TBinaryOp.Divide:
begin
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
exit(nil);
Result := TTypes.Float;
end;
TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual:
begin
if not (promotedKind in [stOrdinal, stFloat, stKeyword, stBoolean, stDateTime]) then
exit(nil);
Result := TTypes.Boolean;
end;
TScalar.TBinaryOp.Less, TScalar.TBinaryOp.Greater, TScalar.TBinaryOp.LessOrEqual, TScalar.TBinaryOp.GreaterOrEqual:
begin
if not (promotedKind in [stOrdinal, stFloat, stDateTime]) then
exit(nil);
Result := TTypes.Boolean;
end;
else
// Operation not supported at the AST level (might need folding later, but here it implies invalid usage)
Result := nil;
end;
end;
class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType;
var
rightKind: TStaticTypeKind;
begin
rightKind := Right.Kind;
if rightKind = stUnknown then
exit(TTypes.Unknown);
case Op of
TScalar.TUnaryOp.Negate:
begin
if not (rightKind in [stOrdinal, stFloat]) then
exit(nil);
Result := Right;
end;
TScalar.TUnaryOp.Not:
begin
if not (rightKind in [stOrdinal, stBoolean]) then
exit(nil);
Result := TTypes.Boolean;
end;
else
Result := nil;
end;
end;
end.