Json Schema WIP

This commit is contained in:
Michael Schimmel
2026-01-07 15:14:54 +01:00
parent 108b47e059
commit a25fec38f8
8 changed files with 639 additions and 412 deletions
File diff suppressed because one or more lines are too long
+3 -2
View File
@@ -43,8 +43,9 @@ uses
Myc.Fmx.AstEditor.Handlers.Pipes in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas',
Demo.Finance in '..\Test\Demo.Finance.pas',
Myc.Ast.Script.Print in '..\Src\AST\Myc.Ast.Script.Print.pas',
Myc.Ast.Json.Schema in '..\Src\AST\Myc.Ast.Json.Schema.pas',
Myc.Ast.Attributes in 'Myc.Ast.Attributes.pas';
Myc.Ast.Json.Schema.Old in '..\Src\AST\Myc.Ast.Json.Schema.Old.pas',
Myc.Ast.Attributes in 'Myc.Ast.Attributes.pas',
Myc.Ast.Json.Schema in '..\Src\AST\Myc.Ast.Json.Schema.pas';
{$R *.res}
+2 -1
View File
@@ -173,8 +173,9 @@
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.Pipes.pas"/>
<DCCReference Include="..\Test\Demo.Finance.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Script.Print.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Json.Schema.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Json.Schema.Old.pas"/>
<DCCReference Include="Myc.Ast.Attributes.pas"/>
<DCCReference Include="..\Src\AST\Myc.Ast.Json.Schema.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
+4 -1
View File
@@ -288,7 +288,10 @@ begin
CompilerStageBox.BringToFront;
ClearButtonClick(Self);
Memo1.Lines.Add(TAstSchema.GenerateFullSystemPrompt(FEnvironment.RootScope));
// Memo1.Lines.Add(TAstSchema.GenerateFullSystemPrompt(FEnvironment.RootScope));
// "Dieses JSON-Objekt betest du in das Feld response_schema (Gemini) oder json_schema (OpenAI) ein."
Memo1.Lines.Add(TAstSchema.GenerateFullSchema.ToJSON);
end;
procedure TForm1.ShowVizualization;
+10 -4
View File
@@ -8,12 +8,18 @@ uses
type
{ Defines the content type for the LLM schema generation. }
TFieldKind = (
fkNode, // IAstNode (recursive structure)
fkTuple, // ITupleNode (explicit ["Tuple", [...]] structure)
fkNode, // Node (recursive structure)
fkIdentifier, // Identifier ["Id", "name"]
fkKeyword, // Keyword literal ["Key", "name"]
fkLambda, // Lambda definition ["Fn", [...], body]
fkTuple, // Tuple (explicit ["Tuple", [...]] structure)
fkString, // Raw String (for identifiers/names)
fkValue, // TDataValue (primitive constants like number, string, boolean)
fkNullableNode, // Optional Node (emits 'AstNode | null' in TypeScript)
fkArrayOfPairs // Special structure for CondExpr: [[Cond, Branch], ...]
fkNullableNode, // Optional Node ('AstNode | null')
fkArrayOfNodes, // Raw Array of Nodes (used inside Tuple)
fkArrayOfPairs, // Special structure for CondExpr: [[Cond, Branch], ...]
fkArrayOfKeys, // Special structure for an array of keywords
fkPipeInputs // Specific structure: ["Tuple", [ ["Tuple", [Id, Tuple]], ... ]]
);
{ AstTagAttribute: Defines the JSON Tag for an AST Node. }
+424
View File
@@ -0,0 +1,424 @@
unit Myc.Ast.Json.Schema.Old;
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.
+167 -362
View File
@@ -1,4 +1,4 @@
unit Myc.Ast.Json.Schema;
unit Myc.Ast.Json.Schema;
interface
@@ -8,417 +8,222 @@ uses
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. }
{ Generates JSON schema for Structured Output based on AST RTTI. }
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;
private
class function GetJsonType(Kind: TFieldKind): TJSONObject; 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;
{ Generates a complete JSON schema for LLM structured output APIs. }
class function GenerateFullSchema: TJSONObject; static;
end;
implementation
{ TAstSchema }
class function TAstSchema.GetTsType(Kind: TFieldKind): string;
class function TAstSchema.GetJsonType(Kind: TFieldKind): TJSONObject;
{$region 'helpers'}
function JRef(const APath: string): TJSONObject;
begin
Result := TJSONObject.Create;
Result.AddPair('$ref', APath);
end;
function JDefRef(const ATag: string): TJSONObject;
begin
Result := JRef('#/$defs/' + ATag);
end;
function JType(const ATypeName: string): TJSONObject;
begin
Result := TJSONObject.Create;
Result.AddPair('type', ATypeName);
end;
function JConst(const AVal: string): TJSONObject;
begin
Result := TJSONObject.Create;
Result.AddPair('const', AVal);
end;
function JArray(AItems: TJSONValue): TJSONObject;
begin
Result := JType('array');
Result.AddPair('items', AItems);
end;
// Combined function: Creates array from items and sets prefixItems + limits
function JFixedArray(const AItems: array of TJSONValue): TJSONObject;
var
arr: TJSONArray;
item: TJSONValue;
count: Integer;
begin
Result := JType('array');
arr := TJSONArray.Create;
for item in AItems do
arr.AddElement(item);
count := arr.Count;
Result.AddPair('prefixItems', arr);
Result.AddPair('minItems', TJSONNumber.Create(count));
Result.AddPair('maxItems', TJSONNumber.Create(count));
end;
function JTuple(AItems: TJSONValue): TJSONObject;
begin
Result := JFixedArray([JConst('Tuple'), AItems]);
end;
function JAnyOf(AOptions: array of TJSONValue): TJSONObject;
var
arr: TJSONArray;
opt: TJSONValue;
begin
arr := TJSONArray.Create;
for opt in AOptions do
arr.AddElement(opt);
Result := TJSONObject.Create;
Result.AddPair('anyOf', arr);
end;
{$endregion}
var
pair, selItems, selTuple, entryContent, entryNode: TJSONObject;
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;
fkNode: Result := JDefRef('Node');
fkTuple: Result := JDefRef('Tuple');
fkKeyword: Result := JDefRef('Key');
fkLambda: Result := JDefRef('Fn');
fkIdentifier: Result := JDefRef('Id');
fkString: Result := JType('string');
fkValue: Result := JAnyOf([JType('number'), JType('string'), JType('boolean')]);
fkNullableNode: Result := JAnyOf([JDefRef('Node'), JType('null')]);
fkArrayOfNodes: Result := JArray(JDefRef('Node'));
class function TAstSchema.TypeToTs(const AType: IStaticType): string;
fkArrayOfPairs:
begin
if not Assigned(AType) then
exit('any');
// [[Cond, Branch], ...]
pair := JFixedArray([JDefRef('Node'), JDefRef('Node')]);
Result := JArray(pair);
end;
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:
fkPipeInputs:
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;
// 1. Selector Tuple: ["Tuple", [Key, ...]]
selTuple := JTuple(JArray(JDefRef('Key')));
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;
// 2. Entry Node: ["Tuple", [Id, SelectorTuple]]
entryNode := JTuple(JFixedArray([JDefRef('Id'), selTuple]));
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;
// 3. Outer Inputs List: ["Tuple", [EntryNode, ...]]
Result := JTuple(JArray(entryNode));
end;
else
Result := 'any';
Result := TJSONObject.Create;
end;
end;
if AType.IsOptional then
Result := Result + ' | null';
end;
class function TAstSchema.GenerateTypeScriptDefinition: string;
class function TAstSchema.GenerateFullSchema: TJSONObject;
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;
defs, nodeDef, astNodeRef: TJSONObject;
anyOfNodes: TJSONArray;
tag: string;
fields: TList<AstFieldAttribute>;
minCount, maxCount: 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;
Result := TJSONObject.Create;
defs := TJSONObject.Create;
anyOfNodes := TJSONArray.Create;
try
// 1. Scan all interfaces for AstTag metadata
for typ in ctx.GetTypes do
begin
if typ.TypeKind <> tkInterface then
continue;
tag := '';
doc := '';
fieldList := nil;
exampleList := nil;
fields := TList<AstFieldAttribute>.Create;
try
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);
fields.Add(AstFieldAttribute(attr));
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
if tag = '' 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('];');
// Sort fields by index
fields.Sort(
TComparer<AstFieldAttribute>
.Construct(function(const L, R: AstFieldAttribute): Integer begin Result := L.Index - R.Index; end)
);
nodeDef := TJSONObject.Create;
nodeDef.AddPair('type', 'array');
var items := TJSONArray.Create;
items.AddElement(TJSONObject.Create.AddPair('const', tag));
minCount := 1;
maxCount := 1;
for var f in fields do
begin
inc(maxCount);
// Only non-nullable fields increase minCount
if f.Kind <> fkNullableNode then
minCount := maxCount;
items.AddElement(GetJsonType(f.Kind));
end;
Result := sb.ToString;
nodeDef.AddPair('prefixItems', items);
nodeDef.AddPair('minItems', TJSONNumber.Create(minCount));
nodeDef.AddPair('maxItems', TJSONNumber.Create(maxCount));
// additionalItems removed as maxItems guarantees strictness
defs.AddPair(tag, nodeDef);
// Add reference to the global AstNode union
astNodeRef := TJSONObject.Create;
astNodeRef.AddPair('$ref', '#/$defs/' + tag);
anyOfNodes.AddElement(astNodeRef);
finally
fields.Free;
end;
end;
// 2. Define the base AstNode anyOf union
var astNodeBase := TJSONObject.Create;
astNodeBase.AddPair('anyOf', anyOfNodes);
defs.AddPair('Node', astNodeBase);
// 3. Assemble final Root Object
Result.AddPair('$ref', '#/$defs/Node');
Result.AddPair('$defs', defs);
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.
+12 -25
View File
@@ -255,7 +255,7 @@ type
[AstDoc('A positional collection of elements (Vector).')]
[AstScriptExample('[1 2 3]')]
[AstScriptExample('["a" :b c]')]
[AstField(0, 'elements', fkNode)]
[AstField(0, 'elements', fkArrayOfNodes)]
ITupleNode = interface(IAstTypedNode)
{$region 'private'}
function GetElements: TArray<IAstNode>;
@@ -265,7 +265,7 @@ type
[AstTag('Field')]
[AstDoc('A single entry in a record literal.')]
[AstField(0, 'key', fkNode)]
[AstField(0, 'key', fkKeyword)]
[AstField(1, 'value', fkNode)]
IRecordFieldNode = interface(IAstNode)
{$region 'private'}
@@ -363,7 +363,8 @@ type
(do
(def x 10)
(assign x (* x 2))
x)
x
)
'''
)
]
@@ -379,7 +380,7 @@ type
[AstDoc('Declares a new variable in the current scope.')]
[AstScriptExample('(def x 10)')]
[AstScriptExample('(def y)')]
[AstField(0, 'target', fkNode)]
[AstField(0, 'target', fkIdentifier)]
[AstField(1, 'init', fkNullableNode)]
IVariableDeclarationNode = interface(IAstTypedNode)
{$region 'private'}
@@ -395,7 +396,7 @@ type
[AstTag('Assign')]
[AstDoc('Updates the value of an existing variable.')]
[AstScriptExample('(assign x 20)')]
[AstField(0, 'target', fkNode)]
[AstField(0, 'target', fkIdentifier)]
[AstField(1, 'value', fkNode)]
IAssignmentNode = interface(IAstTypedNode)
{$region 'private'}
@@ -408,15 +409,8 @@ type
[AstTag('Macro')]
[AstDoc('Defines a compile-time syntactic macro.')]
[
AstScriptExample(
'''
(defmacro unless [c b]
`(if ~c ... ~b))
'''
)
]
[AstField(0, 'name', fkNode)]
[AstScriptExample('(defmacro unless [c b] `(if ~c ... ~b))')]
[AstField(0, 'name', fkIdentifier)]
[AstField(1, 'params', fkTuple)]
[AstField(2, 'body', fkNode)]
IMacroDefinitionNode = interface(IAstTypedNode)
@@ -481,7 +475,7 @@ type
[AstDoc('Accesses a record field or stream member by key.')]
[AstScriptExample('(.price rec)')]
[AstField(0, 'base', fkNode)]
[AstField(1, 'member', fkNode)]
[AstField(1, 'member', fkKeyword)]
IMemberAccessNode = interface(IAstTypedNode)
{$region 'private'}
function GetBase: IAstNode;
@@ -562,16 +556,9 @@ type
[AstTag('Pipe')]
[AstDoc('Reactive pipeline from source streams to a transformation lambda.')]
[
AstScriptExample(
'''
(pipe [[src [:val]]]
(fn [v] {:res (* v 2)}))
'''
)
]
[AstField(0, 'inputs', fkTuple)]
[AstField(1, 'transform', fkNode)]
[AstScriptExample('(pipe [[src [:val]]] (fn [v] {:res (* v 2)}))')]
[AstField(0, 'inputs', fkPipeInputs)]
[AstField(1, 'transform', fkLambda)]
IPipeNode = interface(IAstTypedNode)
{$region 'private'}
function GetInputs: ITupleNode;