MycLib/Src/AST/Myc.Ast.Types.pas

unit Myc.Ast.Types;

interface

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

type
    // Defines the categories of types available in the language.
    TStaticTypeKind = (
        stUnknown, // Used during inference before a type is known
        stVoid,
        stOrdinal, // Int64
        stFloat, // Double
        stText,
        stMethod,
        stSeries,
        stRecord,
        stRecordSeries
    );

    TStaticTypeKindHelper = record helper for TStaticTypeKind
    public
        function ToString: string;
    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;

            // Defines the signature of a method
            IMethodSignature = interface
                {$region 'private'}
                function GetParamTypes: TArray<TStaticType>;
                function GetReturnType: TStaticType;
                {$endregion}
                property ParamTypes: TArray<TStaticType> 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<TStaticType>; 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;

        function ToString: string;
        class operator Equal(const A, B: TStaticType): Boolean;
        class operator NotEqual(A, B: TStaticType): Boolean; inline;
    end;

    ETypeException = class(Exception);

    // Defines the rules of the type system.
    TTypeRules = record
    private
        class function Promote(const A, B: TStaticType): TStaticType; static;
    public
        // Checks if a value of type 'Source' can be assigned to 'Target'.
        class function CanAssign(const Target, Source: TStaticType): 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;
        // Determines the result type of a unary operation.
        class function ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: TStaticType): TStaticType; static;
    end;

implementation

uses
    System.Generics.Defaults;

type
    TMethodSignature = class(TInterfacedObject, TStaticType.IMethodSignature)
    private
        FParamTypes: TArray<TStaticType>;
        FReturnType: TStaticType;
        function GetParamTypes: TArray<TStaticType>;
        function GetReturnType: TStaticType;
    public
        constructor Create(const AParamTypes: TArray<TStaticType>; const AReturnType: TStaticType);
    end;

{ TMethodSignature }

constructor TMethodSignature.Create(const AParamTypes: TArray<TStaticType>; const AReturnType: TStaticType);
begin
    inherited Create;
    FParamTypes := AParamTypes;
    FReturnType := AReturnType;
end;

function TMethodSignature.GetParamTypes: TArray<TStaticType>;
begin
    Result := FParamTypes;
end;

function TMethodSignature.GetReturnType: TStaticType;
begin
    Result := FReturnType;
end;

{ TStaticTypeKindHelper }

function TStaticTypeKindHelper.ToString: string;
begin
    case Self of
        stUnknown: Result := 'Unknown';
        stVoid: Result := 'Void';
        stOrdinal: Result := 'Ordinal';
        stFloat: Result := 'Float';
        stText: Result := 'Text';
        stMethod: Result := 'Method';
        stSeries: Result := 'Series';
        stRecord: Result := 'Record';
        stRecordSeries: Result := 'RecordSeries';
    else
        Result := 'ErrorType';
    end;
end;

{ TStaticType }

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;
    end;
    // TScalarRecordDefinition (FFields) is not owned by this record.
end;

class operator TStaticType.Equal(const A, B: TStaticType): Boolean;
var
    i: Integer;
begin
    if A.Kind <> B.Kind 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;
    end;
end;

class function TStaticType.Create(AKind: TStaticTypeKind): TStaticType;
begin
    Result.Kind := AKind;
end;

class function TStaticType.CreateMethod(const AParamTypes: TArray<TStaticType>; const AReturnType: TStaticType): TStaticType;
begin
    Result.Kind := stMethod;
    Result.Signature := TMethodSignature.Create(AParamTypes, AReturnType);
end;

class function TStaticType.CreateRecord(const ADef: TScalarRecordDefinition): TStaticType;
begin
    Result.Kind := stRecord;
    Result.Definition := ADef;
end;

class function TStaticType.CreateRecordSeries(const ADef: TScalarRecordDefinition): TStaticType;
begin
    Result.Kind := stRecordSeries;
    Result.Definition := ADef;
end;

class function TStaticType.CreateSeries(const AElementType: TStaticType): TStaticType;
begin
    Result.Kind := stSeries;
    New(Result.ElementType);
    Result.ElementType^ := AElementType;
end;

class function TStaticType.FromScalarKind(AKind: TScalar.TKind): TStaticType;
begin
    case AKind of
        TScalar.TKind.Ordinal: Result.Kind := stOrdinal;
        TScalar.TKind.Float: Result.Kind := stFloat;
    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;
begin
    if Target = Source then
        exit(True);

    // Allow assigning an integer (Ordinal) to a float variable.
    if (Target.Kind = stFloat) and (Source.Kind = stOrdinal) then
        exit(True);

    // TODO: Implement full assignment compatibility rules (e.g., for records/series)

    Result := False;
end;

class function TTypeRules.Promote(const A, B: TStaticType): TStaticType;
begin
    // Numeric promotion rule: Float wins
    if (A.Kind = stFloat) and (B.Kind = stFloat) then
        exit(TStaticType.Create(stFloat));
    if (A.Kind = stFloat) and (B.Kind = stOrdinal) then
        exit(TStaticType.Create(stFloat));
    if (A.Kind = stOrdinal) and (B.Kind = stFloat) then
        exit(TStaticType.Create(stFloat));
    if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then
        exit(TStaticType.Create(stOrdinal));

    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;
begin
    case Op of
        TScalar.TBinaryOp.Add, TScalar.TBinaryOp.Subtract, TScalar.TBinaryOp.Multiply:
        begin
            // Numeric operations: Promote and return
            if (Left.Kind in [stOrdinal, stFloat]) and (Right.Kind in [stOrdinal, stFloat]) then
                Result := Promote(Left, Right)
            else
                raise ETypeException.CreateFmt('Operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]);
        end;

        TScalar.TBinaryOp.Divide:
        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)
            else
                raise ETypeException.CreateFmt('Operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]);
        end;

        TScalar.TBinaryOp.Equal,
        TScalar.TBinaryOp.NotEqual,
        TScalar.TBinaryOp.Less,
        TScalar.TBinaryOp.Greater,
        TScalar.TBinaryOp.LessOrEqual,
        TScalar.TBinaryOp.GreaterOrEqual:
        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)
            else
                raise ETypeException
                    .CreateFmt('Comparison operator %s cannot be applied to %s and %s', [Op.ToString, Left.ToString, Right.ToString]);
        end;
    else
        raise ETypeException.Create('Unknown binary operator for type resolution.');
    end;
end;

class function TTypeRules.ResolveUnaryOp(Op: TScalar.TUnaryOp; const Right: TStaticType): TStaticType;
begin
    case Op of
        TScalar.TUnaryOp.Negate:
        begin
            if not (Right.Kind in [stOrdinal, stFloat]) then
                raise ETypeException.CreateFmt('Unary negation cannot be applied to %s', [Right.ToString]);
            Result := Right; // Negation preserves type
        end;

        TScalar.TUnaryOp.Not:
        begin
            if not (Right.Kind = stOrdinal) then
                raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]);
            Result := TStaticType.Create(stOrdinal);
        end;
    else
        raise ETypeException.Create('Unknown unary operator for type resolution.');
    end;
end;

end.