134 lines
4.9 KiB
ObjectPascal
134 lines
4.9 KiB
ObjectPascal
unit Myc.Ast.RTL;
|
|
|
|
interface
|
|
|
|
// This unit is intended to be included in a 'uses' clause.
|
|
// It self-registers its functions via its initialization section.
|
|
|
|
implementation
|
|
|
|
uses
|
|
System.SysUtils,
|
|
System.Math,
|
|
Myc.Data.Scalar,
|
|
Myc.Data.Value,
|
|
Myc.Data.Decimal,
|
|
Myc.Ast,
|
|
Myc.Ast.Nodes,
|
|
Myc.Ast.Scope;
|
|
|
|
//--------------------------------------------------------------------------------------------------
|
|
//== Native Function Implementations
|
|
//--------------------------------------------------------------------------------------------------
|
|
|
|
// A helper to simplify argument validation for unary numeric functions.
|
|
function GetSingleNumericArg(const AName: string; const AArgs: TArray<TDataValue>; out AArg: TScalar): Boolean;
|
|
begin
|
|
if Length(AArgs) <> 1 then
|
|
raise EArgumentException.CreateFmt('%s requires exactly one argument.', [AName]);
|
|
if AArgs[0].Kind <> vkScalar then
|
|
raise EArgumentException.CreateFmt('%s requires a scalar argument.', [AName]);
|
|
|
|
AArg := AArgs[0].AsScalar;
|
|
if not (AArg.Kind in [skInteger, skInt64, skSingle, skDouble, skDecimal]) then
|
|
raise EArgumentException.CreateFmt('%s requires a numeric argument, but got %s.', [AName, AArg.Kind.ToString]);
|
|
|
|
Result := True;
|
|
end;
|
|
|
|
function NativeAbs(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Abs', Args, arg);
|
|
case arg.Kind of
|
|
skInteger: Result := TScalar.FromInteger(Abs(arg.Value.AsInteger));
|
|
skInt64: Result := TScalar.FromInt64(Abs(arg.Value.AsInt64));
|
|
skSingle: Result := TScalar.FromSingle(Abs(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromDouble(Abs(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromDecimal(arg.Value.AsDecimal.Abs);
|
|
else
|
|
// Should be caught by GetSingleNumericArg, but as a safeguard:
|
|
raise EArgumentException.Create('Abs requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeTrunc(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Trunc', Args, arg);
|
|
case arg.Kind of
|
|
skInteger, skInt64: Result := arg; // Trunc on an integer is a no-op
|
|
skSingle: Result := TScalar.FromInt64(Trunc(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInt64(Trunc(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInt64(Trunc(arg.Value.AsDecimal));
|
|
else
|
|
raise EArgumentException.Create('Trunc requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeCeil(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Ceil', Args, arg);
|
|
case arg.Kind of
|
|
skInteger, skInt64: Result := arg; // Ceil on an integer is a no-op
|
|
skSingle: Result := TScalar.FromInt64(Ceil(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInt64(Ceil(arg.Value.AsDouble));
|
|
else
|
|
raise EArgumentException.Create('Ceil requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeFloor(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Floor', Args, arg);
|
|
case arg.Kind of
|
|
skInteger, skInt64: Result := arg; // Floor on an integer is a no-op
|
|
skSingle: Result := TScalar.FromInt64(Floor(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInt64(Floor(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInt64(Trunc(arg.Value.AsDecimal));
|
|
else
|
|
raise EArgumentException.Create('Floor requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
function NativeSign(const Args: TArray<TDataValue>): TDataValue;
|
|
var
|
|
arg: TScalar;
|
|
begin
|
|
GetSingleNumericArg('Sign', Args, arg);
|
|
case arg.Kind of
|
|
skInteger: Result := TScalar.FromInteger(Sign(arg.Value.AsInteger));
|
|
skInt64: Result := TScalar.FromInteger(Sign(arg.Value.AsInt64));
|
|
skSingle: Result := TScalar.FromInteger(Sign(arg.Value.AsSingle));
|
|
skDouble: Result := TScalar.FromInteger(Sign(arg.Value.AsDouble));
|
|
skDecimal: Result := TScalar.FromInteger(arg.Value.AsDecimal.Sign);
|
|
else
|
|
raise EArgumentException.Create('Sign requires a numeric argument.');
|
|
end;
|
|
end;
|
|
|
|
//--------------------------------------------------------------------------------------------------
|
|
//== Library Registration
|
|
//--------------------------------------------------------------------------------------------------
|
|
|
|
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
|
|
begin
|
|
AScope.Define('Abs', TDataValue(NativeAbs));
|
|
AScope.Define('Trunc', TDataValue(NativeTrunc));
|
|
AScope.Define('Ceil', TDataValue(NativeCeil));
|
|
AScope.Define('Floor', TDataValue(NativeFloor));
|
|
AScope.Define('Sign', TDataValue(NativeSign));
|
|
end;
|
|
|
|
initialization
|
|
// Register this library's functions with the central AST factory.
|
|
TAst.RegisterLibrary(RegisterRtlFunctions);
|
|
|
|
end.
|