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

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,
    Myc.Data.Scalar,
    Myc.Data.Value,
    Myc.Ast,
    Myc.Ast.Nodes;

type
    // This attribute is used by the RTTI-based registry to identify
    // and register native functions in the runtime scope.
    TRtlFunctionAttribute = class(TCustomAttribute)
    public
        Name: string;
        constructor Create(const AName: string);
    end;

implementation

uses
    System.Rtti,
    System.TypInfo,
    Myc.Ast.RTL.Core;

//--------------------------------------------------------------------------------------------------
//== Native Function Implementation (Core Logic)
//--------------------------------------------------------------------------------------------------

constructor TRtlFunctionAttribute.Create(const AName: string);
begin
    inherited Create;
    Self.Name := AName;
end;

//--------------------------------------------------------------------------------------------------
//== Library Registration (RTTI-based)
//--------------------------------------------------------------------------------------------------

type
    // Defines a pointer to the static class function signature for scalar->scalar functions.
    TNativeScalarFunc = function(Arg: TScalar): TScalar;

    // A helper record to encapsulate the RTTI-based registration logic.
    TRtlRegistry = record
    private
        class function GetSingleNumericArg(
            const AName: string;
            const AArgs: TArray<TDataValue>;
            out AArg: TScalar
        ): Boolean; static; inline;
        class function CreateScalarWrapper(AFuncName: string; AFuncPtr: Pointer): TDataValue.TFunc; static;
    public
        class procedure RegisterAll(const AScope: IExecutionScope); static;
    end;

// This is the "Wrapper Generator" for the (TScalar):TScalar signature.
// It creates a high-performance anonymous method that uses a direct function pointer.
class function TRtlRegistry.CreateScalarWrapper(AFuncName: string; AFuncPtr: Pointer): TDataValue.TFunc;
var
    // Statically typed pointer to the native function.
    nativeFunc: TNativeScalarFunc;
begin
    nativeFunc := AFuncPtr;

    // This is the generated wrapper that will be registered with the interpreter.
    Result :=
        function(const Args: TArray<TDataValue>): TDataValue
        var
            argScalar: TScalar;
        begin
            // 1. Optimized argument validation and unpacking.
            GetSingleNumericArg(AFuncName, Args, argScalar);

            // 2. Direct, statically typed call via pointer.
            Result := TDataValue(nativeFunc(argScalar));
        end;
end;

{ TRtlRegistry }

class function TRtlRegistry.GetSingleNumericArg(const AName: string; const AArgs: TArray<TDataValue>; out AArg: TScalar): Boolean;
begin
    // This is the validation logic used by the generated wrappers.
    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;

// Main registration method. Uses RTTI to find and register all functions from TRtlFunctions.
class procedure TRtlRegistry.RegisterAll(const AScope: IExecutionScope);
type
    TNativeDataValueFunc1 = function(const Args: TArray<TDataValue>): TDataValue;
var
    ctx: TRttiContext;
    rtlType: TRttiType;
    method: TRttiMethod;
    attribute: TCustomAttribute;
    rtlAttribute: TRtlFunctionAttribute;
    param: TRttiParameter;
    wrapper: TDataValue.TFunc;
begin
    ctx := TRttiContext.Create;
    try
        rtlType := ctx.GetType(TypeInfo(TRtlFunctions));
        for method in rtlType.GetMethods do
        begin
            // Find functions marked with our custom attribute
            for attribute in method.GetAttributes do
            begin
                if not (attribute is TRtlFunctionAttribute) then
                    continue;

                rtlAttribute := attribute as TRtlFunctionAttribute;
                wrapper := nil;

                // --- Signature Dispatcher ---
                // Decide which wrapper to generate based on the method signature.
                if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TScalar)) then
                begin
                    param := method.GetParameters[0];
                    if param.ParamType.Handle = TypeInfo(TScalar) then
                    begin
                        // Signature matches: class function(Arg: TScalar): TScalar;
                        wrapper := CreateScalarWrapper(rtlAttribute.Name, method.CodeAddress);
                    end;
                end
                else if (Length(method.GetParameters) = 1) and (method.ReturnType.Handle = TypeInfo(TDataValue)) then
                begin
                    param := method.GetParameters[0];
                    if (pfConst in param.Flags) and (param.ParamType.Handle = TypeInfo(TArray<TDataValue>)) then
                    begin
                        // Signature matches: class function(const Args: TArray<TDataValue>): TDataValue;
                        // For these, we can just cast the pointer directly. No wrapper needed.
                        wrapper :=
                            function(const Args: TArray<TDataValue>): TDataValue
                            begin
                                Result := TNativeDataValueFunc1(method.CodeAddress)(Args);
                            end;
                    end;
                end;

                if Assigned(wrapper) then
                begin
                    AScope.Define(rtlAttribute.Name, TDataValue(wrapper));
                    break; // Found our attribute, proceed to next method
                end
                else
                    raise ENotImplemented.Create('Native method wrapper not implemented');
            end;
        end;
    finally
        ctx.Free;
    end;
end;

procedure RegisterRtlFunctions(const AScope: IExecutionScope);
begin
    TRtlRegistry.RegisterAll(AScope);
end;

initialization
    // Register this library's functions with the central AST factory.
    TAst.RegisterLibrary(RegisterRtlFunctions);

end.