MycLib/Src/AST/Myc.Ast.Json.Schema.pas

unit Myc.Ast.Json.Schema;

interface

uses
    system.sysutils,
    system.classes,
    system.generics.collections,
    system.generics.defaults,
    system.rtti,
    system.typinfo,
    system.json,
    Myc.Data.Scalar,
    Myc.Data.Value,
    Myc.Ast.Nodes,
    Myc.Ast.Attributes,
    Myc.Ast.RTL,
    Myc.Ast.RTL.Core,
    Myc.Ast.Scope,
    Myc.Ast.Types,
    Myc.Ast.Script,
    Myc.Ast.Json;

type
    { Scans AST, RTL and Scope metadata to generate a context-aware LLM system prompt. }
    TAstSchema = class
    strict private
        type
            TRtlMeta = record
                Doc: string;
                Signatures: TArray<string>;
            end;

            TFieldInfo = record
                Idx: Integer;
                Name: string;
                Kind: TFieldKind;
            end;

        class function GetTsType(Kind: TFieldKind): string; static;
        class function TypeToTs(const AType: IStaticType): string; static;
        class function GetRtlMetadata: TDictionary<string, TRtlMeta>; static;
    public
        // Generates the TypeScript definition for AST nodes
        class function GenerateTypeScriptDefinition: string; static;

        // Unified section: Lists only symbols available in the current scope with their docs/types
        class function GenerateAvailableSymbols(const AScope: IExecutionScope): string; static;

        // Documentation for all RTL functions (used as fallback or for general prompts)
        class function GenerateAllRtlDocumentation: string; static;

        // Detailed generation rules
        class function GenerateGenerationRules: string; static;

        // The final consolidated system prompt for the AI
        class function GenerateFullSystemPrompt(const AScope: IExecutionScope = nil): string; static;
    end;

implementation

{ TAstSchema }

class function TAstSchema.GetTsType(Kind: TFieldKind): string;
begin
    case Kind of
        fkNode: Result := 'AstNode';
        fkTuple: Result := 'Tuple';
        fkString: Result := 'string';
        fkValue: Result := 'number | string | boolean';
        fkNullableNode: Result := 'AstNode | null';
        fkArrayOfPairs: Result := 'Array<[AstNode, AstNode]>';
    else
        Result := 'any';
    end;
end;

class function TAstSchema.TypeToTs(const AType: IStaticType): string;
begin
    if not Assigned(AType) then
        exit('any');

    case AType.Kind of
        stOrdinal, stFloat: Result := 'number';
        stBoolean: Result := 'boolean';
        stDateTime: Result := 'datetime';
        stText: Result := 'string';
        stKeyword: Result := 'keyword';
        stSeries: Result := Format('Series<%s>', [TypeToTs(AType.AsSeries.ElementType)]);
        stRecord:
        begin
            var def := AType.AsRecord.Definition;
            var fields := TList<string>.Create;
            try
                for var i := 0 to def.Count - 1 do
                    fields.Add(Format('%s: %s', [def.Keywords[i].Name, def[i].ToString.ToLower]));
                Result := '{ ' + string.Join(', ', fields.ToArray) + ' }';
            finally
                fields.Free;
            end;
        end;
        stRecordSeries: Result := 'Stream<' + TypeToTs(TTypes.CreateRecord(AType.AsRecord.Definition)) + '>';
        stMethod:
        begin
            if Length(AType.AsMethod.Signatures) = 0 then
                exit('function');
            var sig := AType.AsMethod.Signatures[0];
            var args := TList<string>.Create;
            try
                for var p in sig.ParamTypes do
                    args.Add(TypeToTs(p));
                Result := Format('(%s) => %s', [string.Join(', ', args.ToArray), TypeToTs(sig.ReturnType)]);
            finally
                args.Free;
            end;
        end;
    else
        Result := 'any';
    end;

    if AType.IsOptional then
        Result := Result + ' | null';
end;

class function TAstSchema.GetRtlMetadata: TDictionary<string, TRtlMeta>;
var
    ctx: TRttiContext;
    typ: TRttiType;
    meth: TRttiMethod;
    attr: TCustomAttribute;
    meta: TRtlMeta;
    rtlName: string;
    sigs: TList<string>;
begin
    Result := TDictionary<string, TRtlMeta>.Create;
    sigs := TList<string>.Create;
    try
        typ := ctx.GetType(TypeInfo(TRtlFunctions));
        for meth in typ.GetMethods do
        begin
            rtlName := '';
            meta.Doc := '';
            sigs.Clear;
            for attr in meth.GetAttributes do
            begin
                if attr is AstDocAttribute then
                    meta.Doc := AstDocAttribute(attr).Description;
                if attr is TRtlExportAttribute then
                    rtlName := TRtlExportAttribute(attr).Name;
                if attr is AstSignatureAttribute then
                    sigs.Add(AstSignatureAttribute(attr).Signature);
            end;
            if rtlName <> '' then
            begin
                meta.Signatures := sigs.ToArray;
                if Result.ContainsKey(rtlName) then
                begin
                    var existing := Result[rtlName];
                    var combinedSigs := TList<string>.Create;
                    combinedSigs.AddRange(existing.Signatures);
                    combinedSigs.AddRange(meta.Signatures);
                    existing.Signatures := combinedSigs.ToArray;
                    combinedSigs.Free;
                    Result[rtlName] := existing;
                end
                else
                    Result.Add(rtlName, meta);
            end;
        end;
    finally
        sigs.Free;
    end;
end;

class function TAstSchema.GenerateTypeScriptDefinition: string;
var
    ctx: TRttiContext;
    typ: TRttiType;
    attr: TCustomAttribute;
    nodeDefs: TDictionary<string, TList<TFieldInfo>>;
    nodeDocs: TDictionary<string, string>;
    nodeExamples: TDictionary<string, TList<string>>;
    unionTypes: TList<string>;
    sb: TStringBuilder;
    tag, doc: string;
    fieldList: TList<TFieldInfo>;
    exampleList: TList<string>;
    jsonConv: IJsonAstConverter;
    i: Integer;
begin
    ctx := TRttiContext.Create;
    jsonConv := TJsonAstConverter.Create;
    nodeDefs := TDictionary<string, TList<TFieldInfo>>.Create;
    nodeDocs := TDictionary<string, string>.Create;
    nodeExamples := TDictionary<string, TList<string>>.Create;
    unionTypes := TList<string>.Create;
    sb := TStringBuilder.Create;
    try
        for typ in ctx.GetTypes do
        begin
            if typ.TypeKind <> tkInterface then
                continue;
            tag := '';
            doc := '';
            fieldList := nil;
            exampleList := nil;
            for attr in typ.GetAttributes do
            begin
                if attr is AstTagAttribute then
                    tag := AstTagAttribute(attr).Tag;
                if attr is AstDocAttribute then
                    doc := AstDocAttribute(attr).Description;
                if attr is AstScriptExampleAttribute then
                begin
                    if exampleList = nil then
                        exampleList := TList<string>.Create;
                    try
                        var node := TAstScript.Parse(AstScriptExampleAttribute(attr).Script);
                        var jsonVal := jsonConv.Serialize(node);
                        try
                            exampleList.Add(jsonVal.ToJSON);
                        finally
                            jsonVal.Free;
                        end;
                    except
                        on E: Exception do
                            exampleList.Add('/* Error in example */');
                    end;
                end;
                if attr is AstFieldAttribute then
                begin
                    if fieldList = nil then
                        fieldList := TList<TFieldInfo>.Create;
                    var f: TFieldInfo;
                    f.Idx := AstFieldAttribute(attr).Index;
                    f.Name := AstFieldAttribute(attr).Name;
                    f.Kind := AstFieldAttribute(attr).Kind;
                    fieldList.Add(f);
                end;
            end;
            if tag <> '' then
            begin
                unionTypes.Add(tag);
                if doc <> '' then
                    nodeDocs.Add(tag, doc);
                if exampleList <> nil then
                    nodeExamples.Add(tag, exampleList);
                if fieldList = nil then
                    fieldList := TList<TFieldInfo>.Create;
                nodeDefs.Add(tag, fieldList);
            end
            else
            begin
                fieldList.Free;
                exampleList.Free;
            end;
        end;
        sb.AppendLine('// AST Schema Definition' + sLineBreak + '// Format: Compact JSON Arrays [Tag, Arg1, Arg2, ...]' + sLineBreak);
        unionTypes.Sort;
        sb.AppendLine('type AstNode = ');
        for i := 0 to unionTypes.Count - 1 do
        begin
            sb.Append('  | ' + unionTypes[i]);
            if i < unionTypes.Count - 1 then
                sb.AppendLine;
        end;
        sb.AppendLine(
            ';'
                + sLineBreak
                + sLineBreak
                + '/** Explicit list structure */'
                + sLineBreak
                + 'type Tuple = ["Tuple", AstNode[]];'
                + sLineBreak
        );
        for tag in unionTypes do
        begin
            if tag = 'Tuple' then
                continue;
            sb.Append('/** ');
            if nodeDocs.TryGetValue(tag, doc) then
                sb.Append(doc);
            if nodeExamples.TryGetValue(tag, exampleList) then
                for var ex in exampleList do
                    sb.Append(sLineBreak + '    @example ' + ex);
            sb.AppendLine(' */');
            fieldList := nodeDefs[tag];
            fieldList.Sort(TComparer<TFieldInfo>.Construct(function(const L, R: TFieldInfo): Integer begin Result := L.Idx - R.Idx; end));
            sb.Append('type ' + tag + ' = ["' + tag + '"');
            for var f in fieldList do
                sb.Append(Format(', %s /* %s */', [GetTsType(f.Kind), f.Name]));
            sb.AppendLine('];');
        end;
        Result := sb.ToString;
    finally
        for fieldList in nodeDefs.Values do
            fieldList.Free;
        for exampleList in nodeExamples.Values do
            exampleList.Free;
        nodeDefs.Free;
        nodeDocs.Free;
        nodeExamples.Free;
        unionTypes.Free;
        sb.Free;
        ctx.Free;
    end;
end;

class function TAstSchema.GenerateAvailableSymbols(const AScope: IExecutionScope): string;
var
    sb: TStringBuilder;
    rtlMeta: TDictionary<string, TRtlMeta>;
    layout: IScopeLayout;
    symbols: TArray<string>;
    name: string;
    meta: TRtlMeta;
    typ: IStaticType;
begin
    if not Assigned(AScope) then
        exit('');

    rtlMeta := GetRtlMetadata;
    sb := TStringBuilder.Create;
    try
        layout := AScope.Descriptor.Layout;
        symbols := layout.GetSymbols;
        TArray.Sort<string>(symbols);

        sb.AppendLine('### 3. Available Symbols (Environment & Library)');
        sb.AppendLine('The following symbols are currently defined and can be used in your script:');
        sb.AppendLine;

        for name in symbols do
        begin
            if name.StartsWith('<') or name.EndsWith('>') then
                continue;

            sb.Append(Format('- `%s`', [name]));

            if rtlMeta.TryGetValue(name, meta) then
            begin
                if Length(meta.Signatures) > 0 then
                    sb.Append(': ' + string.Join(' | ', meta.Signatures));
                if meta.Doc <> '' then
                    sb.Append(' — ' + meta.Doc);
            end
            else
            begin
                typ := AScope.Descriptor.GetSymbolType(layout.FindSlot(name));
                sb.Append(': ' + TypeToTs(typ));
            end;
            sb.AppendLine;
        end;
        Result := sb.ToString;
    finally
        sb.Free;
        rtlMeta.Free;
    end;
end;

class function TAstSchema.GenerateAllRtlDocumentation: string;
var
    rtlMeta: TDictionary<string, TRtlMeta>;
    sb: TStringBuilder;
    pair: TPair<string, TRtlMeta>;
begin
    rtlMeta := GetRtlMetadata;
    sb := TStringBuilder.Create;
    try
        sb.AppendLine('### 3. Runtime Library (Global Functions)');
        sb.AppendLine;
        for pair in rtlMeta do
        begin
            sb.Append(Format('- `%s`', [pair.Key]));
            if Length(pair.Value.Signatures) > 0 then
                sb.Append(': ' + string.Join(' | ', pair.Value.Signatures));
            if pair.Value.Doc <> '' then
                sb.Append(' — ' + pair.Value.Doc);
            sb.AppendLine;
        end;
        Result := sb.ToString;
    finally
        sb.Free;
        rtlMeta.Free;
    end;
end;

class function TAstSchema.GenerateGenerationRules: string;
begin
    Result :=
        '''
    **⚠️ CRITICAL GENERATION RULES:**

    1. **NO JSON OBJECTS:** Do not use `{}`. Every node MUST be a JSON Array `["Tag", Arg1, Arg2]`.
    2. **EXPLICIT TUPLES:** Fields defined as `Tuple` MUST be wrapped in `["Tuple", [...]]`.
    3. **EXPLICIT NULLS:** Optional fields (`| null`) MUST be explicit `null` if not present.
    4. **STRICT ORDER:** Array elements must follow the schema index exactly.
    5. **OPERATORS:** Use `Call` with an `Id` for operators: `["Call", ["Id", "+"], ["Tuple", [["Const", 1], ["Const", 2]]]]`.
    6. **ID VS KEY:** Use `Key` for record keys. Use `Id` for variables, functions, and operators.
    7. **BOOLEANS:** The literals `true` and `false` are identifiers: `["Id", "true"]` or `["Id", "false"]`.
    8. **SCALAR TYPES:** Valid types for series definitions are: `:Ordinal`, `:Float`, `:Boolean`, `:Text`, `:DateTime`.
    9. **NESTED ARRAYS:** In "Cond", the pairs are an array of arrays: `[ [cond1, branch1], [cond2, branch2] ]`.
    10. **RECURSION:** Use `Recur` for tail-recursive calls to enable optimization.
    11. **NO COMMENTS:** Output raw JSON only.
    ''';
end;

class function TAstSchema.GenerateFullSystemPrompt(const AScope: IExecutionScope): string;
begin
    Result :=
        '''
    You are a compiler frontend for a domain-specific scripting language.
    Your task is to generate a valid Abstract Syntax Tree (AST) in a specific Compact JSON format.

    ### 1. AST Schema (TypeScript Definition)
    '''
            + sLineBreak
            + GenerateTypeScriptDefinition
            + sLineBreak
            + '### 2. Constraints & Rules'
            + sLineBreak
            + GenerateGenerationRules
            + sLineBreak;

    if Assigned(AScope) then
        Result := Result + GenerateAvailableSymbols(AScope)
    else
        Result := Result + GenerateAllRtlDocumentation;
end;

end.