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.Scope,
    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;

procedure RegisterRtlFunctions(const AScope: IExecutionScope);

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;
    public
        class procedure RegisterAll(const AScope: IExecutionScope); static;
    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;
    // The check for specific numeric kinds is no longer necessary,
    // as TScalar can only be Ordinal or Float.
    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;

                if method.MethodKind <> mkClassFunction 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;
                        // Build a factory that captures the method's name and CodeAddress.
                        var wrapperFactory :=
                            function(AName: string; CodeAddress: Pointer): TDataValue.TFunc
                            begin
                                Result :=
                                    function(const Args: TArray<TDataValue>): TDataValue
                                    var
                                        argScalar: TScalar;
                                    begin
                                        GetSingleNumericArg(AName, Args, argScalar);
                                        Result := TDataValue(TNativeScalarFunc(CodeAddress)(argScalar));
                                    end;
                            end;

                        wrapper := wrapperFactory(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;
                        // Build a factory that captures the method's CodeAddress.
                        var wrapperFactory :=
                            function(CodeAddress: Pointer): TDataValue.TFunc
                            begin
                                Result :=
                                    function(const Args: TArray<TDataValue>): TDataValue
                                    begin
                                        Result := TNativeDataValueFunc1(CodeAddress)(Args);
                                    end;
                            end;

                        // Create the wrapper
                        wrapper := wrapperFactory(method.CodeAddress);
                    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.CreateFmt('Native method wrapper for %s() not implemented', [method.Name]);
            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.