unit Myc.Ast.Types;

interface

uses
    System.SysUtils,
    System.Generics.Collections,
    System.Generics.Defaults,
    Myc.Data.Scalar,
    Myc.Data.Keyword;

type
    // Forward declarations
    IStaticType = interface;
    ITupleType = interface;
    IVectorType = interface;
    IMatrixType = interface;
    ISeriesType = interface;
    IMethodType = interface;
    IRecordType = interface;
    IGenericRecordType = interface;

    TStaticTypeKind = (
        stUnknown,
        stVoid,
        stOrdinal,
        stFloat,
        stBoolean,
        stDateTime,
        stText,
        stKeyword,
        stMethod,
        stSeries,
        stRecord,
        stRecordSeries,
        stGenericRecord,
        // New N-dimensional types
        stTuple,
        stVector,
        stMatrix
    );

    TStaticTypeKindHelper = record helper for TStaticTypeKind
    public
        function ToString: string;
    end;

    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;

    IGenericRecordDefinition = IKeywordMapping<IStaticType>;
    TGenericRecordRegistry = TKeywordMappingRegistry<IStaticType>;

    IScalarRecordDefinition = Myc.Data.Scalar.IScalarRecordDefinition;

    // Base Interface
    IStaticType = interface
        {$region 'private'}
        function GetKind: TStaticTypeKind;
        function GetIsOptional: Boolean;
        function GetIsScalarPure: Boolean;
        {$endregion}

        property Kind: TStaticTypeKind read GetKind;
        property IsOptional: Boolean read GetIsOptional;
        property IsScalarPure: Boolean read GetIsScalarPure;

        function IsEqual(const Other: IStaticType): Boolean;
        function IsStructurallyEqual(const Other: IStaticType): Boolean;
        function ToString: string;
        function GetHashCode: Integer;

        // Hard casts to specialized interfaces
        function AsTuple: ITupleType;
        function AsVector: IVectorType;
        function AsMatrix: IMatrixType;
        function AsSeries: ISeriesType;
        function AsMethod: IMethodType;
        function AsRecord: IRecordType;
        function AsGenericRecord: IGenericRecordType;
    end;

    // --- Specialized Interfaces ---

    ITupleType = interface(IStaticType)
        {$region 'private'}
        function GetElements: TArray<IStaticType>;
        function GetCount: Integer;
        {$endregion}
        property Elements: TArray<IStaticType> read GetElements;
        property Count: Integer read GetCount;
    end;

    IVectorType = interface(IStaticType)
        {$region 'private'}
        function GetElementType: IStaticType;
        function GetCount: Integer;
        {$endregion}
        property ElementType: IStaticType read GetElementType;
        property Count: Integer read GetCount;
    end;

    IMatrixType = interface(IStaticType)
        {$region 'private'}
        function GetElementType: IStaticType;
        function GetDimensions: TArray<Integer>;
        {$endregion}
        property ElementType: IStaticType read GetElementType;
        property Dimensions: TArray<Integer> read GetDimensions;
    end;

    ISeriesType = interface(IStaticType)
        {$region 'private'}
        function GetElementType: IStaticType;
        {$endregion}
        property ElementType: IStaticType read GetElementType;
    end;

    IMethodType = interface(IStaticType)
        {$region 'private'}
        function GetSignatures: TArray<IMethodSignature>;
        {$endregion}
        property Signatures: TArray<IMethodSignature> read GetSignatures;
    end;

    IRecordType = interface(IStaticType)
        {$region 'private'}
        function GetDefinition: IScalarRecordDefinition;
        {$endregion}
        property Definition: IScalarRecordDefinition read GetDefinition;
    end;

    IGenericRecordType = interface(IStaticType)
        {$region 'private'}
        function GetGenericDefinition: IGenericRecordDefinition;
        {$endregion}
        property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition;
    end;

    // --- Factory ---

    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 var
            FOrdinalOpt: IStaticType;
        class var
            FFloatOpt: IStaticType;
        class var
            FBooleanOpt: IStaticType;
        class var
            FDateTimeOpt: IStaticType;
        class var
            FTextOpt: IStaticType;
        class var
            FKeywordOpt: IStaticType;

        class var
            FSeriesCache: TDictionary<IStaticType, IStaticType>;
        class var
            FRecordCache: TDictionary<IScalarRecordDefinition, IStaticType>;
        class var
            FRecordSeriesCache: TDictionary<IScalarRecordDefinition, IStaticType>;
        class var
            FGenericRecordCache: TDictionary<IGenericRecordDefinition, IStaticType>;
        class var
            FMethodCache: TDictionary<TArray<IMethodSignature>, IStaticType>;
        class var
            FOptionalCache: TDictionary<IStaticType, IStaticType>;

        class constructor Create;
        class destructor Destroy;
    public
        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;

        class property OrdinalOpt: IStaticType read FOrdinalOpt;
        class property FloatOpt: IStaticType read FFloatOpt;
        class property BooleanOpt: IStaticType read FBooleanOpt;
        class property DateTimeOpt: IStaticType read FDateTimeOpt;
        class property TextOpt: IStaticType read FTextOpt;
        class property KeywordOpt: IStaticType read FKeywordOpt;

        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 CreateTuple(const AElements: TArray<IStaticType>): ITupleType; static;
        class function CreateVector(const AElementType: IStaticType; ACount: Integer): IVectorType; static;
        class function CreateMatrix(const AElementType: IStaticType; const ADimensions: TArray<Integer>): IMatrixType; static;

        class function MakeOptional(const AType: IStaticType): IStaticType; static;
        class function Unwrap(const AType: IStaticType): IStaticType; static;
        class function FromScalarKind(AKind: TScalar.TKind): IStaticType; static;
    end;

    TTypeRules = record
    public
        class function Promote(const A, B: IStaticType): IStaticType; static;
        class function CanAssign(const Target, Source: IStaticType): Boolean; static;
        class function ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType; static;
        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.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';
        stTuple: Result := 'Tuple';
        stVector: Result := 'Vector';
        stMatrix: Result := 'Matrix';
    else
        Result := 'ErrorType';
    end;
end;

// --- Abstract Base Implementation ---

type
    TAbstractStaticType = class(TInterfacedObject, IStaticType)
    protected
        function GetKind: TStaticTypeKind; virtual; abstract;
        function GetIsOptional: Boolean; virtual;
        function GetIsScalarPure: Boolean; virtual;
        function IsEqual(const Other: IStaticType): Boolean; virtual;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; virtual;
        function GetHashCode: Integer; override; abstract;
        function ToString: string; override;

        function AsTuple: ITupleType; virtual;
        function AsVector: IVectorType; virtual;
        function AsMatrix: IMatrixType; virtual;
        function AsSeries: ISeriesType; virtual;
        function AsMethod: IMethodType; virtual;
        function AsRecord: IRecordType; virtual;
        function AsGenericRecord: IGenericRecordType; virtual;
    end;

function TAbstractStaticType.GetIsOptional: Boolean;
begin
    Result := False;
end;

function TAbstractStaticType.GetIsScalarPure: Boolean;
begin
    Result := False;
end;

function TAbstractStaticType.IsStructurallyEqual(const Other: IStaticType): Boolean;
begin
    if not Assigned(Other) then
        exit(False);
    Result := (GetKind = TTypes.Unwrap(Other).Kind);
end;

function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean;
begin
    if not Assigned(Other) then
        exit(False);
    if GetIsOptional <> Other.IsOptional then
        exit(False);
    Result := IsStructurallyEqual(Other);
end;

function TAbstractStaticType.ToString: string;
begin
    Result := GetKind.ToString;
end;

// Cast Defaults
function TAbstractStaticType.AsTuple: ITupleType;
begin
    raise EInvalidCast.Create('Type is not a Tuple.');
end;
function TAbstractStaticType.AsVector: IVectorType;
begin
    raise EInvalidCast.Create('Type is not a Vector.');
end;
function TAbstractStaticType.AsMatrix: IMatrixType;
begin
    raise EInvalidCast.Create('Type is not a Matrix.');
end;
function TAbstractStaticType.AsSeries: ISeriesType;
begin
    raise EInvalidCast.Create('Type is not a Series.');
end;
function TAbstractStaticType.AsMethod: IMethodType;
begin
    raise EInvalidCast.Create('Type is not a Method.');
end;
function TAbstractStaticType.AsRecord: IRecordType;
begin
    raise EInvalidCast.Create('Type is not a Record.');
end;
function TAbstractStaticType.AsGenericRecord: IGenericRecordType;
begin
    raise EInvalidCast.Create('Type is not a Generic Record.');
end;

// --- Optional Type Decorator ---

type
    TOptionalType = class(TInterfacedObject, IStaticType)
    private
        FInner: IStaticType;
    public
        constructor Create(const AInner: IStaticType);
        function GetKind: TStaticTypeKind;
        function GetIsOptional: Boolean;
        function GetIsScalarPure: Boolean;
        function IsStructurallyEqual(const Other: IStaticType): Boolean;
        function IsEqual(const Other: IStaticType): Boolean;
        function GetHashCode: Integer; override;
        function ToString: string; override;

        function AsTuple: ITupleType;
        function AsVector: IVectorType;
        function AsMatrix: IMatrixType;
        function AsSeries: ISeriesType;
        function AsMethod: IMethodType;
        function AsRecord: IRecordType;
        function AsGenericRecord: IGenericRecordType;
    end;

constructor TOptionalType.Create(const AInner: IStaticType);
begin
    inherited Create;
    FInner := AInner;
end;

function TOptionalType.GetKind: TStaticTypeKind;
begin
    Result := FInner.Kind;
end;

function TOptionalType.GetIsOptional: Boolean;
begin
    Result := True;
end;

function TOptionalType.GetIsScalarPure: Boolean;
begin
    Result := False;
end;

function TOptionalType.IsStructurallyEqual(const Other: IStaticType): Boolean;
begin
    Result := FInner.IsStructurallyEqual(TTypes.Unwrap(Other));
end;

function TOptionalType.IsEqual(const Other: IStaticType): Boolean;
begin
    if not Assigned(Other) then
        exit(False);
    if not Other.IsOptional then
        exit(False);
    Result := IsStructurallyEqual(Other);
end;

function TOptionalType.GetHashCode: Integer;
var
    h: Integer;
    optionalMarker: Integer;
begin
    h := FInner.GetHashCode;
    optionalMarker := $11111111;
    Result := THashBobJenkins.GetHashValue(optionalMarker, SizeOf(Integer), h);
end;

function TOptionalType.ToString: string;
begin
    Result := FInner.ToString + '?';
end;

// Delegation
function TOptionalType.AsTuple: ITupleType;
begin
    Result := FInner.AsTuple;
end;
function TOptionalType.AsVector: IVectorType;
begin
    Result := FInner.AsVector;
end;
function TOptionalType.AsMatrix: IMatrixType;
begin
    Result := FInner.AsMatrix;
end;
function TOptionalType.AsSeries: ISeriesType;
begin
    Result := FInner.AsSeries;
end;
function TOptionalType.AsMethod: IMethodType;
begin
    Result := FInner.AsMethod;
end;
function TOptionalType.AsRecord: IRecordType;
begin
    Result := FInner.AsRecord;
end;
function TOptionalType.AsGenericRecord: IGenericRecordType;
begin
    Result := FInner.AsGenericRecord;
end;

// --- Simple (Flyweight) Type Implementations ---

type
    TSimpleStaticType = class(TAbstractStaticType)
    private
        FKind: TStaticTypeKind;
    public
        constructor Create(AKind: TStaticTypeKind);
        function GetKind: TStaticTypeKind; override;
        function GetIsScalarPure: Boolean; 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.GetIsScalarPure: Boolean;
begin
    Result := FKind in [stOrdinal, stFloat, stBoolean, stDateTime, stKeyword];
end;

function TSimpleStaticType.GetHashCode: Integer;
begin
    Result := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0);
end;

// --- Complex Type Implementations ---

type
    TSeriesType = class(TAbstractStaticType, ISeriesType)
    private
        FElementType: IStaticType;
    public
        constructor Create(AElementType: IStaticType);
        function GetKind: TStaticTypeKind; override;
        function GetElementType: IStaticType;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
        function GetHashCode: Integer; override;
        function ToString: string; override;
        function AsSeries: ISeriesType; 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.AsSeries: ISeriesType;
begin
    Result := Self;
end;

function TSeriesType.IsStructurallyEqual(const Other: IStaticType): Boolean;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> stSeries then
        exit(False);
    Result := FElementType.IsEqual(uOther.AsSeries.ElementType);
end;

function TSeriesType.GetHashCode: Integer;
var
    h: Integer;
begin
    h := Ord(stSeries);
    Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
    if Assigned(FElementType) then
    begin
        h := FElementType.GetHashCode;
        Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
    end;
end;

function TSeriesType.ToString: string;
begin
    Result := inherited + '<' + FElementType.ToString + '>';
end;

// --- Tuple ---

type
    TTupleType = class(TAbstractStaticType, ITupleType)
    private
        FElements: TArray<IStaticType>;
    public
        constructor Create(const AElements: TArray<IStaticType>);
        function GetKind: TStaticTypeKind; override;
        function GetIsScalarPure: Boolean; override;
        function GetElements: TArray<IStaticType>;
        function GetCount: Integer;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
        function GetHashCode: Integer; override;
        function ToString: string; override;
        function AsTuple: ITupleType; override;
    end;

constructor TTupleType.Create(const AElements: TArray<IStaticType>);
begin
    inherited Create;
    FElements := AElements;
end;

function TTupleType.GetKind: TStaticTypeKind;
begin
    Result := stTuple;
end;

function TTupleType.GetIsScalarPure: Boolean;
begin
    for var elem in FElements do
        if not elem.IsScalarPure then
            exit(False);
    Result := True;
end;

function TTupleType.GetElements: TArray<IStaticType>;
begin
    Result := FElements;
end;

function TTupleType.GetCount: Integer;
begin
    Result := Length(FElements);
end;

function TTupleType.AsTuple: ITupleType;
begin
    Result := Self;
end;

function TTupleType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
    otherTuple: ITupleType;
    i: Integer;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> stTuple then
        exit(False);
    otherTuple := uOther.AsTuple;

    if Length(FElements) <> otherTuple.Count then
        exit(False);
    for i := 0 to High(FElements) do
        if not FElements[i].IsEqual(otherTuple.Elements[i]) then
            exit(False);
    Result := True;
end;

function TTupleType.GetHashCode: Integer;
var
    h, i: Integer;
begin
    h := Ord(stTuple);
    Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
    for i := 0 to High(FElements) do
    begin
        h := FElements[i].GetHashCode;
        Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
    end;
end;

function TTupleType.ToString: string;
var
    sb: TStringBuilder;
    i: Integer;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('[');
        for i := 0 to High(FElements) do
        begin
            sb.Append(FElements[i].ToString);
            if i < High(FElements) then
                sb.Append(', ');
        end;
        sb.Append(']');
        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

// --- Vector ---

type
    TVectorType = class(TAbstractStaticType, IVectorType)
    private
        FElementType: IStaticType;
        FCount: Integer;
    public
        constructor Create(const AElementType: IStaticType; ACount: Integer);
        function GetKind: TStaticTypeKind; override;
        function GetIsScalarPure: Boolean; override;
        function GetElementType: IStaticType;
        function GetCount: Integer;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
        function GetHashCode: Integer; override;
        function ToString: string; override;
        function AsVector: IVectorType; override;
    end;

constructor TVectorType.Create(const AElementType: IStaticType; ACount: Integer);
begin
    inherited Create;
    FElementType := AElementType;
    FCount := ACount;
end;

function TVectorType.GetKind: TStaticTypeKind;
begin
    Result := stVector;
end;

function TVectorType.GetIsScalarPure: Boolean;
begin
    Result := FElementType.IsScalarPure;
end;

function TVectorType.GetElementType: IStaticType;
begin
    Result := FElementType;
end;

function TVectorType.GetCount: Integer;
begin
    Result := FCount;
end;

function TVectorType.AsVector: IVectorType;
begin
    Result := Self;
end;

function TVectorType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
    otherVec: IVectorType;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> stVector then
        exit(False);
    otherVec := uOther.AsVector;
    Result := (FCount = otherVec.Count) and (FElementType.IsEqual(otherVec.ElementType));
end;

function TVectorType.GetHashCode: Integer;
var
    h: Integer;
begin
    h := Ord(stVector);
    Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
    h := FElementType.GetHashCode;
    Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
    Result := THashBobJenkins.GetHashValue(FCount, SizeOf(Integer), Result);
end;

function TVectorType.ToString: string;
begin
    Result := inherited + Format('[%s; %d]', [FElementType.ToString, FCount]);
end;

// --- Matrix ---

type
    TMatrixType = class(TAbstractStaticType, IMatrixType)
    private
        FElementType: IStaticType;
        FDimensions: TArray<Integer>;
    public
        constructor Create(const AElementType: IStaticType; const ADimensions: TArray<Integer>);
        function GetKind: TStaticTypeKind; override;
        function GetIsScalarPure: Boolean; override;
        function GetElementType: IStaticType;
        function GetDimensions: TArray<Integer>;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
        function GetHashCode: Integer; override;
        function ToString: string; override;
        function AsMatrix: IMatrixType; override;
    end;

constructor TMatrixType.Create(const AElementType: IStaticType; const ADimensions: TArray<Integer>);
begin
    inherited Create;
    FElementType := AElementType;
    FDimensions := ADimensions;
end;

function TMatrixType.GetKind: TStaticTypeKind;
begin
    Result := stMatrix;
end;

function TMatrixType.GetIsScalarPure: Boolean;
begin
    Result := FElementType.IsScalarPure;
end;

function TMatrixType.GetElementType: IStaticType;
begin
    Result := FElementType;
end;

function TMatrixType.GetDimensions: TArray<Integer>;
begin
    Result := FDimensions;
end;

function TMatrixType.AsMatrix: IMatrixType;
begin
    Result := Self;
end;

function TMatrixType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
    otherMat: IMatrixType;
    i: Integer;
    dims: TArray<Integer>;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> stMatrix then
        exit(False);
    otherMat := uOther.AsMatrix;

    if not FElementType.IsEqual(otherMat.ElementType) then
        exit(False);

    dims := otherMat.Dimensions;
    if Length(FDimensions) <> Length(dims) then
        exit(False);
    for i := 0 to High(FDimensions) do
        if FDimensions[i] <> dims[i] then
            exit(False);
    Result := True;
end;

function TMatrixType.GetHashCode: Integer;
var
    h, i: Integer;
begin
    h := Ord(stMatrix);
    Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
    h := FElementType.GetHashCode;
    Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
    for i := 0 to High(FDimensions) do
        Result := THashBobJenkins.GetHashValue(FDimensions[i], SizeOf(Integer), Result);
end;

function TMatrixType.ToString: string;
var
    sb: TStringBuilder;
    i: Integer;
begin
    sb := TStringBuilder.Create;
    try
        sb.Append('[');
        sb.Append(FElementType.ToString);
        sb.Append('; ');
        for i := 0 to High(FDimensions) do
        begin
            sb.Append(FDimensions[i]);
            if i < High(FDimensions) then
                sb.Append('x');
        end;
        sb.Append(']');
        Result := inherited + sb.ToString;
    finally
        sb.Free;
    end;
end;

// --- Method Type ---

type
    TMethodType = class(TAbstractStaticType, IMethodType)
    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>;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; override;
        function GetHashCode: Integer; override;
        function ToString: string; override;
        function AsMethod: IMethodType; 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.AsMethod: IMethodType;
begin
    Result := Self;
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.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
    otherMeth: IMethodType;
    i, j: Integer;
    s1, s2: IMethodSignature;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> stMethod then
        exit(False);
    otherMeth := uOther.AsMethod;

    if Length(FSignatures) <> Length(otherMeth.Signatures) then
        exit(False);
    for i := 0 to High(FSignatures) do
    begin
        s1 := FSignatures[i];
        s2 := otherMeth.Signatures[i];
        if not s1.ReturnType.IsEqual(s2.ReturnType) then
            exit(False);
        if Length(s1.ParamTypes) <> Length(s2.ParamTypes) then
            exit(False);
        for j := 0 to High(s1.ParamTypes) do
            if not s1.ParamTypes[j].IsEqual(s2.ParamTypes[j]) then
                exit(False);
    end;
    Result := True;
end;

function TMethodType.GetHashCode: Integer;
var
    h: Integer;
    sig: IMethodSignature;
begin
    h := Ord(stMethod);
    Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
    for sig in FSignatures do
    begin
        if Assigned(sig) then
        begin
            h := sig.GetHashCode;
            Result := THashBobJenkins.GetHashValue(h, 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;

// --- Record Type ---

type
    TRecordType = class(TAbstractStaticType, IRecordType)
    private
        FKind: TStaticTypeKind;
        FDefinition: IScalarRecordDefinition;
    public
        constructor Create(AKind: TStaticTypeKind; ADef: IScalarRecordDefinition);
        function GetKind: TStaticTypeKind; override;
        function GetDefinition: IScalarRecordDefinition;
        function GetHashCode: Integer; override;
        function AsRecord: IRecordType; override;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; 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.AsRecord: IRecordType;
begin
    Result := Self;
end;

function TRecordType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
    i: Integer;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> FKind then
        exit(False);
    var otherDef := uOther.AsRecord.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.Keywords[i] <> otherDef.Keywords[i]) or (Self.FDefinition[i] <> otherDef[i]) then
            exit(False);
    end;
    Result := True;
end;

function TRecordType.GetHashCode: Integer;
var
    i, h: Integer;
begin
    Result := THashBobJenkins.GetHashValue(FKind, SizeOf(TStaticTypeKind), 0);
    if Assigned(FDefinition) then
    begin
        for i := 0 to FDefinition.Count - 1 do
        begin
            h := FDefinition.Keywords[i].Idx;
            Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
            h := Ord(FDefinition[i]);
            Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
        end;
    end;
end;

function TRecordType.ToString: string;
var
    i: Integer;
begin
    Result := GetKind.ToString + '{';
    if Assigned(FDefinition) then
    begin
        for i := 0 to FDefinition.Count - 1 do
        begin
            Result := Result + FDefinition.Keywords[i].Name + ': ' + FDefinition[i].ToString;
            if i < FDefinition.Count - 1 then
                Result := Result + ', ';
        end;
    end;
    Result := Result + '}';
end;

// --- Generic Record Type ---

type
    TGenericRecordType = class(TAbstractStaticType, IGenericRecordType)
    private
        FDefinition: IGenericRecordDefinition;
    public
        constructor Create(const ADef: IGenericRecordDefinition);
        function GetKind: TStaticTypeKind; override;
        function GetGenericDefinition: IGenericRecordDefinition;
        function GetHashCode: Integer; override;
        function AsGenericRecord: IGenericRecordType; override;
        function IsStructurallyEqual(const Other: IStaticType): Boolean; 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.AsGenericRecord: IGenericRecordType;
begin
    Result := Self;
end;

function TGenericRecordType.IsStructurallyEqual(const Other: IStaticType): Boolean;
var
    i: Integer;
begin
    var uOther := TTypes.Unwrap(Other);
    if uOther.Kind <> stGenericRecord then
        exit(False);
    var otherDef := uOther.AsGenericRecord.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.Keywords[i] <> otherDef.Keywords[i]) or (not Self.FDefinition[i].IsEqual(otherDef[i])) then
            exit(False);
    end;
    Result := True;
end;

function TGenericRecordType.GetHashCode: Integer;
var
    i, h: Integer;
begin
    h := Ord(stGenericRecord);
    Result := THashBobJenkins.GetHashValue(h, SizeOf(TStaticTypeKind), 0);
    if Assigned(FDefinition) then
    begin
        for i := 0 to FDefinition.Count - 1 do
        begin
            h := FDefinition.Keywords[i].Idx;
            Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
            var val := FDefinition[i];
            if Assigned(val) then
            begin
                h := val.GetHashCode;
                Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
            end;
        end;
    end;
end;

function TGenericRecordType.ToString: string;
var
    i: Integer;
begin
    Result := GetKind.ToString + '{';
    if Assigned(FDefinition) then
    begin
        for i := 0 to FDefinition.Count - 1 do
        begin
            Result := Result + FDefinition.Keywords[i].Name + ': ' + FDefinition[i].ToString;
            if i < FDefinition.Count - 1 then
                Result := Result + ', ';
        end;
    end;
    Result := Result + '}';
end;

// --- TMethodSigArrayComparer ---

type
    TMethodSigArrayComparer = class(TEqualityComparer<TArray<IMethodSignature>>)
    public
        function Equals(const Left, Right: TArray<IMethodSignature>): Boolean; override;
        function GetHashCode(const Value: TArray<IMethodSignature>): Integer; override;
    end;

function TMethodSigArrayComparer.Equals(const Left, Right: TArray<IMethodSignature>): Boolean;
var
    i, j: Integer;
begin
    if Length(Left) <> Length(Right) then
        exit(False);
    for i := 0 to High(Left) do
    begin
        if not Left[i].ReturnType.IsEqual(Right[i].ReturnType) then
            exit(False);

        var pLeft := Left[i].ParamTypes;
        var pRight := Right[i].ParamTypes;
        if Length(pLeft) <> Length(pRight) then
            exit(False);

        for j := 0 to High(pLeft) do
            if not pLeft[j].IsEqual(pRight[j]) then
                exit(False);
    end;
    Result := True;
end;

function TMethodSigArrayComparer.GetHashCode(const Value: TArray<IMethodSignature>): Integer;
var
    sig: IMethodSignature;
    p: IStaticType;
    h: Integer;
begin
    Result := 0;
    for sig in Value do
    begin
        if Assigned(sig.ReturnType) then
        begin
            h := sig.ReturnType.GetHashCode;
            Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
        end;

        for p in sig.ParamTypes do
        begin
            h := p.GetHashCode;
            Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
        end;
    end;
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, h: Integer;
begin
    Result := 0;
    if Assigned(FReturnType) then
    begin
        h := FReturnType.GetHashCode;
        Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
    end;
    for i := 0 to High(FParamTypes) do
    begin
        if Assigned(FParamTypes[i]) then
        begin
            h := FParamTypes[i].GetHashCode;
            Result := THashBobJenkins.GetHashValue(h, SizeOf(Integer), Result);
        end;
    end;
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);

    FOrdinalOpt := TOptionalType.Create(FOrdinal);
    FFloatOpt := TOptionalType.Create(FFloat);
    FBooleanOpt := TOptionalType.Create(FBoolean);
    FDateTimeOpt := TOptionalType.Create(FDateTime);
    FTextOpt := TOptionalType.Create(FText);
    FKeywordOpt := TOptionalType.Create(FKeyword);

    FSeriesCache := TDictionary<IStaticType, IStaticType>.Create;
    FRecordCache := TDictionary<IScalarRecordDefinition, IStaticType>.Create;
    FRecordSeriesCache := TDictionary<IScalarRecordDefinition, IStaticType>.Create;
    FGenericRecordCache := TDictionary<IGenericRecordDefinition, IStaticType>.Create;
    FMethodCache := TDictionary<TArray<IMethodSignature>, IStaticType>.Create(TMethodSigArrayComparer.Create);
    FOptionalCache := TDictionary<IStaticType, IStaticType>.Create;
end;

class destructor TTypes.Destroy;
begin
    FSeriesCache.Free;
    FRecordCache.Free;
    FRecordSeriesCache.Free;
    FGenericRecordCache.Free;
    FMethodCache.Free;
    FOptionalCache.Free;
end;

class function TTypes.CreateSeries(const AElementType: IStaticType): IStaticType;
begin
    if not Assigned(AElementType) then
        exit(FUnknown);

    TMonitor.Enter(FSeriesCache);
    try
        if not FSeriesCache.TryGetValue(AElementType, Result) then
        begin
            Result := TSeriesType.Create(AElementType);
            FSeriesCache.Add(AElementType, Result);
        end;
    finally
        TMonitor.Exit(FSeriesCache);
    end;
end;

class function TTypes.CreateRecord(const ADef: IScalarRecordDefinition): IStaticType;
begin
    TMonitor.Enter(FRecordCache);
    try
        if not FRecordCache.TryGetValue(ADef, Result) then
        begin
            Result := TRecordType.Create(stRecord, ADef);
            FRecordCache.Add(ADef, Result);
        end;
    finally
        TMonitor.Exit(FRecordCache);
    end;
end;

class function TTypes.CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType;
begin
    TMonitor.Enter(FRecordSeriesCache);
    try
        if not FRecordSeriesCache.TryGetValue(ADef, Result) then
        begin
            Result := TRecordType.Create(stRecordSeries, ADef);
            FRecordSeriesCache.Add(ADef, Result);
        end;
    finally
        TMonitor.Exit(FRecordSeriesCache);
    end;
end;

class function TTypes.CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType;
begin
    TMonitor.Enter(FGenericRecordCache);
    try
        if not FGenericRecordCache.TryGetValue(ADef, Result) then
        begin
            Result := TGenericRecordType.Create(ADef);
            FGenericRecordCache.Add(ADef, Result);
        end;
    finally
        TMonitor.Exit(FGenericRecordCache);
    end;
end;

class function TTypes.CreateMethod(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType): IStaticType;
begin
    Result := CreateMethodSet([TMethodSignature.Create(AParamTypes, AReturnType)]);
end;

class function TTypes.CreateMethodSet(const ASignatures: TArray<IMethodSignature>): IStaticType;
begin
    if Length(ASignatures) = 0 then
        exit(FUnknown);

    TMonitor.Enter(FMethodCache);
    try
        if not FMethodCache.TryGetValue(ASignatures, Result) then
        begin
            Result := TMethodType.Create(ASignatures);
            FMethodCache.Add(ASignatures, Result);
        end;
    finally
        TMonitor.Exit(FMethodCache);
    end;
end;

class function TTypes.MakeOptional(const AType: IStaticType): IStaticType;
begin
    if (not Assigned(AType)) or (AType.Kind = stUnknown) or (AType.Kind = stVoid) then
        exit(AType);
    if AType.IsOptional then
        exit(AType);

    // Fast path flyweights
    if Pointer(AType) = Pointer(FOrdinal) then
        exit(FOrdinalOpt);
    if Pointer(AType) = Pointer(FFloat) then
        exit(FFloatOpt);
    if Pointer(AType) = Pointer(FBoolean) then
        exit(FBooleanOpt);
    if Pointer(AType) = Pointer(FDateTime) then
        exit(FDateTimeOpt);
    if Pointer(AType) = Pointer(FText) then
        exit(FTextOpt);
    if Pointer(AType) = Pointer(FKeyword) then
        exit(FKeywordOpt);

    TMonitor.Enter(FOptionalCache);
    try
        if not FOptionalCache.TryGetValue(AType, Result) then
        begin
            Result := TOptionalType.Create(AType);
            FOptionalCache.Add(AType, Result);
        end;
    finally
        TMonitor.Exit(FOptionalCache);
    end;
end;

class function TTypes.Unwrap(const AType: IStaticType): IStaticType;
begin
    if (Assigned(AType)) and (AType is TOptionalType) then
        Result := (AType as TOptionalType).FInner
    else
        Result := AType;
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
        Result := nil;
    end;
end;

// --- New Factories ---

class function TTypes.CreateTuple(const AElements: TArray<IStaticType>): ITupleType;
begin
    Result := TTupleType.Create(AElements);
end;

class function TTypes.CreateVector(const AElementType: IStaticType; ACount: Integer): IVectorType;
begin
    Result := TVectorType.Create(AElementType, ACount);
end;

class function TTypes.CreateMatrix(const AElementType: IStaticType; const ADimensions: TArray<Integer>): IMatrixType;
begin
    Result := TMatrixType.Create(AElementType, ADimensions);
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 Source.IsOptional and (not Target.IsOptional) then
        exit(False);

    var uTarget := TTypes.Unwrap(Target);
    var uSource := TTypes.Unwrap(Source);

    if uTarget.IsStructurallyEqual(uSource) then
        exit(True);

    // Auto-Promotion rules
    if (uTarget.Kind = stFloat) and (uSource.Kind = stOrdinal) then
        exit(True);
    if (uTarget.Kind = stOrdinal) and (uSource.Kind = stBoolean) then
        exit(True);
    if (uTarget.Kind = stFloat) and (uSource.Kind = stDateTime) then
        exit(True);
    if (uTarget.Kind = stVoid) and (uSource.Kind = stMethod) then
        exit(True);
    if (uTarget.Kind = stOrdinal) and (uSource.Kind = stKeyword) then
        exit(True);

    Result := False;
end;

class function TTypeRules.Promote(const A, B: IStaticType): IStaticType;
begin
    if A.Kind = stUnknown then
        exit(B);
    if B.Kind = stUnknown then
        exit(A);

    if (A.Kind = stVoid) and (B.Kind <> stVoid) then
        exit(TTypes.MakeOptional(B));
    if (B.Kind = stVoid) and (A.Kind <> stVoid) then
        exit(TTypes.MakeOptional(A));
    if (A.Kind = stVoid) and (B.Kind = stVoid) then
        exit(TTypes.Void);

    var uA := TTypes.Unwrap(A);
    var uB := TTypes.Unwrap(B);
    var common: IStaticType := nil;

    if uA.IsStructurallyEqual(uB) then
        common := uA
    else if (uA.Kind = stFloat) and (uB.Kind = stFloat) then
        common := TTypes.Float
    else if (uA.Kind = stFloat) and (uB.Kind = stOrdinal) then
        common := TTypes.Float
    else if (uA.Kind = stOrdinal) and (uB.Kind = stFloat) then
        common := TTypes.Float
    else if (uA.Kind = stOrdinal) and (uB.Kind = stOrdinal) then
        common := TTypes.Ordinal;

    if common = nil then
        exit(nil);

    if A.IsOptional or B.IsOptional then
        Result := TTypes.MakeOptional(common)
    else
        Result := common;
end;

class function TTypeRules.ResolveBinaryOp(Op: TScalar.TBinaryOp; const Left, Right: IStaticType): IStaticType;
begin
    if Left.IsOptional or Right.IsOptional then
        exit(nil);
    var promotedType := Promote(Left, Right);
    if not Assigned(promotedType) then
        exit(nil);
    if promotedType.Kind = stUnknown then
        exit(TTypes.Unknown);

    var 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
        Result := nil;
    end;
end;

class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: IStaticType): IStaticType;
begin
    if Right.IsOptional then
        exit(nil);
    var 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.
