From 28e4d94b97aba9f9751dbe329e1c9c59b0bd4912 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 25 Oct 2025 16:23:16 +0200 Subject: [PATCH] ASt Types --- Src/AST/Myc.Ast.Types.pas | 545 +++++++++++++++++++++++++------------- 1 file changed, 356 insertions(+), 189 deletions(-) diff --git a/Src/AST/Myc.Ast.Types.pas b/Src/AST/Myc.Ast.Types.pas index b9c0f0f..e557cf0 100644 --- a/Src/AST/Myc.Ast.Types.pas +++ b/Src/AST/Myc.Ast.Types.pas @@ -8,6 +8,8 @@ uses Myc.Data.Scalar; type + IStaticType = interface; + // Defines the categories of types available in the language. TStaticTypeKind = ( stUnknown, // Used during inference before a type is known @@ -26,64 +28,85 @@ type function ToString: string; end; + // Defines the signature of a method + IMethodSignature = interface + {$region 'private'} + function GetParamTypes: TArray; + function GetReturnType: IStaticType; + {$endregion} + property ParamTypes: TArray read GetParamTypes; + property ReturnType: IStaticType read GetReturnType; + end; + // Represents a complete static type definition. - // This is a managed record, passed by value, cheap to copy. - TStaticType = record - public - type - // Forward declaration for mutual recursion - PStaticType = ^TStaticType; + IStaticType = interface + {$region 'private'} + function GetKind: TStaticTypeKind; + function GetElementType: IStaticType; + function GetSignature: IMethodSignature; + function GetDefinition: TScalarRecordDefinition; + {$endregion} - // Defines the signature of a method - IMethodSignature = interface - {$region 'private'} - function GetParamTypes: TArray; - function GetReturnType: TStaticType; - {$endregion} - property ParamTypes: TArray read GetParamTypes; - property ReturnType: TStaticType read GetReturnType; - end; - - public - Kind: TStaticTypeKind; - // Used if Kind = stMethod - Signature: IMethodSignature; - // Used if Kind = stSeries - ElementType: PStaticType; - // Used if Kind = stRecord or stRecordSeries - Definition: TScalarRecordDefinition; - - class operator Initialize(out Dest: TStaticType); - class operator Finalize(var Dest: TStaticType); - - // Factory functions - class function Create(AKind: TStaticTypeKind): TStaticType; static; - class function CreateSeries(const AElementType: TStaticType): TStaticType; static; - class function CreateMethod(const AParamTypes: TArray; const AReturnType: TStaticType): TStaticType; static; - class function CreateRecord(const ADef: TScalarRecordDefinition): TStaticType; static; - class function CreateRecordSeries(const ADef: TScalarRecordDefinition): TStaticType; static; - - class function FromScalarKind(AKind: TScalar.TKind): TStaticType; static; + // 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 signature (if Kind = stMethod) + property Signature: IMethodSignature read GetSignature; + // The definition (if Kind = stRecord or stRecordSeries) + property Definition: TScalarRecordDefinition read GetDefinition; + // Checks for type equality + function IsEqual(const Other: IStaticType): Boolean; function ToString: string; - class operator Equal(const A, B: TStaticType): Boolean; - class operator NotEqual(A, B: TStaticType): Boolean; inline; end; ETypeException = class(Exception); + // Factory and Flyweight access for static types. + // Use this record to create or access all IStaticType instances. + TTypes = record + private + class var + FUnknown: IStaticType; + class var + FVoid: IStaticType; + class var + FOrdinal: IStaticType; + class var + FFloat: IStaticType; + class var + FText: IStaticType; + class constructor Create; + public + // Flyweight accessors for simple types + 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 Text: IStaticType read FText; + + // Factory functions for complex types + class function CreateSeries(const AElementType: IStaticType): IStaticType; static; + class function CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; static; + class function CreateRecord(const ADef: TScalarRecordDefinition): IStaticType; static; + class function CreateRecordSeries(const ADef: TScalarRecordDefinition): IStaticType; static; + + class function FromScalarKind(AKind: TScalar.TKind): IStaticType; static; + end; + // Defines the rules of the type system. TTypeRules = record private - class function Promote(const A, B: TStaticType): TStaticType; static; + class function Promote(const A, B: IStaticType): IStaticType; static; public // Checks if a value of type 'Source' can be assigned to 'Target'. - class function CanAssign(const Target, Source: TStaticType): Boolean; static; + class function CanAssign(const Target, Source: IStaticType): Boolean; static; // Determines the result type of a binary operation. // Raises ETypeException on failure. - class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: TStaticType): TStaticType; static; + class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static; // Determines the result type of a unary operation. - class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: TStaticType): TStaticType; static; + class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; static; end; implementation @@ -91,36 +114,6 @@ implementation uses System.Generics.Defaults; -type - TMethodSignature = class(TInterfacedObject, TStaticType.IMethodSignature) - private - FParamTypes: TArray; - FReturnType: TStaticType; - function GetParamTypes: TArray; - function GetReturnType: TStaticType; - public - constructor Create(const AParamTypes: TArray; const AReturnType: TStaticType); - end; - -{ TMethodSignature } - -constructor TMethodSignature.Create(const AParamTypes: TArray; const AReturnType: TStaticType); -begin - inherited Create; - FParamTypes := AParamTypes; - FReturnType := AReturnType; -end; - -function TMethodSignature.GetParamTypes: TArray; -begin - Result := FParamTypes; -end; - -function TMethodSignature.GetReturnType: TStaticType; -begin - Result := FReturnType; -end; - { TStaticTypeKindHelper } function TStaticTypeKindHelper.ToString: string; @@ -140,150 +133,324 @@ begin end; end; -{ TStaticType } +// --- Abstract Base Implementation --- -class operator TStaticType.Initialize(out Dest: TStaticType); -begin - Dest.Kind := stUnknown; - Dest.Signature := nil; - Dest.ElementType := nil; -end; - -class operator TStaticType.Finalize(var Dest: TStaticType); -begin - Dest.Signature := nil; - if Dest.ElementType <> nil then - begin - Finalize(Dest.ElementType^); - FreeMem(Dest.ElementType); - Dest.ElementType := nil; +type + TAbstractStaticType = class(TInterfacedObject, IStaticType) + protected + // IStaticType (default implementations for non-applicable properties) + function GetKind: TStaticTypeKind; virtual; abstract; + function GetElementType: IStaticType; virtual; + function GetSignature: IMethodSignature; virtual; + function GetDefinition: TScalarRecordDefinition; virtual; + function IsEqual(const Other: IStaticType): Boolean; virtual; + function ToString: string; override; end; - // TScalarRecordDefinition (FFields) is not owned by this record. + +function TAbstractStaticType.GetElementType: IStaticType; +begin + Result := nil; end; -class operator TStaticType.Equal(const A, B: TStaticType): Boolean; +function TAbstractStaticType.GetSignature: IMethodSignature; +begin + Result := nil; +end; + +function TAbstractStaticType.GetDefinition: TScalarRecordDefinition; +begin + // Return an empty/invalid definition + Result := Default(TScalarRecordDefinition); +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); +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; + end; + +constructor TSimpleStaticType.Create(AKind: TStaticTypeKind); +begin + inherited Create; + FKind := AKind; +end; + +function TSimpleStaticType.GetKind: TStaticTypeKind; +begin + Result := 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 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.ToString: string; +begin + Result := 'Series<' + FElementType.ToString + '>'; +end; + +// --- +type + TMethodSignature = class(TInterfacedObject, IMethodSignature) + private + FParamTypes: TArray; + FReturnType: IStaticType; + function GetParamTypes: TArray; + function GetReturnType: IStaticType; + public + constructor Create(const AParamTypes: TArray; const AReturnType: IStaticType); + end; + +constructor TMethodSignature.Create(const AParamTypes: TArray; const AReturnType: IStaticType); +begin + inherited Create; + FParamTypes := AParamTypes; + FReturnType := AReturnType; +end; + +function TMethodSignature.GetParamTypes: TArray; +begin + Result := FParamTypes; +end; + +function TMethodSignature.GetReturnType: IStaticType; +begin + Result := FReturnType; +end; + +// --- +type + TMethodType = class(TAbstractStaticType) + private + FSignature: IMethodSignature; + public + constructor Create(AParamTypes: TArray; AReturnType: IStaticType); + function GetKind: TStaticTypeKind; override; + function GetSignature: IMethodSignature; override; + function IsEqual(const Other: IStaticType): Boolean; override; + function ToString: string; override; + end; + +constructor TMethodType.Create(AParamTypes: TArray; AReturnType: IStaticType); +begin + inherited Create; + FSignature := TMethodSignature.Create(AParamTypes, AReturnType); +end; + +function TMethodType.GetKind: TStaticTypeKind; +begin + Result := stMethod; +end; + +function TMethodType.GetSignature: IMethodSignature; +begin + Result := FSignature; +end; + +function TMethodType.IsEqual(const Other: IStaticType): Boolean; var i: Integer; begin - if A.Kind <> B.Kind then + if (not Assigned(Other)) or (Other.Kind <> stMethod) then exit(False); - case A.Kind of - stSeries: Result := A.ElementType^ = B.ElementType^; - stRecord, stRecordSeries: - begin - if Length(A.Definition.Fields) <> Length(B.Definition.Fields) then - exit(False); - for i := 0 to High(A.Definition.Fields) do - begin - if (A.Definition.Fields[i].Name <> B.Definition.Fields[i].Name) - or (A.Definition.Fields[i].Kind <> B.Definition.Fields[i].Kind) then - exit(False); - end; - Result := True; - end; - stMethod: - begin - if A.Signature.ReturnType <> B.Signature.ReturnType then - exit(False); - if Length(A.Signature.ParamTypes) <> Length(B.Signature.ParamTypes) then - exit(False); - for i := 0 to High(A.Signature.ParamTypes) do - begin - if A.Signature.ParamTypes[i] <> B.Signature.ParamTypes[i] then - exit(False); - end; - Result := True; - end; - else - // stUnknown, stVoid, stOrdinal, stFloat, stText are equal if their kinds are equal. - Result := True; + var otherSig := Other.Signature; + if not Self.FSignature.ReturnType.IsEqual(otherSig.ReturnType) then + exit(False); + + if Length(Self.FSignature.ParamTypes) <> Length(otherSig.ParamTypes) then + exit(False); + + for i := 0 to High(Self.FSignature.ParamTypes) do + begin + if not Self.FSignature.ParamTypes[i].IsEqual(otherSig.ParamTypes[i]) then + exit(False); end; + + Result := True; end; -class function TStaticType.Create(AKind: TStaticTypeKind): TStaticType; +function TMethodType.ToString: string; +var + i: Integer; + paramStr: string; begin - Result.Kind := AKind; + paramStr := ''; + for i := 0 to High(FSignature.ParamTypes) do + begin + paramStr := paramStr + FSignature.ParamTypes[i].ToString; + if i < High(FSignature.ParamTypes) then + paramStr := paramStr + ', '; + end; + Result := Format('Method(%s): %s', [paramStr, FSignature.ReturnType.ToString]); end; -class function TStaticType.CreateMethod(const AParamTypes: TArray; const AReturnType: TStaticType): TStaticType; +// --- +type + TRecordType = class(TAbstractStaticType) + private + FKind: TStaticTypeKind; + FDefinition: TScalarRecordDefinition; + public + constructor Create(AKind: TStaticTypeKind; ADef: TScalarRecordDefinition); + function GetKind: TStaticTypeKind; override; + function GetDefinition: TScalarRecordDefinition; override; + function IsEqual(const Other: IStaticType): Boolean; override; + function ToString: string; override; + end; + +constructor TRecordType.Create(AKind: TStaticTypeKind; ADef: TScalarRecordDefinition); begin - Result.Kind := stMethod; - Result.Signature := TMethodSignature.Create(AParamTypes, AReturnType); + inherited Create; + Assert(AKind in [stRecord, stRecordSeries]); + FKind := AKind; + FDefinition := ADef; end; -class function TStaticType.CreateRecord(const ADef: TScalarRecordDefinition): TStaticType; +function TRecordType.GetKind: TStaticTypeKind; begin - Result.Kind := stRecord; - Result.Definition := ADef; + Result := FKind; end; -class function TStaticType.CreateRecordSeries(const ADef: TScalarRecordDefinition): TStaticType; +function TRecordType.GetDefinition: TScalarRecordDefinition; begin - Result.Kind := stRecordSeries; - Result.Definition := ADef; + Result := FDefinition; end; -class function TStaticType.CreateSeries(const AElementType: TStaticType): TStaticType; +function TRecordType.IsEqual(const Other: IStaticType): Boolean; +var + i: Integer; begin - Result.Kind := stSeries; - New(Result.ElementType); - Result.ElementType^ := AElementType; + if (not Assigned(Other)) or (Other.Kind <> GetKind) then + exit(False); + + var otherDef := Other.Definition; + if Length(Self.FDefinition.Fields) <> Length(otherDef.Fields) then + exit(False); + + for i := 0 to High(Self.FDefinition.Fields) do + begin + if (Self.FDefinition.Fields[i].Name <> otherDef.Fields[i].Name) or (Self.FDefinition.Fields[i].Kind <> otherDef.Fields[i].Kind) then + exit(False); + end; + + Result := True; end; -class function TStaticType.FromScalarKind(AKind: TScalar.TKind): TStaticType; +function TRecordType.ToString: string; +var + i: Integer; +begin + Result := GetKind.ToString + '{'; + for i := 0 to High(FDefinition.Fields) do + begin + Result := Result + FDefinition.Fields[i].Name + ': ' + FDefinition.Fields[i].Kind.ToString; + if i < High(FDefinition.Fields) then + Result := Result + ', '; + end; + Result := Result + '}'; +end; + +{ TTypes (Factory) } + +class constructor TTypes.Create; +begin + // Create the flyweight singletons + FUnknown := TSimpleStaticType.Create(stUnknown); + FVoid := TSimpleStaticType.Create(stVoid); + FOrdinal := TSimpleStaticType.Create(stOrdinal); + FFloat := TSimpleStaticType.Create(stFloat); + FText := TSimpleStaticType.Create(stText); +end; + +class function TTypes.CreateMethod(const AParamTypes: TArray; const AReturnType: IStaticType): IStaticType; +begin + Result := TMethodType.Create(AParamTypes, AReturnType); +end; + +class function TTypes.CreateRecord(const ADef: TScalarRecordDefinition): IStaticType; +begin + Result := TRecordType.Create(stRecord, ADef); +end; + +class function TTypes.CreateRecordSeries(const ADef: TScalarRecordDefinition): IStaticType; +begin + Result := TRecordType.Create(stRecordSeries, 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.Kind := stOrdinal; - TScalar.TKind.Float: Result.Kind := stFloat; + TScalar.TKind.Ordinal: Result := FOrdinal; + TScalar.TKind.Float: Result := FFloat; else raise ETypeException.Create('Cannot convert invalid TScalar.TKind to TStaticType.'); end; end; -function TStaticType.ToString: string; -var - i: Integer; - paramStr: string; -begin - Result := Kind.ToString; - case Kind of - stSeries: Result := 'Series<' + ElementType^.ToString + '>'; - stRecord, stRecordSeries: - begin - Result := Result + '{'; - for i := 0 to High(Definition.Fields) do - begin - Result := Result + Definition.Fields[i].Name + ': ' + Definition.Fields[i].Kind.ToString; - if i < High(Definition.Fields) then - Result := Result + ', '; - end; - Result := Result + '}'; - end; - stMethod: - begin - paramStr := ''; - for i := 0 to High(Signature.ParamTypes) do - begin - paramStr := paramStr + Signature.ParamTypes[i].ToString; - if i < High(Signature.ParamTypes) then - paramStr := paramStr + ', '; - end; - Result := Format('Method(%s): %s', [paramStr, Signature.ReturnType.ToString]); - end; - end; -end; - -class operator TStaticType.NotEqual(A, B: TStaticType): Boolean; -begin - Result := not (A = B); -end; - { TTypeRules } -class function TTypeRules.CanAssign(const Target, Source: TStaticType): Boolean; +class function TTypeRules.CanAssign(const Target, Source: IStaticType): Boolean; begin - if Target = Source then + if (not Assigned(Target)) or (not Assigned(Source)) then + exit(False); + + if Target.IsEqual(Source) then exit(True); // Allow assigning an integer (Ordinal) to a float variable. @@ -295,22 +462,22 @@ begin Result := False; end; -class function TTypeRules.Promote(const A, B: TStaticType): TStaticType; +class function TTypeRules.Promote(const A, B: IStaticType): IStaticType; begin // Numeric promotion rule: Float wins if (A.Kind = stFloat) and (B.Kind = stFloat) then - exit(TStaticType.Create(stFloat)); + exit(TTypes.Float); if (A.Kind = stFloat) and (B.Kind = stOrdinal) then - exit(TStaticType.Create(stFloat)); + exit(TTypes.Float); if (A.Kind = stOrdinal) and (B.Kind = stFloat) then - exit(TStaticType.Create(stFloat)); + exit(TTypes.Float); if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then - exit(TStaticType.Create(stOrdinal)); + exit(TTypes.Ordinal); raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]); end; -class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: TStaticType): TStaticType; +class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; begin case Op of TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply: @@ -326,7 +493,7 @@ begin begin // Division *always* results in Float, even Ordinal / Ordinal if (Left.Kind in [stOrdinal, stFloat]) and (Right.Kind in [stOrdinal, stFloat]) then - Result := TStaticType.Create(stFloat) + Result := TTypes.Float else raise ETypeException.CreateFmt('Operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]); end; @@ -340,7 +507,7 @@ begin begin // Comparison operations: Check if promotion is possible, but always return Ordinal (boolean) if (Left.Kind in [stOrdinal, stFloat]) and (Right.Kind in [stOrdinal, stFloat]) then - Result := TStaticType.Create(stOrdinal) + Result := TTypes.Ordinal else raise ETypeException .CreateFmt('Comparison operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]); @@ -350,7 +517,7 @@ begin end; end; -class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: TStaticType): TStaticType; +class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType; begin case Op of TScalar.TUnaryOp.Negate: @@ -364,7 +531,7 @@ begin begin if not (Right.Kind = stOrdinal) then raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]); - Result := TStaticType.Create(stOrdinal); + Result := TTypes.Ordinal; end; else raise ETypeException.Create('Unknown unary operator for type resolution.');