ASt Types

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<IStaticType>;
+        function GetReturnType: IStaticType;
+        {$endregion}
+        property ParamTypes: TArray<IStaticType> 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.
+    IStaticType = interface
-    TStaticType = record
+        {$region 'private'}
-    public
+        function GetKind: TStaticTypeKind;
-        type
+        function GetElementType: IStaticType;
-            // Forward declaration for mutual recursion
+        function GetSignature: IMethodSignature;
-            PStaticType = ^TStaticType;
+        function GetDefinition: TScalarRecordDefinition;
+        {$endregion}
 
-            // Defines the signature of a method
+        // The kind of type (e.g., Ordinal, Series, etc.)
-            IMethodSignature = interface
+        property Kind: TStaticTypeKind read GetKind;
-                {$region 'private'}
+        // The element type (if Kind = stSeries)
-                function GetParamTypes: TArray<TStaticType>;
+        property ElementType: IStaticType read GetElementType;
-                function GetReturnType: TStaticType;
+        // The signature (if Kind = stMethod)
-                {$endregion}
+        property Signature: IMethodSignature read GetSignature;
-                property ParamTypes: TArray<TStaticType> read GetParamTypes;
+        // The definition (if Kind = stRecord or stRecordSeries)
-                property ReturnType: TStaticType read GetReturnType;
+        property Definition: TScalarRecordDefinition read GetDefinition;
-            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;
 
+        // 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<IStaticType>; 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<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;
@@ -140,150 +133,324 @@ begin
     end;
 end;
 
-{ TStaticType }
+// --- Abstract Base Implementation ---
 
-class operator TStaticType.Initialize(out Dest: TStaticType);
+type
-begin
+    TAbstractStaticType = class(TInterfacedObject, IStaticType)
-    Dest.Kind := stUnknown;
+    protected
-    Dest.Signature := nil;
+        // IStaticType (default implementations for non-applicable properties)
-    Dest.ElementType := nil;
+        function GetKind: TStaticTypeKind; virtual; abstract;
-end;
+        function GetElementType: IStaticType; virtual;
-
+        function GetSignature: IMethodSignature; virtual;
-class operator TStaticType.Finalize(var Dest: TStaticType);
+        function GetDefinition: TScalarRecordDefinition; virtual;
-begin
+        function IsEqual(const Other: IStaticType): Boolean; virtual;
-    Dest.Signature := nil;
+        function ToString: string; override;
-    if Dest.ElementType <> nil then
-    begin
-        Finalize(Dest.ElementType^);
-        FreeMem(Dest.ElementType);
-        Dest.ElementType := nil;
     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<IStaticType>;
+        FReturnType: IStaticType;
+        function GetParamTypes: TArray<IStaticType>;
+        function GetReturnType: IStaticType;
+    public
+        constructor Create(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType);
+    end;
+
+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;
+
+// ---
+type
+    TMethodType = class(TAbstractStaticType)
+    private
+        FSignature: IMethodSignature;
+    public
+        constructor Create(AParamTypes: TArray<IStaticType>; 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<IStaticType>; 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
+    var otherSig := Other.Signature;
-        stSeries: Result := A.ElementType^ = B.ElementType^;
+    if not Self.FSignature.ReturnType.IsEqual(otherSig.ReturnType) then
-        stRecord, stRecordSeries:
+        exit(False);
-        begin
+
-            if Length(A.Definition.Fields) <> Length(B.Definition.Fields) then
+    if Length(Self.FSignature.ParamTypes) <> Length(otherSig.ParamTypes) then
-                exit(False);
+        exit(False);
-            for i := 0 to High(A.Definition.Fields) do
+
-            begin
+    for i := 0 to High(Self.FSignature.ParamTypes) do
-                if (A.Definition.Fields[i].Name <> B.Definition.Fields[i].Name)
+    begin
-                    or (A.Definition.Fields[i].Kind <> B.Definition.Fields[i].Kind) then
+        if not Self.FSignature.ParamTypes[i].IsEqual(otherSig.ParamTypes[i]) then
-                    exit(False);
+            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;
+
+    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<TStaticType>; 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;
+    inherited Create;
-    Result.Signature := TMethodSignature.Create(AParamTypes, AReturnType);
+    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 := FKind;
-    Result.Definition := ADef;
 end;
 
-class function TStaticType.CreateRecordSeries(const ADef: TScalarRecordDefinition): TStaticType;
+function TRecordType.GetDefinition: TScalarRecordDefinition;
 begin
-    Result.Kind := stRecordSeries;
+    Result := FDefinition;
-    Result.Definition := ADef;
 end;
 
-class function TStaticType.CreateSeries(const AElementType: TStaticType): TStaticType;
+function TRecordType.IsEqual(const Other: IStaticType): Boolean;
+var
+    i: Integer;
 begin
-    Result.Kind := stSeries;
+    if (not Assigned(Other)) or (Other.Kind <> GetKind) then
-    New(Result.ElementType);
+        exit(False);
-    Result.ElementType^ := AElementType;
+
+    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<IStaticType>; 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.Ordinal: Result := FOrdinal;
-        TScalar.TKind.Float: Result.Kind := stFloat;
+        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.');