Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

AST testing

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-22 17:02:16 +01:00
parent 240f794211
commit c5167b8550
10 changed files with 1202 additions and 792 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.RTL.Core.pas
+227 -159
View File
@@ -3,6 +3,7 @@ unit Myc.Ast.RTL.Core;
interface
uses
system.sysutils,
Myc.Utils,
Myc.Data.Scalar,
Myc.Data.Value,
@@ -12,74 +13,84 @@ type
// Contains the "pure" native implementations.
TRtlFunctions = record
public
// (* --- Dynamic Fallbacks --- *)
// (* --- Dynamic Fallbacks (Interpreter) --- *)
// Arithmetic
[TRtlExport('+')]
class function Add(const Args: TArray<TDataValue>): TDataValue; overload; static;
[TRtlExport('-')]
class function Subtract(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('*')]
class function Multiply(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('/')]
class function Divide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('div')]
class function IntDivide(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('mod')]
class function Modulus(const Args: TArray<TDataValue>): TDataValue; static;
// Comparison
[TRtlExport('=')]
class function Equal(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<>')]
class function NotEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<')]
class function LessThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('<=')]
class function LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('>')]
class function GreaterThan(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('>=')]
class function GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue; static;
// Logic / Bitwise
[TRtlExport('not')]
class function LogicalNot(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('and')]
class function BitwiseAnd(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('or')]
class function BitwiseOr(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('xor')]
class function BitwiseXor(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('shl')]
class function LeftShift(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('shr')]
class function RightShift(const Args: TArray<TDataValue>): TDataValue; static;
// (* Dynamic fallbacks for TScalar input *)
[TRtlExport('Abs')]
class function Abs(const Arg: TScalar): TScalar; static;
[TRtlExport('Round')]
class function Round(const Arg: TScalar): TScalar; static; // <-- Added
[TRtlExport('Trunc')]
class function Trunc(const Arg: TScalar): TScalar; static;
[TRtlExport('Ceil')]
class function Ceil(const Arg: TScalar): TScalar; static;
[TRtlExport('Floor')]
class function Floor(const Arg: TScalar): TScalar; static;
[TRtlExport('Sign')]
class function Sign(const Arg: TScalar): TScalar; static;
// (* DateTime Constructors *)
[TRtlExport('Now', False)]
class function Now(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Date')]
class function Date(const Args: TArray<TDataValue>): TDataValue; static;
// (* Other dynamic functions *)
[TRtlExport('Memoize')]
class function Memoize(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Map')]
class function Map(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Reduce')]
class function Reduce(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Where')]
class function Where(const Args: TArray<TDataValue>): TDataValue; static;
[TRtlExport('Any')]
class function Any(const Args: TArray<TDataValue>): TDataValue; static;
// (* --- Static Specializations (for Monomorphization) --- *)
// (* Schema: FunctionName_Arg1_ArgN_Return *)
// (* --- Static Specializations (Monomorphization Targets) --- *)
// Add
[TRtlExport('+', True)]
@@ -111,7 +122,7 @@ type
[TRtlExport('*', True)]
class function Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
// Divide (NOT pure due to DivByZero)
// Divide (Impure due to EDivByZero potential)
[TRtlExport('/')]
class function Divide_Ordinal_Ordinal_Float(A, B: Int64): Double; static;
[TRtlExport('/')]
@@ -121,7 +132,13 @@ type
[TRtlExport('/')]
class function Divide_Float_Ordinal_Float(A: Double; B: Int64): Double; static;
// Comparisons (Return Ordinal)
// Integer Math (Impure due to EDivByZero)
[TRtlExport('div')]
class function Div_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('mod')]
class function Mod_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
// Comparisons
[TRtlExport('=', True)]
class function Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('=', True)]
@@ -180,6 +197,18 @@ type
[TRtlExport('>=', True)]
class function GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64; static;
// Bitwise Static
[TRtlExport('and', True)]
class function And_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('or', True)]
class function Or_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('xor', True)]
class function Xor_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('shl', True)]
class function Shl_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
[TRtlExport('shr', True)]
class function Shr_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64; static;
// Unary
[TRtlExport('-', True)]
class function Negate_Ordinal_Ordinal(A: Int64): Int64; static;
@@ -195,6 +224,11 @@ type
[TRtlExport('Abs', True)]
class function Abs_Float_Float(A: Double): Double; static;
[TRtlExport('Round', True)]
class function Round_Ordinal_Ordinal(A: Int64): Int64; static; // <-- Added
[TRtlExport('Round', True)]
class function Round_Float_Ordinal(A: Double): Int64; static; // <-- Added
[TRtlExport('Trunc', True)]
class function Trunc_Ordinal_Ordinal(A: Int64): Int64; static;
[TRtlExport('Trunc', True)]
@@ -204,140 +238,143 @@ type
implementation
uses
System.SysUtils,
System.Generics.Collections,
System.Math,
system.generics.collections,
system.math,
system.dateutils,
Myc.Data.Decimal;
{ TRtlFunctions - Operator Implementations }
class function TRtlFunctions.Add(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator + requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Add, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator +.');
Result := res;
Result := Args[0].AsScalar + Args[1].AsScalar;
end;
class function TRtlFunctions.Subtract(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) = 1 then // Unary negation
begin
if not TScalar.TryUnaryOperation(TScalar.TUnaryOp.Negate, Args[0], res) then
raise EArgumentException.Create('Invalid argument for unary operator -.');
end
else if Length(Args) = 2 then // Binary subtraction
begin
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Subtract, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for binary operator -.');
end
if Length(Args) = 1 then
Result := -Args[0].AsScalar
else if Length(Args) = 2 then
Result := Args[0].AsScalar - Args[1].AsScalar
else
raise EArgumentException.Create('Operator - requires 1 or 2 arguments.');
Result := res;
end;
class function TRtlFunctions.Multiply(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator * requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Multiply, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator *.');
Result := res;
Result := Args[0].AsScalar * Args[1].AsScalar;
end;
class function TRtlFunctions.Divide(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator / requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Divide, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator /.');
Result := res;
// Explicit check is handled in TScalar.Divide
Result := Args[0].AsScalar / Args[1].AsScalar;
end;
class function TRtlFunctions.IntDivide(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator div requires 2 arguments.');
Result := Args[0].AsScalar div Args[1].AsScalar;
end;
class function TRtlFunctions.Modulus(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator mod requires 2 arguments.');
Result := Args[0].AsScalar mod Args[1].AsScalar;
end;
class function TRtlFunctions.Equal(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator = requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Equal, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator =.');
Result := res;
Result := TScalar.FromBoolean(Args[0].AsScalar = Args[1].AsScalar);
end;
class function TRtlFunctions.NotEqual(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator <> requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.NotEqual, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator <>.');
Result := res;
Result := TScalar.FromBoolean(Args[0].AsScalar <> Args[1].AsScalar);
end;
class function TRtlFunctions.LessThan(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator < requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Less, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator <.');
Result := res;
Result := TScalar.FromBoolean(Args[0].AsScalar < Args[1].AsScalar);
end;
class function TRtlFunctions.LessThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator <= requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.LessOrEqual, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator <=.');
Result := res;
Result := TScalar.FromBoolean(Args[0].AsScalar <= Args[1].AsScalar);
end;
class function TRtlFunctions.GreaterThan(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator > requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.Greater, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator >.');
Result := res;
Result := TScalar.FromBoolean(Args[0].AsScalar > Args[1].AsScalar);
end;
class function TRtlFunctions.GreaterThanOrEqual(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator >= requires 2 arguments.');
if not TScalar.TryBinaryOperation(TScalar.TBinaryOp.GreaterOrEqual, Args[0], Args[1], res) then
raise EArgumentException.Create('Invalid arguments for operator >=.');
Result := res;
Result := TScalar.FromBoolean(Args[0].AsScalar >= Args[1].AsScalar);
end;
// --- Logic / Bitwise ---
class function TRtlFunctions.LogicalNot(const Args: TArray<TDataValue>): TDataValue;
var
res: TScalar;
begin
if Length(Args) <> 1 then
raise EArgumentException.Create('Operator not requires 1 argument.');
if not TScalar.TryUnaryOperation(TScalar.TUnaryOp.Not, Args[0], res) then
raise EArgumentException.Create('Invalid argument for operator not.');
Result := res;
Result := not Args[0].AsScalar;
end;
class function TRtlFunctions.BitwiseAnd(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator and requires 2 arguments.');
Result := Args[0].AsScalar and Args[1].AsScalar;
end;
class function TRtlFunctions.BitwiseOr(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator or requires 2 arguments.');
Result := Args[0].AsScalar or Args[1].AsScalar;
end;
class function TRtlFunctions.BitwiseXor(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator xor requires 2 arguments.');
Result := Args[0].AsScalar xor Args[1].AsScalar;
end;
class function TRtlFunctions.LeftShift(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator shl requires 2 arguments.');
Result := Args[0].AsScalar shl Args[1].AsScalar;
end;
class function TRtlFunctions.RightShift(const Args: TArray<TDataValue>): TDataValue;
begin
if Length(Args) <> 2 then
raise EArgumentException.Create('Operator shr requires 2 arguments.');
Result := Args[0].AsScalar shr Args[1].AsScalar;
end;
{ TRtlFunctions - Standard Functions }
@@ -352,20 +389,22 @@ begin
end;
end;
class function TRtlFunctions.Round(const Arg: TScalar): TScalar;
begin
var val: Double := Arg;
Result := TScalar.FromInt64(System.Round(val));
end;
class function TRtlFunctions.Trunc(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
TScalar.TKind.Ordinal: Result := Arg; // Trunc on an integer is a no-op
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Trunc(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Trunc requires a numeric argument.');
end;
var val: Double := Arg;
Result := TScalar.FromInt64(System.Trunc(val));
end;
class function TRtlFunctions.Ceil(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
TScalar.TKind.Ordinal: Result := Arg; // Ceil on an integer is a no-op
TScalar.TKind.Ordinal: Result := Arg;
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Ceil(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Ceil requires a numeric argument.');
@@ -375,7 +414,7 @@ end;
class function TRtlFunctions.Floor(const Arg: TScalar): TScalar;
begin
case Arg.Kind of
TScalar.TKind.Ordinal: Result := Arg; // Floor on an integer is a no-op
TScalar.TKind.Ordinal: Result := Arg;
TScalar.TKind.Float: Result := TScalar.FromInt64(System.Math.Floor(Arg.Value.AsDouble));
else
raise EArgumentException.Create('Floor requires a numeric argument.');
@@ -392,6 +431,38 @@ begin
end;
end;
// --- Date Constructors ---
class function TRtlFunctions.Now(const Args: TArray<TDataValue>): TDataValue;
begin
Result := TScalar.FromDateTime(System.SysUtils.Now);
end;
class function TRtlFunctions.Date(const Args: TArray<TDataValue>): TDataValue;
function GetInt(const V: TDataValue; ArgIndex: Integer): Word;
begin
if V.AsScalar.Kind <> TScalar.TKind.Ordinal then
raise EArgumentException.CreateFmt('Date argument %d must be an Integer.', [ArgIndex]);
Result := V.AsScalar.Value.AsInt64;
end;
begin
if Length(Args) = 3 then
begin
var y := GetInt(Args[0], 1);
var m := GetInt(Args[1], 2);
var d := GetInt(Args[2], 3);
Result := TScalar.FromDateTime(EncodeDate(y, m, d));
end
else if Length(Args) = 0 then
Result := TScalar.FromDateTime(System.SysUtils.Date)
else
raise EArgumentException.Create('Date expects 0 or 3 arguments (Year, Month, Day).');
end;
// --- High-Order / Series ---
class function TRtlFunctions.Memoize(const Args: TArray<TDataValue>): TDataValue;
var
funcToMemoize: TDataValue.TFunc;
@@ -402,7 +473,6 @@ begin
if Args[0].Kind <> vkMethod then
raise EArgumentException.Create('The argument to Memoize must be a function.');
// create a managed dictionary
var cCache: TDataValue;
cCache.FromObj(TDictionary<Int64, TDataValue>.Create);
@@ -518,9 +588,9 @@ begin
begin
item := sourceSeries.Items[i];
predicateResult := predicateFunc([TDataValue(item)]);
if (predicateResult.Kind = vkScalar)
and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal)
and (predicateResult.AsScalar.Value.AsInt64 <> 0) then
// Use the implicit Boolean operator of TScalar
if (predicateResult.Kind = vkScalar) and (Boolean(predicateResult.AsScalar)) then
matchingIndices.Add(i);
end;
@@ -569,105 +639,91 @@ begin
item := sourceSeries.Items[i];
predicateResult := predicateFunc([TDataValue(item)]);
if (predicateResult.Kind = vkScalar)
and (predicateResult.AsScalar.Kind = TScalar.TKind.Ordinal)
and (predicateResult.AsScalar.Value.AsInt64 <> 0) then
if (predicateResult.Kind = vkScalar) and (Boolean(predicateResult.AsScalar)) then
begin
Result := TScalar.FromInt64(1);
Result := TScalar.FromBoolean(True);
exit;
end;
end;
Result := TScalar.FromInt64(0);
Result := TScalar.FromBoolean(False);
end;
{ TRtlFunctions - Static Specializations }
// --- Static Specializations ---
// --- Add ---
// Add
class function TRtlFunctions.Add_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A + B;
end;
class function TRtlFunctions.Add_Float_Float_Float(A, B: Double): Double;
begin
Result := A + B;
end;
class function TRtlFunctions.Add_Ordinal_Float_Float(A: Int64; B: Double): Double;
begin
Result := A + B;
end;
class function TRtlFunctions.Add_Float_Ordinal_Float(A: Double; B: Int64): Double;
begin
Result := A + B;
end;
// --- Subtract ---
// Subtract
class function TRtlFunctions.Subtract_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A - B;
end;
class function TRtlFunctions.Subtract_Float_Float_Float(A, B: Double): Double;
begin
Result := A - B;
end;
class function TRtlFunctions.Subtract_Ordinal_Float_Float(A: Int64; B: Double): Double;
begin
Result := A - B;
end;
class function TRtlFunctions.Subtract_Float_Ordinal_Float(A: Double; B: Int64): Double;
begin
Result := A - B;
end;
// --- Multiply ---
// Multiply
class function TRtlFunctions.Multiply_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A * B;
end;
class function TRtlFunctions.Multiply_Float_Float_Float(A, B: Double): Double;
begin
Result := A * B;
end;
class function TRtlFunctions.Multiply_Ordinal_Float_Float(A: Int64; B: Double): Double;
begin
Result := A * B;
end;
class function TRtlFunctions.Multiply_Float_Ordinal_Float(A: Double; B: Int64): Double;
begin
Result := A * B;
end;
// --- Divide ---
// Divide
class function TRtlFunctions.Divide_Ordinal_Ordinal_Float(A, B: Int64): Double;
begin
if B = 0 then
raise EDivByZero.Create('Division by zero.');
Result := A / B;
end;
class function TRtlFunctions.Divide_Float_Float_Float(A, B: Double): Double;
begin
if B = 0.0 then
raise EDivByZero.Create('Division by zero.');
Result := A / B;
end;
class function TRtlFunctions.Divide_Ordinal_Float_Float(A: Int64; B: Double): Double;
begin
if B = 0.0 then
raise EDivByZero.Create('Division by zero.');
Result := A / B;
end;
class function TRtlFunctions.Divide_Float_Ordinal_Float(A: Double; B: Int64): Double;
begin
if B = 0 then
@@ -675,32 +731,35 @@ begin
Result := A / B;
end;
// --- Comparisons ---
(* Delphi bools: 0=False, 1=True. We return Int64 (0 or 1) *)
// Integer Math
class function TRtlFunctions.Div_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A div B;
end; // Delphi runtime handles EDivByZero for integers
class function TRtlFunctions.Mod_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A mod B;
end;
// Comparisons
class function TRtlFunctions.Equal_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := Ord(A = B);
end;
class function TRtlFunctions.Equal_Float_Float_Ordinal(A, B: Double): Int64;
begin
Result := Ord(A = B); // Note: Standard float comparison
Result := Ord(SameValue(A, B));
end;
class function TRtlFunctions.Equal_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
begin
Result := Ord(A = B);
Result := Ord(SameValue(A, B));
end;
class function TRtlFunctions.Equal_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
begin
Result := Ord(A = B);
Result := Ord(SameValue(A, B));
end;
class function TRtlFunctions.Equal_Keyword_Keyword_Ordinal(A, B: Int64): Int64;
begin
// Keywords are passed as their Int64 index
Result := Ord(A = B);
end;
@@ -708,22 +767,18 @@ class function TRtlFunctions.NotEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): Int6
begin
Result := Ord(A <> B);
end;
class function TRtlFunctions.NotEqual_Float_Float_Ordinal(A, B: Double): Int64;
begin
Result := Ord(A <> B);
Result := Ord(not SameValue(A, B));
end;
class function TRtlFunctions.NotEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
begin
Result := Ord(A <> B);
Result := Ord(not SameValue(A, B));
end;
class function TRtlFunctions.NotEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
begin
Result := Ord(A <> B);
Result := Ord(not SameValue(A, B));
end;
class function TRtlFunctions.NotEqual_Keyword_Keyword_Ordinal(A, B: Int64): Int64;
begin
Result := Ord(A <> B);
@@ -733,17 +788,14 @@ class function TRtlFunctions.Less_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := Ord(A < B);
end;
class function TRtlFunctions.Less_Float_Float_Ordinal(A, B: Double): Int64;
begin
Result := Ord(A < B);
end;
class function TRtlFunctions.Less_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
begin
Result := Ord(A < B);
end;
class function TRtlFunctions.Less_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
begin
Result := Ord(A < B);
@@ -753,17 +805,14 @@ class function TRtlFunctions.LessOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64): I
begin
Result := Ord(A <= B);
end;
class function TRtlFunctions.LessOrEqual_Float_Float_Ordinal(A, B: Double): Int64;
begin
Result := Ord(A <= B);
end;
class function TRtlFunctions.LessOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
begin
Result := Ord(A <= B);
end;
class function TRtlFunctions.LessOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
begin
Result := Ord(A <= B);
@@ -773,17 +822,14 @@ class function TRtlFunctions.Greater_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64
begin
Result := Ord(A > B);
end;
class function TRtlFunctions.Greater_Float_Float_Ordinal(A, B: Double): Int64;
begin
Result := Ord(A > B);
end;
class function TRtlFunctions.Greater_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
begin
Result := Ord(A > B);
end;
class function TRtlFunctions.Greater_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
begin
Result := Ord(A > B);
@@ -793,29 +839,46 @@ class function TRtlFunctions.GreaterOrEqual_Ordinal_Ordinal_Ordinal(A, B: Int64)
begin
Result := Ord(A >= B);
end;
class function TRtlFunctions.GreaterOrEqual_Float_Float_Ordinal(A, B: Double): Int64;
begin
Result := Ord(A >= B);
end;
class function TRtlFunctions.GreaterOrEqual_Ordinal_Float_Ordinal(A: Int64; B: Double): Int64;
begin
Result := Ord(A >= B);
end;
class function TRtlFunctions.GreaterOrEqual_Float_Ordinal_Ordinal(A: Double; B: Int64): Int64;
begin
Result := Ord(A >= B);
end;
// --- Unary ---
// Bitwise Static
class function TRtlFunctions.And_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A and B;
end;
class function TRtlFunctions.Or_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A or B;
end;
class function TRtlFunctions.Xor_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A xor B;
end;
class function TRtlFunctions.Shl_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A shl B;
end;
class function TRtlFunctions.Shr_Ordinal_Ordinal_Ordinal(A, B: Int64): Int64;
begin
Result := A shr B;
end;
// Unary
class function TRtlFunctions.Negate_Ordinal_Ordinal(A: Int64): Int64;
begin
Result := -A;
end;
class function TRtlFunctions.Negate_Float_Float(A: Double): Double;
begin
Result := -A;
@@ -823,27 +886,32 @@ end;
class function TRtlFunctions.Not_Ordinal_Ordinal(A: Int64): Int64;
begin
// Lisp-style 'not': 0 -> 1, everything else -> 0
Result := Ord(A = 0);
end;
// --- Standard functions ---
end; // Logical NOT for Int64
// Standard
class function TRtlFunctions.Abs_Ordinal_Ordinal(A: Int64): Int64;
begin
Result := System.Abs(A);
end;
class function TRtlFunctions.Abs_Float_Float(A: Double): Double;
begin
Result := System.Abs(A);
end;
class function TRtlFunctions.Trunc_Ordinal_Ordinal(A: Int64): Int64;
class function TRtlFunctions.Round_Ordinal_Ordinal(A: Int64): Int64;
begin
Result := A; // No-op
Result := A;
end;
class function TRtlFunctions.Round_Float_Ordinal(A: Double): Int64;
begin
Result := System.Round(A);
end;
class function TRtlFunctions.Trunc_Ordinal_Ordinal(A: Int64): Int64;
begin
Result := A;
end;
class function TRtlFunctions.Trunc_Float_Ordinal(A: Double): Int64;
begin
Result := System.Trunc(A);
Src/AST/Myc.Ast.RTL.pas
+12 -1
View File
@@ -332,9 +332,20 @@ begin
var wrapper := CreateStaticWrapper(method, retType, argTypes, rttiParams);
if Assigned(wrapper) then
begin
// (* UPDATED: Capture IsPure from attribute *)
methodRecord := TSpecializedMethod.Create(wrapper, retType, exportAttr.IsPure);
RegisterStaticSpecialization(rtlName, argTypes, methodRecord);
// If this is a generic wrapper (e.g. Abs(TScalar)) and no DynamicWrapper exists yet,
// use this wrapper as the interpreter fallback!
if (not Assigned(funcInfo.DynamicWrapper)) and (Length(argTypes) = 1) and (argTypes[0].Kind = stUnknown) then
begin
funcInfo.DynamicWrapper := wrapper;
end
else if (not Assigned(funcInfo.DynamicWrapper)) and (Length(argTypes) = 2) and (argTypes[0].Kind = stUnknown) then
begin
// Potentially handle 2-arg scalar wrappers here too if needed
// For now, Abs/Trunc are 1-arg TScalar->TScalar, which matches stUnknown check above.
end;
end
else
raise ENotImplemented.CreateFmt('Static native method wrapper for %s() not implemented', [method.Name]);
Src/Data/Myc.Data.Scalar.pas
+399 -125
View File
@@ -3,9 +3,11 @@ unit Myc.Data.Scalar;
interface
uses
System.SysUtils,
System.Generics.Collections,
System.Generics.Defaults,
system.sysutils,
system.generics.collections,
system.generics.defaults,
system.math,
system.dateutils,
Myc.Utils,
Myc.Data.Decimal,
Myc.Data.Series,
@@ -19,17 +21,36 @@ type
public
type
// Defines the underlying storage kinds for scalar values
TKind = (Ordinal, Float, Keyword);
TKind = (Ordinal, Float, Keyword, Boolean, DateTime);
// The 8-byte storage for the scalar value
TValue = record
case TKind of
TKind.Ordinal, TKind.Keyword: (AsInt64: Int64); // Ordinal and Keyword index
TKind.Float: (AsDouble: Double);
TKind.Ordinal, TKind.Keyword, TKind.Boolean: (AsInt64: Int64);
TKind.Float, TKind.DateTime: (AsDouble: Double);
end;
TBinaryOp = (Add, Subtract, Multiply, Divide, Equal, NotEqual, Less, Greater, LessOrEqual, GreaterOrEqual);
TUnaryOp = (Negate, &Not);
TBinaryOp = (
Add,
Subtract,
Multiply,
Divide,
IntDivide,
Modulus,
Equal,
NotEqual,
Less,
Greater,
LessOrEqual,
GreaterOrEqual,
BitwiseAnd,
BitwiseOr,
BitwiseXor,
LeftShift,
RightShift
);
TUnaryOp = (Negate, Positive, &Not);
TKindHelper = record helper for TKind
public
@@ -55,13 +76,19 @@ type
class function FromInt64(AValue: Int64): TScalar; static; inline;
class function FromDouble(AValue: Double): TScalar; static; inline;
class function FromKeyword(const AValue: IKeyword): TScalar; static; inline;
class function FromBoolean(AValue: Boolean): TScalar; static; inline;
class function FromDateTime(AValue: TDateTime): TScalar; static; inline;
// Implicit casts for core types.
class operator Implicit(AValue: Int64): TScalar; overload; inline;
class operator Implicit(AValue: Double): TScalar; overload; inline;
class operator Implicit(const AValue: IKeyword): TScalar; overload; inline;
class operator Implicit(const A: TScalar): Double; overload;
class operator Implicit(const A: TScalar): Int64; overload;
class operator Implicit(AValue: Boolean): TScalar; overload; inline;
class operator Implicit(const A: TScalar): Double; overload; inline;
class operator Implicit(const A: TScalar): Int64; overload; inline;
class operator Implicit(const A: TScalar): Boolean; overload; inline;
class operator Implicit(const A: TScalar): TDateTime; overload; inline;
class function StringToKind(const AName: string): TKind; static;
function ToString: String;
@@ -72,20 +99,34 @@ type
class function TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean; static;
class function TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean; static;
class operator Add(const A, B: TScalar): TScalar;
class operator Divide(const A, B: TScalar): TScalar;
class operator Equal(const A, B: TScalar): Boolean;
class operator GreaterThan(const A, B: TScalar): Boolean;
class operator GreaterThanOrEqual(const A, B: TScalar): Boolean;
class operator LessThan(const A, B: TScalar): Boolean;
class operator LessThanOrEqual(const A, B: TScalar): Boolean;
class operator LogicalNot(const A: TScalar): TScalar;
class operator Multiply(const A, B: TScalar): TScalar;
class operator Negative(const A: TScalar): TScalar;
class operator NotEqual(const A, B: TScalar): Boolean;
class operator Round(const A: TScalar): TScalar;
class operator Subtract(const A, B: TScalar): TScalar;
class operator Trunc(const A: TScalar): TScalar;
// Operators
class operator Add(const A, B: TScalar): TScalar; inline;
class operator Subtract(const A, B: TScalar): TScalar; inline;
class operator Multiply(const A, B: TScalar): TScalar; inline;
class operator Divide(const A, B: TScalar): TScalar; inline;
class operator IntDivide(const A, B: TScalar): TScalar; inline;
class operator Modulus(const A, B: TScalar): TScalar; inline;
class operator Positive(const A: TScalar): TScalar; inline;
class operator Equal(const A, B: TScalar): Boolean; inline;
class operator NotEqual(const A, B: TScalar): Boolean; inline;
class operator GreaterThan(const A, B: TScalar): Boolean; inline;
class operator GreaterThanOrEqual(const A, B: TScalar): Boolean; inline;
class operator LessThan(const A, B: TScalar): Boolean; inline;
class operator LessThanOrEqual(const A, B: TScalar): Boolean; inline;
class operator BitwiseAnd(const A, B: TScalar): TScalar; inline;
class operator BitwiseOr(const A, B: TScalar): TScalar; inline;
class operator BitwiseXor(const A, B: TScalar): TScalar; inline;
class operator LeftShift(const A, B: TScalar): TScalar; inline;
class operator RightShift(const A, B: TScalar): TScalar; inline;
class operator LogicalNot(const A: TScalar): TScalar; inline;
class operator Negative(const A: TScalar): TScalar; inline;
class operator Round(const A: TScalar): TScalar; inline;
class operator Trunc(const A: TScalar): TScalar; inline;
end;
// An array of scalar values of the same kind.
@@ -236,6 +277,20 @@ begin
Result.Value.AsInt64 := AValue.Idx
end;
class function TScalar.FromBoolean(AValue: Boolean): TScalar;
begin
Result.Kind := TKind.Boolean;
Result.Value.AsInt64 := Ord(AValue);
end;
class function TScalar.FromDateTime(AValue: TDateTime): TScalar;
begin
Result.Kind := TKind.DateTime;
Result.Value.AsDouble := AValue;
end;
// --- Implicit Conversions ---
class operator TScalar.Implicit(AValue: Double): TScalar;
begin
Result.Kind := TKind.Float;
@@ -256,13 +311,20 @@ begin
Result.Value.AsInt64 := AValue.Idx
end;
class operator TScalar.Implicit(AValue: Boolean): TScalar;
begin
Result.Kind := TKind.Boolean;
Result.Value.AsInt64 := Ord(AValue);
end;
class operator TScalar.Implicit(const A: TScalar): Double;
begin
case A.Kind of
TKind.Ordinal: Result := A.Value.AsInt64;
TKind.Float: Result := A.Value.AsDouble;
TKind.DateTime: Result := A.Value.AsDouble;
else
raise EInvalidCast.Create('Cannot implicitly convert Keyword to Double');
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Double', [A.Kind.ToString]);
end;
end;
@@ -270,33 +332,111 @@ class operator TScalar.Implicit(const A: TScalar): Int64;
begin
case A.Kind of
TKind.Ordinal: Result := A.Value.AsInt64;
TKind.Boolean: Result := A.Value.AsInt64;
else
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Int64', [A.Kind.ToString]);
end;
end;
class operator TScalar.Implicit(const A: TScalar): Boolean;
begin
case A.Kind of
TKind.Boolean, TKind.Ordinal: Result := A.Value.AsInt64 <> 0;
else
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Boolean', [A.Kind.ToString]);
end;
end;
class operator TScalar.Implicit(const A: TScalar): TDateTime;
begin
case A.Kind of
TKind.DateTime: Result := A.Value.AsDouble;
else
raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to TDateTime', [A.Kind.ToString]);
end;
end;
// --- Support Checks ---
class function TScalar.IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean;
begin
// Deny all operations if either operand is Keyword...
// Keyword logic
if (A = TKind.Keyword) or (B = TKind.Keyword) then
begin
// ...except for Equality checks
Result := (Op in [TBinaryOp.Equal, TBinaryOp.NotEqual]);
exit;
end;
// Default for Ordinal/Float
// DateTime logic
if (A = TKind.DateTime) or (B = TKind.DateTime) then
begin
case Op of
TBinaryOp.Add:
// Date + Num or Num + Date
Result :=
(A in [TKind.DateTime, TKind.Ordinal, TKind.Float])
and (B in [TKind.DateTime, TKind.Ordinal, TKind.Float])
and not ((A = TKind.DateTime) and (B = TKind.DateTime));
TBinaryOp.Subtract:
// Date - Num or Date - Date
Result := (A = TKind.DateTime) and (B in [TKind.DateTime, TKind.Ordinal, TKind.Float]);
TBinaryOp.Equal, TBinaryOp.NotEqual, TBinaryOp.Less, TBinaryOp.Greater, TBinaryOp.LessOrEqual, TBinaryOp.GreaterOrEqual:
Result := True;
else
Result := False;
end;
exit;
end;
// Boolean Logic
if (A = TKind.Boolean) or (B = TKind.Boolean) then
begin
if (A = TKind.Boolean) and (B = TKind.Boolean) then
begin
Result := Op in [TBinaryOp.Equal, TBinaryOp.NotEqual, TBinaryOp.BitwiseAnd, TBinaryOp.BitwiseOr, TBinaryOp.BitwiseXor];
exit;
end;
Result := Op in [TBinaryOp.Equal, TBinaryOp.NotEqual];
exit;
end;
// Bitwise/Int Math requires Ordinals
if Op
in [
TBinaryOp.IntDivide,
TBinaryOp.Modulus,
TBinaryOp.BitwiseAnd,
TBinaryOp.BitwiseOr,
TBinaryOp.BitwiseXor,
TBinaryOp.LeftShift,
TBinaryOp.RightShift] then
begin
Result := (A = TKind.Ordinal) and (B = TKind.Ordinal);
exit;
end;
// Default Numeric
Result := True;
end;
class function TScalar.IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean;
begin
// Deny all unary ops for Keywords
if (A = TKind.Keyword) then
if A = TKind.Keyword then
exit(False);
// Deny 'not' for Float
if (Op = TUnaryOp.Not) and (A = TKind.Float) then
if A = TKind.Boolean then
begin
Result := (Op = TUnaryOp.Not);
exit;
end;
if A = TKind.DateTime then
exit(False);
if (Op = TUnaryOp.Not) and (A <> TKind.Ordinal) then
exit(False);
Result := True;
@@ -310,6 +450,10 @@ begin
Result := TKind.Float
else if SameText(AName, 'Keyword') then
Result := TKind.Keyword
else if SameText(AName, 'Boolean') then
Result := TKind.Boolean
else if SameText(AName, 'DateTime') then
Result := TKind.DateTime
else
raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]);
end;
@@ -320,6 +464,8 @@ begin
TKind.Ordinal: Result := IntToStr(Value.AsInt64);
TKind.Float: Result := FloatToStr(Value.AsDouble);
TKind.Keyword: Result := ':' + TKeywordRegistry.GetName(Value.AsInt64);
TKind.Boolean: Result := BoolToStr(Value.AsInt64 <> 0, True);
TKind.DateTime: Result := DateToISO8601(Value.AsDouble, True);
else
Result := '[Unknown Scalar]';
end;
@@ -329,22 +475,27 @@ class function TScalar.TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; ou
begin
if not IsBinaryOperatorSupported(Op, A.Kind, B.Kind) then
exit(False);
try
case Op of
TBinaryOp.Add: Res := A + B;
TBinaryOp.Subtract: Res := A - B;
TBinaryOp.Multiply: Res := A * B;
TBinaryOp.Divide: Res := A / B;
TBinaryOp.Equal: Res := TScalar.FromInt64(Integer(A = B));
TBinaryOp.NotEqual: Res := TScalar.FromInt64(Integer(A <> B));
TBinaryOp.Less: Res := TScalar.FromInt64(Integer(A < B));
TBinaryOp.Greater: Res := TScalar.FromInt64(Integer(A > B));
TBinaryOp.LessOrEqual: Res := TScalar.FromInt64(Integer(A <= B));
TBinaryOp.GreaterOrEqual: Res := TScalar.FromInt64(Integer(A >= B));
TBinaryOp.IntDivide: Res := A div B;
TBinaryOp.Modulus: Res := A mod B;
TBinaryOp.Equal: Res := TScalar.FromBoolean(A = B);
TBinaryOp.NotEqual: Res := TScalar.FromBoolean(A <> B);
TBinaryOp.Less: Res := TScalar.FromBoolean(A < B);
TBinaryOp.Greater: Res := TScalar.FromBoolean(A > B);
TBinaryOp.LessOrEqual: Res := TScalar.FromBoolean(A <= B);
TBinaryOp.GreaterOrEqual: Res := TScalar.FromBoolean(A >= B);
TBinaryOp.BitwiseAnd: Res := A and B;
TBinaryOp.BitwiseOr: Res := A or B;
TBinaryOp.BitwiseXor: Res := A xor B;
TBinaryOp.LeftShift: Res := A shl B;
TBinaryOp.RightShift: Res := A shr B;
else
Result := False;
exit;
exit(False);
end;
Result := True;
except
@@ -359,10 +510,10 @@ begin
try
case Op of
TUnaryOp.Negate: Res := -A;
TUnaryOp.Positive: Res := +A;
TUnaryOp.Not: Res := not A;
else
Result := False;
exit;
exit(False);
end;
Result := True;
except
@@ -370,80 +521,163 @@ begin
end;
end;
// --- Operators ---
class operator TScalar.Add(const A, B: TScalar): TScalar;
begin
// Date Math
if (A.Kind = TKind.DateTime) or (B.Kind = TKind.DateTime) then
begin
if (A.Kind = TKind.DateTime) and (B.Kind = TKind.DateTime) then
raise EArgumentException.Create('Cannot add two DateTimes.');
var dateVal: Double;
var numVal: Double;
if A.Kind = TKind.DateTime then
begin
dateVal := A.Value.AsDouble;
numVal := Double(B);
end
else
begin
dateVal := B.Value.AsDouble;
numVal := Double(A);
end;
Result.Kind := TKind.DateTime;
Result.Value.AsDouble := dateVal + numVal;
exit;
end;
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 + B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
else if (A.Kind in [TKind.Ordinal, TKind.Float]) and (B.Kind in [TKind.Ordinal, TKind.Float]) then
begin
var valA, valB: Double;
valA := A; // Use implicit cast
valB := B; // Use implicit cast
var valA: Double := A;
var valB: Double := B;
Result := valA + valB;
end
else
raise EArgumentException.CreateFmt('Operator Add not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.Subtract(const A, B: TScalar): TScalar;
begin
// Date Math
if A.Kind = TKind.DateTime then
begin
var dateA := A.Value.AsDouble;
if B.Kind = TKind.DateTime then
begin
Result.Kind := TKind.Float;
Result.Value.AsDouble := dateA - B.Value.AsDouble;
end
else if B.Kind in [TKind.Ordinal, TKind.Float] then
begin
Result.Kind := TKind.DateTime;
Result.Value.AsDouble := dateA - Double(B);
end
else
raise EArgumentException.Create('Invalid operand for Date subtraction.');
exit;
end;
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 - B.Value.AsInt64
else if (A.Kind in [TKind.Ordinal, TKind.Float]) and (B.Kind in [TKind.Ordinal, TKind.Float]) then
begin
var valA: Double := A;
var valB: Double := B;
Result := valA - valB;
end
else
raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.Multiply(const A, B: TScalar): TScalar;
begin
if (A.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) or (B.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) then
raise EArgumentException.CreateFmt('Operator Multiply not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 * B.Value.AsInt64
else
begin
var valA: Double := A;
var valB: Double := B;
Result := valA * valB;
end;
end;
class operator TScalar.Divide(const A, B: TScalar): TScalar;
begin
// Division *always* promotes to Float, unless types are invalid
if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) then
if (A.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) or (B.Kind in [TKind.DateTime, TKind.Keyword, TKind.Boolean]) then
raise EArgumentException.CreateFmt('Operator Divide not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
var valA, valB: Double;
valA := A; // Use implicit cast
valB := B; // Use implicit cast
var valB: Double := B;
if valB = 0.0 then
raise EDivByZero.Create('Division by zero');
var valA: Double := A;
Result := valA / valB;
end;
class operator TScalar.IntDivide(const A, B: TScalar): TScalar;
begin
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
raise EArgumentException.Create('Operator div requires Ordinal arguments.');
if B.Value.AsInt64 = 0 then
raise EDivByZero.Create('Division by zero');
Result.Kind := TKind.Ordinal;
Result.Value.AsInt64 := A.Value.AsInt64 div B.Value.AsInt64;
end;
class operator TScalar.Modulus(const A, B: TScalar): TScalar;
begin
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
raise EArgumentException.Create('Operator mod requires Ordinal arguments.');
if B.Value.AsInt64 = 0 then
raise EDivByZero.Create('Division by zero');
Result.Kind := TKind.Ordinal;
Result.Value.AsInt64 := A.Value.AsInt64 mod B.Value.AsInt64;
end;
class operator TScalar.Equal(const A, B: TScalar): Boolean;
begin
// Must be same kind to be equal (e.g., Ordinal(5) <> Keyword(5))
if A.Kind <> B.Kind then
exit(False);
case A.Kind of
TKind.Ordinal, TKind.Keyword: Result := A.Value.AsInt64 = B.Value.AsInt64;
TKind.Float: Result := A.Value.AsDouble = B.Value.AsDouble;
if A.Kind = B.Kind then
begin
case A.Kind of
TKind.Ordinal, TKind.Keyword, TKind.Boolean: Result := A.Value.AsInt64 = B.Value.AsInt64;
TKind.Float, TKind.DateTime: Result := SameValue(A.Value.AsDouble, B.Value.AsDouble);
else
Result := False;
end;
end
else if (A.Kind in [TKind.Ordinal, TKind.Float]) and (B.Kind in [TKind.Ordinal, TKind.Float]) then
Result := SameValue(Double(A), Double(B))
else
Result := False;
end;
end;
class operator TScalar.GreaterThan(const A, B: TScalar): Boolean;
class operator TScalar.NotEqual(const A, B: TScalar): Boolean;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 > B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA > valB;
end
else
raise EArgumentException.CreateFmt('Operator GreaterThan not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
end;
class operator TScalar.GreaterThanOrEqual(const A, B: TScalar): Boolean;
begin
Result := not (A < B);
Result := not (A = B);
end;
class operator TScalar.LessThan(const A, B: TScalar): Boolean;
begin
if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) or (A.Kind = TKind.Boolean) or (B.Kind = TKind.Boolean) then
raise EArgumentException.Create('Order comparison not supported for Keyword/Boolean.');
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 < B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA < valB;
end
else
raise EArgumentException.CreateFmt('Operator LessThan not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
Result := Double(A) < Double(B);
end;
class operator TScalar.LessThanOrEqual(const A, B: TScalar): Boolean;
@@ -451,30 +685,74 @@ begin
Result := not (A > B);
end;
class operator TScalar.LogicalNot(const A: TScalar): TScalar;
class operator TScalar.GreaterThan(const A, B: TScalar): Boolean;
begin
if A.Kind <> TKind.Ordinal then
raise EArgumentException.CreateFmt('Operator Not not supported for type %s', [A.Kind.ToString]);
if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) or (A.Kind = TKind.Boolean) or (B.Kind = TKind.Boolean) then
raise EArgumentException.Create('Order comparison not supported for Keyword/Boolean.');
if A.Value.AsInt64 = 0 then
Result := 1
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 > B.Value.AsInt64
else
Result := 0;
Result := Double(A) > Double(B);
end;
class operator TScalar.Multiply(const A, B: TScalar): TScalar;
class operator TScalar.GreaterThanOrEqual(const A, B: TScalar): Boolean;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 * B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA * valB;
end
Result := not (A < B);
end;
class operator TScalar.BitwiseAnd(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Boolean) and (B.Kind = TKind.Boolean) then
Result := FromBoolean((A.Value.AsInt64 <> 0) and (B.Value.AsInt64 <> 0))
else if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := FromInt64(A.Value.AsInt64 and B.Value.AsInt64)
else
raise EArgumentException.CreateFmt('Operator Multiply not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
raise EArgumentException.Create('Operator "and" requires Ordinal or Boolean arguments.');
end;
class operator TScalar.BitwiseOr(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Boolean) and (B.Kind = TKind.Boolean) then
Result := FromBoolean((A.Value.AsInt64 <> 0) or (B.Value.AsInt64 <> 0))
else if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := FromInt64(A.Value.AsInt64 or B.Value.AsInt64)
else
raise EArgumentException.Create('Operator "or" requires Ordinal or Boolean arguments.');
end;
class operator TScalar.BitwiseXor(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Boolean) and (B.Kind = TKind.Boolean) then
Result := FromBoolean((A.Value.AsInt64 <> 0) xor (B.Value.AsInt64 <> 0))
else if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := FromInt64(A.Value.AsInt64 xor B.Value.AsInt64)
else
raise EArgumentException.Create('Operator "xor" requires Ordinal or Boolean arguments.');
end;
class operator TScalar.LeftShift(const A, B: TScalar): TScalar;
begin
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
raise EArgumentException.Create('Operator shl requires Ordinal arguments.');
Result := FromInt64(A.Value.AsInt64 shl B.Value.AsInt64);
end;
class operator TScalar.RightShift(const A, B: TScalar): TScalar;
begin
if (A.Kind <> TKind.Ordinal) or (B.Kind <> TKind.Ordinal) then
raise EArgumentException.Create('Operator shr requires Ordinal arguments.');
Result := FromInt64(A.Value.AsInt64 shr B.Value.AsInt64);
end;
class operator TScalar.LogicalNot(const A: TScalar): TScalar;
begin
if A.Kind = TKind.Boolean then
Result := FromBoolean(A.Value.AsInt64 = 0)
else if A.Kind = TKind.Ordinal then
Result := FromBoolean(A.Value.AsInt64 = 0)
else
raise EArgumentException.CreateFmt('Operator Not not supported for type %s', [A.Kind.ToString]);
end;
class operator TScalar.Negative(const A: TScalar): TScalar;
@@ -488,38 +766,24 @@ begin
end;
end;
class operator TScalar.NotEqual(const A, B: TScalar): Boolean;
class operator TScalar.Positive(const A: TScalar): TScalar;
begin
Result := not (A = B);
if A.Kind in [TKind.Ordinal, TKind.Float] then
Result := A
else
raise EArgumentException.CreateFmt('Operator Positive not supported for type %s', [A.Kind.ToString]);
end;
class operator TScalar.Round(const A: TScalar): TScalar;
begin
var val: Double;
val := A; // Implicit cast handles Ordinal or Float
Result := System.Round(val);
end;
class operator TScalar.Subtract(const A, B: TScalar): TScalar;
begin
if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then
Result := A.Value.AsInt64 - B.Value.AsInt64
else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then
begin
var valA, valB: Double;
valA := A;
valB := B;
Result := valA - valB;
end
else
raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]);
var val: Double := A;
Result := FromInt64(System.Round(val));
end;
class operator TScalar.Trunc(const A: TScalar): TScalar;
begin
var val: Double;
val := A; // Implicit cast handles Ordinal or Float
Result := System.Trunc(val);
var val: Double := A;
Result := FromInt64(System.Trunc(val));
end;
{ TScalarArray }
@@ -623,6 +887,8 @@ begin
TScalar.TKind.Ordinal: Result := 'Ordinal';
TScalar.TKind.Float: Result := 'Float';
TScalar.TKind.Keyword: Result := 'Keyword';
TScalar.TKind.Boolean: Result := 'Boolean';
TScalar.TKind.DateTime: Result := 'DateTime';
else
Result := 'unknown';
end;
@@ -637,12 +903,19 @@ begin
TScalar.TBinaryOp.Subtract: Result := '-';
TScalar.TBinaryOp.Multiply: Result := '*';
TScalar.TBinaryOp.Divide: Result := '/';
TScalar.TBinaryOp.IntDivide: Result := 'div';
TScalar.TBinaryOp.Modulus: Result := 'mod';
TScalar.TBinaryOp.Equal: Result := '=';
TScalar.TBinaryOp.NotEqual: Result := '<>';
TScalar.TBinaryOp.Less: Result := '<';
TScalar.TBinaryOp.Greater: Result := '>';
TScalar.TBinaryOp.LessOrEqual: Result := '<=';
TScalar.TBinaryOp.GreaterOrEqual: Result := '>=';
TScalar.TBinaryOp.BitwiseAnd: Result := 'and';
TScalar.TBinaryOp.BitwiseOr: Result := 'or';
TScalar.TBinaryOp.BitwiseXor: Result := 'xor';
TScalar.TBinaryOp.LeftShift: Result := 'shl';
TScalar.TBinaryOp.RightShift: Result := 'shr';
else
Result := '?';
end;
@@ -654,6 +927,7 @@ function TScalar.TUnaryOpHelper.ToString: string;
begin
case Self of
TScalar.TUnaryOp.Negate: Result := '-';
TScalar.TUnaryOp.Positive: Result := '+';
TScalar.TUnaryOp.Not: Result := 'not';
else
Result := '?';