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.Scope,
    Myc.Ast.Types,
    Myc.Ast.Script,
    Myc.Ast.Json,
    Myc.Ast;

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

        class function GetTsType(Kind: TFieldKind): string; static;
        class function TypeToTs(const AType: IStaticType): string; static;
    public
        // Generates the TypeScript definition for AST nodes using RTTI on the Node Interfaces
        class function GenerateTypeScriptDefinition: string; static;

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

        // Generates documentation for the standard library by creating a temporary scope.
        class function GenerateAllRtlDocumentation: string; static;

        // Detailed generation rules for the LLM
        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
        stUnknown: Result := 'any';
        stVoid: Result := 'void';
        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
                begin
                    var k := def.Keywords[i].Name;
                    var tStr: string;
                    case def[i] of
                        TScalar.TKind.Ordinal, TScalar.TKind.Float: tStr := 'number';
                        TScalar.TKind.Boolean: tStr := 'boolean';
                        TScalar.TKind.DateTime: tStr := 'datetime';
                        TScalar.TKind.Keyword: tStr := 'keyword';
                    else
                        tStr := 'any';
                    end;
                    fields.Add(Format('%s: %s', [k, tStr]));
                end;
                Result := '{ ' + string.Join(', ', fields.ToArray) + ' }';
            finally
                fields.Free;
            end;
        end;

        stGenericRecord:
        begin
            var def := AType.AsGenericRecord.GenericDefinition;
            var fields := TList<string>.Create;
            try
                for var i := 0 to def.Count - 1 do
                    fields.Add(Format('%s: %s', [def.Keywords[i].Name, TypeToTs(def[i])]));
                Result := '{ ' + string.Join(', ', fields.ToArray) + ' }';
            finally
                fields.Free;
            end;
        end;

        stRecordSeries: Result := 'Stream<' + TypeToTs(TTypes.CreateRecord(AType.AsRecord.Definition)) + '>';

        stTuple:
        begin
            var elems := AType.AsTuple.Elements;
            var elemStrings := TList<string>.Create;
            try
                for var t in elems do
                    elemStrings.Add(TypeToTs(t));
                Result := '[' + string.Join(', ', elemStrings.ToArray) + ']';
            finally
                elemStrings.Free;
            end;
        end;

        stVector: Result := TypeToTs(AType.AsVector.ElementType) + '[]';

        stMatrix:
        begin
            var dims := AType.AsMatrix.Dimensions;
            Result := TypeToTs(AType.AsMatrix.ElementType);
            for var k := 0 to High(dims) do
                Result := Result + '[]';
        end;

        stMethod:
        begin
            var signatures := AType.AsMethod.Signatures;
            if Length(signatures) = 0 then
                exit('function');

            var sigStrings := TList<string>.Create;
            try
                for var sig in signatures do
                begin
                    var args := TList<string>.Create;
                    try
                        for var p in sig.ParamTypes do
                            args.Add(TypeToTs(p));

                        var s := Format('(%s) => %s', [string.Join(', ', args.ToArray), TypeToTs(sig.ReturnType)]);

                        // Deduplicate: If multiple RTL overloads map to the same TS signature, only show it once.
                        if not sigStrings.Contains(s) then
                            sigStrings.Add(s);
                    finally
                        args.Free;
                    end;
                end;
                Result := string.Join(' | ', sigStrings.ToArray);
            finally
                sigStrings.Free;
            end;
        end;
    else
        Result := 'any';
    end;

    if AType.IsOptional then
        Result := Result + ' | null';
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
                        // Parse example script to ensure valid JSON output in documentation
                        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: ' + E.Message + ' */');
                    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;
    layout: IScopeLayout;
    descriptor: IScopeDescriptor;
    symbols: TArray<string>;
    name, doc: string;
    typ: IStaticType;
    slot: Integer;
begin
    if not Assigned(AScope) then
        exit('');

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

        sb.AppendLine('### 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
            // Filter internal compiler symbols
            if name.StartsWith('<') or name.EndsWith('>') then
                continue;

            slot := layout.FindSlot(name);
            typ := descriptor.GetSymbolType(slot);
            doc := layout.GetSymbolDoc(name);

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

            if (typ <> nil) then
                sb.Append(': ' + TypeToTs(typ));

            if doc <> '' then
                sb.Append(' — ' + doc);

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

class function TAstSchema.GenerateAllRtlDocumentation: string;
begin
    // Create a temporary root scope.
    // The True parameter triggers the registration of all standard libraries (RTL).
    // This populates the scope with function definitions and their documentation strings.
    var tempScope := TAst.CreateScope(nil, nil, True);
    Result := GenerateAvailableSymbols(tempScope);
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.

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

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

end.