220 lines
6.5 KiB
ObjectPascal
220 lines
6.5 KiB
ObjectPascal
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;
|
|
|
|
type
|
|
TAstSchema = class
|
|
public
|
|
// Generates the TypeScript definition by scanning classes via RTTI
|
|
class function GenerateTypeScriptDefinition: string;
|
|
|
|
// Static rules for the format
|
|
class function GenerateGenerationRules: string;
|
|
|
|
// Combined prompt
|
|
class function GenerateFullSystemPrompt: string;
|
|
end;
|
|
|
|
implementation
|
|
|
|
type
|
|
// Helper structure to collect fields per type
|
|
// Moved here to avoid scope issues with generics
|
|
TFieldInfo = record
|
|
Idx: Integer;
|
|
Def: string;
|
|
end;
|
|
|
|
{ TAstSchema }
|
|
|
|
class function TAstSchema.GenerateTypeScriptDefinition: string;
|
|
var
|
|
ctx: TRttiContext;
|
|
types: TArray<TRttiType>;
|
|
typ: TRttiType;
|
|
attr: TCustomAttribute;
|
|
fieldAttr: AstFieldAttribute;
|
|
nodeDefs: TDictionary<string, TList<TFieldInfo>>;
|
|
unionTypes: TList<string>;
|
|
fieldsList: TList<TFieldInfo>;
|
|
sb: TStringBuilder;
|
|
tag: string;
|
|
fieldInfo: TFieldInfo;
|
|
f: TRttiField;
|
|
i: Integer;
|
|
|
|
function 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;
|
|
|
|
begin
|
|
ctx := TRttiContext.Create;
|
|
nodeDefs := TDictionary<string, TList<TFieldInfo>>.Create;
|
|
unionTypes := TList<string>.Create;
|
|
sb := TStringBuilder.Create;
|
|
|
|
try
|
|
// 1. Scan all types in the application context
|
|
types := ctx.GetTypes;
|
|
|
|
for typ in types do
|
|
begin
|
|
if not typ.IsInstance then
|
|
Continue;
|
|
|
|
// Check for [AstTag] attribute on the class
|
|
tag := '';
|
|
for attr in typ.GetAttributes do
|
|
if attr is AstTagAttribute then
|
|
begin
|
|
tag := AstTagAttribute(attr).Tag;
|
|
Break;
|
|
end;
|
|
|
|
if tag = '' then
|
|
Continue;
|
|
|
|
if not nodeDefs.ContainsKey(tag) then
|
|
begin
|
|
nodeDefs.Add(tag, TList<TFieldInfo>.Create);
|
|
unionTypes.Add(tag);
|
|
end;
|
|
|
|
fieldsList := nodeDefs[tag];
|
|
|
|
// Scan Fields (Variables) of the class
|
|
for f in typ.AsInstance.GetFields do
|
|
begin
|
|
for attr in f.GetAttributes do
|
|
if attr is AstFieldAttribute then
|
|
begin
|
|
fieldAttr := AstFieldAttribute(attr);
|
|
|
|
fieldInfo.Idx := fieldAttr.Index;
|
|
fieldInfo.Def := GetTsType(fieldAttr.Kind) + ' /*' + fieldAttr.Name + '*/';
|
|
|
|
fieldsList.Add(fieldInfo);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// 2. Build the output
|
|
sb.AppendLine('// AST Schema Definition (Auto-Generated via RTTI)');
|
|
sb.AppendLine('// Format: Compact JSON Arrays [Tag, Arg1, Arg2, ...]');
|
|
sb.AppendLine;
|
|
|
|
unionTypes.Sort;
|
|
|
|
// Union Type Definition
|
|
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('type Tuple = ["Tuple", AstNode[]];');
|
|
sb.AppendLine;
|
|
|
|
// Node Definitions
|
|
for tag in unionTypes do
|
|
begin
|
|
// Tuple is special base type
|
|
if tag = 'Tuple' then
|
|
Continue;
|
|
|
|
fieldsList := nodeDefs[tag];
|
|
|
|
// Sort fields by Index to ensure correct JSON array order
|
|
fieldsList.Sort(TComparer<TFieldInfo>.Construct(function(const L, R: TFieldInfo): Integer begin Result := L.Idx - R.Idx; end));
|
|
|
|
sb.Append('type ' + tag + ' = ["' + tag + '"');
|
|
|
|
for fieldInfo in fieldsList do
|
|
sb.Append(', ' + fieldInfo.Def);
|
|
|
|
sb.AppendLine('];');
|
|
end;
|
|
|
|
Result := sb.ToString;
|
|
|
|
finally
|
|
// Clean up lists in dictionary
|
|
for tag in nodeDefs.Keys do
|
|
nodeDefs[tag].Free;
|
|
|
|
nodeDefs.Free;
|
|
unionTypes.Free;
|
|
sb.Free;
|
|
ctx.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TAstSchema.GenerateGenerationRules: string;
|
|
var
|
|
sb: TStringBuilder;
|
|
begin
|
|
// These rules describe the PROTOCOL (Compact Arrays), not the content.
|
|
// They remain static unless you change TJsonAstConverter logic significantly.
|
|
sb := TStringBuilder.Create;
|
|
try
|
|
sb.AppendLine('**⚠️ CRITICAL GENERATION RULES:**');
|
|
sb.AppendLine;
|
|
sb.AppendLine('1. **NO JSON OBJECTS:** Do not use `{ "key": "value" }`. Every node MUST be a JSON Array `["Tag", Arg1, Arg2]`.');
|
|
sb.AppendLine(
|
|
'2. **EXPLICIT TUPLES:** Whenever a field in the schema is defined as `Tuple`, you MUST wrap the list in a `["Tuple", [...]]` node.'
|
|
);
|
|
sb.AppendLine(
|
|
'3. **EXPLICIT NULLS:** Optional fields (marked as `| null`) MUST be explicit `null` if not present. Do not omit them.'
|
|
);
|
|
sb.AppendLine('4. **STRICT ORDER:** The order of elements in the array is fixed defined by the schema. Never swap arguments.');
|
|
|
|
Result := sb.ToString;
|
|
finally
|
|
sb.Free;
|
|
end;
|
|
end;
|
|
|
|
class function TAstSchema.GenerateFullSystemPrompt: string;
|
|
begin
|
|
// Combine everything
|
|
Result :=
|
|
'You are a compiler frontend for the "Myc" 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;
|
|
end;
|
|
|
|
end.
|