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,
    Myc.Ast.Nodes,
    Myc.Ast.Attributes,
    Myc.Ast.RTL,
    Myc.Ast.RTL.Core;

type
    { Scans AST and RTL metadata to generate a high-precision LLM system prompt. }
    TAstSchema = class
    strict private
        type
            TFieldInfo = record
                Idx: Integer;
                Name: string;
                Kind: TFieldKind;
            end;

        class function GetTsType(Kind: TFieldKind): string; static;
    public
        // Generates the TypeScript definition including JSDoc and multiple @example entries
        class function GenerateTypeScriptDefinition: string; static;

        // Generates documented RTL function signatures with all overloads
        class function GenerateRtlDocumentation: string; static;

        // Detailed generation rules to eliminate ambiguity
        class function GenerateGenerationRules: string; static;

        // The final consolidated system prompt
        class function GenerateFullSystemPrompt: 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.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>;
    i: Integer;
begin
    ctx := TRttiContext.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 AstExampleAttribute then
                begin
                    if exampleList = nil then
                        exampleList := TList<string>.Create;
                    exampleList.Add(AstExampleAttribute(attr).Example);
                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 (Auto-Generated)');
        sb.AppendLine('// Format: Compact JSON Arrays [Tag, Arg1, Arg2, ...]');
        sb.AppendLine;

        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(';');
        sb.AppendLine;

        sb.AppendLine('/** Explicit list structure */');
        sb.AppendLine('type Tuple = ["Tuple", AstNode[]];');
        sb.AppendLine;

        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
            begin
                for var ex in exampleList do
                    sb.Append(sLineBreak + '    @example ' + ex);
            end;
            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.GenerateRtlDocumentation: string;
var
    ctx: TRttiContext;
    typ: TRttiType;
    meth: TRttiMethod;
    attr: TCustomAttribute;
    doc, rtlName: string;
    sigs: TList<string>;
    sb: TStringBuilder;
    processedNames: THashSet<string>;
begin
    ctx := TRttiContext.Create;
    sb := TStringBuilder.Create;
    sigs := TList<string>.Create;
    processedNames := THashSet<string>.Create;
    try
        typ := ctx.GetType(TypeInfo(TRtlFunctions));
        sb.AppendLine('### 3. Runtime Library (Available Functions)');
        sb.AppendLine;

        for meth in typ.GetMethods do
        begin
            doc := '';
            rtlName := '';
            sigs.Clear;

            for attr in meth.GetAttributes do
            begin
                if attr is AstDocAttribute then
                    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 <> '') and (not processedNames.Contains(rtlName)) then
            begin
                sb.Append(Format('- `%s`', [rtlName]));
                if sigs.Count > 0 then
                    sb.Append(': ' + string.Join(' | ', sigs.ToArray));
                if doc <> '' then
                    sb.Append(' — ' + doc);
                sb.AppendLine;
                processedNames.Add(rtlName);
            end;
        end;
        Result := sb.ToString;
    finally
        processedNames.Free;
        sigs.Free;
        sb.Free;
        ctx.Free;
    end;
end;

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

        Result := sb.ToString;
    finally
        sb.Free;
    end;
end;

class function TAstSchema.GenerateFullSystemPrompt: string;
begin
    Result :=
        'You are a compiler frontend for a domain-specific scripting language.'
            + sLineBreak
            + 'Your task is to generate a valid Abstract Syntax Tree (AST) in a specific Compact JSON format.'
            + sLineBreak
            + sLineBreak
            + '### 1. AST Schema (TypeScript Definition)'
            + sLineBreak
            + GenerateTypeScriptDefinition
            + sLineBreak
            + '### 2. Constraints & Rules'
            + sLineBreak
            + GenerateGenerationRules
            + sLineBreak
            + GenerateRtlDocumentation;
end;

end.