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

RTL refactoring

Browse Source
This commit is contained in:
Michael Schimmel
2026-01-13 17:01:33 +01:00
parent 1429278765
commit 1c6a6fe5a0
9 changed files with 1031 additions and 1012 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.RTL.pas
+321 -417
View File
@@ -2,9 +2,6 @@ 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.
uses
System.SysUtils,
System.Generics.Collections,
@@ -19,27 +16,11 @@ uses
Myc.Ast.Types;
type
// Defines the export parameters for a native RTL function.
TRtlExportAttribute = class(TCustomAttribute)
type
TPurity = (Pure, Impure);
public
Name: string;
IsPure: Boolean;
constructor Create(const AName: string); overload;
constructor Create(const AName: string; APurity: TPurity); overload;
end;
//==============================================================================================
// Internal Structures
//==============================================================================================
// Defines a constant export (via class function).
// The registry will INVOKE this function at startup and register the RESULT as a value.
TRtlConstAttribute = class(TCustomAttribute)
public
Name: string;
constructor Create(const AName: string);
end;
// Defines the key for the static bootstrap cache.
type
// Key used to identify specific overloads of a function based on argument types.
TStaticSignatureKey = record
public
Name: string;
@@ -47,13 +28,14 @@ type
constructor Create(const AName: string; const AArgTypes: TArray<IStaticType>);
end;
// Comparer for the static signature key
// Equality comparer for TStaticSignatureKey to be used in dictionaries.
TStaticSignatureKeyComparer = class(TEqualityComparer<TStaticSignatureKey>)
public
function Equals(const Left, Right: TStaticSignatureKey): Boolean; override;
function GetHashCode(const Value: TStaticSignatureKey): Integer; override;
end;
// Holds a reference to a specialized, type-safe native function wrapper.
TSpecializedMethod = record
public
Target: TDataValue.TFunc;
@@ -62,21 +44,22 @@ type
constructor Create(const ATarget: TDataValue.TFunc; const AReturnType: IStaticType; AIsPure: Boolean);
end;
// The cache holding TDataValue.TFunc wrappers for static native functions.
// Cache for static specializations.
TStaticBootstrapCache = TDictionary<TStaticSignatureKey, TSpecializedMethod>;
// Metadata for a registered function, including dynamic fallback and signatures.
TRtlFunctionInfo = class
public
DynamicWrapper: TDataValue.TFunc;
Signatures: TList<IMethodSignature>;
Doc: string; // Documentation string from AstDoc attribute
Doc: string;
constructor Create;
destructor Destroy; override;
end;
TRtlFunctionMap = TDictionary<string, TRtlFunctionInfo>;
// Container for constant metadata
// Metadata for a registered constant.
TRtlConstantInfo = record
Name: string;
Value: TDataValue;
@@ -85,14 +68,18 @@ type
constructor Create(const AName: string; const AValue: TDataValue; const AType: IStaticType; const ADoc: string);
end;
//--------------------------------------------------------------------------------------------------
//== Library Registration (RTTI-based)
//--------------------------------------------------------------------------------------------------
//==============================================================================================
// RTL Registry
//==============================================================================================
// A helper record to encapsulate the RTTI-based registration logic.
// Central registry logic using RTTI to scan provider classes.
TRtlRegistry = record
private
// Function pointer types for static wrappers
type
// --- Static Wrapper Signatures ---
TNativeDataValueFunc = function(const Args: TArray<TDataValue>): TDataValue;
TNativeScalarFunc = function(Arg: TScalar): TScalar;
TNativeFunc_O_O = function(A: Int64): Int64;
TNativeFunc_F_F = function(A: Double): Double;
TNativeFunc_F_O = function(A: Double): Int64;
@@ -112,15 +99,13 @@ type
private
class var
FStaticBootstrap: TStaticBootstrapCache;
class var
FStaticFuncMap: TRtlFunctionMap;
class var
FStaticConstList: TList<TRtlConstantInfo>;
class constructor Create;
class destructor Destroy;
// --- Wrapper Creation Helpers ---
// Wrapper generators for specific function signatures
class function CreateWrapper_O_O(CodeAddress: Pointer): TDataValue.TFunc; static;
class function CreateWrapper_F_F(CodeAddress: Pointer): TDataValue.TFunc; static;
class function CreateWrapper_F_O(CodeAddress: Pointer): TDataValue.TFunc; static;
@@ -136,19 +121,14 @@ type
class function CreateWrapper_FO_O(CodeAddress: Pointer): TDataValue.TFunc; static;
class function CreateWrapper_TT_T(CodeAddress: Pointer): TDataValue.TFunc; static;
// --- RTTI Helpers ---
class function RttiTypeToStaticType(const AType: TRttiType): IStaticType; static;
// Helpers
class function TValueToDataValue(const V: TValue): TDataValue; static;
class function RttiTypeToStaticType(const AType: TRttiType): IStaticType; static;
class function ParseStaticSuffix(
const AMethodName: string;
out AArgTypes: TArray<IStaticType>;
out AReturnType: IStaticType
): Boolean; static;
public
class procedure RegisterAll(const AScope: IExecutionScope); static;
class function CreateStaticWrapper(
method: TRttiMethod;
retType: IStaticType;
@@ -156,7 +136,14 @@ type
rttiParams: TArray<TRttiParameter>
): TDataValue.TFunc; static;
// Public accessor for the TStaticSpecializer
public
// Scans a specific provider type for attributes and registers them internally.
class procedure Scan<T>; static;
// Dumps all registered functions and constants into the execution scope.
class procedure RegisterAll(const AScope: IExecutionScope); static;
// API for the type checker to retrieve specialized methods.
class function GetStaticSpecialization(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod; static;
class procedure RegisterStaticSpecialization(
const AName: string;
@@ -165,6 +152,7 @@ type
); static;
end;
// Main entry point for library registration.
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
implementation
@@ -173,39 +161,14 @@ uses
System.Hash,
System.StrUtils,
Myc.Ast.Attributes,
Myc.Ast.RTL.Core;
Myc.Ast.RTL.Core,
Myc.Ast.RTL.Math,
Myc.Ast.RTL.Series,
Myc.Ast.RTL.DateTime;
type
TNativeDataValueFunc = function(const Args: TArray<TDataValue>): TDataValue;
TNativeScalarFunc = function(Arg: TScalar): TScalar;
//--------------------------------------------------------------------------------------------------
//== Native Function Implementation (Core Logic)
//--------------------------------------------------------------------------------------------------
constructor TRtlExportAttribute.Create(const AName: string);
begin
inherited Create;
Self.Name := AName;
Self.IsPure := False; // Default to impure (safe)
end;
constructor TRtlExportAttribute.Create(const AName: string; APurity: TPurity);
begin
inherited Create;
Self.Name := AName;
Self.IsPure := APurity = Pure;
end;
{ TRtlConstAttribute }
constructor TRtlConstAttribute.Create(const AName: string);
begin
inherited Create;
Name := AName;
end;
{ TStaticSignatureKey }
//==================================================================================================
// Helper Structure Implementations
//==================================================================================================
constructor TStaticSignatureKey.Create(const AName: string; const AArgTypes: TArray<IStaticType>);
begin
@@ -213,8 +176,6 @@ begin
ArgTypes := AArgTypes;
end;
{ TStaticSignatureKeyComparer }
function TStaticSignatureKeyComparer.Equals(const Left, Right: TStaticSignatureKey): Boolean;
var
i: Integer;
@@ -223,42 +184,28 @@ begin
exit(False);
if Length(Left.ArgTypes) <> Length(Right.ArgTypes) then
exit(False);
// Compare types
for i := 0 to High(Left.ArgTypes) do
begin
if not Left.ArgTypes[i].IsEqual(Right.ArgTypes[i]) then
exit(False);
end;
Result := True;
end;
function TStaticSignatureKeyComparer.GetHashCode(const Value: TStaticSignatureKey): Integer;
var
i: Integer;
hash: Integer;
ptrHash: Integer;
i, hash, ptrHash: Integer;
begin
// 1. Hash the function name to get the initial value
hash := THashBobJenkins.GetHashValue(Value.Name);
// 2. Iteratively combine the hash of each argument type
for i := 0 to High(Value.ArgTypes) do
begin
if Assigned(Value.ArgTypes[i]) then
ptrHash := Value.ArgTypes[i].GetHashCode
else
ptrHash := 0;
hash := THashBobJenkins.GetHashValue(ptrHash, SizeOf(Integer), hash);
end;
Result := hash;
end;
{ TRtlFunctionInfo }
constructor TRtlFunctionInfo.Create;
begin
inherited Create;
@@ -273,8 +220,6 @@ begin
inherited Destroy;
end;
{ TRtlConstantInfo }
constructor TRtlConstantInfo.Create(const AName: string; const AValue: TDataValue; const AType: IStaticType; const ADoc: string);
begin
Name := AName;
@@ -283,8 +228,6 @@ begin
Doc := ADoc;
end;
{ TSpecializedMethod }
constructor TSpecializedMethod.Create(const ATarget: TDataValue.TFunc; const AReturnType: IStaticType; AIsPure: Boolean);
begin
Target := ATarget;
@@ -292,7 +235,153 @@ begin
IsPure := AIsPure;
end;
{ TRtlRegistry }
//==================================================================================================
// TRtlRegistry Implementation
//==================================================================================================
class constructor TRtlRegistry.Create;
begin
FStaticBootstrap := TStaticBootstrapCache.Create(TStaticSignatureKeyComparer.Create);
FStaticFuncMap := TRtlFunctionMap.Create;
FStaticConstList := TList<TRtlConstantInfo>.Create;
end;
class destructor TRtlRegistry.Destroy;
var
funcInfo: TRtlFunctionInfo;
begin
for funcInfo in FStaticFuncMap.Values do
funcInfo.Free;
FStaticFuncMap.Free;
FStaticConstList.Free;
FStaticBootstrap.Free;
end;
class procedure TRtlRegistry.Scan<T>;
var
ctx: TRttiContext;
typ: TRttiType;
method: TRttiMethod;
attribute: TCustomAttribute;
exportAttr: TRtlExportAttribute;
constAttr: TRtlConstAttribute;
docString, rtlName: string;
argTypes: TArray<IStaticType>;
retType: IStaticType;
methodRecord: TSpecializedMethod;
funcInfo: TRtlFunctionInfo;
constInfo: TRtlConstantInfo;
rttiParams: TArray<TRttiParameter>;
isDynamic: Boolean;
i: Integer;
begin
ctx := TRttiContext.Create;
try
typ := ctx.GetType(TypeInfo(T));
if typ = nil then
exit;
for method in typ.GetMethods do
begin
if method.MethodKind <> mkClassFunction then
continue;
exportAttr := nil;
constAttr := nil;
docString := '';
// Extract attributes
for attribute in method.GetAttributes do
begin
if attribute is TRtlExportAttribute then
exportAttr := attribute as TRtlExportAttribute
else if attribute is TRtlConstAttribute then
constAttr := attribute as TRtlConstAttribute
else if attribute is AstDocAttribute then
docString := AstDocAttribute(attribute).Description;
end;
// --- CASE A: CONSTANT (via class function) ---
if Assigned(constAttr) then
begin
var val: TValue := method.Invoke(nil, []);
var dataVal: TDataValue := TValueToDataValue(val);
var staticType: IStaticType := RttiTypeToStaticType(method.ReturnType);
constInfo := TRtlConstantInfo.Create(constAttr.Name, dataVal, staticType, docString);
FStaticConstList.Add(constInfo);
continue;
end;
// --- CASE B: FUNCTION ---
if not Assigned(exportAttr) then
continue;
rtlName := exportAttr.Name;
if not FStaticFuncMap.TryGetValue(rtlName, funcInfo) then
begin
funcInfo := TRtlFunctionInfo.Create;
FStaticFuncMap.Add(rtlName, funcInfo);
end;
if (funcInfo.Doc = '') and (docString <> '') then
funcInfo.Doc := docString;
rttiParams := method.GetParameters;
isDynamic :=
(Length(rttiParams) = 1)
and (method.ReturnType.Handle = TypeInfo(TDataValue))
and (rttiParams[0].ParamType.Handle = TypeInfo(TArray<TDataValue>));
if isDynamic then
begin
// Dynamic wrapper (Interpreted mode)
if Assigned(funcInfo.DynamicWrapper) then
raise EInvalidOpException.CreateFmt('Duplicate dynamic fallback defined for %s', [rtlName]);
var wrapperFactory :=
function(CodeAddress: Pointer): TDataValue.TFunc
begin
Result :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := TNativeDataValueFunc(CodeAddress)(Args);
end;
end;
funcInfo.DynamicWrapper := wrapperFactory(method.CodeAddress);
end
else
begin
// Static wrapper (Compiled mode / Fast path)
if not ParseStaticSuffix(method.Name, argTypes, retType) then
begin
// Fallback to RTTI if name convention fails
SetLength(argTypes, Length(rttiParams));
for i := 0 to High(rttiParams) do
argTypes[i] := RttiTypeToStaticType(rttiParams[i].ParamType);
retType := RttiTypeToStaticType(method.ReturnType);
end;
var sig := TMethodSignature.Create(argTypes, retType);
funcInfo.Signatures.Add(sig);
var wrapper := CreateStaticWrapper(method, retType, argTypes, rttiParams);
if Assigned(wrapper) then
begin
methodRecord := TSpecializedMethod.Create(wrapper, retType, exportAttr.IsPure);
RegisterStaticSpecialization(rtlName, argTypes, methodRecord);
// Use static wrapper as fallback for interpreter if no dynamic wrapper exists
if (not Assigned(funcInfo.DynamicWrapper)) and (Length(argTypes) = 1) and (argTypes[0].Kind = stUnknown) then
funcInfo.DynamicWrapper := wrapper;
end
else
raise ENotImplemented.CreateFmt('Wrapper for %s not implemented', [method.Name]);
end;
end;
finally
ctx.Free;
end;
end;
class function TRtlRegistry.TValueToDataValue(const V: TValue): TDataValue;
begin
@@ -310,299 +399,14 @@ begin
end;
end;
class constructor TRtlRegistry.Create;
var
ctx: TRttiContext;
rtlType: TRttiType;
method: TRttiMethod;
attribute: TCustomAttribute;
exportAttr: TRtlExportAttribute;
constAttr: TRtlConstAttribute;
rtlName: string;
argTypes: TArray<IStaticType>;
retType: IStaticType;
methodRecord: TSpecializedMethod;
funcInfo: TRtlFunctionInfo;
constInfo: TRtlConstantInfo;
rttiParams: TArray<TRttiParameter>;
isDynamic: Boolean;
i: Integer;
docString: string;
begin
// 1. Create global caches
FStaticBootstrap := TStaticBootstrapCache.Create(TStaticSignatureKeyComparer.Create);
FStaticFuncMap := TRtlFunctionMap.Create;
FStaticConstList := TList<TRtlConstantInfo>.Create;
// 2. Perform RTTI Scan
ctx := TRttiContext.Create;
try
rtlType := ctx.GetType(TypeInfo(TRtlFunctions));
// --- SCAN METHODS ---
// Includes Class Functions used as Constants!
for method in rtlType.GetMethods do
begin
if method.MethodKind <> mkClassFunction then
continue;
exportAttr := nil;
constAttr := nil;
docString := '';
for attribute in method.GetAttributes do
begin
if attribute is TRtlExportAttribute then
exportAttr := attribute as TRtlExportAttribute
else if attribute is TRtlConstAttribute then
constAttr := attribute as TRtlConstAttribute
else if attribute is AstDocAttribute then
docString := AstDocAttribute(attribute).Description;
end;
// --- CASE A: CONSTANT (via class function) ---
if Assigned(constAttr) then
begin
// Since this is a static method (class function), we can invoke it with nil instance
// to get the value immediately.
var val: TValue := method.Invoke(nil, []);
var dataVal: TDataValue := TValueToDataValue(val);
var staticType: IStaticType := RttiTypeToStaticType(method.ReturnType);
constInfo := TRtlConstantInfo.Create(constAttr.Name, dataVal, staticType, docString);
FStaticConstList.Add(constInfo);
continue; // Done with this method
end;
// --- CASE B: FUNCTION ---
if not Assigned(exportAttr) then
continue;
rtlName := exportAttr.Name;
if not FStaticFuncMap.TryGetValue(rtlName, funcInfo) then
begin
funcInfo := TRtlFunctionInfo.Create;
FStaticFuncMap.Add(rtlName, funcInfo);
end;
// Update documentation (if not already set or override)
if (funcInfo.Doc = '') and (docString <> '') then
funcInfo.Doc := docString;
// Check Signature Type (Dynamic vs Static)
rttiParams := method.GetParameters;
isDynamic :=
(Length(rttiParams) = 1)
and (method.ReturnType.Handle = TypeInfo(TDataValue))
and (rttiParams[0].ParamType.Handle = TypeInfo(TArray<TDataValue>));
if isDynamic then
begin
if Assigned(funcInfo.DynamicWrapper) then
raise EInvalidOpException.CreateFmt('Duplicate dynamic fallback defined for %s', [rtlName]);
var wrapperFactory :=
function(CodeAddress: Pointer): TDataValue.TFunc
begin
Result :=
function(const Args: TArray<TDataValue>): TDataValue
begin
Result := TNativeDataValueFunc(CodeAddress)(Args);
end;
end;
funcInfo.DynamicWrapper := wrapperFactory(method.CodeAddress);
end
else
begin
// This is a STATIC SPECIALIZATION
if not ParseStaticSuffix(method.Name, argTypes, retType) then
begin
SetLength(argTypes, Length(rttiParams));
for i := 0 to High(rttiParams) do
argTypes[i] := RttiTypeToStaticType(rttiParams[i].ParamType);
retType := RttiTypeToStaticType(method.ReturnType);
end;
var sig := TMethodSignature.Create(argTypes, retType);
funcInfo.Signatures.Add(sig);
var wrapper := CreateStaticWrapper(method, retType, argTypes, rttiParams);
if Assigned(wrapper) then
begin
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;
end
else
raise ENotImplemented.CreateFmt('Static native method wrapper for %s() not implemented', [method.Name]);
end;
end;
finally
ctx.Free;
end;
end;
class destructor TRtlRegistry.Destroy;
var
funcInfo: TRtlFunctionInfo;
begin
for funcInfo in FStaticFuncMap.Values do
funcInfo.Free;
FStaticFuncMap.Free;
FStaticConstList.Free;
FStaticBootstrap.Free;
end;
class function TRtlRegistry.GetStaticSpecialization(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
var
key: TStaticSignatureKey;
begin
key.Name := AName;
key.ArgTypes := AArgTypes;
FStaticBootstrap.TryGetValue(key, Result);
end;
class procedure TRtlRegistry.RegisterStaticSpecialization(
const AName: string;
const AArgTypes: TArray<IStaticType>;
const AMethod: TSpecializedMethod
);
var
key: TStaticSignatureKey;
begin
key := TStaticSignatureKey.Create(AName, AArgTypes);
FStaticBootstrap.AddOrSetValue(key, AMethod);
end;
class function TRtlRegistry.RttiTypeToStaticType(const AType: TRttiType): IStaticType;
begin
if not Assigned(AType) then
exit(TTypes.Unknown);
if AType.Handle = TypeInfo(Int64) then
Result := TTypes.Ordinal
else if AType.Handle = TypeInfo(Double) then
Result := TTypes.Float
else if AType.Handle = TypeInfo(string) then
Result := TTypes.Text
else if (AType.Handle = TypeInfo(TScalar)) or (AType.Handle = TypeInfo(TDataValue)) then
Result := TTypes.Unknown
else
Result := TTypes.Unknown;
end;
class function TRtlRegistry.ParseStaticSuffix(
const AMethodName: string;
out AArgTypes: TArray<IStaticType>;
out AReturnType: IStaticType
): Boolean;
var
parts: TArray<string>;
i: Integer;
t: IStaticType;
function ParseType(const S: string): IStaticType;
begin
if SameText(S, 'Ordinal') then
Result := TTypes.Ordinal
else if SameText(S, 'Float') then
Result := TTypes.Float
else if SameText(S, 'Keyword') then
Result := TTypes.Keyword
else if SameText(S, 'Boolean') then
Result := TTypes.Boolean
else if SameText(S, 'DateTime') then
Result := TTypes.DateTime
else
Result := TTypes.Unknown;
end;
begin
Result := False;
AReturnType := TTypes.Unknown;
AArgTypes := nil;
parts := AMethodName.Split(['_']);
if Length(parts) < 2 then
exit;
AReturnType := ParseType(parts[High(parts)]);
if AReturnType.Kind = stUnknown then
exit;
SetLength(AArgTypes, Length(parts) - 2);
if Length(AArgTypes) = 0 then
begin
Result := True;
exit;
end;
for i := 1 to High(parts) - 1 do
begin
t := ParseType(parts[i]);
if t.Kind = stUnknown then
begin
AArgTypes := nil;
AReturnType := TTypes.Unknown;
exit(False);
end;
AArgTypes[i - 1] := t;
end;
Result := True;
end;
class procedure TRtlRegistry.RegisterAll(const AScope: IExecutionScope);
var
rtlName: string;
funcInfo: TRtlFunctionInfo;
constInfo: TRtlConstantInfo;
staticType: IStaticType;
pair: TPair<string, TRtlFunctionInfo>;
begin
// Register Functions
for pair in FStaticFuncMap do
begin
rtlName := pair.Key;
funcInfo := pair.Value;
if funcInfo.Signatures.Count > 0 then
staticType := TTypes.CreateMethodSet(funcInfo.Signatures.ToArray)
else
staticType := nil;
var wrapper := funcInfo.DynamicWrapper; // Default is Void
// Pass documentation to scope definition
AScope.Define(rtlName, wrapper, staticType, funcInfo.Doc);
end;
// Register Constants
for constInfo in FStaticConstList do
begin
AScope.Define(constInfo.Name, constInfo.Value, constInfo.StaticType, constInfo.Doc);
end;
end;
// --- Wrapper Generation ---
// --- Wrapper Implementations ---
class function TRtlRegistry.CreateWrapper_O_O(CodeAddress: Pointer): TDataValue.TFunc;
begin
Result :=
function(const Args: TArray<TDataValue>): TDataValue
var
A: Int64;
Res: Int64;
A, Res: Int64;
begin
A := Args[0].AsScalar.Value.AsInt64;
Res := TNativeFunc_O_O(CodeAddress)(A);
@@ -615,8 +419,7 @@ begin
Result :=
function(const Args: TArray<TDataValue>): TDataValue
var
A: Double;
Res: Double;
A, Res: Double;
begin
A := Args[0].AsScalar.Value.AsDouble;
Res := TNativeFunc_F_F(CodeAddress)(A);
@@ -728,8 +531,7 @@ begin
function(const Args: TArray<TDataValue>): TDataValue
var
A: Int64;
B: Double;
Res: Double;
B, Res: Double;
begin
A := Args[0].AsScalar.Value.AsInt64;
B := Args[1].AsScalar.Value.AsDouble;
@@ -791,8 +593,7 @@ begin
Result :=
function(const Args: TArray<TDataValue>): TDataValue
var
A: String;
B: String;
A, B: String;
begin
A := Args[0].AsText;
B := Args[1].AsText;
@@ -800,6 +601,77 @@ begin
end;
end;
class function TRtlRegistry.RttiTypeToStaticType(const AType: TRttiType): IStaticType;
begin
if not Assigned(AType) then
exit(TTypes.Unknown);
if AType.Handle = TypeInfo(Int64) then
Result := TTypes.Ordinal
else if AType.Handle = TypeInfo(Double) then
Result := TTypes.Float
else if AType.Handle = TypeInfo(string) then
Result := TTypes.Text
else
Result := TTypes.Unknown;
end;
class function TRtlRegistry.ParseStaticSuffix(
const AMethodName: string;
out AArgTypes: TArray<IStaticType>;
out AReturnType: IStaticType
): Boolean;
var
parts: TArray<string>;
i: Integer;
function ParseType(const S: string): IStaticType;
begin
if SameText(S, 'Ordinal') then
Result := TTypes.Ordinal
else if SameText(S, 'Float') then
Result := TTypes.Float
else if SameText(S, 'Keyword') then
Result := TTypes.Keyword
else if SameText(S, 'Boolean') then
Result := TTypes.Boolean
else if SameText(S, 'DateTime') then
Result := TTypes.DateTime
else
Result := TTypes.Unknown;
end;
begin
Result := False;
AReturnType := TTypes.Unknown;
AArgTypes := nil;
parts := AMethodName.Split(['_']);
// Format: Name_Arg1_Arg2_Return
if Length(parts) < 2 then
exit;
AReturnType := ParseType(parts[High(parts)]);
if AReturnType.Kind = stUnknown then
exit;
SetLength(AArgTypes, Length(parts) - 2);
if Length(AArgTypes) = 0 then
begin
Result := True;
exit;
end;
for i := 1 to High(parts) - 1 do
begin
AArgTypes[i - 1] := ParseType(parts[i]);
if AArgTypes[i - 1].Kind = stUnknown then
begin
AArgTypes := nil;
exit(False);
end;
end;
Result := True;
end;
class function TRtlRegistry.CreateStaticWrapper(
method: TRttiMethod;
retType: IStaticType;
@@ -814,13 +686,9 @@ begin
case Length(argTypes) of
0:
begin
if retType.Kind = stFloat then
Result := CreateWrapper_V_F(ptr);
end;
1:
begin
if (argTypes[0].Kind = stOrdinal) and (retType.Kind = stOrdinal) then
Result := CreateWrapper_O_O(ptr)
else if (argTypes[0].Kind = stFloat) and (retType.Kind = stFloat) then
@@ -831,25 +699,19 @@ begin
Result := CreateWrapper_O_F(ptr)
else if (argTypes[0].Kind = stUnknown) and (rttiParams[0].ParamType.Handle = TypeInfo(TScalar)) then
begin
// This is the wrapper for: class function(Arg: TScalar): TScalar;
var wrapperFactory :=
function(CodeAddress: Pointer): TDataValue.TFunc
begin
Result :=
function(const Args: TArray<TDataValue>): TDataValue
var
argScalar: TScalar;
begin
if (Length(Args) <> 1) or (Args[0].Kind <> vkScalar) then
raise EArgumentException.Create('Invalid argument for TScalar function.');
argScalar := Args[0].AsScalar;
Result := TDataValue(TNativeScalarFunc(CodeAddress)(argScalar));
raise EArgumentException.Create('Invalid argument');
Result := TDataValue(TNativeScalarFunc(CodeAddress)(Args[0].AsScalar));
end;
end;
Result := wrapperFactory(ptr);
end;
end;
2:
begin
var k1 := argTypes[0].Kind;
@@ -861,54 +723,96 @@ begin
if rk = stOrdinal then
Result := CreateWrapper_OO_O(ptr)
else if rk = stFloat then
Result := CreateWrapper_OO_F(ptr); // Divide
Result := CreateWrapper_OO_F(ptr);
end
else if (k1 = stFloat) and (k2 = stFloat) then
begin
if rk = stFloat then
Result := CreateWrapper_FF_F(ptr)
else if rk = stOrdinal then
Result := CreateWrapper_FF_O(ptr); // Comparisons
Result := CreateWrapper_FF_O(ptr);
end
else if (k1 = stOrdinal) and (k2 = stFloat) then
begin
if rk = stFloat then
Result := CreateWrapper_OF_F(ptr)
else if rk = stOrdinal then
Result := CreateWrapper_OF_O(ptr); // Comparisons
Result := CreateWrapper_OF_O(ptr);
end
else if (k1 = stFloat) and (k2 = stOrdinal) then
begin
if rk = stFloat then
Result := CreateWrapper_FO_F(ptr)
else if rk = stOrdinal then
Result := CreateWrapper_FO_O(ptr); // Comparisons
Result := CreateWrapper_FO_O(ptr);
end
else if (k1 = stKeyword) and (k2 = stKeyword) and (rk = stOrdinal) then
begin
// Keywords are passed as Int64 (index)
Result := CreateWrapper_OO_O(ptr); // e.g. Equal_Keyword_Keyword
end
Result := CreateWrapper_OO_O(ptr)
else if (k1 = stText) and (k2 = stText) then
begin
Result := CreateWrapper_TT_T(ptr); // e.g. String concat
end;
Result := CreateWrapper_TT_T(ptr);
end;
else
Assert(false, 'Wrapper not implemented');
end;
end;
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
class function TRtlRegistry.GetStaticSpecialization(const AName: string; const AArgTypes: TArray<IStaticType>): TSpecializedMethod;
var
key: TStaticSignatureKey;
begin
key.Name := AName;
key.ArgTypes := AArgTypes;
FStaticBootstrap.TryGetValue(key, Result);
end;
class procedure TRtlRegistry.RegisterStaticSpecialization(
const AName: string;
const AArgTypes: TArray<IStaticType>;
const AMethod: TSpecializedMethod
);
var
key: TStaticSignatureKey;
begin
key := TStaticSignatureKey.Create(AName, AArgTypes);
FStaticBootstrap.AddOrSetValue(key, AMethod);
end;
class procedure TRtlRegistry.RegisterAll(const AScope: IExecutionScope);
var
rtlName: string;
funcInfo: TRtlFunctionInfo;
constInfo: TRtlConstantInfo;
staticType: IStaticType;
pair: TPair<string, TRtlFunctionInfo>;
begin
AScope.Define('true', TDataValue(TScalar.FromBoolean(True)), TTypes.Boolean, 'Boolean true.');
AScope.Define('false', TDataValue(TScalar.FromBoolean(False)), TTypes.Boolean, 'Boolean false.');
for pair in FStaticFuncMap do
begin
rtlName := pair.Key;
funcInfo := pair.Value;
if funcInfo.Signatures.Count > 0 then
staticType := TTypes.CreateMethodSet(funcInfo.Signatures.ToArray)
else
staticType := nil;
AScope.Define(rtlName, funcInfo.DynamicWrapper, staticType, funcInfo.Doc);
end;
for constInfo in FStaticConstList do
AScope.Define(constInfo.Name, constInfo.Value, constInfo.StaticType, constInfo.Doc);
end;
procedure RegisterRtlFunctions(const AScope: IExecutionScope);
begin
TRtlRegistry.RegisterAll(AScope);
end;
initialization
// Register this library's functions with the central AST factory.
TRtlRegistry.Scan<TRtlCoreFunctions>;
TRtlRegistry.Scan<TRtlMathFunctions>;
TRtlRegistry.Scan<TRtlDateTimeFunctions>;
TRtlRegistry.Scan<TRtlSeriesFunctions>;
TAst.RegisterLibrary(RegisterRtlFunctions);
end.